unikernel/duniverse/ppxlib/test/driver/attributes/dune

@@ -0,0 +1,14 @@
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} "4.08.0"))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))

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

@@ -0,0 +1,264 @@
+open Ppxlib
+
+let () = Driver.enable_checks ()
+
+let x = 1 [@@foo]
+[%%expect{|
+Line _, characters 13-16:
+Error: Attribute `foo' was not used
+|}]
+
+let f x = 1 [@@deprecatd "..."]
+[%%expect{|
+Line _, characters 15-24:
+Error: Attribute `deprecatd' was not used.
+       Hint: Did you mean deprecated?
+|}]
+
+let attr : _ Attribute.t =
+  Attribute.declare "blah"
+    Attribute.Context.type_declaration
+    Ast_pattern.(__)
+    ignore
+[%%expect{|
+val attr : (type_declaration, unit) Attribute.t = <abstr>
+|}]
+
+type t = int [@blah]
+[%%expect{|
+Line _, characters 15-19:
+Error: Attribute `blah' was not used.
+       Hint: `blah' is available for type declarations but is used here in
+       the
+       context of a core type.
+       Did you put it at the wrong level?
+|}]
+
+let attr : _ Attribute.t =
+  Attribute.declare "blah"
+    Attribute.Context.expression
+    Ast_pattern.(__)
+    ignore
+[%%expect{|
+val attr : (expression, unit) Attribute.t = <abstr>
+|}]
+
+type t = int [@blah]
+[%%expect{|
+Line _, characters 15-19:
+Error: Attribute `blah' was not used.
+       Hint: `blah' is available for expressions and type declarations but is
+       used
+       here in the context of a core type.
+       Did you put it at the wrong level?
+|}]
+
+let _ = () [@blah]
+[%%expect{|
+Line _, characters 13-17:
+Error: Attribute `blah' was not used
+|}]
+
+(* Attribute drops *)
+
+let faulty_transformation = object
+  inherit Ast_traverse.map as super
+
+  method! expression e =
+    match e.pexp_desc with
+    | Pexp_constant c ->
+      Ast_builder.Default.pexp_constant ~loc:e.pexp_loc c
+    | _ -> super#expression e
+end
+[%%expect{|
+val faulty_transformation : Ast_traverse.map = <obj>
+|}]
+
+let () =
+  Driver.register_transformation "faulty" ~impl:faulty_transformation#structure
+
+let x = (42 [@foo])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `foo' was silently dropped
+|}]
+
+type t1 = < >
+type t2 = < t1 >
+type t3 = < (t1[@foo]) >
+[%%expect{|
+type t1 = <  >
+type t2 = <  >
+Line _, characters 17-20:
+Error: Attribute `foo' was not used
+|}]
+
+(* Reserved Namespaces *)
+
+(* ppxlib checks that unreserved attributes aren't dropped *)
+
+let x = (42 [@bar])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `bar' was silently dropped
+|}]
+
+let x = (42 [@bar.baz])
+[%%expect{|
+Line _, characters 14-21:
+Error: Attribute `bar.baz' was silently dropped
+|}]
+
+(* But reserving a namespace disables those checks. *)
+
+let () = Reserved_namespaces.reserve "bar"
+
+let x = (42 [@bar])
+let x = (42 [@bar.baz])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@bar_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-42:
+Error: Attribute `bar_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* The namespace reservation process understands dots as namespace
+   separators. *)
+
+let () = Reserved_namespaces.reserve "baz.qux"
+
+let x = (42 [@baz])
+[%%expect{|
+Line _, characters 14-17:
+Error: Attribute `baz' was silently dropped
+|}]
+
+let x = (42 [@baz.qux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux.quux])
+[%%expect{|
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux_not_proper_sub_namespace])
+[%%expect{|
+Line _, characters 14-46:
+Error: Attribute `baz.qux_not_proper_sub_namespace' was silently dropped
+|}]
+
+(* You can reserve multiple subnamespaces under the same namespace *)
+
+let () = Reserved_namespaces.reserve "baz.qux2"
+
+let x = (42 [@baz.qux])
+let x = (42 [@baz.qux2])
+[%%expect{|
+val x : int = 42
+val x : int = 42
+|}]
+
+let x = (42 [@baz.qux3])
+[%%expect{|
+Line _, characters 14-22:
+Error: Attribute `baz.qux3' was silently dropped
+|}]
+
+(* Testing flags *)
+
+let flag = Attribute.declare_flag "flag" Attribute.Context.expression
+[%%expect{|
+val flag : expression Attribute.flag = <abstr>
+|}]
+
+let extend name f =
+  let ext =
+    Extension.V3.declare
+      name
+      Expression
+      Ast_pattern.(single_expr_payload __)
+      (fun ~ctxt:_ e -> f e)
+  in
+  Driver.register_transformation name ~rules:[ Context_free.Rule.extension ext ]
+[%%expect{|
+val extend : string -> (expression -> expression) -> unit = <fun>
+|}]
+
+let () =
+  extend "flagged" (fun e ->
+    if Attribute.has_flag flag e
+    then e
+    else Location.raise_errorf ~loc:e.pexp_loc "flag not found")
+
+let e1 = [%flagged "Absent flag"]
+[%%expect{|
+Line _, characters 19-32:
+Error: flag not found
+|}]
+
+let e2 = [%flagged "Found flag" [@flag]]
+[%%expect{|
+val e2 : string = "Found flag"
+|}]
+
+let e3 = [%flagged "Misused flag" [@flag 12]]
+[%%expect{|
+Line _, characters 41-43:
+Error: [] expected
+|}]
+
+(* Testing attribute in trivial transformation *)
+
+open Ast_builder.Default
+
+let flagged e =
+  let loc = e.pexp_loc in
+  pexp_extension ~loc ({ loc; txt = "flagged" }, PStr [pstr_eval ~loc e []])
+[%%expect{|
+val flagged : expression -> expression = <fun>
+|}]
+
+let () = extend "simple" flagged
+
+let e = [%simple "flagged" [@flag]]
+[%%expect{|
+val e : string = "flagged"
+|}]
+
+(* When duplicating code, apply [ghost] to all but one copy. *)
+
+let ghost = object
+  inherit Ast_traverse.map
+  method! location l = { l with loc_ghost = true }
+end
+[%%expect{|
+val ghost : Ast_traverse.map = <obj>
+|}]
+
+(* Test attribute lookup in non-ghosted subexpression. *)
+
+let () =
+  extend "flag_alive" (fun e ->
+    pexp_tuple ~loc:e.pexp_loc [ flagged e; ghost#expression e ])
+
+let e = [%flag_alive "hello" [@flag]]
+[%%expect{|
+val e : string * string = ("hello", "hello")
+|}]
+
+(* Test attribute lookup in ghosted subexpression. *)
+
+let () =
+  extend "flag_ghost" (fun e ->
+    pexp_tuple ~loc:e.pexp_loc [ e; flagged (ghost#expression e) ])
+
+let e = [%flag_ghost "bye" [@flag]]
+[%%expect{|
+val e : string * string = ("bye", "bye")
+|}]

unikernel/duniverse/ppxlib/test/driver/compiler-pp/driver.ml

@@ -0,0 +1,34 @@
+open Ppxlib
+
+let existential ~loc =
+  let lident = { loc; txt = Longident.parse "Constructor" } in
+  let pattern =
+    {
+      ppat_loc = loc;
+      ppat_loc_stack = [];
+      ppat_attributes = [];
+      ppat_desc =
+        Ppat_construct (lident, Some ([ { loc; txt = "a" } ], [%pat? _]));
+    }
+  in
+  [%stri let f x = match x with [%p pattern] -> ()]
+
+let named_existential =
+  Context_free.Rule.extension
+    (Extension.V3.declare "named_existentials" Extension.Context.structure_item
+       Ast_pattern.(pstr nil)
+       (fun ~ctxt ->
+         let loc = Expansion_context.Extension.extension_point_loc ctxt in
+         existential ~loc))
+
+let () =
+  Driver.V2.register_transformation ~rules:[ named_existential ]
+    "named_existentials"
+
+let str_type_decl =
+  Deriving.Generator.V2.make_noarg (fun ~ctxt _type_decl ->
+      let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+      [ existential ~loc ])
+
+let _ = Deriving.add ~str_type_decl "named_existentials"
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/compiler-pp/dune

@@ -0,0 +1,16 @@
+(executable
+ (name driver)
+ (enabled_if
+  (and
+   (>= %{ocaml_version} "4.09")
+   (< %{ocaml_version} "4.13")))
+ (libraries ppxlib)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(cram
+ (enabled_if
+  (and
+   (>= %{ocaml_version} "4.09")
+   (< %{ocaml_version} "4.13")))
+ (deps driver.exe))

unikernel/duniverse/ppxlib/test/driver/compiler-pp/run.t

@@ -0,0 +1,65 @@
+The --use-compiler-pp flag can be used when using the driver's source code
+output, either directly when generating a .corrected file or to force
+printing the AST as source using the installed compiler's printer.
+
+Our driver has a deriver and an extension that produces a pattern-matching with
+named existentials.
+
+This feature has been introduced in 4.13 so the syntax is unsupported before that.
+
+If we run the driver in source output mode, without the `--use-compiler-pp` flag,
+it will successfully print out the source using the 4.13 syntax. If we're running
+on an older compiler, like we are for this test, that can be troublesome.
+
+If instead we use the flag, this will force the migration thus causing an error as
+named existentials can't be migrated down to 4.12.
+
+Let's consider the following file:
+
+  $ cat > test.ml << EOF
+  > [%%named_existentials]
+  > EOF
+
+Running the driver will generate a function with a single pattern matching in it:
+
+  $ ./driver.exe test.ml
+  let f x = match x with | Constructor (type a) _ -> ()
+
+Now if we run it with `--use-compiler-pp`, we should get the migration error:
+
+  $ ./driver.exe --use-compiler-pp test.ml
+  File "test.ml", line 1, characters 0-22:
+  1 | [%%named_existentials]
+      ^^^^^^^^^^^^^^^^^^^^^^
+  Error: migration error: existentials in pattern-matching is not supported before OCaml 4.13
+  [1]
+
+This should also work for correction based code gen:
+
+  $ cat > test_inline.ml << EOF
+  > type t = int
+  > [@@deriving_inline named_existentials]
+  > [@@@end]
+  > EOF
+
+If we run the driver without `--use-compiler-pp`:
+
+  $ ./driver.exe test_inline.ml -diff-cmd -
+  type t = int[@@deriving_inline named_existentials]
+  [@@@end ]
+  $ cat test_inline.ml.ppx-corrected
+  type t = int
+  [@@deriving_inline named_existentials]
+  let _ = fun (_ : t) -> ()
+  let f x = match x with | Constructor (type a) _ -> ()
+  let _ = f
+  [@@@end]
+
+and with the flag:
+
+  $ ./driver.exe test_inline.ml -diff-cmd - --use-compiler-pp
+  File "test_inline.ml", lines 1-2, characters 0-38:
+  1 | type t = int
+  2 | [@@deriving_inline named_existentials]
+  Error: migration error: existentials in pattern-matching is not supported before OCaml 4.13
+  [1]

unikernel/duniverse/ppxlib/test/driver/error_embedding/dune

@@ -0,0 +1,7 @@
+(executables
+ (names raiser pp)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (deps raiser.exe pp.exe))

unikernel/duniverse/ppxlib/test/driver/error_embedding/pp.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Location.raise_errorf "Raising inside the preprocessor"

unikernel/duniverse/ppxlib/test/driver/error_embedding/raiser.ml

@@ -0,0 +1,13 @@
+open Ppxlib
+
+let rule =
+  let expand ~loc ~path:_ =
+    Location.raise_errorf ~loc "Raising inside the rewriter"
+  in
+  Extension.declare "raise" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+let () = Driver.register_transformation ~rules:[ rule ] "test"
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/error_embedding/test.t/run.t

@@ -0,0 +1,54 @@
+Keep the error output short in order to avoid different error output between
+different compiler versions in the subsequent tests
+
+  $ export OCAML_ERROR_STYLE=short
+
+With the `-embed-errors` options, if a PPX raises, the first such exception
+is caught and prepended to the last valid AST
+
+  $ echo "let _ = [%raise]" > impl.ml
+  $ ../raiser.exe -embed-errors impl.ml
+  let _ = [%ocaml.error "Raising inside the rewriter"]
+
+The same is true when using the `-as-ppx` mode (note that the error is reported
+by ocaml itself)
+
+  $ ocaml -ppx '../raiser.exe -as-ppx' impl.ml
+  File "./impl.ml", line 1, characters 8-16:
+  Error: Raising inside the rewriter
+  [2]
+
+Also exceptions raised in a preprocessor get embedded into an AST(while the
+error from the preprocessor's stderr also gets reported on the driver's stderr)
+
+  $ touch file.ml
+  $ ../raiser.exe -embed-errors -pp ../pp.exe file.ml | sed "s/> '.*'/> tmpfile/"
+  Fatal error: exception Raising inside the preprocessor
+  [%%ocaml.error
+    "Error while running external preprocessor\nCommand line: ../pp.exe 'file.ml' > tmpfile\n"]
+
+Also `unknown version` errors are embedded into an AST when using the
+main standalone
+
+  $ ../raiser.exe -embed-errors -intf unknown_version_binary_ast
+  [%%ocaml.error
+    "File is a binary ast for an unknown version of OCaml with magic number 'Caml1999N012'"]
+
+... but the `-as-ppx` standalone raises them
+
+  $ ../raiser.exe -as-ppx unknown_version_binary_ast output
+  File "unknown_version_binary_ast", line 1:
+  Error: The input is a binary ast for an unknown version of OCaml with magic number 'Caml1999N012'
+  [1]
+
+Similar for 'input doesn't exist' errors: they get embedded by the main standalone...
+
+  $ ../raiser.exe -embed-errors -impl non_existing_file
+  [%%ocaml.error "I/O error: non_existing_file: No such file or directory"]
+
+... but not by the `-as-ppx` standalone
+
+  $ ../raiser.exe -as-ppx non_existing_file output
+  File "non_existing_file", line 1:
+  Error: I/O error: non_existing_file: No such file or directory
+  [1]

unikernel/duniverse/ppxlib/test/driver/exception_handling/constant_type.ml

@@ -0,0 +1,13 @@
+open Ppxlib
+
+let kind = Context_free.Rule.Constant_kind.Integer
+
+let rewriter loc s =
+  Location.raise_errorf ~loc
+    "A raised located error in the constant rewriting transformation." s
+
+let rule = Context_free.Rule.constant kind 'g' rewriter;;
+
+Driver.register_transformation ~rules:[ rule ] "constant"
+
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/deriver.ml

@@ -0,0 +1,59 @@
+open Ppxlib
+
+let generate_impl_extension_node ~ctxt (_rec_flag, _type_declarations) =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  let extension_node =
+    Location.error_extensionf ~loc "An error message in an extension node"
+  in
+  [ Ast_builder.Default.pstr_extension ~loc extension_node [] ]
+
+let generate_impl_located_error ~ctxt (_rec_flag, _type_declarations) =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  Location.raise_errorf ~loc "A raised located error"
+
+let generate_impl_located_error2 ~ctxt (_rec_flag, _type_declarations) =
+  let loc = Expansion_context.Deriver.derived_item_loc ctxt in
+  Location.raise_errorf ~loc "A second raised located error"
+
+let generate_impl_raised_exception ~ctxt:_ (_rec_flag, _type_declarations) =
+  failwith "A raised exception"
+
+let generate_impl_raised_exception2 ~ctxt:_ (_rec_flag, _type_declarations) =
+  failwith "A Second raised exception"
+
+let impl_generator_extension_node =
+  Deriving.Generator.V2.make_noarg generate_impl_extension_node
+
+let impl_generator_located_error =
+  Deriving.Generator.V2.make_noarg generate_impl_located_error
+
+let impl_generator_located_error2 =
+  Deriving.Generator.V2.make_noarg generate_impl_located_error2
+
+let impl_generator_raised_exception =
+  Deriving.Generator.V2.make_noarg generate_impl_raised_exception
+
+let impl_generator_raised_exception2 =
+  Deriving.Generator.V2.make_noarg generate_impl_raised_exception2
+
+let _ =
+  Deriving.add "deriver_extension_node"
+    ~str_type_decl:impl_generator_extension_node
+
+let _ =
+  Deriving.add "deriver_located_error"
+    ~str_type_decl:impl_generator_located_error
+
+let _ =
+  Deriving.add "deriver_located_error2"
+    ~str_type_decl:impl_generator_located_error2
+
+let _ =
+  Deriving.add "deriver_raised_exception"
+    ~str_type_decl:impl_generator_raised_exception
+
+let _ =
+  Deriving.add "deriver_raised_exception2"
+    ~str_type_decl:impl_generator_raised_exception2
+
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/dune

@@ -0,0 +1,23 @@
+(executables
+ (names
+  whole_file_exception
+  whole_file_extension_point
+  whole_file_located_error
+  extender
+  deriver
+  whole_file_multiple_errors
+  constant_type
+  special_functions)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (deps
+  extender.exe
+  whole_file_exception.exe
+  whole_file_located_error.exe
+  deriver.exe
+  whole_file_extension_point.exe
+  whole_file_multiple_errors.exe
+  constant_type.exe
+  special_functions.exe))

unikernel/duniverse/ppxlib/test/driver/exception_handling/extender.ml

@@ -0,0 +1,50 @@
+open Ppxlib
+
+let expand_into_extension_node ~ctxt =
+  let loc = Expansion_context.Extension.extension_point_loc ctxt in
+  let extension_node =
+    Location.error_extensionf ~loc "An error message in an extension node"
+  in
+  Ast_builder.Default.pexp_extension ~loc extension_node
+
+let expand_raise_exception ~ctxt:_ = failwith "A raised exception"
+
+let expand_raise_located_error ~ctxt =
+  let loc = Expansion_context.Extension.extension_point_loc ctxt in
+  Location.raise_errorf ~loc "A raised located error"
+
+let expand_raise_located_error2 ~ctxt =
+  let loc = Expansion_context.Extension.extension_point_loc ctxt in
+  Location.raise_errorf ~loc "A second raised located error"
+
+let extension_point_extension =
+  Extension.V3.declare "gen_ext_node" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand_into_extension_node
+
+let raise_exception_extension =
+  Extension.V3.declare "gen_raise_exc" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand_raise_exception
+
+let raise_located_error_extension =
+  Extension.V3.declare "gen_raise_located_error" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand_raise_located_error
+
+let raise_located_error_extension2 =
+  Extension.V3.declare "gen_raise_located_error2" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand_raise_located_error2
+
+let rule1 = Ppxlib.Context_free.Rule.extension extension_point_extension
+let rule2 = Ppxlib.Context_free.Rule.extension raise_exception_extension
+let rule3 = Ppxlib.Context_free.Rule.extension raise_located_error_extension
+let rule4 = Ppxlib.Context_free.Rule.extension raise_located_error_extension2
+
+let () =
+  Driver.register_transformation
+    ~rules:[ rule1; rule2; rule3; rule4 ]
+    "gen_errors"
+
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/run.t

@@ -0,0 +1,231 @@
+In this test we verify the behavior of ppxlib with regard to rewriters
+error generations. We test both extenders, derivers and whole file
+rewriters.
+
+There is mainly three way for ppxs to handle errors, from best to
+worst practice:
+
+1. Putting an "error extension node" in the AST. In this test, the AST
+is rewritten to contain two of these nodes.
+
+ In the case of extenders
+
+  $ echo "let _ = [%gen_ext_node] + [%gen_ext_node]" > impl.ml
+  $ ./extender.exe impl.ml
+  let _ =
+    ([%ocaml.error "An error message in an extension node"]) +
+      ([%ocaml.error "An error message in an extension node"])
+
+ In the case of derivers
+
+  $ echo "type a = int [@@deriving deriver_extension_node]" > impl.ml
+  $ ./deriver.exe impl.ml
+  type a = int[@@deriving deriver_extension_node]
+  include
+    struct
+      let _ = fun (_ : a) -> ()
+      [%%ocaml.error "An error message in an extension node"]
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+ In the case of whole file transformations:
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ ./whole_file_extension_point.exe impl.ml
+  [%%ocaml.error "An error message in an extension node"]
+
+(Note that Merlin will notify all errors, while the compiler only
+notifies the first.)
+
+2. Raising a located error. In these tests, such an error is raised
+during the rewritting of the AST. By default, the exception is not
+caught, so no AST is produced.
+
+ In the case of extenders:
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ echo "let _ = [%gen_raise_located_error]" >> impl.ml
+  $ echo "let _ = [%gen_raise_located_error2]" >> impl.ml
+  $ export OCAML_ERROR_STYLE=short
+
+ when the -embed-errors flag is not passed  
+  $ ./extender.exe impl.ml
+  File "impl.ml", line 2, characters 8-34:
+  Error: A raised located error
+  [1]
+
+
+ when the -embed-errors flag is  passed
+  $ ./extender.exe -embed-errors impl.ml
+  let x = 1 + 1.
+  let _ = [%ocaml.error "A raised located error"]
+  let _ = [%ocaml.error "A second raised located error"]
+
+ In the case of derivers
+
+  $ echo "type a = int" > impl.ml
+  $ echo "type b = int [@@deriving deriver_located_error]" >> impl.ml
+  $ echo "type c = int [@@deriving deriver_located_error2]" >> impl.ml
+
+ when the -embed-errors flag is not passed  
+  $ ./deriver.exe impl.ml
+  File "impl.ml", line 2, characters 0-47:
+  Error: A raised located error
+  [1]
+
+ when the -embed-errors flag is  passed
+  $ ./deriver.exe -embed-errors impl.ml
+  type a = int
+  type b = int[@@deriving deriver_located_error]
+  [%%ocaml.error "A raised located error"]
+  type c = int[@@deriving deriver_located_error2]
+  [%%ocaml.error "A second raised located error"]
+
+ In the case of whole file transformations:
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ ./whole_file_located_error.exe impl.ml
+  File "impl.ml", line 1, characters 0-12:
+  Error: A located error in a whole file transform
+  [1]
+
+When the argument `-embed-errors` is added, the exception is caught
+and the whole AST is prepended with an error extension node.
+
+ In the case of extenders:
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ echo "let _ = [%gen_raise_located_error]" >> impl.ml
+  $ echo "let _ = [%gen_raise_located_error2]" >> impl.ml
+
+when the -embed-errors flag is not passed
+  $ ./extender.exe impl.ml
+  File "impl.ml", line 2, characters 8-34:
+  Error: A raised located error
+  [1]
+
+ when the -embed-errors flag is  passed 
+  $ ./extender.exe -embed-errors impl.ml
+  let x = 1 + 1.
+  let _ = [%ocaml.error "A raised located error"]
+  let _ = [%ocaml.error "A second raised located error"]
+
+ In the case of derivers
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ echo "type a = int" >> impl.ml
+  $ echo "type b = int [@@deriving deriver_located_error]" >> impl.ml
+  $ echo "type b = int [@@deriving deriver_located_error2]" >> impl.ml
+ 
+ when the -embed-errors flag is not passed 
+  $ ./deriver.exe impl.ml
+  File "impl.ml", line 3, characters 0-47:
+  Error: A raised located error
+  [1]
+ when the -embed-errors flag is passed 
+  $ ./deriver.exe -embed-errors impl.ml
+  let x = 1 + 1.
+  type a = int
+  type b = int[@@deriving deriver_located_error]
+  [%%ocaml.error "A raised located error"]
+  type b = int[@@deriving deriver_located_error2]
+  [%%ocaml.error "A second raised located error"]
+
+ In the case of whole file transformations:
+
+  $ echo "let x = 1+1. " > impl.ml
+  $ ./whole_file_located_error.exe -embed-errors impl.ml
+  [%%ocaml.error "A located error in a whole file transform"]
+  let x = 1 + 1.
+
+3. Raising an exception. The exception is not caught by the driver.
+
+ In the case of extensions:
+
+  $ echo "let _ = [%gen_raise_exc] + [%gen_raise_exc]" > impl.ml
+  $ ./extender.exe impl.ml
+  Fatal error: exception Failure("A raised exception")
+  [2]
+  $ ./extender.exe -embed-errors impl.ml
+  Fatal error: exception Failure("A raised exception")
+  [2]
+
+ In the case of derivers
+
+  $ echo "type a = int" > impl.ml
+  $ echo "type b = int [@@deriving deriver_raised_exception]" >> impl.ml
+  $ echo "type b = int [@@deriving deriver_raised_exception2]" >> impl.ml
+  $ ./deriver.exe -embed-errors impl.ml
+  Fatal error: exception Failure("A raised exception")
+  [2]
+
+ In the case of Constant types
+
+  $ echo "let x = 2g + 3g" > impl.ml
+  $ echo "let x = 2g + 3g" >> impl.ml
+
+ When embed-errors is not passed 
+  $ ./constant_type.exe impl.ml
+  File "impl.ml", line 1, characters 8-10:
+  Error: A raised located error in the constant rewriting transformation.
+  [1]
+
+ When embed-errors is not passed
+  $ ./constant_type.exe -embed-errors impl.ml
+  let x =
+    ([%ocaml.error
+       "A raised located error in the constant rewriting transformation."])
+      +
+      ([%ocaml.error
+         "A raised located error in the constant rewriting transformation."])
+  let x =
+    ([%ocaml.error
+       "A raised located error in the constant rewriting transformation."])
+      +
+      ([%ocaml.error
+         "A raised located error in the constant rewriting transformation."])
+
+ In the case of Special functions
+
+  $ echo "let x1 = n_args" > impl.ml
+  $ echo "let x2 = n_args2" >> impl.ml
+ When embed-errors is not passed 
+  $ ./special_functions.exe impl.ml
+  File "impl.ml", line 1, characters 9-15:
+  Error: error special function
+  [1]
+
+ When embed-errors is not passed
+  $ ./special_functions.exe -embed-errors impl.ml
+  let x1 = [%ocaml.error "error special function"]
+  let x2 = [%ocaml.error "second error special function"]
+
+ In the case of whole file transformations:
+
+  $ echo "let _ = [%gen_raise_exc] + [%gen_raise_exc]" > impl.ml
+  $ ./whole_file_exception.exe impl.ml
+  Fatal error: exception Failure("An exception in a whole file transform")
+  [2]
+  $ ./whole_file_exception.exe -embed-errors impl.ml
+  Fatal error: exception Failure("An exception in a whole file transform")
+  [2]
+
+
+4. Reporting Multiple Exceptions
+
+When the `-embed-error` flag is not set, exceptions stop the rewriting process. Therefore, only the first exception is reported to the user
+  $ ./whole_file_multiple_errors.exe impl.ml
+  File "impl.ml", line 1, characters 0-43:
+  Error: Raising a located exception during the first instrumentation phase
+  [1]
+
+When the `-embed-error` flag is set, located exceptions thrown during the rewriting process are caught, and collected. The "throwing transformations" are ignored. After all transformations have been applied, the collected errors are appended at the beginning of the AST.
+  $ echo 'let () = print_endline "Hello, World!" ' > impl.ml
+  $ ./whole_file_multiple_errors.exe -embed-errors impl.ml
+  [%%ocaml.error
+    "Raising a located exception during the first instrumentation phase"]
+  [%%ocaml.error
+    "Raising a located exception during the Global transformation phase"]
+  [%%ocaml.error
+    "Raising a located exception during the Last instrumentation phase"]
+  let () = print_endline "Hello, World!"
+

unikernel/duniverse/ppxlib/test/driver/exception_handling/special_functions.ml

@@ -0,0 +1,13 @@
+open Ppxlib
+
+let expand e = Location.raise_errorf ~loc:e.pexp_loc "error special function"
+
+let expand2 e =
+  Location.raise_errorf ~loc:e.pexp_loc "second error special function"
+
+let rule = Context_free.Rule.special_function "n_args" expand
+let rule2 = Context_free.Rule.special_function "n_args2" expand2;;
+
+Driver.register_transformation ~rules:[ rule; rule2 ] "special_function_demo"
+
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/whole_file_exception.ml

@@ -0,0 +1,9 @@
+open Ppxlib
+
+let () =
+  Driver.V2.(
+    register_transformation
+      ~impl:(fun _ _ -> failwith "An exception in a whole file transform")
+      "raise_exc")
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/whole_file_extension_point.ml

@@ -0,0 +1,18 @@
+open Ppxlib
+
+let () =
+  Driver.V2.(
+    register_transformation
+      ~impl:(fun ctxt str ->
+        let loc =
+          match str with
+          | [] -> Location.in_file (Expansion_context.Base.input_name ctxt)
+          | hd :: _ -> hd.pstr_loc
+        in
+        let extension_node =
+          Location.error_extensionf ~loc "An error message in an extension node"
+        in
+        [ Ast_builder.Default.pstr_extension ~loc extension_node [] ])
+      "raise_exc")
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/whole_file_located_error.ml

@@ -0,0 +1,15 @@
+open Ppxlib
+
+let () =
+  Driver.V2.(
+    register_transformation
+      ~impl:(fun ctxt str ->
+        let loc =
+          match str with
+          | [] -> Location.in_file (Expansion_context.Base.input_name ctxt)
+          | hd :: _ -> hd.pstr_loc
+        in
+        Location.raise_errorf ~loc "A located error in a whole file transform")
+      "raise_exc")
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/exception_handling/whole_file_multiple_errors.ml

@@ -0,0 +1,46 @@
+open Ppxlib
+
+let () =
+  let instrument =
+    let transformation ctxt str =
+      let loc =
+        match str with
+        | [] -> Location.in_file (Expansion_context.Base.input_name ctxt)
+        | hd :: _ -> hd.pstr_loc
+      in
+      Location.raise_errorf ~loc
+        "Raising a located exception during the first instrumentation phase"
+    in
+    Driver.Instrument.V2.make ~position:Driver.Instrument.Before transformation
+  in
+  Driver.V2.(register_transformation ~instrument "a_raise_exc")
+
+let () =
+  Driver.V2.(
+    register_transformation
+      ~impl:(fun ctxt str ->
+        let loc =
+          match str with
+          | [] -> Location.in_file (Expansion_context.Base.input_name ctxt)
+          | hd :: _ -> hd.pstr_loc
+        in
+        Location.raise_errorf ~loc
+          "Raising a located exception during the Global transformation phase")
+      "b_raise_exc_second")
+
+let () =
+  let instrument =
+    let transformation ctxt str =
+      let loc =
+        match str with
+        | [] -> Location.in_file (Expansion_context.Base.input_name ctxt)
+        | hd :: _ -> hd.pstr_loc
+      in
+      Location.raise_errorf ~loc
+        "Raising a located exception during the Last instrumentation phase"
+    in
+    Driver.Instrument.V2.make ~position:Driver.Instrument.After transformation
+  in
+  Driver.V2.(register_transformation ~instrument "c_raise_exc")
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/flag_cookie/dune

@@ -0,0 +1,9 @@
+(executable
+ (name print_cookie_driver)
+ (libraries ppxlib)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(cram
+ (package ppxlib)
+ (deps print_cookie_driver.exe))

unikernel/duniverse/ppxlib/test/driver/flag_cookie/print_cookie_driver.ml

@@ -0,0 +1,33 @@
+open Ppxlib
+
+let value_x = ref ""
+
+let f = function
+  | Some value_of_x ->
+      value_x := Printf.sprintf "Value of cookie x: %i" value_of_x
+  | None -> value_x := "Cookie x isn't set."
+
+let () = Ppxlib.Driver.Cookies.(add_simple_handler ~f "x" Ast_pattern.(eint __))
+
+let print_cookie_x =
+  object
+    inherit Ast_traverse.map as super
+
+    method! structure str =
+      let new_str =
+        List.fold_left
+          (fun acc str_item ->
+            match str_item with
+            | [%stri [@@@print_cookie_x]] ->
+                let _ = print_endline !value_x in
+                acc
+            | _ -> str_item :: acc)
+          [] str
+      in
+      super#structure (List.rev new_str)
+  end
+
+let () =
+  Driver.register_transformation ~impl:print_cookie_x#structure "test_cookies"
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/flag_cookie/run.t

@@ -0,0 +1,10 @@
+The cookie flag is taken into account, both by the main standalone
+
+  $ echo "[@@@print_cookie_x]" > impl.ml
+  $ ./print_cookie_driver.exe -cookie x=1 impl.ml
+  Value of cookie x: 1
+
+...and by the `-as-ppx` standalone
+
+  $ ocaml -ppx './print_cookie_driver.exe --as-ppx -cookie x=1' impl.ml
+  Value of cookie x: 1

unikernel/duniverse/ppxlib/test/driver/instrument/dune

@@ -0,0 +1,14 @@
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} "4.08.0"))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))

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

@@ -0,0 +1,36 @@
+open Ppxlib
+
+let extend_list_by name = object
+  inherit Ast_traverse.map as super
+
+  method! expression e =
+    match e.pexp_desc with
+    | Pexp_construct ({txt = Lident "[]"; _}, None) -> Ast_builder.Default.elist ~loc:e.pexp_loc [Ast_builder.Default.estring ~loc:e.pexp_loc name]
+    | _ -> super#expression e
+end
+[%%expect{|
+val extend_list_by : string -> Ast_traverse.map = <fun>
+|}]
+
+let () =
+  let name = "a: instr pos=Before" in
+  let transform = extend_list_by name in
+  Driver.(register_transformation ~instrument:(Instrument.make ~position:Before transform#structure) name)
+
+let () =
+  let name = "b: instr pos=After" in
+  let transform = extend_list_by name in
+  Driver.(register_transformation ~instrument:(Instrument.make ~position:After transform#structure) name)
+
+let () =
+  let name = "c: impl" in
+  let transform = extend_list_by name in
+  Driver.register_transformation ~impl:transform#structure name
+
+(* The order of the list should only depend on how the rewriters got registered,
+   not on the alphabetic order of the names they got registered with. *)
+let x = []
+[%%expect{|
+val x : string list =
+  ["a: instr pos=Before"; "c: impl"; "b: instr pos=After"]
+|}]

unikernel/duniverse/ppxlib/test/driver/keywords-option/driver.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/keywords-option/dune

@@ -0,0 +1,11 @@
+(executable
+ (name driver)
+ (enabled_if
+  (>= %{ocaml_version} "5.3"))
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (>= %{ocaml_version} "5.3"))
+ (deps driver.exe))

unikernel/duniverse/ppxlib/test/driver/keywords-option/run.t

@@ -0,0 +1,38 @@
+This test can only work with OCaml 5.3 or higher.
+
+OCaml 5.3 introduced the new `effect` keyword. To allow old code to compile
+under 5.3 it also introduced a `-keyword=version+list` CLI option, allowing one to
+override the set of keywords.
+
+The ppxlib driver also has such an option now to properly configure the lexer before
+attempting to parse source code.
+
+Let's consider the following source file:
+
+  $ cat > test.ml << EOF
+  > let effect = 1
+  > EOF
+
+If passed to the driver as is, it will trigger a parse error:
+
+  $ ./driver.exe --impl test.ml -o ignore.ml
+  File "test.ml", line 1, characters 4-10:
+  1 | let effect = 1
+          ^^^^^^
+  Error: Syntax error
+  [1]
+
+Now, if we use the 5.2 set of keywords, it should happily handle the file:
+
+  $ ./driver.exe --keywords 5.2 --impl test.ml -o ignore.ml
+
+It can also be set using OCAMLPARAM:
+
+  $ OCAMLPARAM=_,keywords=5.2 ./driver.exe --impl test.ml -o ignore.ml
+
+The priority between the CLI option and OCAMLPARAM must be respected, therefore
+both of the following invocation should parse:
+
+  $ OCAMLPARAM=_,keywords=5.2 ./driver.exe --keywords 5.3 --impl test.ml -o ignore.ml
+
+  $ OCAMLPARAM=keywords=5.3,_ ./driver.exe --keywords 5.2 --impl test.ml -o ignore.ml

unikernel/duniverse/ppxlib/test/driver/non-compressible-suffix/dune

@@ -0,0 +1,14 @@
+(rule
+ (package ppxlib)
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} "4.08.0"))
+ (deps
+  (:test test.ml)
+  (package ppxlib))
+ (action
+  (chdir
+   %{project_root}
+   (progn
+    (run expect-test %{test})
+    (diff? %{test} %{test}.corrected)))))

unikernel/duniverse/ppxlib/test/driver/non-compressible-suffix/test.ml

@@ -0,0 +1,35 @@
+open Ppxlib;;
+open Ast_builder.Default;;
+
+Driver.register_transformation "blah"
+  ~rules:[ Context_free.Rule.extension
+             (Extension.declare "foo"
+                Expression
+                Ast_pattern.(pstr nil)
+                (fun ~loc ~path:_ -> eint ~loc 42))
+         ; Context_free.Rule.extension
+             (Extension.declare "@foo.bar"
+                Expression
+                Ast_pattern.(pstr nil)
+                (fun ~loc ~path:_ -> eint ~loc 42))
+         ]
+;;
+[%%expect{|
+- : unit = ()
+|}]
+
+[%foo];;
+[%%expect{|
+- : int = 42
+|}]
+
+[%foo.bar];;
+[%%expect{|
+- : int = 42
+|}]
+
+[%bar];;
+[%%expect{|
+Line _, characters 2-5:
+Error: Uninterpreted extension 'bar'.
+|}]

unikernel/duniverse/ppxlib/test/driver/ocaml-ppx-context-load-path-migration/driver.ml

@@ -0,0 +1,92 @@
+module To_before_502 =
+  Ppxlib_ast.Convert (Ppxlib_ast.Js) (Ppxlib_ast__.Versions.OCaml_501)
+
+module From_before_502 =
+  Ppxlib_ast.Convert (Ppxlib_ast__.Versions.OCaml_501) (Ppxlib_ast.Js)
+
+module Before_502_to_ocaml =
+  Ppxlib_ast.Convert
+    (Ppxlib_ast__.Versions.OCaml_501)
+    (Ppxlib_ast.Compiler_version)
+
+module OCaml_501 = Ppxlib_ast__.Versions.OCaml_501.Ast
+
+let rec unfold_list_lit x next =
+  let open OCaml_501.Parsetree in
+  let open Astlib.Longident in
+  match next.pexp_desc with
+  | Pexp_construct ({ txt = Lident "[]"; _ }, None) -> [ x ]
+  | Pexp_construct
+      ( { txt = Lident "::"; _ },
+        Some { pexp_desc = Pexp_tuple [ elm; rest ]; _ } ) ->
+      x :: unfold_list_lit elm rest
+  | _ -> invalid_arg "list_lit"
+
+(* Only deals with the basic blocks needed for ocaml.ppx.context *)
+let rec basic_expr_to_string expr =
+  let open OCaml_501.Parsetree in
+  let open Astlib.Longident in
+  match expr.pexp_desc with
+  | Pexp_constant (Pconst_string (s, _, None)) -> Printf.sprintf "%S" s
+  | Pexp_ident { txt = Lident name; _ } -> name
+  | Pexp_tuple l ->
+      let strs = List.map basic_expr_to_string l in
+      "(" ^ String.concat ", " strs ^ ")"
+  | Pexp_construct ({ txt = Lident s; _ }, None) -> s
+  | Pexp_construct
+      ( { txt = Lident "::"; _ },
+        Some { pexp_desc = Pexp_tuple [ elm; rest ]; _ } ) ->
+      let exprs = unfold_list_lit elm rest in
+      let strs = List.map basic_expr_to_string exprs in
+      "[" ^ String.concat "; " strs ^ "]"
+  | _ -> invalid_arg "basic_expr_to_string"
+
+let print_field (lident_loc, expr) =
+  match lident_loc with
+  | { OCaml_501.Asttypes.txt = Astlib.Longident.Lident name; _ } ->
+      Printf.printf "    %s: %s;\n" name (basic_expr_to_string expr)
+  | _ -> ()
+
+let print_ocaml_ppx_context stri =
+  let open OCaml_501.Parsetree in
+  match stri.pstr_desc with
+  | Pstr_attribute
+      {
+        attr_payload =
+          PStr
+            [
+              {
+                pstr_desc =
+                  Pstr_eval ({ pexp_desc = Pexp_record (fields, None); _ }, _);
+                _;
+              };
+            ];
+        _;
+      } ->
+      Printf.printf "[@@@ocaml.ppx.context\n";
+      Printf.printf "  {\n";
+      List.iter print_field fields;
+      Printf.printf "  }\n";
+      Printf.printf "]\n"
+  | _ -> ()
+
+let is_ppx_context stri =
+  let open OCaml_501.Parsetree in
+  match stri.pstr_desc with
+  | Pstr_attribute
+      { attr_name = { OCaml_501.Asttypes.txt = "ocaml.ppx.context"; _ }; _ } ->
+      true
+  | _ -> false
+
+let impl _ctxt str =
+  let before_502_ast = To_before_502.copy_structure str in
+  let ppx_context = List.find is_ppx_context before_502_ast in
+  Printf.printf "ocaml.ppx.context before 5.02:\n";
+  print_ocaml_ppx_context ppx_context;
+  let round_trip = Before_502_to_ocaml.copy_structure_item ppx_context in
+  Printf.printf "ocaml.ppx.context round tripped:\n";
+  Ocaml_common.Pprintast.structure_item Format.std_formatter round_trip;
+  str
+
+let () = Ppxlib.Driver.V2.register_transformation ~impl "ocaml.ppx.context-test"
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/ocaml-ppx-context-load-path-migration/dune

@@ -0,0 +1,16 @@
+(executable
+ (name driver)
+ (enabled_if
+  (>= %{ocaml_version} "5.2"))
+ (libraries
+  ppxlib
+  ppxlib.ast
+  ppxlib.astlib
+  ocaml-compiler-libs.common
+  compiler-libs.common))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (>= %{ocaml_version} "5.2"))
+ (deps driver.exe))

unikernel/duniverse/ppxlib/test/driver/ocaml-ppx-context-load-path-migration/run.t

@@ -0,0 +1,73 @@
+In 5.2 the format of ocaml.ppx.context load_path changed.
+To ensure compat, we defined migration for ocaml.ppx.context attributes
+
+We write such an attribute to an .ml file. The compiler will add its own
+and it should be consumed by the driver but our handwritten attribute will
+be migrated as well and should remain in the AST.
+  $ cat > test.ml << EOF
+  > let x = 1
+  > [@@@ocaml.ppx.context
+  >   {
+  >     tool_name = "ocaml";
+  >     include_dirs = ["foo"];
+  >     hidden_include_dirs = [];
+  >     load_path = (["foo"; "bar"], ["baz"]);
+  >     open_modules = [];
+  >     for_package = None;
+  >     debug = true;
+  >     use_threads = false;
+  >     use_vmthreads = false;
+  >     recursive_types = false;
+  >     principal = false;
+  >     transparent_modules = false;
+  >     unboxed_types = false;
+  >     unsafe_string = false;
+  >     cookies = []
+  >   }]
+  > EOF
+
+We then run a custom driver that will read our ast, migrate it back to 5.01,
+pretty print the ocaml.ppx.context, convert it back to the latest version and
+pretty print it again. This last, round-tripped version should be identical to
+the one above.
+
+  $ ./driver.exe --impl test.ml -o ignore.ml
+  ocaml.ppx.context before 5.02:
+  [@@@ocaml.ppx.context
+    {
+      tool_name: "ocaml";
+      include_dirs: ["foo"];
+      hidden_include_dirs: [];
+      load_path: ["foo"; "bar"; "baz"];
+      open_modules: [];
+      for_package: None;
+      debug: true;
+      use_threads: false;
+      use_vmthreads: false;
+      recursive_types: false;
+      principal: false;
+      transparent_modules: false;
+      unboxed_types: false;
+      unsafe_string: false;
+      cookies: [];
+    }
+  ]
+  ocaml.ppx.context round tripped:
+  [@@@ocaml.ppx.context
+    {
+      tool_name = "ocaml";
+      include_dirs = ["foo"];
+      hidden_include_dirs = [];
+      load_path = (["foo"; "bar"], ["baz"]);
+      open_modules = [];
+      for_package = None;
+      debug = true;
+      use_threads = false;
+      use_vmthreads = false;
+      recursive_types = false;
+      principal = false;
+      transparent_modules = false;
+      unboxed_types = false;
+      unsafe_string = false;
+      cookies = []
+    }]

unikernel/duniverse/ppxlib/test/driver/parse_error_locations/dune

@@ -0,0 +1,7 @@
+(executable
+ (name identity_standalone)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (deps identity_standalone.exe))

unikernel/duniverse/ppxlib/test/driver/parse_error_locations/identity_standalone.ml

@@ -0,0 +1 @@
+let _ = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/parse_error_locations/run.t

@@ -0,0 +1,15 @@
+Keep the error output short in order to avoid different error output between
+different compiler versions in the subsequent test
+
+  $ export OCAML_ERROR_STYLE=short
+
+Syntax errors in files parsed by ppxlib are reported correctly
+
+  $ cat > test.ml << EOF
+  > let x = 5
+  > let let
+  > EOF
+  $ ./identity_standalone.exe -impl test.ml
+  File "test.ml", line 2, characters 4-7:
+  Error: Syntax error
+  [1]

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/dune

@@ -0,0 +1,9 @@
+(executable
+ (name print_greetings)
+ (libraries ppxlib)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(cram
+ (package ppxlib)
+ (deps print_greetings.exe))

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/print_greetings.ml

@@ -0,0 +1,20 @@
+open Ppxlib
+
+let hi_rule =
+  let expand ~loc ~path:_ = [%expr print_endline "hi"] in
+  Extension.declare "print_hi" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+let bye_rule =
+  let expand ~loc ~path:_ = [%expr print_endline "bye"] in
+  Extension.declare "print_bye" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+(* the two rules need to be registered separately in order to test the `-apply` flag in run.t *)
+let () = Driver.register_transformation ~rules:[ hi_rule ] "print_hi"
+let () = Driver.register_transformation ~rules:[ bye_rule ] "print_bye"
+let () = Ppxlib.Driver.run_as_ppx_rewriter ()

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/run.t

@@ -0,0 +1,92 @@
+Keep the error output short in order to avoid different error output between
+different compiler versions in the subsequent tests
+
+  $ export OCAML_ERROR_STYLE=short
+
+The registered rewriters get applied when using `run_as_ppx_rewriter` as entry point
+
+  $ cat > file.ml << EOF
+  > let () = [%print_hi]
+  > let () = [%print_bye]
+  > EOF
+  $ ocaml -ppx './print_greetings.exe' file.ml
+  hi
+  bye
+
+The driver's `shared_args` are taken into account, such as `-apply`...
+
+  $ ocaml -ppx './print_greetings.exe -apply print_hi' file.ml
+  hi
+  File "./file.ml", line 2, characters 11-20:
+  Error: Uninterpreted extension 'print_bye'.
+  [2]
+
+... and `-check`
+
+  $ echo "[@@@attr non_registered_attr]" > attribute_file.ml
+  $ ocaml -ppx './print_greetings.exe -check' attribute_file.ml
+  File "./attribute_file.ml", line 1, characters 4-8:
+  Error: Attribute `attr' was not used
+  [2]
+
+
+If a non-compatible file gets fed, the file name is reported correctly
+
+  $ touch no_binary_ast.ml
+  $ ./print_greetings.exe no_binary_ast.ml some_output
+  File "no_binary_ast.ml", line 1:
+  Error: Expected a binary AST as input
+  [1]
+
+The only possible usage is [extra_args] <infile> <outfile>...
+
+  $ ./print_greetings.exe some_input
+  Usage: print_greetings.exe [extra_args] <infile> <outfile>
+  [2]
+
+...in particular the order between the flags and the input/output matters.
+
+  $ touch some_output
+  $ ./print_greetings.exe some_input some_output -check
+  ./print_greetings.exe: anonymous arguments not accepted.
+  print_greetings.exe [extra_args] <infile> <outfile>
+    -loc-filename <string>      File name to use in locations
+    -reserve-namespace <string> Mark the given namespace as reserved
+    -no-check                   Disable checks (unsafe)
+    -check                      Enable checks
+    -no-check-on-extensions     Disable checks on extension point only
+    -check-on-extensions        Enable checks on extension point only
+    -no-locations-check         Disable locations check only
+    -locations-check            Enable locations check only
+    -apply <names>              Apply these transformations in order (comma-separated list)
+    -dont-apply <names>         Exclude these transformations
+    -no-merge                   Do not merge context free transformations (better for debugging rewriters). As a result, the context-free transformations are not all applied before all impl and intf.
+    -cookie NAME=EXPR           Set the cookie NAME to EXPR
+    --cookie                    Same as -cookie
+    -raise-embedded-errors      Raise the first embedded error found in the processed AST
+    -allow-deriving-end         Whether to allow [@@@deriving.end], which will soon be deprecated.
+    -help                       Display this list of options
+    --help                      Display this list of options
+  [2]
+
+The only exception is consulting help
+
+  $ ./print_greetings.exe -help
+  print_greetings.exe [extra_args] <infile> <outfile>
+    -loc-filename <string>      File name to use in locations
+    -reserve-namespace <string> Mark the given namespace as reserved
+    -no-check                   Disable checks (unsafe)
+    -check                      Enable checks
+    -no-check-on-extensions     Disable checks on extension point only
+    -check-on-extensions        Enable checks on extension point only
+    -no-locations-check         Disable locations check only
+    -locations-check            Enable locations check only
+    -apply <names>              Apply these transformations in order (comma-separated list)
+    -dont-apply <names>         Exclude these transformations
+    -no-merge                   Do not merge context free transformations (better for debugging rewriters). As a result, the context-free transformations are not all applied before all impl and intf.
+    -cookie NAME=EXPR           Set the cookie NAME to EXPR
+    --cookie                    Same as -cookie
+    -raise-embedded-errors      Raise the first embedded error found in the processed AST
+    -allow-deriving-end         Whether to allow [@@@deriving.end], which will soon be deprecated.
+    -help                       Display this list of options
+    --help                      Display this list of options

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/dune

@@ -0,0 +1,20 @@
+(executable
+ (name identity_standalone)
+ (libraries ppxlib)
+ (modules identity_standalone))
+
+(executable
+ (name print_magic_number)
+ (libraries astlib)
+ (modules print_magic_number))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (or
+   (= %{system} linux)
+   (= %{system} linux_elf)
+   (= %{system} elf)
+   (= %{system} linux_eabihf)
+   (= %{system} linux_eabi)))
+ (deps identity_standalone.exe print_magic_number.exe))

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/identity_standalone.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Driver.run_as_ppx_rewriter ()

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/print_magic_number.ml

@@ -0,0 +1,5 @@
+let magic_length = String.length Astlib.Config.ast_impl_magic_number
+let buf = Bytes.create magic_length
+let len = input stdin buf 0 magic_length
+let s = Bytes.sub_string buf 0 len
+let () = Printf.printf "Magic number: %s" s

unikernel/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/run.t

@@ -0,0 +1,8 @@
+Binary AST's of any by ppxlib supported OCaml version are supported.
+The version is preserved.
+
+  $ cat 408_binary_ast | ../print_magic_number.exe
+  Magic number: Caml1999M025
+
+  $ ../identity_standalone.exe 408_binary_ast /dev/stdout | ../print_magic_number.exe
+  Magic number: Caml1999M025

unikernel/duniverse/ppxlib/test/driver/skip-hash-bang/dune

@@ -0,0 +1,12 @@
+(library
+ (name empty_rewriter)
+ (modules empty_rewriter)
+ (kind ppx_rewriter)
+ (libraries ppxlib))
+
+(tests
+ (package ppxlib)
+ (names test test2)
+ (modules test test2)
+ (preprocess
+  (pps empty_rewriter)))

unikernel/duniverse/ppxlib/test/driver/skip-hash-bang/test.expected

@@ -0,0 +1 @@
+OK

unikernel/duniverse/ppxlib/test/driver/skip-hash-bang/test.ml

@@ -0,0 +1,3 @@
+#!ignored_line
+
+let () = print_endline "OK"

unikernel/duniverse/ppxlib/test/driver/skip-hash-bang/test2.expected

@@ -0,0 +1 @@
+OK

unikernel/duniverse/ppxlib/test/driver/skip-hash-bang/test2.ml

@@ -0,0 +1,3 @@
+#!ignored line
+
+let () = print_endline "OK"

unikernel/duniverse/ppxlib/test/driver/source-quotation-in-errors/dune

@@ -0,0 +1,15 @@
+(executable
+ (name raising_driver)
+ (modules raising_driver)
+ (libraries ppxlib))
+
+(executable
+ (name identity_driver)
+ (modules identity_driver)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (>= %{ocaml_version} "4.08.0"))
+ (deps raising_driver.exe identity_driver.exe))

