unikernel/duniverse/ppxlib/test/driver/transformations/dune

@@ -0,0 +1,40 @@
+; The error-reporting format changed in 4.12; thus the expect-tests need to be duplicated
+
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (and
+   (>= %{ocaml_version} "4.08.0")
+   (< %{ocaml_version} "4.12.0")))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))
+
+; This runs expect-test on the same input test.ml but compares the .corrected
+; file to test_412.ml
+
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} "4.12.0"))
+ (deps
+  (:test test.ml)
+  (:t test_412.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run mv %{t} %{t}.old)
+    (run cp %{test} %{t})
+    (run expect-test %{t})
+    (run mv %{t}.old %{t})
+    (diff? %{t} %{t}.corrected)))))

unikernel/duniverse/ppxlib/test/driver/transformations/test.ml

@@ -0,0 +1,103 @@
+open Stdppx
+open Ppxlib
+
+
+(* Linters *)
+
+let lint = object
+  inherit [Driver.Lint_error.t list] Ast_traverse.fold as super
+
+  method! type_declaration td acc =
+    let acc = super#type_declaration td acc in
+    match td.ptype_kind with
+    | Ptype_record lds ->
+      if Poly.(<>)
+           (List.sort lds ~cmp:(fun a b -> String.compare a.pld_name.txt b.pld_name.txt))
+           lds
+      then
+        Driver.Lint_error.of_string { td.ptype_loc with loc_ghost = true }
+          "Fields are not sorted!"
+        :: acc
+      else
+        acc
+    | _ -> acc
+end
+let () =
+  Driver.register_transformation "lint" ~lint_impl:(fun st -> lint#structure st [])
+[%%expect{|
+val lint : Driver.Lint_error.t list Ast_traverse.fold = <obj>
+|}]
+
+type t =
+  { b : int
+  ; a : int
+  }
+[%%expect{|
+Line _, characters 0-36:
+Error (warning 22): Fields are not sorted!
+|}]
+
+
+(* Extension with a path argument *)
+
+let () =
+  Driver.register_transformation "plop"
+    ~rules:[Context_free.Rule.extension
+              (Extension.declare_with_path_arg "plop"
+                 Expression
+                 Ast_pattern.(pstr nil)
+                 (fun ~loc ~path:_ ~arg ->
+                    let open Ast_builder.Default in
+                    match arg with
+                    | None -> estring ~loc "-"
+                    | Some { loc; txt } -> estring ~loc (Longident.name txt)))]
+[%%expect{|
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
+[%%expect{|
+- : string = "-\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
+[%%expect{|
+- : string = "Truc\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
+[%%expect{|
+- : string = "Truc.Bidule\n"
+|}]
+
+
+(* Extension with a path argument and ctxt *)
+
+let () =
+  Driver.register_transformation "plop_ctxt"
+    ~rules:[Context_free.Rule.extension
+              (Extension.V3.declare_with_path_arg "plop_ctxt"
+                 Expression
+                 Ast_pattern.(pstr nil)
+                 (fun ~ctxt ~arg ->
+                    let open Ast_builder.Default in
+                    let loc = Expansion_context.Extension.extension_point_loc ctxt in
+                    match arg with
+                    | None -> estring ~loc "-"
+                    | Some { loc; txt } -> estring ~loc (Longident.name txt)))]
+[%%expect{|
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
+[%%expect{|
+- : string = "-\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
+[%%expect{|
+- : string = "Truc\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
+[%%expect{|
+- : string = "Truc.Bidule\n"
+|}]

unikernel/duniverse/ppxlib/test/driver/transformations/test_412.ml

@@ -0,0 +1,103 @@
+open Stdppx
+open Ppxlib
+
+
+(* Linters *)
+
+let lint = object
+  inherit [Driver.Lint_error.t list] Ast_traverse.fold as super
+
+  method! type_declaration td acc =
+    let acc = super#type_declaration td acc in
+    match td.ptype_kind with
+    | Ptype_record lds ->
+      if Poly.(<>)
+           (List.sort lds ~cmp:(fun a b -> String.compare a.pld_name.txt b.pld_name.txt))
+           lds
+      then
+        Driver.Lint_error.of_string { td.ptype_loc with loc_ghost = true }
+          "Fields are not sorted!"
+        :: acc
+      else
+        acc
+    | _ -> acc
+end
+let () =
+  Driver.register_transformation "lint" ~lint_impl:(fun st -> lint#structure st [])
+[%%expect{|
+val lint : Driver.Lint_error.t list Ast_traverse.fold = <obj>
+|}]
+
+type t =
+  { b : int
+  ; a : int
+  }
+[%%expect{|
+Line _, characters 0-36:
+Error (warning 22 [preprocessor]): Fields are not sorted!
+|}]
+
+
+(* Extension with a path argument *)
+
+let () =
+  Driver.register_transformation "plop"
+    ~rules:[Context_free.Rule.extension
+              (Extension.declare_with_path_arg "plop"
+                 Expression
+                 Ast_pattern.(pstr nil)
+                 (fun ~loc ~path:_ ~arg ->
+                    let open Ast_builder.Default in
+                    match arg with
+                    | None -> estring ~loc "-"
+                    | Some { loc; txt } -> estring ~loc (Longident.name txt)))]
+[%%expect{|
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop]
+[%%expect{|
+- : string = "-\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc]
+[%%expect{|
+- : string = "Truc\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop.Truc.Bidule]
+[%%expect{|
+- : string = "Truc.Bidule\n"
+|}]
+
+
+(* Extension with a path argument and ctxt *)
+
+let () =
+  Driver.register_transformation "plop_ctxt"
+    ~rules:[Context_free.Rule.extension
+              (Extension.V3.declare_with_path_arg "plop_ctxt"
+                 Expression
+                 Ast_pattern.(pstr nil)
+                 (fun ~ctxt ~arg ->
+                    let open Ast_builder.Default in
+                    let loc = Expansion_context.Extension.extension_point_loc ctxt in
+                    match arg with
+                    | None -> estring ~loc "-"
+                    | Some { loc; txt } -> estring ~loc (Longident.name txt)))]
+[%%expect{|
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt]
+[%%expect{|
+- : string = "-\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc]
+[%%expect{|
+- : string = "Truc\n"
+|}]
+
+let _ = Stdlib.Printf.sprintf "%s\n" [%plop_ctxt.Truc.Bidule]
+[%%expect{|
+- : string = "Truc.Bidule\n"
+|}]