feature(boot): strip let%expect_test (#13794)

allows us to write ppx_expect tests in more places without depending on
the ppx itself

As an example, add some unit tests for Dune_sexp.Escape. These will be
handy once we drop support for pre 4.14

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Author: rgrinberg

.github/workflows/workflow.yml

@@ -376,7 +376,7 @@ jobs:
         run: opam install --fake binaryen-bin
 
       - name: Install Wasm_of_ocaml
-        run: opam install "wasm_of_ocaml-compiler>=6.1" csexp pp re spawn uutf
+        run: opam install "wasm_of_ocaml-compiler>=6.1" csexp pp re spawn uutf ppx_expect
 
       - name: Set Git User
         run: |

bench.Dockerfile

@@ -1,4 +1,4 @@
 FROM ocaml/opam:debian-13-ocaml-5.4
-RUN opam install csexp pp re spawn uutf
+RUN opam install csexp pp re spawn uutf ppx_expect
 COPY --chown=opam:opam . bench-dir
 WORKDIR bench-dir

boot/bootstrap.ml

@@ -25,7 +25,8 @@ let keep_generated_files =
   !keep_generated_files
 ;;
 
-let modules = [ "boot/types"; "boot/libs"; "boot/duneboot" ]
+let pps = "boot/pps"
+let modules = pps :: [ "boot/types"; "boot/libs"; "boot/duneboot" ]
 let duneboot = ".duneboot"
 let prog = duneboot ^ ".exe"
 
@@ -40,6 +41,8 @@ let () =
   if not keep_generated_files
   then
     at_exit (fun () ->
+      (try Sys.remove "boot/pps.ml" with
+       | Sys_error _ -> ());
       Array.iter (Sys.readdir ".") ~f:(fun fn ->
         if
           String.length fn >= String.length duneboot
@@ -71,9 +74,9 @@ let read_file fn =
 
 let () =
   let v = Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun a b c -> a, b, c) in
-  let compiler, which =
+  let compiler, ocamllex, which =
     if v >= min_supported_natively
-    then "ocamlc", None
+    then "ocamlc", "ocamllex", None
     else (
       let compiler = "ocamlfind -toolchain secondary ocamlc" in
       let output_fn, out = Filename.open_temp_file "duneboot" "ocamlfind-output" in
@@ -95,8 +98,10 @@ let () =
              a
              b);
         exit 2);
-      compiler, Some "--secondary")
+      let ocamllex = "ocamlfind -toolchain secondary ocamllex" in
+      compiler, ocamllex, Some "--secondary")
   in
+  exit_if_non_zero (runf "%s -q -o %s %s" ocamllex (pps ^ ".ml") (pps ^ ".mll"));
   exit_if_non_zero
     (runf
        "%s %s -intf-suffix .dummy -g -o %s -I boot %sunix.cma %s"

boot/dune

@@ -31,6 +31,8 @@
  (action
   (diff libs.ml libs.ml.gen)))
 
+(ocamllex pps)
+
 (executable
  (name duneboot)
  (modules :standard \ configure bootstrap)

boot/duneboot.ml

@@ -539,24 +539,24 @@ module Io = struct
     | Ok s -> s
   ;;
 
-  let do_then_copy ~f a b =
+  let do_then_copy ~f ~pp a b =
     let s = read_file a in
     with_file_out b ~f:(fun oc ->
       f oc;
-      output_string oc s)
+      output_string oc (if pp then Pps.pp s else s))
   ;;
 
   (* copy a file - fails if the file exists *)
-  let copy a b = do_then_copy ~f:(fun _ -> ()) a b
+  let copy a b = do_then_copy ~pp:false ~f:(fun _ -> ()) a b
 
   (* copy a file and insert a header - fails if the file exists *)
-  let copy_with_header ~header a b =
-    do_then_copy ~f:(fun oc -> output_string oc header) a b
+  let copy_with_header ~pp ~header a b =
+    do_then_copy ~pp ~f:(fun oc -> output_string oc header) a b
   ;;
 
   (* copy a file and insert a directive - fails if the file exists *)
   let copy_with_directive ~directive a b =
-    do_then_copy ~f:(fun oc -> fprintf oc "#%s 1 %S\n" directive a) a b
+    do_then_copy ~pp:false ~f:(fun oc -> fprintf oc "#%s 1 %S\n" directive a) a b
   ;;
 
   let rec rm_rf fn =
@@ -1610,8 +1610,11 @@ module Library = struct
     | Header | C _ ->
       Io.copy_with_directive ~directive:"line" fn dst;
       Fiber.return [ mangled ]
-    | Ml { kind = `Ml | `Mli; _ } ->
-      Io.copy_with_header ~header fn dst;
+    | Ml { kind = `Mli; _ } ->
+      Io.copy_with_header ~pp:false ~header fn dst;
+      Fiber.return [ mangled ]
+    | Ml { kind = `Ml; _ } ->
+      Io.copy_with_header ~pp:true ~header fn dst;
       Fiber.return [ mangled ]
     | Ml { kind = `Mll; _ } -> copy_lexer fn dst ~header >>> Fiber.return [ mangled ]
     | Ml { kind = `Mly; _ } ->

boot/pps.mli

@@ -0,0 +1 @@
+val pp : string -> string

boot/pps.mll

@@ -0,0 +1,21 @@
+{
+  let b = Buffer.create 512
+}
+
+rule pp = parse
+ | "let%expect_test" { skip lexbuf }
+ | _ as c { Buffer.add_char b c; pp lexbuf }
+ | eof { () }
+
+and skip = parse
+  | ";;" { pp lexbuf }
+  | _ { skip lexbuf }
+  | eof { failwith "unterminated let%expect_test" }
+
+{
+  let pp s =
+    let lb = Lexing.from_string s in
+    Buffer.clear b;
+    pp lb;
+    Buffer.contents b
+}

ci/workflow.yml.in

@@ -375,7 +375,7 @@ jobs:
         run: opam install --fake binaryen-bin
 
       - name: Install Wasm_of_ocaml
-        run: opam install "wasm_of_ocaml-compiler>=6.1" csexp pp re spawn uutf
+        run: opam install "wasm_of_ocaml-compiler>=6.1" csexp pp re spawn uutf ppx_expect
 
       - name: Set Git User
         run: |

flake.nix

@@ -429,7 +429,9 @@
             buildInputs = with pkgs.ocamlPackages; [
               csexp
               pp
-              # re shouldn't be needed. this is an issue with the fmt rules
+              # Some additional dependencies are needed because formatting
+              # promoted files in boot/ requires building them first
+              ppx_expect
               re
               spawn
               uutf

src/dune_sexp/dune

@@ -1,6 +1,9 @@
 (library
  (name dune_sexp)
  (synopsis "[Internal] S-expression library")
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect))
  (libraries stdune uutf))
 
 (ocamllex lexer versioned_file_first_line)