unikernel/duniverse/ppxlib/test/extensions_and_deriving/floating_attr/dune

@@ -0,0 +1,9 @@
+(executables
+ (names ppx)
+ (libraries ppxlib)
+ (preprocess
+  (pps ppxlib.metaquot)))
+
+(cram
+ (package ppxlib)
+ (deps ppx.exe))

unikernel/duniverse/ppxlib/test/extensions_and_deriving/floating_attr/ppx.ml

@@ -0,0 +1,50 @@
+open Ppxlib
+
+let () =
+  let open Context_free.Rule in
+  let open Ast_pattern in
+  let ghost =
+    object
+      inherit Ast_traverse.map
+      method! location loc = { loc with loc_ghost = true }
+    end
+  in
+  let make_str_attr name =
+    Attribute.Floating.declare name Structure_item (pstr __) (fun x -> x)
+  in
+  let make_sig_attr name =
+    Attribute.Floating.declare name Signature_item (psig __) (fun x -> x)
+  in
+  let expand_str ~ctxt:_ x = ghost#structure x in
+  let expand_sig ~ctxt:_ x = ghost#signature x in
+  let make_str name rule = rule (make_str_attr name) expand_str in
+  let make_sig name rule = rule (make_sig_attr name) expand_sig in
+  let rules =
+    [
+      make_str "identity_inline_expanded" attr_str_floating_expect_and_expand;
+      make_sig "identity_inline_expanded" attr_sig_floating_expect_and_expand;
+    ]
+  in
+  Driver.register_transformation "identity" ~rules
+
+let () =
+  let extractor = Ast_pattern.(single_expr_payload (estring __)) in
+  let expander ~loc ~path:_ s =
+    Ast_builder.Default.(estring ~loc (s ^ "_suffix"))
+  in
+  let extender =
+    Extension.declare "suffix" Extension.Context.Expression extractor expander
+  in
+  Driver.register_transformation "suffix"
+    ~rules:[ Context_free.Rule.extension extender ]
+
+let () =
+  let extractor = Ast_pattern.(pstr nil) in
+  let expander ~loc ~path:_ = [%type: string] in
+  let extender =
+    Extension.declare "str" Extension.Context.Core_type extractor expander
+  in
+  Driver.register_transformation "str"
+    ~rules:[ Context_free.Rule.extension extender ]
+
+let () = Driver.standalone ()

unikernel/duniverse/ppxlib/test/extensions_and_deriving/floating_attr/run-expand-inline.t

@@ -0,0 +1,140 @@
+Test `expand_inline` for structures.
+
+  $ cat << 'EOF' > program.ml
+  > [@@@expand_inline
+  >   module T : sig
+  >     val foo : [%str]
+  >   end = struct
+  >     let foo = [%suffix "apples"]
+  >   end]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -4,4 +4,5 @@
+     end = struct
+       let foo = [%suffix "apples"]
+     end]
+  +module T : sig val foo : string end = struct let foo = "apples_suffix" end
+   [@@@end]
+  [1]
+
+Test `expand_inline` for signatures.
+
+  $ cat << 'EOF' > program.ml
+  > module type S = sig
+  >   [@@@expand_inline:
+  >     val foo : [%str]
+  >     include module type of struct
+  >       let foo = [%suffix "apples"]
+  >     end]
+  >   [@@@end]
+  > end 
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -4,5 +4,8 @@
+       include module type of struct
+         let foo = [%suffix "apples"]
+       end]
+  -  [@@@end]
+  +  
+  +val foo : string
+  +include module type of struct let foo = "apples_suffix" end
+  +[@@@end]
+   end 
+  [1]
+
+Test (** ... *) comments get translated using {| |} syntax.
+
+  $ cat << 'EOF' > program.ml
+  > [@@@expand_inline 
+  > module T : sig
+  > (**foo*)
+  > val foo : [%str]
+  > end = struct
+  > (**bar*)
+  > let foo = [%suffix "apples"]
+  > end
+  > 
+  > (** baz *)
+  > 
+  > ]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -10,4 +10,7 @@
+   (** baz *)
+   
+   ]
+  +module T : sig val foo : string[@@ocaml.doc {|foo|}] end =
+  +  struct let foo = "apples_suffix"[@@ocaml.doc {|bar|}] end
+  +[@@@ocaml.text {| baz |}]
+   [@@@end]
+  [1]
+
+Test [@@ocaml.doc ...] attributes do not get swapped to using {| |}.
+
+  $ cat << 'EOF' > program.ml
+  > [@@@expand_inline 
+  > module T : sig
+  > val foo : [%str] [@@ocaml.doc "foo"]
+  > end = struct
+  > let foo = [%suffix "apples"] [@@ocaml.doc "foo"]
+  > end
+  > ]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -5,4 +5,6 @@
+   let foo = [%suffix "apples"] [@@ocaml.doc "foo"]
+   end
+   ]
+  +module T : sig val foo : string[@@ocaml.doc "foo"] end =
+  +  struct let foo = "apples_suffix"[@@ocaml.doc "foo"] end
+   [@@@end]
+  [1]
+
+Test the delim finding behaviour when translating (** ... *) comments to {| |} syntax.
+
+  $ cat << 'EOF' > program.ml
+  > [@@@expand_inline 
+  > (**blah blah |} blah blah*)
+  > let foo = [%suffix "apples"]
+  > ]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -2,4 +2,5 @@
+   (**blah blah |} blah blah*)
+   let foo = [%suffix "apples"]
+   ]
+  +let foo = "apples_suffix"[@@ocaml.doc {x|blah blah |} blah blah|x}]
+   [@@@end]
+  [1]
+
+  $ cat << 'EOF' > program.ml
+  > [@@@expand_inline 
+  > (**blxxx |} blaxxxxxxxxxh blxxahx*)
+  > let foo = [%suffix "apples"]
+  > ]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -2,4 +2,5 @@
+   (**blxxx |} blaxxxxxxxxxh blxxahx*)
+   let foo = [%suffix "apples"]
+   ]
+  +let foo = "apples_suffix"[@@ocaml.doc {x|blxxx |} blaxxxxxxxxxh blxxahx|x}]
+   [@@@end]
+  [1]

unikernel/duniverse/ppxlib/test/extensions_and_deriving/floating_attr/run-floating-attr.t

@@ -0,0 +1,48 @@
+Test `attr_str_floating_expect_and_expand` via `@@@identity_inline_expanded`.
+
+  $ cat << 'EOF' > program.ml
+  > [@@@identity_inline_expanded
+  >   module T : sig
+  >     val foo : [%str]
+  >   end = struct
+  >     let foo = [%suffix "apples"]
+  >   end]
+  > [@@@end]
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -4,4 +4,5 @@
+     end = struct
+       let foo = [%suffix "apples"]
+     end]
+  +module T : sig val foo : string end = struct let foo = "apples_suffix" end
+   [@@@end]
+  [1]
+
+Test `attr_sig_floating_expect_and_expand` via `@@@identity_inline_expanded`.
+
+  $ cat << 'EOF' > program.ml
+  > module type S = sig
+  >   [@@@identity_inline_expanded:
+  >     val foo : [%str]
+  >     include module type of struct
+  >       let foo = [%suffix "apples"]
+  >     end]
+  >   [@@@end]
+  > end 
+  > EOF
+  $ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
+  --- 
+  +++ 
+  @@ -4,5 +4,8 @@
+       include module type of struct
+         let foo = [%suffix "apples"]
+       end]
+  -  [@@@end]
+  +  
+  +val foo : string
+  +include module type of struct let foo = "apples_suffix" end
+  +[@@@end]
+   end 
+  [1]