unikernel/duniverse/ppxlib/test/deriving/dune

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

unikernel/duniverse/ppxlib/test/deriving/inline/example/dune

@@ -0,0 +1,9 @@
+(library
+ (name ppx_deriving_example)
+ (preprocess
+  (pps ppx_foo_deriver)))
+
+(alias
+ (package ppxlib)
+ (name runtest)
+ (deps ppx_deriving_example.cma))

unikernel/duniverse/ppxlib/test/deriving/inline/example/ppx_deriving_example.ml

@@ -0,0 +1,16 @@
+type t = A [@@deriving_inline foo]
+
+include struct
+  [@@@ocaml.warning "-60"]
+
+  let _ = fun (_ : t) -> ()
+
+  module Foo = struct end
+
+  let _ =
+    ();
+    ();
+    [%foo]
+end [@@ocaml.doc "@inline"]
+
+[@@@inline.end]

unikernel/duniverse/ppxlib/test/deriving/inline/foo-deriver/dune

@@ -0,0 +1,5 @@
+(library
+ (package ppxlib)
+ (kind ppx_deriver)
+ (name ppx_foo_deriver)
+ (libraries ppxlib))

unikernel/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml

@@ -0,0 +1,99 @@
+open Ppxlib
+open Ast_builder.Default
+
+(*
+   [[@@deriving foo]] expands to:
+   {[
+     module Foo = struct end
+
+     let _ = (); (); [%foo]
+   ]}
+
+   and then [[%foo]] expands to ["foo"].
+*)
+
+let add_deriver () =
+  let str_type_decl =
+    Deriving.Generator.make_noarg
+      (fun ~loc ~path:_ _ ->
+        let expr desc : expression =
+          {
+            pexp_desc = desc;
+            pexp_loc = loc;
+            pexp_attributes = [];
+            pexp_loc_stack = [];
+          }
+        in
+        [
+          {
+            pstr_loc = loc;
+            pstr_desc =
+              Pstr_module
+                {
+                  pmb_loc = loc;
+                  pmb_name = { loc; txt = Some "Foo" };
+                  pmb_expr =
+                    {
+                      pmod_loc = loc;
+                      pmod_desc = Pmod_structure [];
+                      pmod_attributes = [];
+                    };
+                  pmb_attributes = [];
+                };
+          };
+          {
+            pstr_loc = loc;
+            pstr_desc =
+              Pstr_value
+                ( Nonrecursive,
+                  [
+                    {
+                      pvb_pat =
+                        {
+                          ppat_desc = Ppat_any;
+                          ppat_loc = loc;
+                          ppat_attributes = [];
+                          ppat_loc_stack = [];
+                        };
+                      pvb_expr =
+                        esequence ~loc
+                          [
+                            eunit ~loc;
+                            eunit ~loc;
+                            expr
+                              (Pexp_extension ({ loc; txt = "foo" }, PStr []));
+                          ];
+                      pvb_attributes = [];
+                      pvb_loc = loc;
+                      pvb_constraint = None;
+                    };
+                  ] );
+          };
+        ])
+      ~attributes:[]
+  in
+  let sig_type_decl =
+    Deriving.Generator.make_noarg (fun ~loc ~path decl ->
+        ignore loc;
+        ignore path;
+        ignore decl;
+        [])
+  in
+  Deriving.add "foo" ~str_type_decl ~sig_type_decl
+
+let () =
+  Driver.register_transformation "foo"
+    ~rules:
+      [
+        Context_free.Rule.extension
+          (Extension.declare "foo" Expression Ast_pattern.__
+             (fun ~loc ~path:_ _payload ->
+               {
+                 pexp_desc = Pexp_constant (Pconst_string ("foo", loc, None));
+                 pexp_loc = loc;
+                 pexp_attributes = [];
+                 pexp_loc_stack = [];
+               }));
+      ]
+
+let (_ : Deriving.t) = add_deriver ()

unikernel/duniverse/ppxlib/test/deriving/test.ml

@@ -0,0 +1,101 @@
+open Ppxlib
+
+
+let foo =
+  Deriving.add "foo"
+    ~str_type_decl:(Deriving.Generator.make_noarg
+                      (fun ~loc ~path:_ _ -> [%str let foo = 42]))
+    ~sig_type_decl:(Deriving.Generator.make_noarg
+                      (fun ~loc ~path:_ _ -> [%sig: val foo : int]))
+[%%expect{|
+val foo : Deriving.t = <abstr>
+|}]
+
+let bar =
+  Deriving.add "bar"
+    ~str_type_decl:(Deriving.Generator.make_noarg
+                      ~deps:[foo]
+                      (fun ~loc ~path:_ _ -> [%str let bar = foo + 1]))
+[%%expect{|
+val bar : Deriving.t = <abstr>
+|}]
+
+let mtd =
+  Deriving.add "mtd"
+    ~sig_module_type_decl:(
+      Deriving.Generator.make_noarg
+        (fun ~loc ~path:_ _ -> [%sig: val y : int]))
+    ~str_module_type_decl:(
+      Deriving.Generator.make_noarg
+        (fun ~loc ~path:_ _ -> [%str let y = 42]))
+[%%expect{|
+val mtd : Deriving.t = <abstr>
+|}]
+
+let cd =
+  Deriving.add "cd"
+    ~sig_class_type_decl:(Deriving.Generator.make_noarg (fun ~loc ~path:_ _ -> [%sig: val y : int]))
+    ~str_class_type_decl:(Deriving.Generator.make_noarg (fun ~loc ~path:_ _ -> [%str let y = 42]))
+[%%expect{|
+val cd : Deriving.t = <abstr>
+|}]
+
+type t = int [@@deriving bar, foo]
+[%%expect{|
+Line _, characters 25-33:
+Error: Deriver foo is needed for bar, you need to add it before in the list
+|}]
+
+type nonrec int = int [@@deriving foo, bar]
+[%%expect{|
+type nonrec int = int
+val foo : int = 42
+val bar : int = 43
+|}]
+
+module type Foo_sig = sig
+  type t [@@deriving foo]
+end
+[%%expect{|
+module type Foo_sig = sig type t val foo : int end
+|}]
+
+module type X = sig end [@@deriving mtd]
+[%%expect{|
+module type X = sig end
+val y : int = 42
+|}]
+
+module Y : sig
+  module type X = sig end [@@deriving mtd]
+end = struct
+  module type X = sig end
+  let y = 42
+end
+[%%expect{|
+module Y : sig module type X = sig end val y : int end
+|}]
+
+class type x = object end[@@deriving cd]
+[%%expect{|
+class type x = object  end
+val y : int = 42
+|}]
+
+
+let mbmd =
+  Deriving.add "mbmd"
+    ~sig_module_decl:(Deriving.Generator.make_noarg (fun ~loc ~path:_ _ -> [%sig: val y : int]))
+    ~str_module_binding:(Deriving.Generator.make_noarg (fun ~loc ~path:_ _ -> [%str let y = 42]))
+
+[%%expect{|
+val mbmd : Deriving.t = <abstr>
+|}]
+
+module X = struct
+  type t
+end[@@deriving mbmd]
+[%%expect{|
+module X : sig type t end
+val y : int = 42
+|}]