2026-03-02 11:01.22: New job: test ocaml-ppx/ppxlib https://github.com/ocaml-ppx/ppxlib.git#refs/pull/629/head (51fb44d0bd133b6658a939ee098b9a09c78df740) (windows-x86_64:windows-server-mingw-ltsc2025-5.4_opam-2.5)
Base: ocaml/opam:windows-server-mingw-ltsc2025-ocaml-5.4@sha256:fedecf8e7810af08d566e6e877bd4ed7ad4c107b8cc32164f71632fffceb8869
Opam project build
To reproduce locally:
git clone --recursive "https://github.com/ocaml-ppx/ppxlib.git" && cd "ppxlib" && git fetch origin "refs/pull/629/head" && git reset --hard 51fb44d0
cat > Dockerfile <<'END-OF-DOCKERFILE'
FROM ocaml/opam:windows-server-mingw-ltsc2025-ocaml-5.4@sha256:fedecf8e7810af08d566e6e877bd4ed7ad4c107b8cc32164f71632fffceb8869
# windows-server-mingw-ltsc2025-5.4_opam-2.5
USER 1000:1000
ENV CLICOLOR_FORCE="1"
ENV OPAMCOLOR="always"
RUN ln -f /usr/local/bin/opam-2.5 /usr/local/bin/opam
RUN opam init --reinit -ni
RUN uname -rs && opam exec -- ocaml -version && opam --version
RUN cd ~/opam-repository && (git cat-file -e 302e116c4009da2f5a31c350a57c8b3c9b27289e || git fetch origin master) && git reset -q --hard 302e116c4009da2f5a31c350a57c8b3c9b27289e && git log --no-decorate -n1 --oneline && opam update -u
COPY --chown=1000:1000 ppxlib.opam ppxlib-tools.opam ppxlib-bench.opam /cygwin64/home/opam/src/./
RUN opam pin add -yn ppxlib.dev '/cygwin64/home/opam/src/./' && \
opam pin add -yn ppxlib-tools.dev '/cygwin64/home/opam/src/./' && \
opam pin add -yn ppxlib-bench.dev '/cygwin64/home/opam/src/./'
RUN echo '(lang dune 3.0)' > '/home/opam/src/./dune-project'
ENV DEPS="arch-x86_64.1 base.v0.17.3 base-bigarray.base base-domains.base base-effects.base base-nnp.base base-threads.base base-unix.base cinaps.v0.15.1 cmdliner.2.1.0 conf-mingw-w64-gcc-x86_64.1 csexp.1.5.2 dune.3.21.1 dune-configurator.3.21.1 flexdll.0.44 host-arch-x86_64.1 host-system-mingw.1 mingw-w64-shims.0.2.0 ocaml.5.4.0 ocaml-base-compiler.5.4.0 ocaml-compiler.5.4.0 ocaml-compiler-libs.v0.17.0 ocaml-config.3 ocaml-env-mingw64.1 ocaml-options-vanilla.1 ocaml_intrinsics_kernel.v0.17.1 ocamlfind.1.9.8 ppx_derivers.1.2.1 re.1.14.0 sexplib0.v0.17.0 stdlib-shims.0.3.0 system-mingw.1 yojson.3.0.0"
ENV CI="true"
ENV OCAMLCI="true"
RUN opam update --depexts && opam install --cli=2.5 --depext-only -y ppxlib.dev ppxlib-tools.dev ppxlib-bench.dev $DEPS
RUN opam install $DEPS
COPY --chown=1000:1000 . /cygwin64/home/opam/src
RUN cd /home/opam/src && opam exec -- dune build @install @check @runtest && rm -rf _build
END-OF-DOCKERFILE
docker build .
END-REPRO-BLOCK
2026-03-02 11:01.22: Using cache hint "ocaml-ppx/ppxlib-ocaml/opam:windows-server-mingw-ltsc2025-ocaml-5.4@sha256:fedecf8e7810af08d566e6e877bd4ed7ad4c107b8cc32164f71632fffceb8869-windows-server-mingw-ltsc2025-5.4_opam-2.5-51843497af0c31fdf43633f7769ee504"
2026-03-02 11:01.22: Using OBuilder spec:
((from ocaml/opam:windows-server-mingw-ltsc2025-ocaml-5.4@sha256:fedecf8e7810af08d566e6e877bd4ed7ad4c107b8cc32164f71632fffceb8869)
(comment windows-server-mingw-ltsc2025-5.4_opam-2.5)
(user (uid 1000) (gid 1000))
(env CLICOLOR_FORCE 1)
(env OPAMCOLOR always)
(run (shell "ln -f /usr/local/bin/opam-2.5 /usr/local/bin/opam"))
(run (shell "opam init --reinit -ni"))
(run (shell "uname -rs && opam exec -- ocaml -version && opam --version"))
(run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "cd ~/opam-repository && (git cat-file -e 302e116c4009da2f5a31c350a57c8b3c9b27289e || git fetch origin master) && git reset -q --hard 302e116c4009da2f5a31c350a57c8b3c9b27289e && git log --no-decorate -n1 --oneline && opam update -u"))
(copy (src ppxlib.opam ppxlib-tools.opam ppxlib-bench.opam)
(dst /cygwin64/home/opam/src/./))
(run (network host)
(shell "opam pin add -yn ppxlib.dev '/cygwin64/home/opam/src/./' && \
\nopam pin add -yn ppxlib-tools.dev '/cygwin64/home/opam/src/./' && \
\nopam pin add -yn ppxlib-bench.dev '/cygwin64/home/opam/src/./'"))
(run (shell "echo '(lang dune 3.0)' > '/home/opam/src/./dune-project'"))
(env DEPS "arch-x86_64.1 base.v0.17.3 base-bigarray.base base-domains.base base-effects.base base-nnp.base base-threads.base base-unix.base cinaps.v0.15.1 cmdliner.2.1.0 conf-mingw-w64-gcc-x86_64.1 csexp.1.5.2 dune.3.21.1 dune-configurator.3.21.1 flexdll.0.44 host-arch-x86_64.1 host-system-mingw.1 mingw-w64-shims.0.2.0 ocaml.5.4.0 ocaml-base-compiler.5.4.0 ocaml-compiler.5.4.0 ocaml-compiler-libs.v0.17.0 ocaml-config.3 ocaml-env-mingw64.1 ocaml-options-vanilla.1 ocaml_intrinsics_kernel.v0.17.1 ocamlfind.1.9.8 ppx_derivers.1.2.1 re.1.14.0 sexplib0.v0.17.0 stdlib-shims.0.3.0 system-mingw.1 yojson.3.0.0")
(env CI true)
(env OCAMLCI true)
(run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "opam update --depexts && opam install --cli=2.5 --depext-only -y ppxlib.dev ppxlib-tools.dev ppxlib-bench.dev $DEPS"))
(run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "opam install $DEPS"))
(copy (src .) (dst /cygwin64/home/opam/src))
(run (shell "cd /home/opam/src && opam exec -- dune build @install @check @runtest && rm -rf _build"))
)
2026-03-02 11:01.22: Waiting for resource in pool OCluster
2026-03-02 11:01.22: Waiting for worker…
2026-03-02 11:01.22: Got resource from pool OCluster
Building on ltsc2025-2
HEAD is now at 07c686ac Merge pull request #627 from NathanReb/document-future-nodes-manipulation
HEAD is now at 51fb44d0 Add support for 5.4 bivariant type parameters in type declaration
(from ocaml/opam:windows-server-mingw-ltsc2025-ocaml-5.4@sha256:fedecf8e7810af08d566e6e877bd4ed7ad4c107b8cc32164f71632fffceb8869)
2026-03-02 11:01.43 ---> using "a21c3d6a5c8ade59b5718498d4946f2d30bc2f15b3081890bc8673cc20de69f7" from cache
C:/: (comment windows-server-mingw-ltsc2025-5.4_opam-2.5)
C:/: (user (uid 1000) (gid 1000))
C:/: (env CLICOLOR_FORCE 1)
C:/: (env OPAMCOLOR always)
C:/: (run (shell "ln -f /usr/local/bin/opam-2.5 /usr/local/bin/opam"))
2026-03-02 11:01.43 ---> using "ba707ce1f62b585e8ecb40306d921206316b14fded440e6c49f33aa7897cc9c7" from cache
C:/: (run (shell "opam init --reinit -ni"))
No configuration file found, using built-in defaults.
<><> Unix support infrastructure ><><><><><><><><><><><><><><><><><><><><><><><>
opam and the OCaml ecosystem in general require various Unix tools in order to operate correctly. At present, this requires the installation of Cygwin to provide these tools.
How should opam obtain Unix tools?
> 1. Use tools found in PATH (Cygwin installation at C:\cygwin64)
2. Automatically create an internal Cygwin installation that will be managed by opam (recommended)
3. Use Cygwin installation found in C:\cygwin64
4. Use another existing Cygwin/MSYS2 installation
5. Abort initialisation
[1/2/3/4/5] 1
Checking for available remotes: rsync and local, git.
- you won't be able to use mercurial repositories unless you install the hg command on your system.
- you won't be able to use darcs repositories unless you install the darcs command on your system.
<><> Updating repositories ><><><><><><><><><><><><><><><><><><><><><><><><><><>
[default] Initialised
2026-03-02 11:01.43 ---> using "dd67e9cc18682a923590cd564dd7cd6177b4afe1c25b1d53bacf8ae6b5b2364f" from cache
C:/: (run (shell "uname -rs && opam exec -- ocaml -version && opam --version"))
CYGWIN_NT-10.0-26100 3.6.6-1.x86_64
The OCaml toplevel, version 5.4.0
2.5.0
2026-03-02 11:01.43 ---> using "c97059ecb6d76caa6ea35cf8e41cecaa775dc323c43ea7e5cc23418742ce7876" from cache
C:/: (run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "cd ~/opam-repository && (git cat-file -e 302e116c4009da2f5a31c350a57c8b3c9b27289e || git fetch origin master) && git reset -q --hard 302e116c4009da2f5a31c350a57c8b3c9b27289e && git log --no-decorate -n1 --oneline && opam update -u"))
302e116c40 Merge pull request #29374 from shonfeder/release-dune-3.21.1
<><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><>
[default] synchronised from git+file://C:/cygwin64/home/opam/opam-repository
Already up-to-date.
Nothing to do.
# To update the current shell environment, run: eval $(opam env)
2026-03-02 11:01.43 ---> using "a0d9e0d7c9d5b32fb7d724ee470675e47ec362564b5a242a8fabe787c66973e7" from cache
C:/: (copy (src ppxlib.opam ppxlib-tools.opam ppxlib-bench.opam)
(dst /cygwin64/home/opam/src/./))
2026-03-02 11:01.43 ---> using "6a4e1283b2bea78866b23fc77191b0d8717ebed918275140c4975cb464f1ead8" from cache
C:/: (run (network host)
(shell "opam pin add -yn ppxlib.dev '/cygwin64/home/opam/src/./' && \
\nopam pin add -yn ppxlib-tools.dev '/cygwin64/home/opam/src/./' && \
\nopam pin add -yn ppxlib-bench.dev '/cygwin64/home/opam/src/./'"))
[ppxlib.dev] synchronised (file://C:/cygwin64/home/opam/src)
ppxlib is now pinned to file://C:/cygwin64/home/opam/src (version dev)
[ppxlib-tools.dev] synchronised (file://C:/cygwin64/home/opam/src)
ppxlib-tools is now pinned to file://C:/cygwin64/home/opam/src (version dev)
[NOTE] Package ppxlib-bench does not exist in opam repositories registered in the current switch.
[ppxlib-bench.dev] synchronised (file://C:/cygwin64/home/opam/src)
ppxlib-bench is now pinned to file://C:/cygwin64/home/opam/src (version dev)
2026-03-02 11:01.43 ---> using "85e5bf8c42cdf6dc46395870be8b4eed4927838905b8c04400fb8cf01baf17d8" from cache
C:/: (run (shell "echo '(lang dune 3.0)' > '/home/opam/src/./dune-project'"))
2026-03-02 11:01.43 ---> using "b097e22775daf88ca0b5c3d09c0f6e880348ff6a3ef3c44da001d63b6b595305" from cache
C:/: (env DEPS "arch-x86_64.1 base.v0.17.3 base-bigarray.base base-domains.base base-effects.base base-nnp.base base-threads.base base-unix.base cinaps.v0.15.1 cmdliner.2.1.0 conf-mingw-w64-gcc-x86_64.1 csexp.1.5.2 dune.3.21.1 dune-configurator.3.21.1 flexdll.0.44 host-arch-x86_64.1 host-system-mingw.1 mingw-w64-shims.0.2.0 ocaml.5.4.0 ocaml-base-compiler.5.4.0 ocaml-compiler.5.4.0 ocaml-compiler-libs.v0.17.0 ocaml-config.3 ocaml-env-mingw64.1 ocaml-options-vanilla.1 ocaml_intrinsics_kernel.v0.17.1 ocamlfind.1.9.8 ppx_derivers.1.2.1 re.1.14.0 sexplib0.v0.17.0 stdlib-shims.0.3.0 system-mingw.1 yojson.3.0.0")
C:/: (env CI true)
C:/: (env OCAMLCI true)
C:/: (run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "opam update --depexts && opam install --cli=2.5 --depext-only -y ppxlib.dev ppxlib-tools.dev ppxlib-bench.dev $DEPS"))
<><> Synchronising pinned packages ><><><><><><><><><><><><><><><><><><><><><><>
[ppxlib.dev] synchronised (file://C:/cygwin64/home/opam/src)
[ppxlib-bench.dev] synchronised (file://C:/cygwin64/home/opam/src)
[ppxlib-tools.dev] synchronised (file://C:/cygwin64/home/opam/src)
[NOTE] Package system-mingw is already installed (current version is 1).
[NOTE] Package ocaml-options-vanilla is already installed (current version is 1).
[NOTE] Package ocaml-env-mingw64 is already installed (current version is 1).
[NOTE] Package ocaml-config is already installed (current version is 3).
[NOTE] Package ocaml-compiler is already installed (current version is 5.4.0).
[NOTE] Package ocaml-base-compiler is already installed (current version is 5.4.0).
[NOTE] Package ocaml is already installed (current version is 5.4.0).
[NOTE] Package mingw-w64-shims is already installed (current version is 0.2.0).
[NOTE] Package host-system-mingw is already installed (current version is 1).
[NOTE] Package host-arch-x86_64 is already installed (current version is 1).
[NOTE] Package flexdll is already installed (current version is 0.44).
[NOTE] Package conf-mingw-w64-gcc-x86_64 is already installed (current version is 1).
[NOTE] Package base-unix is already installed (current version is base).
[NOTE] Package base-threads is already installed (current version is base).
[NOTE] Package base-nnp is already installed (current version is base).
[NOTE] Package base-effects is already installed (current version is base).
[NOTE] Package base-domains is already installed (current version is base).
[NOTE] Package base-bigarray is already installed (current version is base).
[NOTE] Package arch-x86_64 is already installed (current version is 1).
# To update the current shell environment, run: eval $(opam env)
2026-03-02 11:01.43 ---> using "1b804844d0f00ef92213e571a3b768a4f61d9b5dbe0931e23bb11497d4242bde" from cache
C:/: (run (cache (opam-archives (target "c:\\opam\\.opam\\download-cache")))
(network host)
(shell "opam install $DEPS"))
[NOTE] Package system-mingw is already installed (current version is 1).
[NOTE] Package ocaml-options-vanilla is already installed (current version is 1).
[NOTE] Package ocaml-env-mingw64 is already installed (current version is 1).
[NOTE] Package ocaml-config is already installed (current version is 3).
[NOTE] Package ocaml-compiler is already installed (current version is 5.4.0).
[NOTE] Package ocaml-base-compiler is already installed (current version is 5.4.0).
[NOTE] Package ocaml is already installed (current version is 5.4.0).
[NOTE] Package mingw-w64-shims is already installed (current version is 0.2.0).
[NOTE] Package host-system-mingw is already installed (current version is 1).
[NOTE] Package host-arch-x86_64 is already installed (current version is 1).
[NOTE] Package flexdll is already installed (current version is 0.44).
[NOTE] Package conf-mingw-w64-gcc-x86_64 is already installed (current version is 1).
[NOTE] Package base-unix is already installed (current version is base).
[NOTE] Package base-threads is already installed (current version is base).
[NOTE] Package base-nnp is already installed (current version is base).
[NOTE] Package base-effects is already installed (current version is base).
[NOTE] Package base-domains is already installed (current version is base).
[NOTE] Package base-bigarray is already installed (current version is base).
[NOTE] Package arch-x86_64 is already installed (current version is 1).
The following actions will be performed:
=== install 14 packages
- install base v0.17.3
- install cinaps v0.15.1
- install cmdliner 2.1.0
- install csexp 1.5.2
- install dune 3.21.1
- install dune-configurator 3.21.1
- install ocaml-compiler-libs v0.17.0
- install ocaml_intrinsics_kernel v0.17.1
- install ocamlfind 1.9.8
- install ppx_derivers 1.2.1
- install re 1.14.0
- install sexplib0 v0.17.0
- install stdlib-shims 0.3.0
- install yojson 3.0.0
<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><>
-> retrieved cmdliner.2.1.0 (cached)
-> retrieved base.v0.17.3 (cached)
-> retrieved csexp.1.5.2 (cached)
-> retrieved cinaps.v0.15.1 (https://github.com/ocaml-ppx/cinaps/archive/v0.15.1.tar.gz)
-> retrieved ocaml-compiler-libs.v0.17.0 (cached)
-> retrieved ocaml_intrinsics_kernel.v0.17.1 (cached)
-> retrieved ocamlfind.1.9.8 (cached)
-> retrieved ppx_derivers.1.2.1 (cached)
-> retrieved re.1.14.0 (cached)
-> retrieved sexplib0.v0.17.0 (cached)
-> retrieved stdlib-shims.0.3.0 (cached)
-> retrieved yojson.3.0.0 (https://github.com/ocaml-community/yojson/releases/download/3.0.0/yojson-3.0.0.tbz)
-> retrieved dune.3.21.1, dune-configurator.3.21.1 (cached)
-> installed cmdliner.2.1.0
[WARNING] .install file is missing .exe extension for src/findlib/ocamlfind
[WARNING] .install file is missing .exe extension for src/findlib/ocamlfind_opt
[WARNING] Automatically adding .exe to C:\opam\.opam\5.4\.opam-switch\build\ocamlfind.1.9.8\src\findlib\ocamlfind.exe
[WARNING] Automatically adding .exe to C:\opam\.opam\5.4\.opam-switch\build\ocamlfind.1.9.8\src\findlib\ocamlfind_opt.exe
[WARNING] C:\opam\.opam\5.4\bin\safe_camlp4 is a script; the command won't be available
-> installed ocamlfind.1.9.8
-> installed dune.3.21.1
-> installed csexp.1.5.2
-> installed ocaml-compiler-libs.v0.17.0
-> installed ocaml_intrinsics_kernel.v0.17.1
-> installed ppx_derivers.1.2.1
-> installed re.1.14.0
-> installed sexplib0.v0.17.0
-> installed stdlib-shims.0.3.0
-> installed yojson.3.0.0
-> installed cinaps.v0.15.1
-> installed dune-configurator.3.21.1
-> installed base.v0.17.3
Done.
# To update the current shell environment, run: eval $(opam env)
2026-03-02 11:14.10 ---> saved as "31b0e04de20a5cefcf5465fe62981cf01e0d1ecf288a3b9fdce9a0a43ec155dc"
C:/: (copy (src .) (dst /cygwin64/home/opam/src))
2026-03-02 11:15.14 ---> saved as "611c1fec4ff51f8faa02e61f167a9b351511edd1a2da35727d0c3ef792a146e0"
C:/: (run (shell "cd /home/opam/src && opam exec -- dune build @install @check @runtest && rm -rf _build"))
File "src/dune", lines 24-26, characters 0-65:
24 | (cinaps
25 | (files *.ml *.mli)
26 | (libraries ppxlib_cinaps_helpers))
(cd _build/default/src && .cinaps.610def89\cinaps.exe -diff-cmd -)
Fatal error: exception Sys_error("C:\\cygwin64\\tmp\\cinaps0c86f8.mli: Permission denied")
File "astlib/dune", lines 15-17, characters 0-65:
15 | (cinaps
16 | (files *.ml *.mli)
17 | (libraries astlib_cinaps_helpers))
(cd _build/default/astlib && .cinaps.35700fcc\cinaps.exe -diff-cmd -)
Fatal error: exception Sys_error("C:\\cygwin64\\tmp\\cinaps97c89b.ml: Permission denied")
File "ast/dune", lines 21-23, characters 0-62:
21 | (cinaps
22 | (files *.ml *.mli)
23 | (libraries ast_cinaps_helpers))
(cd _build/default/ast && .cinaps.ff91fa5e\cinaps.exe -diff-cmd -)
Fatal error: exception Sys_error("C:\\cygwin64\\tmp\\cinaps4bc0e8.ml: Permission denied")
File "test/expect/expect_test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/expect/expect_test.ml _build/default/test/expect/expect_test.ml.cinaps-corrected
diff --git a/_build/default/test/expect/expect_test.ml b/_build/default/test/expect/expect_test.ml.cinaps-corrected
index 325af15..d65620f 100755
--- a/_build/default/test/expect/expect_test.ml
+++ b/_build/default/test/expect/expect_test.ml.cinaps-corrected
@@ -1,218 +1,218 @@
-open StdLabels
-
-let compiler_version =
- match String.split_on_char ~sep:'.' Sys.ocaml_version with
- | major :: minor :: _ -> (int_of_string major, int_of_string minor)
- | _ -> assert false
-
-let include_compiler_version range =
- let cmajor, cminor = compiler_version in
- match (range : Expect_lexer.version_range) with
- | Only (major, minor) -> cmajor = major && cminor = minor
- | From (major, minor) -> cmajor > major || (cmajor = major && cminor >= minor)
- | Up_to (major, minor) -> cmajor < major || (cmajor = major && cminor <= minor)
- | Between ((min_major, min_minor), (max_major, max_minor)) ->
- (cmajor > min_major && cmajor < max_major)
- || (cmajor = min_major && cminor >= min_minor)
- || (cmajor = max_major && cminor <= max_minor)
-
-let read_file file =
- let ic = open_in_bin file in
- let len = in_channel_length ic in
- let file_contents = really_input_string ic len in
- close_in ic;
- file_contents
-
-let run_expect_test file ~f =
- let file_contents = read_file file in
- let lexbuf = Lexing.from_string file_contents in
- lexbuf.lex_curr_p <-
- { pos_fname = file; pos_cnum = 0; pos_lnum = 1; pos_bol = 0 };
-
- let expected = f file_contents lexbuf in
-
- let corrected_file = file ^ ".corrected" in
- if file_contents <> expected then (
- let oc = open_out_bin corrected_file in
- output_string oc expected;
- close_out oc)
- else (
- if Sys.file_exists corrected_file then Sys.remove corrected_file;
- exit 0)
-
-let capture_trimmed_fmt printer arg =
- let buf = Buffer.create 1024 in
- let buf_fmt = Format.formatter_of_buffer buf in
- printer buf_fmt arg;
- String.trim (Buffer.contents buf)
-
-let print_loc _ _ ppf (loc : Location.t) =
- let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
- let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
- Format.fprintf ppf "Line _";
- if startchar >= 0 then
- Format.fprintf ppf ", characters %d-%d" startchar endchar;
- Format.fprintf ppf ":@."
-
-let report_printer () =
- let default = Location.default_report_printer () in
- let trimmed_pp report_printer ppf report =
- let trimmed = capture_trimmed_fmt (default.pp report_printer) report in
- Format.fprintf ppf "%s\n" trimmed
- in
- {
- default with
- pp = trimmed_pp;
- pp_main_loc = print_loc;
- pp_submsg_loc = print_loc;
- }
-
-let setup_printers ppf =
- Location.formatter_for_warnings := ppf;
- Location.warning_reporter := Location.default_warning_reporter;
- Location.report_printer := report_printer;
- Location.alert_reporter := Location.default_alert_reporter
-
-let apply_rewriters : Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase =
- function
- | Ptop_dir _ as x -> x
- | Ptop_def s ->
- let s = Ppxlib.Selected_ast.of_ocaml Structure s in
- let s' = Ppxlib.Driver.map_structure s in
- Ptop_def (Ppxlib.Selected_ast.to_ocaml Structure s')
-
-let execute_phrase ppf phr =
- let trimmed =
- capture_trimmed_fmt
- (fun ppf phr -> ignore (Toploop.execute_phrase true ppf phr))
- phr
- in
- match trimmed with "" -> () | _ -> Format.fprintf ppf "%s\n" trimmed
-
-let pp_version ppf (major, minor) = Format.fprintf ppf "%d.%d" major minor
-
-let pp_range ppf range =
- match (range : Expect_lexer.version_range) with
- | Only v -> pp_version ppf v
- | From v -> Format.fprintf ppf ">= %a" pp_version v
- | Up_to v -> Format.fprintf ppf "<= %a" pp_version v
- | Between (v1, v2) ->
- Format.fprintf ppf "%a <=> %a" pp_version v1 pp_version v2
-
-let run_code ppf starting_pos code =
- let lexbuf = Lexing.from_string code in
- lexbuf.lex_curr_p <- { starting_pos with pos_lnum = 1 };
- let phrases = !Toploop.parse_use_file lexbuf in
- List.iter phrases ~f:(function
- | Parsetree.Ptop_def [] -> ()
- | phr -> (
- try
- let phr = apply_rewriters phr in
- if !Clflags.dump_source then
- Format.fprintf ppf "%a@?" Ppxlib.Pprintast.top_phrase
- (Ppxlib.Selected_ast.Of_ocaml.copy_toplevel_phrase phr);
- execute_phrase ppf phr
- with exn -> Location.report_exception ppf exn))
-
-let trash_buffer = Buffer.create 1024
-let trash_ppf = Format.formatter_of_buffer trash_buffer
-
-let handle_ignore_block ppf starting_pos code =
- Format.fprintf ppf "%s[%%%%ignore]@." code;
- run_code trash_ppf starting_pos code;
- Buffer.clear trash_buffer
-
-let handle_regular_expect_block ppf starting_pos code =
- Format.fprintf ppf "%s[%%%%expect{|@." code;
- run_code ppf starting_pos code;
- Format.fprintf ppf "@?|}]@."
-
-let handle_versioned_expect_blocks ppf starting_pos code vexpect_blocks =
- let matched = ref false in
- let loc =
- {
- Ppxlib.Location.loc_start = starting_pos;
- loc_end = starting_pos;
- loc_ghost = false;
- }
- in
- Format.fprintf ppf "%s@?" code;
- List.iter vexpect_blocks ~f:(fun (range, content) ->
- Format.fprintf ppf "[%%%%expect_in %a {|@." pp_range range;
- if include_compiler_version range && not !matched then (
- matched := true;
- run_code ppf starting_pos code;
- Format.fprintf ppf "@?|}]@.")
- else if include_compiler_version range && !matched then
- Ppxlib.Location.raise_errorf ~loc
- "Multiple versioned expect block in a group matched our compiler \
- version %a"
- pp_version compiler_version
- else Format.fprintf ppf "%s|}]@." content);
- if not !matched then
- Ppxlib.Location.raise_errorf ~loc
- "No versioned expect block in a group matched our compiler version %a"
- pp_version compiler_version
-
-let main () =
- let rec map_tree = function
- | Outcometree.Oval_constr (name, params) ->
- Outcometree.Oval_constr (name, List.map ~f:map_tree params)
- | Oval_variant (name, Some param) ->
- Oval_variant (name, Some (map_tree param))
- | Oval_string (s, maxlen, kind) ->
- Oval_string (s, (if maxlen < 8 then 8 else maxlen), kind)
- (*IF_NOT_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:map_tree tl) *)
- (*IF_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:(fun (label, v) -> (label, map_tree v)) tl) *)
- (*IF_NOT_AT_LEAST 504 | Oval_array tl -> Oval_array (List.map ~f:map_tree tl) *)
- (*IF_AT_LEAST 504 | Oval_array (tl, mutable_) -> Oval_array ((List.map ~f:map_tree tl), mutable_) *)
- | Oval_list tl -> Oval_list (List.map ~f:map_tree tl)
- | Oval_record fel ->
- Oval_record
- (List.map ~f:(fun (name, tree) -> (name, map_tree tree)) fel)
- | tree -> tree
- in
- let print_out_value = !Toploop.print_out_value in
- (* Achieve 4.14 printing behaviour, as introduced in
- https://github.com/ocaml/ocaml/pull/10565 *)
- (Toploop.print_out_value :=
- fun ppf tree -> print_out_value ppf (map_tree tree));
- run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf ->
- let chunks = Expect_lexer.split_file ~file_contents lexbuf in
-
- let buf = Buffer.create (String.length file_contents + 1024) in
- let ppf = Format.formatter_of_buffer buf in
- setup_printers ppf;
- Topfind.log := ignore;
-
- let _ = Warnings.parse_options false "@a-4-29-40-41-42-44-45-48-58" in
- Clflags.real_paths := false;
- Toploop.initialize_toplevel_env ();
-
- (* Findlib stuff *)
- let preds = [ "toploop" ] in
- let preds =
- match Sys.backend_type with
- | Native -> "native" :: preds
- | Bytecode -> "byte" :: preds
- | Other _ -> preds
- in
- Topfind.add_predicates preds;
- (* This just adds the include directories since the [ppx] library
- is statically linked in *)
- Topfind.load_deeply [ "ppxlib" ];
-
- List.iter chunks
- ~f:(fun { Expect_lexer.phrases; phrases_start; expect } ->
- match expect with
- | Ignore -> handle_ignore_block ppf phrases_start phrases
- | Regular -> handle_regular_expect_block ppf phrases_start phrases
- | Versioned vexpects ->
- handle_versioned_expect_blocks ppf phrases_start phrases vexpects);
- Buffer.contents buf)
-
-let () =
- try main ()
- with exn ->
- Location.report_exception Format.err_formatter exn;
- exit 1
+open StdLabels
+
+let compiler_version =
+ match String.split_on_char ~sep:'.' Sys.ocaml_version with
+ | major :: minor :: _ -> (int_of_string major, int_of_string minor)
+ | _ -> assert false
+
+let include_compiler_version range =
+ let cmajor, cminor = compiler_version in
+ match (range : Expect_lexer.version_range) with
+ | Only (major, minor) -> cmajor = major && cminor = minor
+ | From (major, minor) -> cmajor > major || (cmajor = major && cminor >= minor)
+ | Up_to (major, minor) -> cmajor < major || (cmajor = major && cminor <= minor)
+ | Between ((min_major, min_minor), (max_major, max_minor)) ->
+ (cmajor > min_major && cmajor < max_major)
+ || (cmajor = min_major && cminor >= min_minor)
+ || (cmajor = max_major && cminor <= max_minor)
+
+let read_file file =
+ let ic = open_in_bin file in
+ let len = in_channel_length ic in
+ let file_contents = really_input_string ic len in
+ close_in ic;
+ file_contents
+
+let run_expect_test file ~f =
+ let file_contents = read_file file in
+ let lexbuf = Lexing.from_string file_contents in
+ lexbuf.lex_curr_p <-
+ { pos_fname = file; pos_cnum = 0; pos_lnum = 1; pos_bol = 0 };
+
+ let expected = f file_contents lexbuf in
+
+ let corrected_file = file ^ ".corrected" in
+ if file_contents <> expected then (
+ let oc = open_out_bin corrected_file in
+ output_string oc expected;
+ close_out oc)
+ else (
+ if Sys.file_exists corrected_file then Sys.remove corrected_file;
+ exit 0)
+
+let capture_trimmed_fmt printer arg =
+ let buf = Buffer.create 1024 in
+ let buf_fmt = Format.formatter_of_buffer buf in
+ printer buf_fmt arg;
+ String.trim (Buffer.contents buf)
+
+let print_loc _ _ ppf (loc : Location.t) =
+ let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
+ let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
+ Format.fprintf ppf "Line _";
+ if startchar >= 0 then
+ Format.fprintf ppf ", characters %d-%d" startchar endchar;
+ Format.fprintf ppf ":@."
+
+let report_printer () =
+ let default = Location.default_report_printer () in
+ let trimmed_pp report_printer ppf report =
+ let trimmed = capture_trimmed_fmt (default.pp report_printer) report in
+ Format.fprintf ppf "%s\n" trimmed
+ in
+ {
+ default with
+ pp = trimmed_pp;
+ pp_main_loc = print_loc;
+ pp_submsg_loc = print_loc;
+ }
+
+let setup_printers ppf =
+ Location.formatter_for_warnings := ppf;
+ Location.warning_reporter := Location.default_warning_reporter;
+ Location.report_printer := report_printer;
+ Location.alert_reporter := Location.default_alert_reporter
+
+let apply_rewriters : Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase =
+ function
+ | Ptop_dir _ as x -> x
+ | Ptop_def s ->
+ let s = Ppxlib.Selected_ast.of_ocaml Structure s in
+ let s' = Ppxlib.Driver.map_structure s in
+ Ptop_def (Ppxlib.Selected_ast.to_ocaml Structure s')
+
+let execute_phrase ppf phr =
+ let trimmed =
+ capture_trimmed_fmt
+ (fun ppf phr -> ignore (Toploop.execute_phrase true ppf phr))
+ phr
+ in
+ match trimmed with "" -> () | _ -> Format.fprintf ppf "%s\n" trimmed
+
+let pp_version ppf (major, minor) = Format.fprintf ppf "%d.%d" major minor
+
+let pp_range ppf range =
+ match (range : Expect_lexer.version_range) with
+ | Only v -> pp_version ppf v
+ | From v -> Format.fprintf ppf ">= %a" pp_version v
+ | Up_to v -> Format.fprintf ppf "<= %a" pp_version v
+ | Between (v1, v2) ->
+ Format.fprintf ppf "%a <=> %a" pp_version v1 pp_version v2
+
+let run_code ppf starting_pos code =
+ let lexbuf = Lexing.from_string code in
+ lexbuf.lex_curr_p <- { starting_pos with pos_lnum = 1 };
+ let phrases = !Toploop.parse_use_file lexbuf in
+ List.iter phrases ~f:(function
+ | Parsetree.Ptop_def [] -> ()
+ | phr -> (
+ try
+ let phr = apply_rewriters phr in
+ if !Clflags.dump_source then
+ Format.fprintf ppf "%a@?" Ppxlib.Pprintast.top_phrase
+ (Ppxlib.Selected_ast.Of_ocaml.copy_toplevel_phrase phr);
+ execute_phrase ppf phr
+ with exn -> Location.report_exception ppf exn))
+
+let trash_buffer = Buffer.create 1024
+let trash_ppf = Format.formatter_of_buffer trash_buffer
+
+let handle_ignore_block ppf starting_pos code =
+ Format.fprintf ppf "%s[%%%%ignore]@." code;
+ run_code trash_ppf starting_pos code;
+ Buffer.clear trash_buffer
+
+let handle_regular_expect_block ppf starting_pos code =
+ Format.fprintf ppf "%s[%%%%expect{|@." code;
+ run_code ppf starting_pos code;
+ Format.fprintf ppf "@?|}]@."
+
+let handle_versioned_expect_blocks ppf starting_pos code vexpect_blocks =
+ let matched = ref false in
+ let loc =
+ {
+ Ppxlib.Location.loc_start = starting_pos;
+ loc_end = starting_pos;
+ loc_ghost = false;
+ }
+ in
+ Format.fprintf ppf "%s@?" code;
+ List.iter vexpect_blocks ~f:(fun (range, content) ->
+ Format.fprintf ppf "[%%%%expect_in %a {|@." pp_range range;
+ if include_compiler_version range && not !matched then (
+ matched := true;
+ run_code ppf starting_pos code;
+ Format.fprintf ppf "@?|}]@.")
+ else if include_compiler_version range && !matched then
+ Ppxlib.Location.raise_errorf ~loc
+ "Multiple versioned expect block in a group matched our compiler \
+ version %a"
+ pp_version compiler_version
+ else Format.fprintf ppf "%s|}]@." content);
+ if not !matched then
+ Ppxlib.Location.raise_errorf ~loc
+ "No versioned expect block in a group matched our compiler version %a"
+ pp_version compiler_version
+
+let main () =
+ let rec map_tree = function
+ | Outcometree.Oval_constr (name, params) ->
+ Outcometree.Oval_constr (name, List.map ~f:map_tree params)
+ | Oval_variant (name, Some param) ->
+ Oval_variant (name, Some (map_tree param))
+ | Oval_string (s, maxlen, kind) ->
+ Oval_string (s, (if maxlen < 8 then 8 else maxlen), kind)
+ (*IF_NOT_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:map_tree tl) *)
+ (*IF_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:(fun (label, v) -> (label, map_tree v)) tl) *)
+ (*IF_NOT_AT_LEAST 504 | Oval_array tl -> Oval_array (List.map ~f:map_tree tl) *)
+ (*IF_AT_LEAST 504 | Oval_array (tl, mutable_) -> Oval_array ((List.map ~f:map_tree tl), mutable_) *)
+ | Oval_list tl -> Oval_list (List.map ~f:map_tree tl)
+ | Oval_record fel ->
+ Oval_record
+ (List.map ~f:(fun (name, tree) -> (name, map_tree tree)) fel)
+ | tree -> tree
+ in
+ let print_out_value = !Toploop.print_out_value in
+ (* Achieve 4.14 printing behaviour, as introduced in
+ https://github.com/ocaml/ocaml/pull/10565 *)
+ (Toploop.print_out_value :=
+ fun ppf tree -> print_out_value ppf (map_tree tree));
+ run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf ->
+ let chunks = Expect_lexer.split_file ~file_contents lexbuf in
+
+ let buf = Buffer.create (String.length file_contents + 1024) in
+ let ppf = Format.formatter_of_buffer buf in
+ setup_printers ppf;
+ Topfind.log := ignore;
+
+ let _ = Warnings.parse_options false "@a-4-29-40-41-42-44-45-48-58" in
+ Clflags.real_paths := false;
+ Toploop.initialize_toplevel_env ();
+
+ (* Findlib stuff *)
+ let preds = [ "toploop" ] in
+ let preds =
+ match Sys.backend_type with
+ | Native -> "native" :: preds
+ | Bytecode -> "byte" :: preds
+ | Other _ -> preds
+ in
+ Topfind.add_predicates preds;
+ (* This just adds the include directories since the [ppx] library
+ is statically linked in *)
+ Topfind.load_deeply [ "ppxlib" ];
+
+ List.iter chunks
+ ~f:(fun { Expect_lexer.phrases; phrases_start; expect } ->
+ match expect with
+ | Ignore -> handle_ignore_block ppf phrases_start phrases
+ | Regular -> handle_regular_expect_block ppf phrases_start phrases
+ | Versioned vexpects ->
+ handle_versioned_expect_blocks ppf phrases_start phrases vexpects);
+ Buffer.contents buf)
+
+let () =
+ try main ()
+ with exn ->
+ Location.report_exception Format.err_formatter exn;
+ exit 1
File "test/504_migrations/longident-locs/run.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/504_migrations/longident-locs/run.t _build/default/test/504_migrations/longident-locs/run.t.corrected
diff --git a/_build/default/test/504_migrations/longident-locs/run.t b/_build/default/test/504_migrations/longident-locs/run.t.corrected
index cd8af74..5e3fa14 100755
--- a/_build/default/test/504_migrations/longident-locs/run.t
+++ b/_build/default/test/504_migrations/longident-locs/run.t.corrected
@@ -11,10 +11,12 @@ If we run the driver on the following source file:
then the non-existing module should have a sensible error location.
$ ocamlc -ppx "./driver.exe --as-ppx -locations-check" test.ml test.ml.pp
- File "test.ml", line 1, characters 9-30:
- 1 | let () = NonExistingModule.foo ()
- ^^^^^^^^^^^^^^^^^^^^^
- Error: Unbound module NonExistingModule
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File "test.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./driver.exe --as-ppx -locations-check "C:\cygwin64\tmp\camlppx9c3761" "C:\cygwin64\tmp\camlppx85df2e"
+
[2]
Another longident usage:
@@ -24,10 +26,12 @@ Another longident usage:
> EOF
$ ocamlc -ppx "./driver.exe --as-ppx -locations-check" test.ml test.ml.pp
- File "test.ml", line 1, characters 10-24:
- 1 | let t = { ThisModule.age = 43 }
- ^^^^^^^^^^^^^^
- Error: Unbound module ThisModule
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File "test.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./driver.exe --as-ppx -locations-check "C:\cygwin64\tmp\camlppx6103af" "C:\cygwin64\tmp\camlppx3e60aa"
+
[2]
Longidents with Lapplys:
@@ -44,12 +48,12 @@ Longidents with Lapplys:
> EOF
$ ocamlc -ppx "./driver.exe --as-ppx -locations-check" test.ml test.ml.pp
- File "test.ml", line 8, characters 15-28:
- 8 | type t = { v : F(X).G(Int).t }
- ^^^^^^^^^^^^^
- Error: Modules do not match: sig end is not included in sig type t end
- The type t is required but not provided
- File "test.ml", line 1, characters 18-24: Expected declaration
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File "test.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./driver.exe --as-ppx -locations-check "C:\cygwin64\tmp\camlppx9de44e" "C:\cygwin64\tmp\camlppxc57fe7"
+
[2]
Note that we have lost information in this migration. In the future when we
File "test/driver/error_embedding/test.t/run.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/error_embedding/test.t/run.t _build/default/test/driver/error_embedding/test.t/run.t.corrected
diff --git a/_build/default/test/driver/error_embedding/test.t/run.t b/_build/default/test/driver/error_embedding/test.t/run.t.corrected
index da136da..3af2f4a 100755
--- a/_build/default/test/driver/error_embedding/test.t/run.t
+++ b/_build/default/test/driver/error_embedding/test.t/run.t.corrected
@@ -14,8 +14,12 @@ 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
+ '..' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ../raiser.exe -as-ppx "C:\cygwin64\tmp\camlppx360da1" "C:\cygwin64\tmp\camlppx031b83"
+
[2]
Also exceptions raised in a preprocessor get embedded into an AST(while the
@@ -23,9 +27,10 @@ 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
+ '..' is not recognized as an internal or external command,
+ operable program or batch file.
[%%ocaml.error
- "Error while running external preprocessor\nCommand line: ../pp.exe 'file.ml' > tmpfile\n"]
+ "Error while running external preprocessor\nCommand line: ../pp.exe \"file.ml\" > \"C:\\cygwin64\\tmp\\ocamlppccfb4a\"\n"]
Also `unknown version` errors are embedded into an AST when using the
main standalone
File "test/driver/standalone_run_as_ppx/run.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/standalone_run_as_ppx/run.t _build/default/test/driver/standalone_run_as_ppx/run.t.corrected
diff --git a/_build/default/test/driver/standalone_run_as_ppx/run.t b/_build/default/test/driver/standalone_run_as_ppx/run.t.corrected
index f5ccad4..d6f4a73 100755
--- a/_build/default/test/driver/standalone_run_as_ppx/run.t
+++ b/_build/default/test/driver/standalone_run_as_ppx/run.t.corrected
@@ -6,7 +6,13 @@ The rewriter gets applied when using `--as-ppx`
$ echo "let _ = [%print_hi]" > impl.ml
$ ocaml -ppx './print_stuff.exe --as-ppx' impl.ml
- hi
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_stuff.exe --as-ppx "C:\cygwin64\tmp\camlppx67b251" "C:\cygwin64\tmp\camlppx95db5f"
+
+ [2]
If a non-compatible file gets fed, the file name is reported correctly
@@ -20,18 +26,34 @@ The ocaml.ppx.context attribute gets parsed correctly; in particular, the tool n
$ echo "let _ = [%print_tool_name]" > impl.ml
$ ocaml -ppx './print_stuff.exe --as-ppx' impl.ml
- ocaml
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_stuff.exe --as-ppx "C:\cygwin64\tmp\camlppx19cd6d" "C:\cygwin64\tmp\camlppxa0b83a"
+
+ [2]
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
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_stuff.exe --as-ppx -loc-filename new_fn.ml "C:\cygwin64\tmp\camlppxc5ca98" "C:\cygwin64\tmp\camlppx825052"
+
+ [2]
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'.
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_stuff.exe --as-ppx -dont-apply test "C:\cygwin64\tmp\camlppx248d0b" "C:\cygwin64\tmp\camlppxff6424"
+
[2]
File "test/502_pexpfun/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/502_pexpfun/test.ml _build/default/test/502_pexpfun/test.ml.corrected
diff --git a/_build/default/test/502_pexpfun/test.ml b/_build/default/test/502_pexpfun/test.ml.corrected
index 19cd52a..e69de29 100755
--- a/_build/default/test/502_pexpfun/test.ml
+++ b/_build/default/test/502_pexpfun/test.ml.corrected
@@ -1,23 +0,0 @@
-open Ppxlib
-
-module B = Ast_builder.Make (struct
- let loc = !Ast_helper.default_loc
-end)
-[%%ignore]
-
-(** Using multiple calls to [pexp_fun] still produces a maximum arity function
-*)
-let _ =
- let inner =
- B.pexp_fun Nolabel None
- (B.ppat_var { txt = "y"; loc = B.loc })
- (B.pexp_apply (B.evar "Int.add")
- [ (Nolabel, B.evar "x"); (Nolabel, B.evar "y") ])
- in
- let e =
- B.pexp_fun Nolabel None (B.ppat_var { txt = "x"; loc = B.loc }) inner
- in
- Format.asprintf "%a" Pprintast.expression e
-[%%expect{|
-- : string = "fun x y -> Int.add x y"
-|}]
File "test/metaquot/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/metaquot/test.ml _build/default/test/metaquot/test.ml.corrected
diff --git a/_build/default/test/metaquot/test.ml b/_build/default/test/metaquot/test.ml.corrected
index cefd632..e69de29 100755
--- a/_build/default/test/metaquot/test.ml
+++ b/_build/default/test/metaquot/test.ml.corrected
@@ -1,665 +0,0 @@
-let loc = Ppxlib.Location.none
-[%%expect{|
-val loc : Warnings.loc =
- {Ppxlib.Location.loc_start =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_end =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_ghost = true}
-|}]
-
-(* unannotated quotations *)
-
-let _ = [%expr ()]
-[%%expect{|
-- : Ppxlib.expression =
-{Ppxlib_ast.Ast.pexp_desc =
- Ppxlib_ast.Ast.Pexp_construct
- ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}},
- None);
- pexp_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pexp_loc_stack = []; pexp_attributes = []}
-|}]
-
-let _ = [%pat? ()]
-[%%expect{|
-- : Ppxlib.pattern =
-{Ppxlib_ast.Ast.ppat_desc =
- Ppxlib_ast.Ast.Ppat_construct
- ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}},
- None);
- ppat_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- ppat_loc_stack = []; ppat_attributes = []}
-|}]
-
-let _ = [%type: unit]
-[%%expect{|
-- : Ppxlib.core_type =
-{Ppxlib_ast.Ast.ptyp_desc =
- Ppxlib_ast.Ast.Ptyp_constr
- ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "unit";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}},
- []);
- ptyp_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- ptyp_loc_stack = []; ptyp_attributes = []}
-|}]
-
-let _ = [%stri let _ = ()]
-[%%expect{|
-- : Ppxlib.structure_item =
-{Ppxlib_ast.Ast.pstr_desc =
- Ppxlib_ast.Ast.Pstr_value (Ppxlib_ast.Ast.Nonrecursive,
- [{Ppxlib_ast.Ast.pvb_pat =
- {Ppxlib_ast.Ast.ppat_desc = Ppxlib_ast.Ast.Ppat_any;
- ppat_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- ppat_loc_stack = []; ppat_attributes = []};
- pvb_expr =
- {Ppxlib_ast.Ast.pexp_desc =
- Ppxlib_ast.Ast.Pexp_construct
- ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0;
- pos_bol = 0; pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0;
- pos_bol = 0; pos_cnum = -1};
- loc_ghost = true}},
- None);
- pexp_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pexp_loc_stack = []; pexp_attributes = []};
- pvb_constraint = None; pvb_attributes = [];
- pvb_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]);
- pstr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}
-|}]
-
-let _ = [%sigi: include S]
-[%%expect{|
-- : Ppxlib.signature_item =
-{Ppxlib_ast.Ast.psig_desc =
- Ppxlib_ast.Ast.Psig_include
- {Ppxlib_ast.Ast.pincl_mod =
- {Ppxlib_ast.Ast.pmty_desc =
- Ppxlib_ast.Ast.Pmty_ident
- {Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "S";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- pmty_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pmty_attributes = []};
- pincl_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pincl_attributes = []};
- psig_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}
-|}]
-
-let _ = [%str let _ = ()]
-[%%expect{|
-- : Ppxlib_ast.Ast.structure =
-[{Ppxlib_ast.Ast.pstr_desc =
- Ppxlib_ast.Ast.Pstr_value (Ppxlib_ast.Ast.Nonrecursive,
- [{Ppxlib_ast.Ast.pvb_pat =
- {Ppxlib_ast.Ast.ppat_desc = Ppxlib_ast.Ast.Ppat_any;
- ppat_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- ppat_loc_stack = []; ppat_attributes = []};
- pvb_expr =
- {Ppxlib_ast.Ast.pexp_desc =
- Ppxlib_ast.Ast.Pexp_construct
- ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0;
- pos_bol = 0; pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0;
- pos_bol = 0; pos_cnum = -1};
- loc_ghost = true}},
- None);
- pexp_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pexp_loc_stack = []; pexp_attributes = []};
- pvb_constraint = None; pvb_attributes = [];
- pvb_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]);
- pstr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-let _ = [%sig: include S]
-[%%expect{|
-- : Ppxlib_ast.Ast.signature =
-[{Ppxlib_ast.Ast.psig_desc =
- Ppxlib_ast.Ast.Psig_include
- {Ppxlib_ast.Ast.pincl_mod =
- {Ppxlib_ast.Ast.pmty_desc =
- Ppxlib_ast.Ast.Pmty_ident
- {Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "S";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- pmty_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pmty_attributes = []};
- pincl_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true};
- pincl_attributes = []};
- psig_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-(* attributes *)
-
-let _ =
- let e = [%expr (() [@attr1])] in
- [%expr [%e e] [@attr2]].pexp_attributes
-[%%expect{|
-- : Ppxlib_ast.Ast.attributes =
-[{Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr1";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- {Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr2";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-let _ =
- let p = [%pat? (() [@attr1])] in
- [%pat? [%p p] [@attr2]].ppat_attributes
-[%%expect{|
-- : Ppxlib_ast.Ast.attributes =
-[{Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr1";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- {Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr2";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-let _ =
- let t = [%type: (unit [@attr1])] in
- [%type: [%t t] [@attr2]].ptyp_attributes
-[%%expect{|
-- : Ppxlib_ast.Ast.attributes =
-[{Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr1";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- {Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr2";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-let _ =
- let extract_module_M m =
- match m with
- | [%stri module M = [%m? m]] -> m
- | _ -> assert false
- in
- let m = extract_module_M [%stri module M = (struct end [@attr1])] in
- (extract_module_M [%stri module M = [%m m] [@attr2]]).pmod_attributes
-[%%expect{|
-- : Ppxlib_ast.Ast.attributes =
-[{Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr1";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- {Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr2";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-let _ =
- let extract_module_ty_S s =
- match s with
- | [%stri module type S = [%m? s]] -> s
- | _ -> assert false
- in
- let s = extract_module_ty_S [%stri module type S = (sig end [@attr1])] in
- (extract_module_ty_S [%stri module type S = [%m s] [@attr2]]).pmty_attributes
-[%%expect{|
-- : Ppxlib_ast.Ast.attributes =
-[{Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr1";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- {Ppxlib_ast.Ast.attr_name =
- {Ppxlib_ast.Ast.txt = "attr2";
- loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}};
- attr_payload = Ppxlib_ast.Ast.PStr [];
- attr_loc =
- {Ppxlib_ast.Ast.loc_start =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_end =
- {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0;
- pos_cnum = -1};
- loc_ghost = true}}]
-|}]
-
-(* mistyped escapes (not producing ASTs at all) *)
-
-let _ = [%expr [%e ()]]
-[%%expect_in <= 5.2 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.expression
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.expression
-|}]
-
-let _ = [%pat? [%p ()]]
-[%%expect_in <= 5.2 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.pattern
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.pattern
-|}]
-
-let _ = [%type: [%t ()]]
-[%%expect_in <= 5.2 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.core_type
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.core_type
-|}]
-
-let _ = [%stri [%%i ()]]
-[%%expect_in <= 5.2 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.structure_item
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.structure_item
-|}]
-
-let _ = [%sigi: [%%i ()]]
-[%%expect_in <= 5.2 {|
-Line _, characters 21-23:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.signature_item
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 21-23:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.signature_item
-|}]
-
-(* mistyped escapes (not producing ASTs at all) with attributes *)
-
-let _ = [%expr [%e ()] [@attr]]
-[%%expect_in <= 5.2 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.expression
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.expression
-|}]
-
-let _ = [%pat? [%p ()] [@attr]]
-[%%expect_in <= 5.2 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.pattern
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 19-21:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.pattern
-|}]
-
-let _ = [%type: [%t ()] [@attr]]
-[%%expect_in <= 5.2 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.core_type
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 20-22:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.core_type
-|}]
-
-let _ = [%stri module M = [%m ()] [@attr]]
-[%%expect_in <= 5.2 {|
-Line _, characters 30-32:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.module_expr
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 30-32:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.module_expr
-|}]
-
-let _ = [%sigi: module type M = [%m ()] [@attr]]
-[%%expect_in <= 5.2 {|
-Line _, characters 36-38:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib_ast.Ast.module_type
-|}]
-[%%expect_in >= 5.3 {|
-Line _, characters 36-38:
-Error: This expression should not be a unit literal, the expected type is
- Ppxlib.module_type
-|}]
-
-(* Coalescing arguments from [fun x -> fun y -> fun z -> ...] to
- [fun x y z -> ...] *)
-let _ =
- let e = [%expr fun z -> x + y + z] in
- let f = [%expr fun y -> [%e e]] in
- let func = [%expr fun x -> [%e f]] in
- Format.asprintf "%a" Astlib.Pprintast.expression func
-[%%expect{|
-- : string = "fun x y z -> (x + y) + z"
-|}]
File "test/encoding/503/api/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/encoding/503/api/test.ml _build/default/test/encoding/503/api/test.ml.corrected
diff --git a/_build/default/test/encoding/503/api/test.ml b/_build/default/test/encoding/503/api/test.ml.corrected
index c1b1bb5..e69de29 100755
--- a/_build/default/test/encoding/503/api/test.ml
+++ b/_build/default/test/encoding/503/api/test.ml.corrected
@@ -1,55 +0,0 @@
-open Ppxlib_ast
-
-module To_ocaml = Convert (Js) (Compiler_version)
-module From_ocaml = Convert (Compiler_version) (Js)
-
-open Ppxlib
-
-#install_printer Pprintast.pattern;;
-
-module Builder = Ast_builder.Make(struct let loc = Location.none end)
-
-let effect_construct =
- Builder.(ppat_construct
- (Located.mk (Longident.parse "Xchg"))
- (Some (ppat_var (Located.mk "n"))))
-
-(* Generate an encoded effect pattern *)
-let encoded_effect_pattern =
- Builder.ppat_effect
- effect_construct
- Builder.(ppat_var (Located.mk "k"))
-
-(* Migrate it to the current compiler (>= 5.3, as per dune rules) *)
-let effect_pattern = To_ocaml.copy_pattern encoded_effect_pattern
-[%%ignore]
-
-let as_source =
- Format.asprintf "%a" Astlib.Compiler_pprintast.pattern effect_pattern;;
-[%%expect{|
-val as_source : string = "effect Xchg n, k"
-|}]
-
-(* Migrate back to ppxlib's AST *)
-let encoded_by_migration = From_ocaml.copy_pattern effect_pattern
-
-let pattern = Ast_pattern.(ppat_effect __ __)
-[%%ignore]
-
-let destruct_from_migration =
- Ast_pattern.parse_res pattern Location.none encoded_by_migration
- (fun effect_ k -> (effect_, k))
-[%%expect{|
-val destruct_from_migration :
- (pattern * pattern, Location.Error.t Stdppx.NonEmptyList.t) result =
- Ok (Xchg n, k)
-|}]
-
-let destruct =
- Ast_pattern.parse_res pattern Location.none encoded_effect_pattern
- (fun effect_ k -> (effect_, k))
-[%%expect{|
-val destruct :
- (pattern * pattern, Location.Error.t Stdppx.NonEmptyList.t) result =
- Ok (Xchg n, k)
-|}]
File "test/code_path/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/code_path/test.ml _build/default/test/code_path/test.ml.corrected
diff --git a/_build/default/test/code_path/test.ml b/_build/default/test/code_path/test.ml.corrected
index a331cb6..e69de29 100755
--- a/_build/default/test/code_path/test.ml
+++ b/_build/default/test/code_path/test.ml.corrected
@@ -1,160 +0,0 @@
-open Ppxlib
-
-let sexp_of_code_path code_path =
- Sexplib0.Sexp.message
- "code_path"
- [ "main_module_name", Sexplib0.Sexp_conv.sexp_of_string (Code_path.main_module_name code_path)
- ; "submodule_path", Sexplib0.Sexp_conv.sexp_of_list Sexplib0.Sexp_conv.sexp_of_string (Code_path.submodule_path code_path)
- ; "enclosing_module", Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_module code_path)
- ; "enclosing_value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_value code_path)
- ; "value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.value code_path)
- ; "fully_qualified_path", Sexplib0.Sexp_conv.sexp_of_string (Code_path.fully_qualified_path code_path)
- ]
-
-let () =
- Driver.register_transformation "test"
- ~extensions:[
- Extension.V3.declare "code_path"
- Expression
- Ast_pattern.(pstr nil)
- (fun ~ctxt ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- let code_path = Expansion_context.Extension.code_path ctxt in
- Ast_builder.Default.estring ~loc
- (Sexplib0.Sexp.to_string (sexp_of_code_path code_path)))
- ]
-[%%expect{|
-val sexp_of_code_path : Code_path.t -> Sexplib0.Sexp.t = <fun>
-|}]
-
-let s =
- let module A = struct
- module A' = struct
- let a =
- let module B = struct
- module B' = struct
- let b =
- let module C = struct
- module C' = struct
- let c = [%code_path]
- end
- end
- in C.C'.c
- end
- end
- in B.B'.b
- end
- end
- in A.A'.a
-;;
-[%%expect{|
-val s : string =
- "(code_path(main_module_name Test)(submodule_path())(enclosing_module C')(enclosing_value(c))(value(s))(fully_qualified_path Test.s))"
-|}]
-
-let module M = struct
- let m = [%code_path]
- end
- in
- M.m
-[%%expect{|
-- : string =
-"(code_path(main_module_name Test)(submodule_path())(enclosing_module M)(enclosing_value(m))(value())(fully_qualified_path Test))"
-|}]
-
-module Outer = struct
- module Inner = struct
- let code_path = [%code_path]
- end
-end
-let _ = Outer.Inner.code_path
-[%%expect{|
-module Outer : sig module Inner : sig val code_path : string end end
-- : string =
-"(code_path(main_module_name Test)(submodule_path(Outer Inner))(enclosing_module Inner)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test.Outer.Inner.code_path))"
-|}]
-
-module Functor() = struct
- let code_path = ref ""
- module _ = struct
- let x =
- let module First_class = struct
- code_path := [%code_path]
- end in
- let module _ = First_class in
- ()
- ;;
-
- ignore x
- end
-end
-let _ = let module M = Functor() in !M.code_path
-[%%expect_in <= 5.2 {|
-module Functor : functor () -> sig val code_path : string ref end
-- : string =
-"(code_path(main_module_name Test)(submodule_path(Functor _))(enclosing_module First_class)(enclosing_value(x))(value(x))(fully_qualified_path Test.Functor._.x))"
-|}]
-[%%expect_in >= 5.3 {|
-module Functor : () -> sig val code_path : string ref end
-- : string =
-"(code_path(main_module_name Test)(submodule_path(Functor _))(enclosing_module First_class)(enclosing_value(x))(value(x))(fully_qualified_path Test.Functor._.x))"
-|}]
-
-module Actual = struct
- let code_path = [%code_path]
-end [@enter_module Dummy]
-let _ = Actual.code_path
-[%%expect{|
-module Actual : sig val code_path : string end
-- : string =
-"(code_path(main_module_name Test)(submodule_path(Actual Dummy))(enclosing_module Dummy)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test.Actual.Dummy.code_path))"
-|}]
-
-module Ignore_me = struct
- let code_path = [%code_path]
-end [@@do_not_enter_module]
-let _ = Ignore_me.code_path
-[%%expect{|
-module Ignore_me : sig val code_path : string end
-- : string =
-"(code_path(main_module_name Test)(submodule_path())(enclosing_module Test)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test.code_path))"
-|}]
-
-let _ =
- (let module Ignore_me = struct
- let code_path = [%code_path]
- end
- in
- Ignore_me.code_path)
- [@do_not_enter_module]
-[%%expect{|
-- : string =
-"(code_path(main_module_name Test)(submodule_path())(enclosing_module Test)(enclosing_value(code_path))(value())(fully_qualified_path Test))"
-|}]
-
-let _ = ([%code_path] [@ppxlib.enter_value dummy])
-[%%expect{|
-- : string =
-"(code_path(main_module_name Test)(submodule_path())(enclosing_module Test)(enclosing_value(dummy))(value(dummy))(fully_qualified_path Test.dummy))"
-|}]
-
-let _ =
- let ignore_me = [%code_path]
- [@@do_not_enter_value]
- in
- ignore_me
-[%%expect{|
-- : string =
-"(code_path(main_module_name Test)(submodule_path())(enclosing_module Test)(enclosing_value())(value())(fully_qualified_path Test))"
-|}]
-
-
-let _ =
- (* The main module name should properly remove all extensions *)
- let code_path =
- Code_path.top_level ~file_path:"some_dir/module_name.cppo.ml"
- in
- Code_path.main_module_name code_path
-[%%expect{|
-- : string = "Module_name"
-|}]
File "test/base/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/base/test.ml _build/default/test/base/test.ml.corrected
diff --git a/_build/default/test/base/test.ml b/_build/default/test/base/test.ml.corrected
index e9eb9da..e69de29 100755
--- a/_build/default/test/base/test.ml
+++ b/_build/default/test/base/test.ml.corrected
@@ -1,299 +0,0 @@
-let () = Printexc.record_backtrace false
-
-open Ppxlib
-
-module N = Ppxlib_private.Name
-[%%expect{|
-module N = Ppxlib.Ppxlib_private.Name
-|}]
-
-
-let dot_suffixes name =
- Printf.sprintf "%s"
- (Sexplib0.Sexp.to_string_hum
- (Sexplib0.Sexp_conv.sexp_of_list Sexplib0.Sexp_conv.sexp_of_string (N.dot_suffixes name)))
-[%%expect{|
-val dot_suffixes : string -> string = <fun>
-|}]
-
-let _ = dot_suffixes "foo.bar.baz"
-[%%expect{|
-- : string = "(baz bar.baz foo.bar.baz)"
-|}]
-
-let _ = dot_suffixes "foo.@bar.baz"
-[%%expect{|
-- : string = "(bar.baz foo.bar.baz)"
-|}]
-
-
-let split_path name =
- let a, b = N.split_path name in
- Printf.sprintf "%s"
- (Sexplib0.Sexp.to_string_hum
- (List [Sexplib0.Sexp_conv.sexp_of_string a; Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string b]))
-[%%expect{|
-val split_path : string -> string = <fun>
-|}]
-
-let _ = split_path "a.b.c"
-[%%expect{|
-- : string = "(a.b.c ())"
-|}]
-
-let _ = split_path "a.b.c.D"
-[%%expect{|
-- : string = "(a.b.c (D))"
-|}]
-
-let _ = split_path ".D"
-[%%expect{|
-- : string = "(\"\" (D))"
-|}]
-
-let convert_longident string =
- let lident = Longident.parse string in
- let name = Longident.name lident in
- (name, lident)
-[%%expect{|
-val convert_longident : string -> string * longident = <fun>
-|}]
-
-let _ = convert_longident "x"
-[%%expect_in <= 5.3 {|
-- : string * longident = ("x", Ppxlib.Longident.Lident "x")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("x", Longident.Lident "x")
-|}]
-
-let _ = convert_longident "(+)"
-[%%expect_in <= 5.3 {|
-- : string * longident = ("( + )", Ppxlib.Longident.Lident "+")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( + )", Longident.Lident "+")
-|}]
-
-let _ = convert_longident "( + )"
-[%%expect_in <= 5.3 {|
-- : string * longident = ("( + )", Ppxlib.Longident.Lident "+")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( + )", Longident.Lident "+")
-|}]
-
-let _ = convert_longident "Base.x"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Base.x", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "x"))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Base.x", Longident.Ldot (Longident.Lident "Base", "x"))
-|}]
-
-let _ = convert_longident "Base.(+)"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+"))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Base.( + )", Longident.Ldot (Longident.Lident "Base", "+"))
-|}]
-
-let _ = convert_longident "Base.( + )"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+"))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Base.( + )", Longident.Ldot (Longident.Lident "Base", "+"))
-|}]
-
-let _ = convert_longident "Base.( land )"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Base.( land )",
- Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "land"))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Base.( land )", Longident.Ldot (Longident.Lident "Base", "land"))
-|}]
-
-let _ = convert_longident "A(B)"
-[%%expect_in <= 5.3 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(application in path): \"A(B)\"".
-|}]
-[%%expect_in >= 5.4 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(application in path): \"A(B)\"".
-|}]
-
-let _ = convert_longident "A.B(C)"
-[%%expect_in <= 5.3 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(application in path): \"A.B(C)\"".
-|}]
-[%%expect_in >= 5.4 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(application in path): \"A.B(C)\"".
-|}]
-
-let _ = convert_longident ")"
-[%%expect_in <= 5.3 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \")\"".
-|}]
-[%%expect_in >= 5.4 {|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \")\"".
-|}]
-
-let _ = convert_longident "("
-[%%expect{|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \"(\"".
-|}]
-
-let _ = convert_longident "A.(()"
-[%%expect{|
-Exception:
-Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \"A.(()\"".
-|}]
-
-let _ = convert_longident "A.())()"
-[%%expect{|
-Exception:
-Invalid_argument
- "Ppxlib.Longident.parse(right parenthesis misplaced): \"A.())()\"".
-|}]
-
-let _ = convert_longident "+."
-[%%expect_in <= 5.3 {|
-- : string * longident = ("( +. )", Ppxlib.Longident.Lident "+.")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( +. )", Longident.Lident "+.")
-|}]
-
-let _ = conver_longident "(+.)"
-[%%expect_in <= 5.3 {|
-- : string * longident = ("( +. )", Ppxlib.Longident.Lident "+.")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( +. )", Longident.Lident "+.")
-|}]
-
-let _ = convert_longident "Foo.(+.)"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Foo.( +. )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Foo", "+."))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Foo.( +. )", Longident.Ldot (Longident.Lident "Foo", "+."))
-|}]
-
-let _ = convert_longident "Foo.( *. )"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Foo.( *. )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Foo", "*."))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Foo.( *. )", Longident.Ldot (Longident.Lident "Foo", "*."))
-|}]
-
-(* Indexing operators *)
-let _ = convert_longident "(.!())"
-[%%expect_in <= 5.3 {|
-- : string * longident = ("( .!() )", Ppxlib.Longident.Lident ".!()")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( .!() )", Longident.Lident ".!()")
-|}]
-
-let _ = convert_longident "(.%(;..)<-)"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("( .%(;..)<- )", Ppxlib.Longident.Lident ".%(;..)<-")
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident = ("( .%(;..)<- )", Longident.Lident ".%(;..)<-")
-|}]
-
-let _ = convert_longident "Vec.(.%(;..)<-)"
-[%%expect_in <= 5.3 {|
-- : string * longident =
-("Vec.( .%(;..)<- )",
- Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Vec", ".%(;..)<-"))
-|}]
-[%%expect_in >= 5.4 {|
-- : string * longident =
-("Vec.( .%(;..)<- )", Longident.Ldot (Longident.Lident "Vec", ".%(;..)<-"))
-|}]
-
-let _ = Ppxlib.Code_path.(file_path @@ top_level ~file_path:"dir/main.ml")
-[%%expect{|
-- : string = "dir/main.ml"
-|}]
-
-let _ = Ppxlib.Code_path.(fully_qualified_path @@ top_level ~file_path:"dir/main.ml")
-[%%expect{|
-- : string = "Main"
-|}]
-
-let complex_path =
- let open Ppxlib.Code_path in
- let loc = Ppxlib.Location.none in
- top_level ~file_path:"dir/main.ml"
- |> enter_module ~loc "Sub"
- |> enter_module ~loc "Sub_sub"
- |> enter_value ~loc "some_val"
-[%%expect{|
-val complex_path : Code_path.t = <abstr>
-|}]
-
-let _ = Ppxlib.Code_path.fully_qualified_path complex_path
-[%%expect{|
-- : string = "Main.Sub.Sub_sub.some_val"
-|}]
-
-let _ = Ppxlib.Code_path.to_string_path complex_path
-[%%expect{|
-- : string = "dir/main.ml.Sub.Sub_sub"
-|}]
-
-let _ =
- let a = gen_symbol () ~prefix:"__prefix__" in
- let b = gen_symbol () ~prefix:a in
- a, b
-[%%expect{|
-- : string * string = ("__prefix____001_", "__prefix____002_")
-|}]
-
-let _ =
- let open Ast_builder.Make (struct let loc = Location.none end) in
- let params decl =
- List.map (fun (core_type, _) -> core_type.ptyp_desc) decl.ptype_params
- in
- let decl =
- type_declaration
- ~name:{ txt = "t"; loc = Location.none }
- ~params:(List.init 3 (fun _ -> ptyp_any, (NoVariance, NoInjectivity)))
- ~cstrs:[]
- ~kind:Ptype_abstract
- ~private_:Public
- ~manifest:None
- in
- params decl, params (name_type_params_in_td decl)
-[%%expect{|
-- : core_type_desc list * core_type_desc list =
-([Ptyp_any; Ptyp_any; Ptyp_any],
- [Ptyp_var "a__003_"; Ptyp_var "b__004_"; Ptyp_var "c__005_"])
-|}]
File "test/ast_builder_value_binding/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/ast_builder_value_binding/test.ml _build/default/test/ast_builder_value_binding/test.ml.corrected
diff --git a/_build/default/test/ast_builder_value_binding/test.ml b/_build/default/test/ast_builder_value_binding/test.ml.corrected
index 3e537b9..e69de29 100755
--- a/_build/default/test/ast_builder_value_binding/test.ml
+++ b/_build/default/test/ast_builder_value_binding/test.ml.corrected
@@ -1,198 +0,0 @@
-open Ppxlib
-
-(* This file contains tests to ensure that [Ast_builder.value_binding] properly
- translates the given [pattern] and [expression] pair into the correct
- [pattern], [expression] and [value_constraint] triple. *)
-
-
-(* ------- Test Setup -------- *)
-
-#install_printer Pp_ast.Default.structure_item;;
-#install_printer Pp_ast.Default.expression;;
-#install_printer Pp_ast.Default.pattern;;
-
-let loc = Location.none
-[%%ignore]
-
-(* --------- Simple case, no translation --------- *)
-
-let pat = [%pat? f]
-let expr = [%expr fun x -> x + 1]
-[%%ignore]
-
-let vb =
- let open Ast_builder.Default in
- pstr_value ~loc Nonrecursive [value_binding ~pat ~expr ~loc]
-
-[%%expect{|
-val vb : structure_item =
- Pstr_value
- ( Nonrecursive
- , [ { pvb_pat = Ppat_var "f"
- ; pvb_expr =
- Pexp_function
- ( [ { pparam_loc = __loc
- ; pparam_desc = Pparam_val ( Nolabel, None, Ppat_var "x")
- }
- ]
- , None
- , Pfunction_body
- (Pexp_apply
- ( Pexp_ident (Lident "+")
- , [ ( Nolabel, Pexp_ident (Lident "x"))
- ; ( Nolabel
- , Pexp_constant (Pconst_integer ( "1", None))
- )
- ]
- ))
- )
- ; pvb_constraint = None
- ; pvb_attributes = __attrs
- ; pvb_loc = __loc
- }
- ]
- )
-|}]
-
-(* As expected here, the [pvb_constraint] field is none, the pattern and
- expression are used as is. *)
-
-(* --------- No var Ppat_constraint to pvb_constraint --------- *)
-
-let pat = [%pat? (x : int)]
-let expr = [%expr 12]
-[%%ignore]
-
-let vb =
- let open Ast_builder.Default in
- pstr_value ~loc Nonrecursive [value_binding ~pat ~expr ~loc]
-
-[%%expect{|
-val vb : structure_item =
- Pstr_value
- ( Nonrecursive
- , [ { pvb_pat = Ppat_var "x"
- ; pvb_expr = Pexp_constant (Pconst_integer ( "12", None))
- ; pvb_constraint =
- Some
- (Pvc_constraint
- { locally_abstract_univars = []
- ; typ = Ptyp_constr ( Lident "int", [])
- })
- ; pvb_attributes = __attrs
- ; pvb_loc = __loc
- }
- ]
- )
-|}]
-
-(* --------- poly Ppat_constraint to pvb_constraint --------- *)
-
-let pat =
- Ast_builder.Default.ppat_constraint ~loc
- [%pat? f]
- (Ast_builder.Default.ptyp_poly ~loc
- [ Loc.make ~loc "a" ]
- [%type: 'a -> unit])
-
-let expr = [%expr fun x -> unit]
-
-[%%ignore]
-
-let vb =
- let open Ast_builder.Default in
- pstr_value ~loc Nonrecursive [value_binding ~pat ~expr ~loc]
-
-[%%expect{|
-val vb : structure_item =
- Pstr_value
- ( Nonrecursive
- , [ { pvb_pat = Ppat_var "f"
- ; pvb_expr =
- Pexp_function
- ( [ { pparam_loc = __loc
- ; pparam_desc = Pparam_val ( Nolabel, None, Ppat_var "x")
- }
- ]
- , None
- , Pfunction_body (Pexp_ident (Lident "unit"))
- )
- ; pvb_constraint =
- Some
- (Pvc_constraint
- { locally_abstract_univars = []
- ; typ =
- Ptyp_poly
- ( [ "a"]
- , Ptyp_arrow
- ( Nolabel
- , Ptyp_var "a"
- , Ptyp_constr ( Lident "unit", [])
- )
- )
- })
- ; pvb_attributes = __attrs
- ; pvb_loc = __loc
- }
- ]
- )
-|}]
-
-(* --------- desugared locally abstract univars to pvb_constraint --------- *)
-
-let pat =
- Ast_builder.Default.ppat_constraint ~loc
- [%pat? f]
- (Ast_builder.Default.ptyp_poly ~loc
- [ Loc.make ~loc "a" ]
- [%type: 'a -> unit])
-
-let expr = [%expr fun (type a) -> (fun _ -> unit : a -> unit)]
-
-[%%ignore]
-
-let vb =
- let open Ast_builder.Default in
- pstr_value ~loc Nonrecursive [value_binding ~pat ~expr ~loc]
-
-[%%expect{|
-val vb : structure_item =
- Pstr_value
- ( Nonrecursive
- , [ { pvb_pat = Ppat_var "f"
- ; pvb_expr =
- Pexp_function
- ( [ { pparam_loc = __loc
- ; pparam_desc = Pparam_val ( Nolabel, None, Ppat_any)
- }
- ]
- , None
- , Pfunction_body (Pexp_ident (Lident "unit"))
- )
- ; pvb_constraint =
- Some
- (Pvc_constraint
- { locally_abstract_univars = [ "a"]
- ; typ =
- Ptyp_arrow
- ( Nolabel
- , Ptyp_constr ( Lident "a", [])
- , Ptyp_constr ( Lident "unit", [])
- )
- })
- ; pvb_attributes = __attrs
- ; pvb_loc = __loc
- }
- ]
- )
-|}]
-
-(* As expected here, the matching constraint from the pattern and expression or
- recombined into a single value constraint with locally abstract univars set
- correctly. *)
-
-(* --------- coercion to pvb_constraint --------- *)
-
-(*TODO*)
-[%%expect{|
-|}]
File "test/expansion_inside_payloads/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/expansion_inside_payloads/test.ml _build/default/test/expansion_inside_payloads/test.ml.corrected
diff --git a/_build/default/test/expansion_inside_payloads/test.ml b/_build/default/test/expansion_inside_payloads/test.ml.corrected
index 55727f8..e69de29 100755
--- a/_build/default/test/expansion_inside_payloads/test.ml
+++ b/_build/default/test/expansion_inside_payloads/test.ml.corrected
@@ -1,230 +0,0 @@
-open Ppxlib
-
-(* --------------------------- Test Setup ----------------------------------- *)
-
-(* These tests check that the inside of payloads is properly expanded or not
- expanded by the driver. *)
-
-let expr_description ~loc ~error expr =
- match expr.pexp_desc with
- | Pexp_constant (Pconst_integer _) ->
- Ast_builder.Default.estring ~loc "Payload is an integer"
- | Pexp_extension _ ->
- Ast_builder.Default.estring ~loc "Payload is an extension point"
- | _ -> error ()
-
-[%%expect{|
-val expr_description :
- loc:location -> error:(unit -> expression) -> expression -> expression =
- <fun>
-|}]
-
-let payload_description ~loc ~transformation_name payload =
- let error () =
- Location.raise_errorf ~loc "Invalid %s payload!" transformation_name
- in
- (match payload with
- | PStr [{ pstr_desc = Pstr_eval (expr, _attr); _ }] ->
- expr_description ~loc ~error expr
- | _ -> error ())
-
-[%%expect{|
-val payload_description :
- loc:location -> transformation_name:string -> payload -> expression = <fun>
-|}]
-
-(* A legacy transformation, rewriting [%legacy_add_one ...] as
- a string, describing the kind of the payload. Only accepts integer and
- extensions as payloads. *)
-let legacy_describe_payload =
- object
- inherit Ast_traverse.map as super
-
- method! expression expr =
- match expr.pexp_desc with
- | Pexp_extension ({txt = "legacy_describe_payload"; _}, payload) ->
- let loc = expr.pexp_loc in
- payload_description ~loc ~transformation_name:"legacy_describe_payload"
- payload
- | _ -> super#expression expr
- end
-
-let () =
- Driver.register_transformation
- ~impl:legacy_describe_payload#structure
- "legacy_describe_payload"
-
-[%%expect{|
-val legacy_describe_payload : Ast_traverse.map = <obj>
-|}]
-
-(* A legacy attribute-based generator implemented as a whole AST transformation.
- [type _ = _ [@@gen_x payload]] generates an extra [let x = <string>] where
- [<string>] is a descriptiong of the kind of [payload]. Only accepts integer
- and extensions as payloads. *)
-let legacy_deriver =
- let get_gen_x attrs =
- List.find_map
- (function
- | {attr_name = {txt = "gen_x"; _}; attr_payload; attr_loc} ->
- Some (attr_payload, attr_loc)
- | _ -> None)
- attrs
- in
- object(self)
- inherit Ast_traverse.map
-
- method! structure str =
- List.concat_map
- (fun stri ->
- match stri.pstr_desc with
- | Pstr_type (_, [{ptype_attributes = (_::_ as attrs); _}]) ->
- (match get_gen_x attrs with
- | Some (payload, loc) ->
- let value =
- payload_description ~loc ~transformation_name:"gen_x" payload
- in
- let stri = self#structure_item stri in
- let x_binding = [%stri let x = [%e value]] in
- [stri; x_binding]
- | None -> [self#structure_item stri])
- | _ -> [self#structure_item stri])
- str
- end
-
-let () =
- Driver.register_transformation
- ~impl:legacy_deriver#structure
- "legacy_deriver"
-
-[%%expect{|
-val legacy_deriver : Ast_traverse.map = <obj>
-|}]
-
-(* An expression extension that simply expands to its payload.
- I.e. [[%id 1]] expands to [1]. *)
-let id =
- Extension.V3.declare
- "id"
- Extension.Context.expression
- Ast_pattern.(single_expr_payload __)
- (fun ~ctxt:_ expr -> expr)
- |> Context_free.Rule.extension
-
-let () = Driver.register_transformation ~rules:[id] "id"
-
-[%%expect{|
-val id : Context_free.Rule.t = <abstr>
-|}]
-
-(* ------------------------- Actual Test ----------------------------------- *)
-
-(* Context free transformations are applied inside payload of extensions or
- attributes that aren't themselves expanded by context-free rules
-
- The examples below are expected to display that their paylaod is an integer
- as the extension inside the payload should be expanded during the
- context-free rule pass, that happens before whole AST transformations. *)
-let x = [%legacy_describe_payload [%id 1]]
-
-[%%expect{|
-val x : string = "Payload is an integer"
-|}]
-
-type t = unit
-[@@gen_x [%id 1]]
-
-[%%expect{|
-type t = unit
-val x : string = "Payload is an integer"
-|}]
-
-(* --------------------------- Test Setup ----------------------------------- *)
-
-(* The same transformation as [legacy_describe_payload] but written as a
- context-free rule *)
-let describe_payload =
- Extension.V3.declare
- "describe_payload"
- Extension.Context.expression
- Ast_pattern.__
- (fun ~ctxt payload ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- payload_description ~loc ~transformation_name:"describe_payload" payload)
- |> Context_free.Rule.extension
-
-let () = Driver.register_transformation ~rules:[describe_payload] "describe_payload"
-
-[%%expect{|
-val describe_payload : Context_free.Rule.t = <abstr>
-|}]
-
-(* A deriver that accepts a [payload] argument. It generates a value binding
- to a string describing the nature of its payload.
- E.g. [type t = _ [@@deriving x ~payload:1]] will derive
- [let x = "Payload is an integer"].
- The value argument only accepts integer and extensions. *)
-let deriver =
- let expand ~ctxt _type_decl payload =
- let loc = Expansion_context.Deriver.derived_item_loc ctxt in
- let value =
- match payload with
- | None -> Location.raise_errorf ~loc "payload argument is mandatory"
- | Some expr ->
- let error () =
- Location.raise_errorf ~loc "Invalid 'deriving x' payload!"
- in
- expr_description ~loc ~error expr
- in
- [%str let x = [%e value]]
- in
- let args =
- let open Deriving.Args in
- let payload = arg "payload" Ast_pattern.__ in
- empty +> payload
- in
- let str_type_decl =
- Deriving.Generator.V2.make args expand
- in
- Deriving.add ~str_type_decl "x"
-
-[%%expect{|
-val deriver : Deriving.t = <abstr>
-|}]
-
-(* ------------------------- Actual Test ----------------------------------- *)
-
-(* Context-free transformations cannot be applied inside the payload of
- extensions that are themselves expanded by a context-free rule,
- simply because the outermost extension is expanded first.
-
- The example below should describe their payload to be an extension
- because the extension inside their payload should NOT be expanded when they
- run.
-
- This is an expected and relatively sane behaviour. As Carl Eastlund pointed
- out, it might make sense at some point to allow expander to ask ppxlib to
- expand a node explicitly via a callback but it shouldn't be done by default.
- *)
-let y = [%describe_payload [%id 1]]
-
-[%%expect{|
-val y : string = "Payload is an extension point"
-|}]
-
-(* Context-free transformations should not be applied inside the payload of
- attributes interpreted by other context-free rules. This is a bug introduced
- in https://github.com/ocaml-ppx/ppxlib/pull/279.
-
- The example below should report the payload as being an extension point as
- the [value] argument in the paylaod should NOT be expanded.
-
- Here, just as in extensions, we might eventually provide a callback to expand
- nodes explicitly. *)
-type u = unit
-[@@deriving x ~payload:[%id 1]]
-
-[%%expect{|
-type u = t
-val x : string = "Payload is an extension point"
-|}]
File "test/extensions_and_deriving/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/extensions_and_deriving/test.ml _build/default/test/extensions_and_deriving/test.ml.corrected
diff --git a/_build/default/test/extensions_and_deriving/test.ml b/_build/default/test/extensions_and_deriving/test.ml.corrected
index 0fdbf6a..e69de29 100755
--- a/_build/default/test/extensions_and_deriving/test.ml
+++ b/_build/default/test/extensions_and_deriving/test.ml.corrected
@@ -1,142 +0,0 @@
-open Ppxlib
-
-(* Generates a [let derived_<type_name> = "ok"] or a
- [let derived_<type_name> = "uninterpreted extension in input"] if
- the type manifest is an uninterpreted extension. *)
-let deriver =
- let binding ~loc type_name expr =
- let var_name = "derived_" ^ type_name in
- let pat = Ast_builder.Default.ppat_var ~loc {txt = var_name; loc} in
- let vb = Ast_builder.Default.value_binding ~loc ~pat ~expr in
- [Ast_builder.Default.pstr_value ~loc Nonrecursive [vb]]
- in
- let str_type_decl =
- Deriving.Generator.V2.make_noarg
- (fun ~ctxt (_rec_flag, type_decls) ->
- let loc = Expansion_context.Deriver.derived_item_loc ctxt in
- match type_decls with
- | { ptype_manifest = Some {ptyp_desc = Ptyp_extension _; _}
- ; ptype_name = {txt; _}; _}::_ ->
- binding ~loc txt [%expr "uninterpreted extension in input"]
- | {ptype_name = {txt; _}; _}::_ ->
- binding ~loc txt [%expr "ok"]
- | [] -> assert false)
- in
- Deriving.add ~str_type_decl "derived"
-
-[%%expect{|
-val deriver : Deriving.t = <abstr>
-|}]
-
-(* Generates a [type t = int] *)
-let gen_type_decl =
- Extension.V3.declare
- "gen_type_decl"
- Extension.Context.structure_item
- Ast_pattern.(pstr nil)
- (fun ~ctxt ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- [%stri type t = int])
- |> Context_free.Rule.extension
-
-let () = Driver.register_transformation ~rules:[gen_type_decl] "gen_type_decl"
-
-[%%expect{|
-val gen_type_decl : Context_free.Rule.t = <abstr>
-|}]
-
-(* You cannot attach attributes to structure item extension points *)
-[%%gen_type_decl]
-[@@deriving derived]
-
-[%%expect{|
-Line _, characters 3-19:
-Error: Attributes not allowed here
-|}]
-
-(* Generates a [type t = int[@@deriving derived]] *)
-let gen_type_decl_with_derived =
- Extension.V3.declare
- "gen_type_decl_with_derived"
- Extension.Context.structure_item
- Ast_pattern.(pstr nil)
- (fun ~ctxt ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- [%stri type t = int[@@deriving derived]])
- |> Context_free.Rule.extension
-
-let () =
- Driver.register_transformation
- ~rules:[gen_type_decl_with_derived]
- "gen_type_decl_with_derived"
-
-[%%expect{|
-val gen_type_decl_with_derived : Context_free.Rule.t = <abstr>
-|}]
-
-(* Attributes rule must be applied in code generated by a structure item
- extension *)
-[%%gen_type_decl_with_derived]
-
-[%%expect{|
-type t = int
-val derived_t : string = "ok"
-|}]
-
-let gen_inline_type_decls_with_derived =
- Extension.V3.declare_inline
- "gen_inline_type_decls_with_derived"
- Extension.Context.structure_item
- Ast_pattern.(pstr nil)
- (fun ~ctxt ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- [%str
- type t = int[@@deriving derived]
- type u = float[@@deriving derived]])
- |> Context_free.Rule.extension
-
-let () =
- Driver.register_transformation
- ~rules:[gen_inline_type_decls_with_derived]
- "gen_inline_type_decls_with_derived"
-
-[%%expect{|
-val gen_inline_type_decls_with_derived : Context_free.Rule.t = <abstr>
-|}]
-
-(* That also stands for inline extension rules *)
-[%%gen_inline_type_decls_with_derived]
-
-[%%expect{|
-type t = int
-val derived_t : string = "ok"
-type u = float
-val derived_u : string = "ok"
-|}]
-
-let id =
- Extension.V3.declare
- "id"
- Extension.Context.core_type
- Ast_pattern.(ptyp __)
- (fun ~ctxt:_ core_type -> core_type)
- |> Context_free.Rule.extension
-
-let () = Driver.register_transformation ~rules:[id] "id"
-
-[%%expect{|
-val id : Context_free.Rule.t = <abstr>
-|}]
-
-(* Nodes with attributes are expanded before attribute-based, inline
- code generation rules are applied.
- In this below, the `[[%id: int]]` is interpreted before the deriver
- is applied, meaning it can't see this extension point in its expand
- function argument. *)
-type t = [%id: int]
-[@@deriving derived]
-
-[%%expect{|
-type t = int
-val derived_t : string = "ok"
-|}]
File "test/expand-header-and-footer/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/expand-header-and-footer/test.ml _build/default/test/expand-header-and-footer/test.ml.corrected
diff --git a/_build/default/test/expand-header-and-footer/test.ml b/_build/default/test/expand-header-and-footer/test.ml.corrected
index a6edb0c..e69de29 100755
--- a/_build/default/test/expand-header-and-footer/test.ml
+++ b/_build/default/test/expand-header-and-footer/test.ml.corrected
@@ -1,27 +0,0 @@
-open Stdppx
-open Ppxlib
-
-let _ =
- let loc = Location.none in
- let extension =
- Extension.V3.declare_inline
- "include"
- Structure_item
- Ast_pattern.(pstr __)
- (fun ~ctxt:_ x -> x)
- in
- let rules = [ Context_free.Rule.extension extension ] in
- let enclose_impl _ _ = [%str [%%include let a = 1]], [%str [%%include let c = 3]] in
- Driver.V2.register_transformation ~rules ~enclose_impl "example"
-
-[%%expect{|
-- : unit = ()
-|}]
-
-let b = 2
-
-[%%expect{|
-val a : int = 1
-val b : int = 2
-val c : int = 3
-|}]
File "test/deriving/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/deriving/test.ml _build/default/test/deriving/test.ml.corrected
diff --git a/_build/default/test/deriving/test.ml b/_build/default/test/deriving/test.ml.corrected
index dc6558a..e69de29 100755
--- a/_build/default/test/deriving/test.ml
+++ b/_build/default/test/deriving/test.ml.corrected
@@ -1,101 +0,0 @@
-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
-|}]
File "test/quoter/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/quoter/test.ml _build/default/test/quoter/test.ml.corrected
diff --git a/_build/default/test/quoter/test.ml b/_build/default/test/quoter/test.ml.corrected
index 3b14cd7..e69de29 100755
--- a/_build/default/test/quoter/test.ml
+++ b/_build/default/test/quoter/test.ml.corrected
@@ -1,53 +0,0 @@
-open Ppxlib
-open Expansion_helpers
-
-module Ast = Ast_builder.Default
-[%%expect{|
-module Ast = Ppxlib.Ast_builder.Default
-|}]
-
-let quoter = Quoter.create ();;
-[%%expect{|
-val quoter : Quoter.t = <abstr>
-|}]
-
-let expr1 =
- Ast.evar "foo" ~loc:Location.none
- |> Quoter.quote quoter
-[%%ignore]
-
-Pprintast.string_of_expression expr1;;
-[%%expect{|
-- : string = "__0"
-|}]
-
-let expr2 =
- Ast_builder.Default.evar ~loc:Location.none "bar"
- |> Quoter.quote quoter
-[%%ignore]
-
-Pprintast.string_of_expression expr2;;
-[%%expect{|
-- : string = "__1"
-|}]
-
-let expr3 =
- Ast.eapply ~loc:Location.none (Ast.evar "foo" ~loc:Location.none) [Ast.eunit ~loc:Location.none]
- |> Quoter.quote quoter
-[%%ignore]
-
-Pprintast.string_of_expression expr3;;
-[%%expect{|
-- : string = "__2 ()"
-|}]
-
-let quoted =
- let expr = Ast.elist ~loc:Location.none [expr1; expr2; expr3] in
- Quoter.sanitize quoter expr
-[%%ignore]
-
-Pprintast.string_of_expression quoted;;
-[%%expect{|
-- : string =
-"let __2 () = foo ()\nand __1 = bar\nand __0 = foo in [__0; __1; __2 ()]"
-|}]
File "test/ppx_import_support/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/ppx_import_support/test.ml _build/default/test/ppx_import_support/test.ml.corrected
diff --git a/_build/default/test/ppx_import_support/test.ml b/_build/default/test/ppx_import_support/test.ml.corrected
index 7fd1154..e69de29 100755
--- a/_build/default/test/ppx_import_support/test.ml
+++ b/_build/default/test/ppx_import_support/test.ml.corrected
@@ -1,113 +0,0 @@
-(* Test for the ppx_import old syntax compat support *)
-
-open Ppxlib
-
-let id =
- Extension.__declare_ppx_import
- "id"
- (fun ~ctxt:_ td ->
- match td.ptype_manifest with
- | Some {ptyp_desc = Ptyp_extension (_, PTyp wrapped_manifest); _} ->
- {td with ptype_manifest = Some wrapped_manifest}
- | _ -> assert false)
-[%%expect{|
-val id : Extension.t = <abstr>
-|}]
-
-Driver.register_transformation
- ~rules:[Context_free.Rule.extension id]
- "id"
-[%%expect{|
-- : unit = ()
-|}]
-
-(* The expander receives the type decl with the extension point removed, it should preserve
- attibutes *)
-type t = [%id: int]
-[%%expect{|
-type t = int
-|}]
-
-(* It also should work in signatures by default *)
-module type T = sig
- type t = [%id: int]
-end
-[%%expect{|
-module type T = sig type t = int end
-|}]
-
-let foo =
- let check_interpreted (_, type_decls) =
- let {ptype_manifest; _} = List.hd type_decls in
- match ptype_manifest with
- | Some {ptyp_desc = Ptyp_extension _; _} ->
- failwith "Extension should be intepreted before attributes"
- | _ -> ()
- in
- Deriving.add "foo"
- ~str_type_decl:(Deriving.Generator.make_noarg
- (fun ~loc ~path:_ type_decl ->
- check_interpreted type_decl;
- [%str let foo = 42]))
- ~sig_type_decl:(Deriving.Generator.make_noarg
- (fun ~loc ~path:_ type_decl ->
- check_interpreted type_decl;
- [%sig: val foo : int]))
-[%%expect{|
-val foo : Deriving.t = <abstr>
-|}]
-
-(* It should properly compose with [@@deriving] *)
-type t = [%id: int]
-[@@deriving foo]
-[%%expect{|
-type t = int
-val foo : t = 42
-|}]
-
-module type T = sig
- type t = [%id: int]
- [@@deriving foo]
-end
-[%%expect{|
-module type T = sig type t = int val foo : t end
-|}]
-
-(* It should be properly interpreted if it's the result of the expansion of a
- previous node as well *)
-let gen_id =
- Extension.V3.declare
- "gen_id"
- Extension.Context.structure_item
- Ast_pattern.(pstr nil)
- (fun ~ctxt ->
- let loc = Expansion_context.Extension.extension_point_loc ctxt in
- [%stri type t = [%id: int]])
-[%%expect{|
-val gen_id : Extension.t = <abstr>
-|}]
-
-Driver.register_transformation
- ~rules:[Context_free.Rule.extension gen_id]
- "gen_id"
-[%%expect{|
-- : unit = ()
-|}]
-
-[%%gen_id]
-[%%expect{|
-type t = int
-|}]
-
-(* One can't have ppx_import-like and core_type extensions with the same name *)
-let id_for_core_types =
- Extension.V3.declare
- "id"
- Extension.Context.core_type
- Ast_pattern.(ptyp __)
- (fun ~ctxt:_ core_type -> core_type)
-[%%expect{|
-Exception:
-Failure
- "Some ppx-es tried to register conflicting transformations: Extension 'id' on type declarations matches extension 'id'".
-|}]
File "test/patterns_as_and_drop/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/patterns_as_and_drop/test.ml _build/default/test/patterns_as_and_drop/test.ml.corrected
diff --git a/_build/default/test/patterns_as_and_drop/test.ml b/_build/default/test/patterns_as_and_drop/test.ml.corrected
index 9a234f4..e69de29 100755
--- a/_build/default/test/patterns_as_and_drop/test.ml
+++ b/_build/default/test/patterns_as_and_drop/test.ml.corrected
@@ -1,127 +0,0 @@
-[@@@ocamlformat "disable"]
-
-open Ppxlib
-
-(* Simple demo without [as__] and [drop] *)
-let ___1 =
- let loc = Location.none in
- let ast = [%expr List.length xs = 0] in
- let pat =
- let open Ast_pattern in
- let length () =
- pexp_apply
- (pexp_ident (ldot (lident (string "List")) (string "length")))
- ((nolabel ** __) ^:: nil)
- in
- let zero () = pexp_constant (pconst_integer (string "0") none) in
-
- pexp_apply
- (pexp_ident (lident (string "=")))
- ((nolabel ** length ()) ^:: (nolabel ** zero ()) ^:: nil)
- in
-
- Ast_pattern.parse pat loc ast
- ~on_error:(fun () -> "Error")
- (fun _length_argument -> "Success. As expected")
-
-[%%expect{|
-val ___1 : string = "Success. As expected"
-|}]
-
-(* We could use [as__] to capture whole [List.length ...] expression,
- and use [drop] to ignore length's argument *)
-let ___2 =
- let loc = Location.none in
- let ast = [%expr List.length xs = 0] in
-
- let pat =
- let open Ast_pattern in
- let length () =
- as__
- (pexp_apply
- (pexp_ident (ldot (lident (string "List")) (string "length")))
- ((nolabel ** drop) ^:: nil))
- in
- let zero () = as__ (pexp_constant (pconst_integer (string "0") none)) in
-
- pexp_apply
- (pexp_ident (lident (string "=")))
- ((nolabel ** length ()) ^:: (nolabel ** zero ()) ^:: nil)
- in
-
- Ast_pattern.parse pat loc ast
- ~on_error:(fun () -> "error")
- (fun l r ->
- Format.asprintf "Success with '%a' and '%a'. As expected" Pprintast.expression l Pprintast.expression r
- )
-
-[%%expect{|
-val ___2 : string = "Success with 'List.length xs' and '0'. As expected"
-|}]
-
-(* Pitfall. If we forget unit argument and will use [as__], the success case
- will be fired before the error case. *)
-let ___3 =
- let loc = Location.none in
- let ast = [%expr 1] in
-
- let pat () =
- let open Ast_pattern in
- as__ (pexp_constant (pconst_integer (string "0") none))
- in
- let rez = Buffer.create 100 in
- Ast_pattern.parse (pat ()) loc ast
- ~on_error:(fun () -> Printf.bprintf rez "An error")
- (fun zero_expr -> Buffer.add_string rez
- (Format.asprintf "Successfully got '%a' but error right after that (NOT EXPECTED). " Pprintast.expression zero_expr));
- Buffer.contents rez
-
-[%%expect{|
-val ___3 : string =
- "Successfully got '1' but error right after that (NOT EXPECTED). An error"
-|}]
-
-(* To avoid the pitfall above we could add extra () to delay evaluation *)
-let ___4 =
- let loc = Location.none in
- let ast = [%expr 1] in
-
- let pat () =
- let open Ast_pattern in
- as__ (pexp_constant (pconst_integer (string "0") none))
- in
- Ast_pattern.parse (pat ()) loc ast
- ~on_error:(fun () () -> "Error, as expected")
- (fun _zero_expr () -> "Success and error after that\n%!")
- ()
-
-[%%expect{|
-val ___4 : string = "Error, as expected"
-|}]
-
-(* But this pitfall is not introduced by [as__], it existed before too. *)
-let ___5 =
- let loc = Location.none in
- let ast = [%expr string_of_int 43] in
- let pat =
- let open Ast_pattern in
- pexp_apply
- (pexp_ident (lident __))
- ((nolabel ** eint (int 42)) ^::
- (nolabel ** (pexp_ident (lident __))) ^::
- nil)
- in
-
- let b = Buffer.create 10 in
- let () = Ast_pattern.parse pat loc ast
- ~on_error:(fun () -> Buffer.add_string b "It's an error")
- (fun s ->
- Printf.bprintf b "Partial success with '%s', but actually not, because... " s;
- (fun _ -> Printf.bprintf b "no, it's total success"))
- in
- Buffer.contents b
-
-[%%expect{|
-val ___5 : string =
- "Partial success with 'string_of_int', but actually not, because... It's an error"
-|}]
File "test/traverse/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/traverse/test.ml _build/default/test/traverse/test.ml.corrected
diff --git a/_build/default/test/traverse/test.ml b/_build/default/test/traverse/test.ml.corrected
index 6f76152..e69de29 100755
--- a/_build/default/test/traverse/test.ml
+++ b/_build/default/test/traverse/test.ml.corrected
@@ -1,240 +0,0 @@
-type t =
- { x : int
- ; y : u
- }
-
-and u = A of int | B of t
-[@@deriving traverse]
-[%%expect{|
-type t = { x : int; y : u; }
-and u = A of int | B of t
-class virtual map :
- object
- method virtual int : int -> int
- method t : t -> t
- method u : u -> u
- end
-class virtual iter :
- object
- method virtual int : int -> unit
- method t : t -> unit
- method u : u -> unit
- end
-class virtual ['acc] fold :
- object
- method virtual int : int -> 'acc -> 'acc
- method t : t -> 'acc -> 'acc
- method u : u -> 'acc -> 'acc
- end
-class virtual ['acc] fold_map :
- object
- method virtual int : int -> 'acc -> int * 'acc
- method t : t -> 'acc -> t * 'acc
- method u : u -> 'acc -> u * 'acc
- end
-class virtual ['ctx] map_with_context :
- object
- method virtual int : 'ctx -> int -> int
- method t : 'ctx -> t -> t
- method u : 'ctx -> u -> u
- end
-class virtual ['res] lift :
- object
- method virtual constr : string -> 'res list -> 'res
- method virtual int : int -> 'res
- method virtual record : (string * 'res) list -> 'res
- method t : t -> 'res
- method u : u -> 'res
- end
-class virtual ['ctx, 'res] lift_map_with_context :
- object
- method virtual constr : 'ctx -> string -> 'res list -> 'res
- method virtual int : 'ctx -> int -> int * 'res
- method virtual record : 'ctx -> (string * 'res) list -> 'res
- method t : 'ctx -> t -> t * 'res
- method u : 'ctx -> u -> u * 'res
- end
-|}]
-
-type t =
- { a : int
- ; b : Int.t
- ; c : (int, bool) Stdlib.Result.t
- ; d : int Map.Make(Int).t
- }
-[@@deriving traverse_iter]
-[%%expect{|
-type t = {
- a : int;
- b : int;
- c : (int, bool) result;
- d : int Map.Make(Int).t;
-}
-class virtual iter :
- object
- method virtual bool : bool -> unit
- method virtual int : int -> unit
- method virtual int__t : int -> unit
- method virtual map__make_'int'__t :
- ('a -> unit) -> 'a Map.Make(Int).t -> unit
- method virtual stdlib__result__t :
- ('a -> unit) -> ('b -> unit) -> ('a, 'b) result -> unit
- method t : t -> unit
- end
-|}]
-
-type t = Inline of { a : string option; b : t }
-[@@deriving traverse]
-[%%expect{|
-type t = Inline of { a : string option; b : t; }
-class virtual map :
- object
- method virtual option : ('a -> 'a) -> 'a option -> 'a option
- method virtual string : string -> string
- method t : t -> t
- end
-class virtual iter :
- object
- method virtual option : ('a -> unit) -> 'a option -> unit
- method virtual string : string -> unit
- method t : t -> unit
- end
-class virtual ['acc] fold :
- object
- method virtual option : ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc
- method virtual string : string -> 'acc -> 'acc
- method t : t -> 'acc -> 'acc
- end
-class virtual ['acc] fold_map :
- object
- method virtual option :
- ('a -> 'acc -> 'a * 'acc) -> 'a option -> 'acc -> 'a option * 'acc
- method virtual string : string -> 'acc -> string * 'acc
- method t : t -> 'acc -> t * 'acc
- end
-class virtual ['ctx] map_with_context :
- object
- method virtual option :
- ('ctx -> 'a -> 'a) -> 'ctx -> 'a option -> 'a option
- method virtual string : 'ctx -> string -> string
- method t : 'ctx -> t -> t
- end
-class virtual ['res] lift :
- object
- method virtual constr : string -> 'res list -> 'res
- method virtual option : ('a -> 'res) -> 'a option -> 'res
- method virtual record : (string * 'res) list -> 'res
- method virtual string : string -> 'res
- method t : t -> 'res
- end
-class virtual ['ctx, 'res] lift_map_with_context :
- object
- method virtual constr : 'ctx -> string -> 'res list -> 'res
- method virtual option :
- ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a option -> 'a option * 'res
- method virtual record : 'ctx -> (string * 'res) list -> 'res
- method virtual string : 'ctx -> string -> string * 'res
- method t : 'ctx -> t -> t * 'res
- end
-|}]
-
-(* Test [Ast_traverse.sexp_of] and compare it visually to [Pprintast]. *)
-let via_pprintast, via_sexp_of =
- let open Stdppx in
- (* Pretty-print a string by turning it into a multi-line list, all padded to the same
- length. This forces the value printer to split every string onto its own line.
- Otherwise it may put multiple indented strings onto one line, which is unreadable. *)
- let pretty string =
- let lines = String.split_on_char string ~sep:'\n' in
- let len =
- List.fold_left lines ~init:0 ~f:(fun acc string ->
- Int.max acc (String.length string))
- in
- List.map lines ~f:(fun string ->
- string ^ String.make (len - String.length string) ' ')
- in
- (* Tests dotted identifier, infix operator, attributes, and [Location.none]. *)
- let expr =
- let loc = Ppxlib.Location.none in
- [%expr
- function
- | 0 -> true
- | 1 -> false
- | n -> (f [@tailcall]) (Stdlib.Int.( - ) n 2)]
- in
- (* Tests locations and [loc_ghost]. *)
- let structure =
- let loc : Ppxlib.Location.t =
- {
- loc_ghost = true;
- loc_start = { pos_fname = "file.ml"; pos_lnum = 2; pos_bol = 1; pos_cnum = 2 };
- loc_end = { pos_fname = "file.ml"; pos_lnum = 4; pos_bol = 6; pos_cnum = 9 };
- }
- in
- [%str
- module M = struct
- let rec f = [%e expr]
- end]
- in
- (* Render two different ways. *)
- let via_pprintast = Ppxlib.Pprintast.string_of_structure structure |> pretty in
- let via_sexp_of =
- structure
- |> Ppxlib.Ast_traverse.sexp_of#structure
- |> Sexp.to_string_hum
- |> pretty
- in
- via_pprintast, via_sexp_of
-[%%expect{|
-val via_pprintast : string list =
- ["module M = ";
- " struct ";
- " let rec f = ";
- " function ";
- " | 0 -> true ";
- " | 1 -> false ";
- " | n -> ((f)[@tailcall ]) (Stdlib.Int.(-) n 2)";
- " end "]
-val via_sexp_of : string list =
- ["(((pstr_desc ";
- " (Pstr_module ";
- " ((pmb_name ";
- " ((txt (M)) (loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))) ";
- " (pmb_expr ";
- " ((pmod_desc ";
- " (Pmod_structure ";
- " (((pstr_desc ";
- " (Pstr_value Recursive ";
- " (((pvb_pat ";
- " ((ppat_desc ";
- " (Ppat_var ";
- " ((txt f) ";
- " (loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))))";
- " (ppat_loc ";
- " \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))) ";
- " (pvb_expr ";
- " (Pexp_function () () ";
- " (Pfunction_cases ";
- " (((pc_lhs (Ppat_constant (Pconst_integer 0 ()))) ";
- " (pc_rhs (Pexp_construct true ()))) ";
- " ((pc_lhs (Ppat_constant (Pconst_integer 1 ()))) ";
- " (pc_rhs (Pexp_construct false ()))) ";
- " ((pc_lhs (Ppat_var n)) ";
- " (pc_rhs ";
- " (Pexp_apply ";
- " ((pexp_desc (Pexp_ident f)) (pexp_loc_stack (())) ";
- " (pexp_attributes ";
- " (((attr_name tailcall) (attr_payload (PStr ())))))) ";
- " ((Nolabel ";
- " ((pexp_desc ";
- " (Pexp_apply (Pexp_ident \"Stdlib.Int.( - )\") ";
- " ((Nolabel (Pexp_ident n)) ";
- " (Nolabel (Pexp_constant (Pconst_integer 2 ())))))) ";
- " (pexp_loc_stack (()))))))))) ";
- " () ()))) ";
- " (pvb_loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\")))))";
- " (pstr_loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))))) ";
- " (pmod_loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))) ";
- " (pmb_loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\")))) ";
- " (pstr_loc \"File \\\"file.ml\\\", line 2, characters 1-8:<ghost>\"))) "]
-|}]
File "test/type_is_recursive/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/type_is_recursive/test.ml _build/default/test/type_is_recursive/test.ml.corrected
diff --git a/_build/default/test/type_is_recursive/test.ml b/_build/default/test/type_is_recursive/test.ml.corrected
index 48a1ee0..e69de29 100755
--- a/_build/default/test/type_is_recursive/test.ml
+++ b/_build/default/test/type_is_recursive/test.ml.corrected
@@ -1,84 +0,0 @@
-open Ppxlib
-
-let test_is_recursive stri =
- match stri.pstr_desc with
- | Pstr_type (rf, tds) -> really_recursive rf tds
- | _ -> assert false
-
-[%%expect{|
-val test_is_recursive : structure_item -> rec_flag = <fun>
-|}]
-
-let loc = Location.none
-
-[%%expect_in <= 5.3 {|
-val loc : location =
- {Ppxlib.Location.loc_start =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_end =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_ghost = true}
-|}]
-[%%expect_in >= 5.4 {|
-val loc : location =
- {Location.loc_start =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_end =
- {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1};
- loc_ghost = true}
-|}]
-
-(* Should be Nonrecursive *)
-let base_type = test_is_recursive [%stri type t = int]
-
-[%%expect{|
-val base_type : rec_flag = Ppxlib__.Import.Nonrecursive
-|}]
-
-(* Should be Nonrecursive *)
-let looks_recursive_but_is_not = test_is_recursive [%stri type nonrec t = t]
-
-[%%expect{|
-val looks_recursive_but_is_not : rec_flag = Ppxlib__.Import.Nonrecursive
-|}]
-
-(* Should be Nonrecursive *)
-let variant_non_rec = test_is_recursive [%stri type t = A of int | B of string]
-
-[%%expect{|
-val variant_non_rec : rec_flag = Ppxlib__.Import.Nonrecursive
-|}]
-
-(* Should be Nonrecursive *)
-let record_non_rec = test_is_recursive [%stri type t = {a: int; b: string}]
-
-[%%expect{|
-val record_non_rec : rec_flag = Ppxlib__.Import.Nonrecursive
-|}]
-
-(* Should be Recursive *)
-let actually_recursive = test_is_recursive [%stri type t = A of int | T of t]
-
-[%%expect{|
-val actually_recursive : rec_flag = Ppxlib__.Import.Recursive
-|}]
-
-(* Should be Nonrecursive *)
-let ignore_attributes = test_is_recursive [%stri type t = int [@attr: t]]
-
-[%%expect{|
-val ignore_attributes : rec_flag = Ppxlib__.Import.Nonrecursive
-|}]
-
-(* Should be Recursive
-
- This is subject to debate. @ceastlund's intuition is that we should
- traverse extensions so we'll stick to this for now.
-
- It's less of a problem as it is likely that when [really_recursive] is called
- those will have been expanded anyway. *)
-let extension_points = test_is_recursive [%stri type t = [%ext: t]]
-
-[%%expect{|
-val extension_points : rec_flag = Ppxlib__.Import.Recursive
-|}]
File "test/pprintast/raw_identifiers/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/pprintast/raw_identifiers/test.ml _build/default/test/pprintast/raw_identifiers/test.ml.corrected
diff --git a/_build/default/test/pprintast/raw_identifiers/test.ml b/_build/default/test/pprintast/raw_identifiers/test.ml.corrected
index 6f4a2c2..e69de29 100755
--- a/_build/default/test/pprintast/raw_identifiers/test.ml
+++ b/_build/default/test/pprintast/raw_identifiers/test.ml.corrected
@@ -1,63 +0,0 @@
-open Ppxlib
-
-let identifier = Longident.Lident "mod"
-;;
-[%%ignore]
-
-Format.asprintf "%a" Pprintast.longident identifier
-;;
-[%%expect{|
-- : string = "\\#mod"
-|}]
-
-module Build = Ast_builder.Make(struct let loc = Location.none end)
-
-(* 10 mod 3 *)
-let expr =
- let open Build in
- eapply (pexp_ident (Located.mk identifier)) [(eint 10); (eint 3)]
-;;
-[%%ignore]
-
-Format.asprintf "%a" Pprintast.expression expr
-;;
-[%%expect{|
-- : string = "10 mod 3"
-|}]
-
-(* [let f = (mod) *)
-let stri =
- let open Build in
- pstr_value Nonrecursive
- [ value_binding
- ~pat:(pvar "f")
- ~expr:(pexp_ident (Located.mk identifier))
- ]
-;;
-[%%ignore]
-
-Format.asprintf "%a" Pprintast.structure_item stri
-;;
-[%%expect{|
-- : string = "let f = (mod)"
-|}]
-
-let stri2 =
- let open Build in
- pstr_value
- Nonrecursive
- [ value_binding
- ~pat:(pvar "f")
- ~expr:(pexp_function
- [pparam_val Nolabel None (pvar "lsl")]
- None
- (Pfunction_body (pexp_ident (Located.mk identifier))))
- ]
-;;
-[%%ignore]
-
-Format.asprintf "%a" Pprintast.structure_item stri2
-;;
-[%%expect{|
-- : string = "let f (lsl) = (mod)"
-|}]
File "test/driver/attributes/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/attributes/test.ml _build/default/test/driver/attributes/test.ml.corrected
diff --git a/_build/default/test/driver/attributes/test.ml b/_build/default/test/driver/attributes/test.ml.corrected
index 6180516..e69de29 100755
--- a/_build/default/test/driver/attributes/test.ml
+++ b/_build/default/test/driver/attributes/test.ml.corrected
@@ -1,289 +0,0 @@
-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")
-|}]
-
-(* Test extensions aren't flagged as unused inside attributes. *)
-
-let () =
- let attr =
- Attribute.declare
- "ignore_me"
- Attribute.Context.core_type
- Ast_pattern.(__)
- ignore
- in
- let ext =
- Extension.V3.declare
- "ignore_me"
- Core_type
- Ast_pattern.(ptyp __)
- (fun ~ctxt:_ e -> let (_ : unit option) = Attribute.get attr e in e)
- in
- Driver.register_transformation "ignore_me" ~rules:[ Context_free.Rule.extension ext ]
-;;
-
-type t = [%ignore_me: int[@ignore_me [%doesn't_exist]]]
-[%%expect{|
-type t = int
-|}]
File "test/expansion_helpers/mangle/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/expansion_helpers/mangle/test.ml _build/default/test/expansion_helpers/mangle/test.ml.corrected
diff --git a/_build/default/test/expansion_helpers/mangle/test.ml b/_build/default/test/expansion_helpers/mangle/test.ml.corrected
index 9043355..e69de29 100755
--- a/_build/default/test/expansion_helpers/mangle/test.ml
+++ b/_build/default/test/expansion_helpers/mangle/test.ml.corrected
@@ -1,46 +0,0 @@
-open Ppxlib;;
-
-Expansion_helpers.mangle (Prefix "pre") "foo";;
-[%%expect{|
-- : string = "pre_foo"
-|}]
-
-Expansion_helpers.mangle (Suffix "suf") "foo";;
-[%%expect{|
-- : string = "foo_suf"
-|}]
-
-Expansion_helpers.mangle (PrefixSuffix ("pre", "suf")) "foo";;
-[%%expect{|
-- : string = "pre_foo_suf"
-|}]
-
-Expansion_helpers.mangle (Prefix "pre") "t";;
-[%%expect{|
-- : string = "pre"
-|}]
-
-Expansion_helpers.mangle (Suffix "suf") "t";;
-[%%expect{|
-- : string = "suf"
-|}]
-
-Expansion_helpers.mangle (PrefixSuffix ("pre", "suf")) "t";;
-[%%expect{|
-- : string = "pre_suf"
-|}]
-
-Expansion_helpers.mangle ~fixpoint:"foo" (Prefix "pre") "foo";;
-[%%expect{|
-- : string = "pre"
-|}]
-
-Expansion_helpers.mangle ~fixpoint:"foo" (Suffix "suf") "foo";;
-[%%expect{|
-- : string = "suf"
-|}]
-
-Expansion_helpers.mangle ~fixpoint:"foo" (PrefixSuffix ("pre", "suf")) "foo";;
-[%%expect{|
-- : string = "pre_suf"
-|}]
File "test/encoding/504/api/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/encoding/504/api/test.ml _build/default/test/encoding/504/api/test.ml.corrected
diff --git a/_build/default/test/encoding/504/api/test.ml b/_build/default/test/encoding/504/api/test.ml.corrected
index 15d68bc..e69de29 100755
--- a/_build/default/test/encoding/504/api/test.ml
+++ b/_build/default/test/encoding/504/api/test.ml.corrected
@@ -1,148 +0,0 @@
-open Ppxlib_ast
-
-module To_ocaml = Convert (Js) (Compiler_version)
-module From_ocaml = Convert (Compiler_version) (Js)
-
-open Ppxlib
-
-#install_printer Pprintast.core_type;;
-#install_printer Pprintast.expression;;
-#install_printer Pprintast.pattern;;
-
-module Builder = Ast_builder.Make(struct let loc = Location.none end)
-
-let ptyp_int = Builder.(ptyp_constr (Located.mk (Longident.parse "int")) [])
-let ptyp_string =
- Builder.(ptyp_constr (Located.mk (Longident.parse "string")) []);;
-[%%ignore]
-
-(* Generate an encoded labeled tuple type *)
-let encoded_labeled_tuple_type =
- Builder.ptyp_labeled_tuple
- [ Some "a", ptyp_int
- ; Some "b", ptyp_int
- ; None, ptyp_string
- ]
-
-(* Migrate it to the current compiler (>= 5.4, as per dune rules) *)
-let labeled_tuple_type = To_ocaml.copy_core_type encoded_labeled_tuple_type;;
-[%%ignore]
-
-let as_source =
- Format.asprintf "%a" Astlib.Compiler_pprintast.core_type labeled_tuple_type;;
-[%%expect{|
-val as_source : string = "(a:int * b:int * string)"
-|}]
-
-(* Migrate back to ppxlib's AST *)
-let encoded_by_migration = From_ocaml.copy_core_type labeled_tuple_type
-
-let pattern = Ast_pattern.(ptyp_labeled_tuple __);;
-[%%ignore]
-
-(* Destruct both the migration and Ast_builder generated encodings with
- the Ast_pattern function. *)
-let destruct_from_migration =
- Ast_pattern.parse_res pattern Location.none encoded_by_migration (fun x -> x);;
-[%%expect{|
-val destruct_from_migration :
- ((string option * core_type) list, Location.Error.t Stdppx.NonEmptyList.t)
- result = Ok [(Some "a", int); (Some "b", int); (None, string)]
-|}]
-
-let destruct =
- Ast_pattern.parse_res pattern Location.none
- encoded_labeled_tuple_type (fun x -> x);;
-[%%expect{|
-val destruct :
- ((string option * core_type) list, Location.Error.t Stdppx.NonEmptyList.t)
- result = Ok [(Some "a", int); (Some "b", int); (None, string)]
-|}]
-
-(* -------- Same tests with labeled tuples expressions ---------- *)
-
-let encoded_labeled_tuple_expr =
- Builder.pexp_labeled_tuple
- [ Some "a", Builder.eint 0
- ; Some "b", Builder.eint 1
- ; None, Builder.estring "abc"
- ]
-
-let labeled_tuple_expr = To_ocaml.copy_expression encoded_labeled_tuple_expr;;
-[%%ignore]
-
-let as_source =
- Format.asprintf "%a" Astlib.Compiler_pprintast.expression
- labeled_tuple_expr;;
-[%%expect{|
-val as_source : string = "(~a:0, ~b:1, \"abc\")"
-|}]
-
-let encoded_by_migration = From_ocaml.copy_expression labeled_tuple_expr
-
-let pattern = Ast_pattern.(pexp_labeled_tuple __);;
-[%%ignore]
-
-let destruct_from_migration =
- Ast_pattern.parse_res pattern Location.none encoded_by_migration
- (fun x -> x);;
-[%%expect{|
-val destruct_from_migration :
- ((string option * expression) list, Location.Error.t Stdppx.NonEmptyList.t)
- result = Ok [(Some "a", 0); (Some "b", 1); (None, "abc")]
-|}]
-
-let destruct =
- Ast_pattern.parse_res pattern Location.none encoded_labeled_tuple_expr
- (fun x -> x);;
-[%%expect{|
-val destruct :
- ((string option * expression) list, Location.Error.t Stdppx.NonEmptyList.t)
- result = Ok [(Some "a", 0); (Some "b", 1); (None, "abc")]
-|}]
-
-(* -------- Same tests with labeled tuples patterns ---------- *)
-
-let encoded_labeled_tuple_pat =
- Builder.ppat_labeled_tuple
- [ Some "a", Builder.(ppat_var (Located.mk "a"))
- ; Some "b", Builder.ppat_any
- ; None, Builder.(ppat_var (Located.mk "c"))
- ]
- Open
-
-let labeled_tuple_pat = To_ocaml.copy_pattern encoded_labeled_tuple_pat;;
-[%%ignore]
-
-let as_source =
- Format.asprintf "%a" Astlib.Compiler_pprintast.pattern labeled_tuple_pat;;
-[%%expect{|
-val as_source : string = "(~a, ~b:_, c, ..)"
-|}]
-
-let encoded_by_migration = From_ocaml.copy_pattern labeled_tuple_pat
-
-let pattern = Ast_pattern.(ppat_labeled_tuple __);;
-[%%ignore]
-
-let destruct_from_migration =
- Ast_pattern.parse_res pattern Location.none encoded_by_migration
- (fun x -> x);;
-[%%expect{|
-val destruct_from_migration :
- ((string option * pattern) list * closed_flag,
- Location.Error.t Stdppx.NonEmptyList.t)
- result =
- Ok ([(Some "a", a); (Some "b", _); (None, c)], Ppxlib__.Import.Open)
-|}]
-
-let destruct =
- Ast_pattern.parse_res pattern Location.none encoded_by_migration
- (fun x -> x);;
-[%%expect{|
-val destruct :
- ((string option * pattern) list * closed_flag,
- Location.Error.t Stdppx.NonEmptyList.t)
- result =
- Ok ([(Some "a", a); (Some "b", _); (None, c)], Ppxlib__.Import.Open)
-|}]
File "test/location/exception/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/location/exception/test.ml _build/default/test/location/exception/test.ml.corrected
diff --git a/_build/default/test/location/exception/test.ml b/_build/default/test/location/exception/test.ml.corrected
index e44322c..e69de29 100755
--- a/_build/default/test/location/exception/test.ml
+++ b/_build/default/test/location/exception/test.ml.corrected
@@ -1,17 +0,0 @@
-open Ppxlib.Location
-
-let catch_as_compiler_exception =
- try raise_errorf ~loc:none "foo" with
- | Ocaml_common.Location.Error _ -> "caught"
- | _ -> "uncaught"
-[%%expect{|
-val catch_as_compiler_exception : string = "caught"
-|}]
-
-let catch_as_ppxlib_exception =
- try raise_errorf ~loc:none "foo" with
- | Error _ -> "caught"
- | _ -> "uncaught"
-[%%expect{|
-val catch_as_ppxlib_exception : string = "caught"
-|}]
File "test/driver/non-compressible-suffix/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/non-compressible-suffix/test.ml _build/default/test/driver/non-compressible-suffix/test.ml.corrected
diff --git a/_build/default/test/driver/non-compressible-suffix/test.ml b/_build/default/test/driver/non-compressible-suffix/test.ml.corrected
index a897d7f..e69de29 100755
--- a/_build/default/test/driver/non-compressible-suffix/test.ml
+++ b/_build/default/test/driver/non-compressible-suffix/test.ml.corrected
@@ -1,35 +0,0 @@
-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'.
-|}]
File "test/driver/instrument/test.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/instrument/test.ml _build/default/test/driver/instrument/test.ml.corrected
diff --git a/_build/default/test/driver/instrument/test.ml b/_build/default/test/driver/instrument/test.ml.corrected
index 7249c84..e69de29 100755
--- a/_build/default/test/driver/instrument/test.ml
+++ b/_build/default/test/driver/instrument/test.ml.corrected
@@ -1,36 +0,0 @@
-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"]
-|}]
File "test/driver/transformations/test_412.ml", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/transformations/test_412.ml _build/default/test/driver/transformations/test_412.ml.corrected
diff --git a/_build/default/test/driver/transformations/test_412.ml b/_build/default/test/driver/transformations/test_412.ml.corrected
index 29f94ab..e69de29 100755
--- a/_build/default/test/driver/transformations/test_412.ml
+++ b/_build/default/test/driver/transformations/test_412.ml.corrected
@@ -1,103 +0,0 @@
-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"
-|}]
File "test/driver/flag_cookie/run.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/flag_cookie/run.t _build/default/test/driver/flag_cookie/run.t.corrected
diff --git a/_build/default/test/driver/flag_cookie/run.t b/_build/default/test/driver/flag_cookie/run.t.corrected
index 34cdf85..ce257a5 100755
--- a/_build/default/test/driver/flag_cookie/run.t
+++ b/_build/default/test/driver/flag_cookie/run.t.corrected
@@ -7,4 +7,10 @@ The cookie flag is taken into account, both by the main standalone
...and by the `-as-ppx` standalone
$ ocaml -ppx './print_cookie_driver.exe --as-ppx -cookie x=1' impl.ml
- Value of cookie x: 1
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\impl.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_cookie_driver.exe --as-ppx -cookie x=1 "C:\cygwin64\tmp\camlppx602f86" "C:\cygwin64\tmp\camlppx877398"
+
+ [2]
File "test/extensions_and_deriving/floating_attr/run-floating-attr.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t _build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t.corrected
diff --git a/_build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t b/_build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t.corrected
index bd034a4..2a273b9 100755
--- a/_build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t
+++ b/_build/default/test/extensions_and_deriving/floating_attr/run-floating-attr.t.corrected
@@ -12,12 +12,22 @@ Test `attr_str_floating_expect_and_expand` via `@@@identity_inline_expanded`.
$ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
---
+++
- @@ -4,4 +4,5 @@
- end = struct
- let foo = [%suffix "apples"]
- end]
+ @@ -1,7 +1,8 @@
+ -[@@@identity_inline_expanded
+ - module T : sig
+ - val foo : [%str]
+ - end = struct
+ - let foo = [%suffix "apples"]
+ - end]
+ -[@@@end]
+ +[@@@identity_inline_expanded
+ + module T : sig
+ + val foo : [%str]
+ + end = struct
+ + let foo = [%suffix "apples"]
+ + end]
+module T : sig val foo : string end = struct let foo = "apples_suffix" end
- [@@@end]
+ +[@@@end]
[1]
Test `attr_sig_floating_expect_and_expand` via `@@@identity_inline_expanded`.
@@ -35,14 +45,24 @@ Test `attr_sig_floating_expect_and_expand` via `@@@identity_inline_expanded`.
$ ./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]
+ @@ -1,8 +1,11 @@
+ -module type S = sig
+ - [@@@identity_inline_expanded:
+ - val foo : [%str]
+ - include module type of struct
+ - let foo = [%suffix "apples"]
+ - end]
- [@@@end]
+ -end
+ +module type S = sig
+ + [@@@identity_inline_expanded:
+ + val foo : [%str]
+ + include module type of struct
+ + let foo = [%suffix "apples"]
+ + end]
+
+val foo : string
+include module type of struct let foo = "apples_suffix" end
+[@@@end]
- end
+ +end
[1]
File "test/driver/run_as_ppx_rewriter/run.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always -u --ignore-cr-at-eol _build/default/test/driver/run_as_ppx_rewriter/run.t _build/default/test/driver/run_as_ppx_rewriter/run.t.corrected
diff --git a/_build/default/test/driver/run_as_ppx_rewriter/run.t b/_build/default/test/driver/run_as_ppx_rewriter/run.t.corrected
index 31147ee..137796f 100755
--- a/_build/default/test/driver/run_as_ppx_rewriter/run.t
+++ b/_build/default/test/driver/run_as_ppx_rewriter/run.t.corrected
@@ -10,23 +10,35 @@ The registered rewriters get applied when using `run_as_ppx_rewriter` as entry p
> let () = [%print_bye]
> EOF
$ ocaml -ppx './print_greetings.exe' file.ml
- hi
- bye
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\file.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_greetings.exe "C:\cygwin64\tmp\camlppxc0cf10" "C:\cygwin64\tmp\camlppxf8919e"
+
+ [2]
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'.
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\file.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_greetings.exe -apply print_hi "C:\cygwin64\tmp\camlppx8fa71e" "C:\cygwin64\tmp\camlppx7b61f2"
+
[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
+ '.' is not recognized as an internal or external command,
+ operable program or batch file.
+ File ".\attribute_file.ml", line 1:
+ Error: Error while running external preprocessor
+ Command line: ./print_greetings.exe -check "C:\cygwin64\tmp\camlppx5936a7" "C:\cygwin64\tmp\camlppxc3cda0"
+
[2]
@@ -48,7 +60,7 @@ The only possible usage is [extra_args] <infile> <outfile>...
$ touch some_output
$ ./print_greetings.exe some_input some_output -check
- ./print_greetings.exe: anonymous arguments not accepted.
+ C:\cygwin64\home\opam\src\_build\.sandbox\711e20d1c473d2e2f75dded7b6e98793\default\test\driver\run_as_ppx_rewriter\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
File "test/extensions_and_deriving/floating_attr/run-expand-inline.t", line 1, characters 0-0:
C:\cygwin64\bin\git.exe --no-pager diff --no-index --color=always-u --ignore-cr-at-eol _build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t _build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t.corrected
diff --git a/_build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t b/_build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t.corrected
index d6f4438..29d0edc 100755
--- a/_build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t
+++ b/_build/default/test/extensions_and_deriving/floating_attr/run-expand-inline.t.corrected
@@ -12,12 +12,22 @@ Test `expand_inline` for structures.
$ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
---
+++
- @@ -4,4 +4,5 @@
- end = struct
- let foo = [%suffix "apples"]
- end]
+ @@ -1,7 +1,8 @@
+ -[@@@expand_inline
+ - module T : sig
+ - val foo : [%str]
+ - end = struct
+ - let foo = [%suffix "apples"]
+ - end]
+ -[@@@end]
+ +[@@@expand_inline
+ + module T : sig
+ + val foo : [%str]
+ + end = struct
+ + let foo = [%suffix "apples"]
+ + end]
+module T : sig val foo : string end = struct let foo = "apples_suffix" end
- [@@@end]
+ +[@@@end]
[1]
Test `expand_inline` for signatures.
@@ -35,16 +45,26 @@ Test `expand_inline` for signatures.
$ ./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]
+ @@ -1,8 +1,11 @@
+ -module type S = sig
+ - [@@@expand_inline:
+ - val foo : [%str]
+ - include module type of struct
+ - let foo = [%suffix "apples"]
+ - end]
- [@@@end]
+ -end
+ +module type S = sig
+ + [@@@expand_inline:
+ + val foo : [%str]
+ + include module type of struct
+ + let foo = [%suffix "apples"]
+ + end]
+
+val foo : string
+include module type of struct let foo = "apples_suffix" end
+[@@@end]
- end
+ +end
[1]
Test (** ... *) comments get translated using {| |} syntax.
@@ -67,14 +87,36 @@ Test (** ... *) comments get translated using {| |} syntax.
$ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
---
+++
- @@ -10,4 +10,7 @@
- (** baz *)
-
- ]
+ @@ -1,13 +1,16 @@
+ -[@@@expand_inline
+ -module T : sig
+ -(**foo*)
+ -val foo : [%str]
+ -end = struct
+ -(**bar*)
+ -let foo = [%suffix "apples"]
+ -end
+ -
+ -(** baz *)
+ -
+ -]
+ -[@@@end]
+ +[@@@expand_inline
+ +module T : sig
+ +(**foo*)
+ +val foo : [%str]
+ +end = struct
+ +(**bar*)
+ +let foo = [%suffix "apples"]
+ +end
+ +
+ +(** baz *)
+ +
+ +]
+module T : sig val foo : string[@@ocaml.doc {|foo|}] end =
+ struct let foo = "apples_suffix"[@@ocaml.doc {|bar|}] end
+[@@@ocaml.text {| baz |}]
- [@@@end]
+ +[@@@end]
[1]
Test [@@ocaml.doc ...] attributes do not get swapped to using {| |}.
@@ -92,13 +134,25 @@ Test [@@ocaml.doc ...] attributes do not get swapped to using {| |}.
$ ./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
- ]
+ @@ -1,8 +1,10 @@
+ -[@@@expand_inline
+ -module T : sig
+ -val foo : [%str] [@@ocaml.doc "foo"]
+ -end = struct
+ -let foo = [%suffix "apples"] [@@ocaml.doc "foo"]
+ -end
+ -]
+ -[@@@end]
+ +[@@@expand_inline
+ +module T : sig
+ +val foo : [%str] [@@ocaml.doc "foo"]
+ +end = struct
+ +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]
+ +[@@@end]
[1]
Test the delim finding behaviour when translating (** ... *) comments to {| |} syntax.
@@ -113,12 +167,18 @@ Test the delim finding behaviour when translating (** ... *) comments to {| |} s
$ ./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"]
- ]
+ @@ -1,5 +1,6 @@
+ -[@@@expand_inline
+ -(**blah blah |} blah blah*)
+ -let foo = [%suffix "apples"]
+ -]
+ -[@@@end]
+ +[@@@expand_inline
+ +(**blah blah |} blah blah*)
+ +let foo = [%suffix "apples"]
+ +]
+let foo = "apples_suffix"[@@ocaml.doc {x|blah blah |} blah blah|x}]
- [@@@end]
+ +[@@@end]
[1]
$ cat << 'EOF' > program.ml
@@ -131,10 +191,16 @@ Test the delim finding behaviour when translating (** ... *) comments to {| |} s
$ ./ppx.exe -no-color -null -diff-cmd 'diff -u --label "" --label ""' program.ml
---
+++
- @@ -2,4 +2,5 @@
- (**blxxx |} blaxxxxxxxxxh blxxahx*)
- let foo = [%suffix "apples"]
- ]
+ @@ -1,5 +1,6 @@
+ -[@@@expand_inline
+ -(**blxxx |} blaxxxxxxxxxh blxxahx*)
+ -let foo = [%suffix "apples"]
+ -]
+ -[@@@end]
+ +[@@@expand_inline
+ +(**blxxx |} blaxxxxxxxxxh blxxahx*)
+ +let foo = [%suffix "apples"]
+ +]
+let foo = "apples_suffix"[@@ocaml.doc {x|blxxx |} blaxxxxxxxxxh blxxahx|x}]
- [@@@end]
+ +[@@@end]
[1]
"C:\cygwin64\bin\bash.exe" "-lc" "cd /home/opam/src && opam exec -- dune build @install @check @runtest && rm -rf _build" failed with exit status 1
2026-03-02 11:17.54: Job failed: Failed: Build failed