unikernel/duniverse/ppxlib/test/driver/source-quotation-in-errors/identity_driver.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/source-quotation-in-errors/raising_driver.ml

@@ -0,0 +1,14 @@
+open Ppxlib
+
+let rules =
+  [
+    Extension.V3.declare "raise" Extension.Context.expression
+      Ast_pattern.(pstr nil)
+      (fun ~ctxt ->
+        let loc = Expansion_context.Extension.extension_point_loc ctxt in
+        Location.raise_errorf ~loc "An exception, raise be!")
+    |> Context_free.Rule.extension;
+  ]
+
+let () = Driver.V2.register_transformation ~rules "raise"
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/source-quotation-in-errors/run.t

@@ -0,0 +1,45 @@
+When the ppxlib driver reports an error by itself, source quotation should work
+properly.
+
+We start off by explicitly setting the error reporting style to contextual to
+ensure source quotation is enabled:
+
+  $ export OCAML_ERROR_STYLE=contextual
+
+Here we have a driver compiled with a single rule that will raise a located
+exception for every "[%raise]" extension point.
+
+We need an input file:
+
+  $ cat > file.ml << EOF
+  > let x = [%raise]
+  > EOF
+
+When running the driver on this file, it should report the error and show
+the relevant quoted source:
+
+  $ ./raising_driver.exe -impl file.ml
+  File "file.ml", line 1, characters 8-16:
+  1 | let x = [%raise]
+              ^^^^^^^^
+  Error: An exception, raise be!
+  [1]
+
+This should also work when the input is a binary AST as the file contains the name
+of the original source file. Our driver should be able to properly set the input
+lexbuf and get the source quotation to work, assuming the information in the binary
+AST file is correct.
+
+Here we use an identity driver to generate the binary AST for our .ml file above:
+
+  $ ./identity_driver.exe -impl file.ml -dump-ast -o file.pp.ml 
+
+We then call our raising driver on the binary AST, it should be able to report the
+error with source quotation:
+
+  $ ./raising_driver.exe -impl file.pp.ml
+  File "file.ml", line 1, characters 8-16:
+  1 | let x = [%raise]
+              ^^^^^^^^
+  Error: An exception, raise be!
+  [1]

