unikernel/duniverse/ppxlib/test/expansion_context/dune

@@ -0,0 +1,19 @@
+(library
+ (name register_print_ctxt)
+ (modules register_print_ctxt)
+ (kind ppx_rewriter)
+ (libraries stdppx ppxlib))
+
+(executable
+ (name standalone_print_ctxt)
+ (modules standalone_print_ctxt)
+ (libraries ppxlib register_print_ctxt))
+
+(executable
+ (name map_structure_print_ctxt)
+ (modules map_structure_print_ctxt)
+ (libraries ppxlib register_print_ctxt))
+
+(cram
+ (package ppxlib)
+ (deps standalone_print_ctxt.exe map_structure_print_ctxt.exe))

unikernel/duniverse/ppxlib/test/expansion_context/map_structure_print_ctxt.ml

@@ -0,0 +1,9 @@
+open Ppxlib
+
+let set_filename (lexbuf : Lexing.lexbuf) ~filename =
+  { lexbuf with lex_curr_p = { lexbuf.lex_curr_p with pos_fname = filename } }
+
+let _ =
+  Lexing.from_channel stdin
+  |> set_filename ~filename:"lexbuf_pos_fname"
+  |> Parse.implementation |> Driver.map_structure

unikernel/duniverse/ppxlib/test/expansion_context/register_print_ctxt.ml

@@ -0,0 +1,45 @@
+open Stdppx
+open Ppxlib
+
+let pprint_ctxt ctxt =
+  let tool_name = Expansion_context.Base.tool_name ctxt in
+  let input_name = Expansion_context.Base.input_name ctxt in
+  let file_path =
+    Code_path.file_path @@ Expansion_context.Base.code_path @@ ctxt
+  in
+  Printf.printf "tool_name: %s\ninput_name: %s\nfile_path: %s\n" tool_name
+    input_name file_path
+
+let side_print_ctxt =
+  object
+    inherit Ast_traverse.map_with_expansion_context_and_errors as super
+
+    method! structure ctxt st =
+      pprint_ctxt ctxt;
+      super#structure ctxt st
+
+    method! signature ctxt sg =
+      pprint_ctxt ctxt;
+      super#signature ctxt sg
+  end
+
+let () =
+  Driver.V2.(
+    register_transformation
+      ~impl:(fun ctxt structure ->
+        let structure, errors = side_print_ctxt#structure ctxt structure in
+        List.map errors ~f:(fun error ->
+            Ast_builder.Default.pstr_extension
+              ~loc:(Location.Error.get_location error)
+              (Location.Error.to_extension error)
+              [])
+        @ structure)
+      ~intf:(fun ctxt signature ->
+        let signature, errors = side_print_ctxt#signature ctxt signature in
+        List.map errors ~f:(fun error ->
+            Ast_builder.Default.psig_extension
+              ~loc:(Location.Error.get_location error)
+              (Location.Error.to_extension error)
+              [])
+        @ signature)
+      "print_ctxt")

unikernel/duniverse/ppxlib/test/expansion_context/run.t

@@ -0,0 +1,39 @@
+The three context fields can be accessed in a rewriter, both from within an implementation file
+
+  $ echo "let x = 0" > file.ml
+  $ ./standalone_print_ctxt.exe file.ml | grep -E 'tool_name|input_name|file_path'
+  tool_name: ppx_driver
+  input_name: file.ml
+  file_path: file.ml
+
+and from within an interface file
+
+  $ echo "val x : int" > file.mli
+  $ ./standalone_print_ctxt.exe file.mli | grep -E 'tool_name|input_name|file_path'
+  tool_name: ppx_driver
+  input_name: file.mli
+  file_path: file.mli
+
+In most cases, the input name and the file path coincide. But there are some exceptions, such as
+1. empty files
+
+  $ touch empty_file.ml
+  $ ./standalone_print_ctxt.exe empty_file.ml | grep -E 'input_name|file_path'
+  input_name: empty_file.ml
+  file_path: 
+
+2. files with directives pointing to other files
+
+  $ cat > directive.ml << EOF
+  > # 1 "file.ml"
+  > let y = 0
+  > EOF
+  $ ./standalone_print_ctxt.exe directive.ml | grep -E 'input_name|file_path'
+  input_name: directive.ml
+  file_path: file.ml
+
+3. using `map_structure` (or `map_signature`)
+
+  $ echo "let x = 0" | ./map_structure_print_ctxt.exe | grep -E 'input_name|file_path'
+  input_name: _none_
+  file_path: lexbuf_pos_fname

unikernel/duniverse/ppxlib/test/expansion_context/standalone_print_ctxt.ml

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