unikernel/duniverse/ppxlib/test/driver/standalone-supports-old-binary-ast/dune

@@ -0,0 +1,20 @@
+(executable
+ (name identity_standalone)
+ (libraries ppxlib)
+ (modules identity_standalone))
+
+(executable
+ (name print_magic_number)
+ (libraries astlib)
+ (modules print_magic_number))
+
+(cram
+ (package ppxlib)
+ (enabled_if
+  (or
+   (= %{system} linux)
+   (= %{system} linux_elf)
+   (= %{system} elf)
+   (= %{system} linux_eabihf)
+   (= %{system} linux_eabi)))
+ (deps identity_standalone.exe print_magic_number.exe))

unikernel/duniverse/ppxlib/test/driver/standalone-supports-old-binary-ast/identity_standalone.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/standalone-supports-old-binary-ast/print_magic_number.ml

@@ -0,0 +1,5 @@
+let magic_length = String.length Astlib.Config.ast_impl_magic_number
+let buf = Bytes.create magic_length
+let len = input stdin buf 0 magic_length
+let s = Bytes.sub_string buf 0 len
+let () = Printf.printf "Magic number: %s" s

unikernel/duniverse/ppxlib/test/driver/standalone-supports-old-binary-ast/test.t/run.t

@@ -0,0 +1,10 @@
+Binary AST's of any by ppxlib supported OCaml version are supported.
+The version is preserved.
+
+  $ cat 408_binary_ast | ../print_magic_number.exe
+  Magic number: Caml1999N025
+
+  $ ../identity_standalone.exe --intf 408_binary_ast -o transformed --dump-ast
+
+  $ ../print_magic_number.exe < transformed
+  Magic number: Caml1999N025

unikernel/duniverse/ppxlib/test/driver/standalone_run_as_ppx/dune

@@ -0,0 +1,7 @@
+(executable
+ (name print_stuff)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (deps print_stuff.exe))

unikernel/duniverse/ppxlib/test/driver/standalone_run_as_ppx/print_stuff.ml

@@ -0,0 +1,45 @@
+open Ppxlib
+
+let mk_expression ~loc pexp_desc =
+  { pexp_desc; pexp_loc_stack = []; pexp_loc = loc; pexp_attributes = [] }
+
+let print_string s ~loc =
+  let print_exp =
+    mk_expression ~loc (Pexp_ident { txt = Lident "print_endline"; loc })
+  in
+  let string_exp =
+    mk_expression ~loc (Pexp_constant (Pconst_string (s, loc, None)))
+  in
+  mk_expression ~loc (Pexp_apply (print_exp, [ (Nolabel, string_exp) ]))
+
+let hi_rule =
+  let expand ~loc ~path:_ = print_string "hi" ~loc in
+  Extension.declare "print_hi" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+let tool_name_rule =
+  let expand ~ctxt =
+    let loc = Expansion_context.Extension.extension_point_loc ctxt in
+    let tool_name = Expansion_context.Extension.tool_name ctxt in
+    print_string tool_name ~loc
+  in
+  Extension.V3.declare "print_tool_name" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+let fname_rule =
+  let expand ~loc ~path:_ = print_string ~loc loc.loc_start.pos_fname in
+  Extension.declare "print_fname" Extension.Context.expression
+    Ast_pattern.(pstr nil)
+    expand
+  |> Context_free.Rule.extension
+
+let () =
+  Driver.register_transformation
+    ~rules:[ hi_rule; tool_name_rule; fname_rule ]
+    "test"
+
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/standalone_run_as_ppx/run.t

@@ -0,0 +1,37 @@
+Keep the error output short in order to avoid different error output between different compiler versions in the subsequent tests
+
+  $ export OCAML_ERROR_STYLE=short
+
+The rewriter gets applied when using `--as-ppx`
+
+  $ echo "let _ = [%print_hi]" > impl.ml
+  $ ocaml -ppx './print_stuff.exe --as-ppx' impl.ml
+  hi
+
+If a non-compatible file gets fed, the file name is reported correctly
+
+  $ touch no_binary_ast.ml
+  $ ./print_stuff.exe --as-ppx no_binary_ast.ml some_output
+  File "no_binary_ast.ml", line 1:
+  Error: Expected a binary AST as input
+  [1]
+
+The ocaml.ppx.context attribute gets parsed correctly; in particular, the tool name gets set correctly
+
+  $ echo "let _ = [%print_tool_name]" > impl.ml
+  $ ocaml -ppx './print_stuff.exe --as-ppx' impl.ml
+  ocaml
+
+The driver's `shared_args` arguments are taken into account. For example, `-loc-filename`
+
+  $ echo "let _ = [%print_fname]" > impl.ml
+  $ ocaml -ppx './print_stuff.exe --as-ppx -loc-filename new_fn.ml' impl.ml
+  new_fn.ml
+
+or `dont-apply`
+
+  $ echo "let _ = [%print_hi]" > impl.ml
+  $ ocaml -ppx './print_stuff.exe --as-ppx -dont-apply test' impl.ml
+  File "./impl.ml", line 1, characters 10-18:
+  Error: Uninterpreted extension 'print_hi'.
+  [2]

unikernel/duniverse/ppxlib/test/driver/stdin_input/dune

@@ -0,0 +1,7 @@
+(executable
+ (name identity_driver)
+ (libraries ppxlib))
+
+(cram
+ (package ppxlib)
+ (deps identity_driver.exe))

unikernel/duniverse/ppxlib/test/driver/stdin_input/identity_driver.ml

@@ -0,0 +1 @@
+let () = Ppxlib.Driver.standalone ()

unikernel/duniverse/ppxlib/test/driver/stdin_input/test.t/run.t

@@ -0,0 +1,20 @@
+The driver can read from stdin.
+
+It works with sources...
+
+  $ ../identity_driver.exe -impl - << EOF
+  > let a = 1
+  > EOF
+  let a = 1
+
+... but it should also work with binary ASTs.
+We generate a binary AST file...
+
+  $ ../identity_driver.exe --dump-ast -o binary_ast -impl - << EOF
+  > let b = 2
+  > EOF
+
+... and ensure the driver can also read it from stdin
+
+  $ cat binary_ast | ../identity_driver.exe -impl -
+  let b = 2

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"
+|}]