diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index aaef99d0c..592cbf5b5 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -15,7 +15,7 @@ jobs: os: - ubuntu-latest ocaml-compiler: - - 4.14.0 + - 4.14.1 runs-on: ${{ matrix.os }} @@ -33,7 +33,7 @@ jobs: dune-cache: false - name: Install dune - run: opam install dune>=3.4.1 + run: opam install dune>=3.6.1 - name: Build HTML book run: opam exec -- dune build @site diff --git a/Dockerfile b/Dockerfile index 09bb47d86..42167dd73 100644 --- a/Dockerfile +++ b/Dockerfile @@ -2,7 +2,7 @@ FROM ocaml/opam:ubuntu RUN sudo apt-get update && sudo apt-get -y install python3-pygments tzdata pandoc texlive-full # update opam -RUN opam switch 4.13 +RUN opam switch 4.14 RUN git -C /home/opam/opam-repository pull origin master && opam update -uy # install non-OCaml dependencies @@ -10,7 +10,7 @@ WORKDIR /home/opam/src COPY Makefile /home/opam/src/. COPY rwo.opam /home/opam/src/. RUN opam pin add -n rwo /home/opam/src && opam depext -y rwo -RUN opam install dune=3.1.1 +RUN opam install dune=3.6.1 # compile the project COPY . /home/opam/src/ diff --git a/README.md b/README.md index 449dc61c4..b30810eae 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,10 @@ -Real World OCaml v2 +Real World OCaml v3 ------------------- -This is the source code for the Real World OCaml 2nd edition, which is +This is the source code for the Real World OCaml 3rd edition, which is still a work in progress. The original edition was written by Yaron -Minsky, Anil Madhavapeddy and Jason Hickey, and the revised edition is -being led by Yaron Minsky and Anil Madhavapeddy. There have been +Minsky, Anil Madhavapeddy and Jason Hickey, and the 2nd and subsequent +editions are being led by Yaron Minsky and Anil Madhavapeddy. There have been significant contributions to the revised tooling from Ashish Agarwal, Jeremy Yallop, Frederic Bour, and Sander Spies. @@ -27,7 +27,7 @@ mdx is used to keep the examples and the chapter's code block in sync. The `bin/` folder contains the OCaml scripts used to generate the books HTML and PDF versions. -All of the code and examples are built using OCaml 4.09.0. +All of the code and examples are built using OCaml 4.14.1. ## Building @@ -47,8 +47,8 @@ with only `dune` installed to avoid conflicts between the opam and local libraries. To set up your RWO development environment you can run: ``` -opam switch create rwo 4.13.1 -opam install dune=3.0.2 +opam switch create rwo 4.14.1 +opam install dune=3.6.1 ``` ### Generating the HTML diff --git a/bin/bin/app.ml b/bin/bin/app.ml index 5aedb8626..b021eb0f2 100644 --- a/bin/bin/app.ml +++ b/bin/bin/app.ml @@ -1,7 +1,6 @@ open Core open Async open Rwo -let (/) = Filename.concat module Params = struct open Command.Param @@ -11,19 +10,6 @@ module Params = struct let doc = sprintf "dir Root of repository. Default: \"%s\"." default in flag "-repo-root" (optional_with_default default string) ~doc - let production = - let default = false in - let doc = sprintf - " Set to true to generate file for publication. Default \ - is %b, which generates dev version of file." - default - in - flag "-production" (optional_with_default default bool) ~doc - - let chapter = - let doc = "N Build HTML version of chapter N." in - flag "-chapter" (required int) ~doc - let out_dir = let default = "_build" in let doc = sprintf "DIR Output directory. Default: \"%s\"" default in @@ -37,12 +23,6 @@ module Params = struct let file = anon ("file" %: string) - - let run_nondeterministic = - flag "-run-nondeterministic" no_arg - ~doc:" In .mlt files, run code marked [%%expect.nondeterministic ...]. \ - By default, they are skipped." - end diff --git a/bin/bin/convert_md.ml b/bin/bin/convert_md.ml index e267ce7c3..755b70bb9 100644 --- a/bin/bin/convert_md.ml +++ b/bin/bin/convert_md.ml @@ -138,9 +138,6 @@ let pp_block_md ppf (b:Mdx.Block.t) = let pp_text_html ppf l = List.iter (Fmt.pf ppf "%s\n") (List.rev l) -let pp_text_md ppf l = - List.iter (Fmt.pf ppf "%s\n") (List.rev l) - open Astring let pp_text_latex ppf l = diff --git a/bin/examples-rules/examples_rules.ml b/bin/examples-rules/examples_rules.ml index e3a6ce8f9..d306dc669 100644 --- a/bin/examples-rules/examples_rules.ml +++ b/bin/examples-rules/examples_rules.ml @@ -40,6 +40,7 @@ let print_rule ~dir_name ~path (config : Config.t) = {| (rule (alias %s) + (locks /global) (deps (source_tree %s)%s) (action diff --git a/book/classes/README.md b/book/classes/README.md index d1057f861..058cbd77d 100644 --- a/book/classes/README.md +++ b/book/classes/README.md @@ -145,7 +145,7 @@ Error: Some type variables are unbound in this type: method pop : 'b option method push : 'b -> unit end - The method pop has type 'a option where 'a is unbound + The method pop has type 'b option where 'b is unbound ``` In general, we need to provide enough constraints so that the compiler will diff --git a/book/classes/dune b/book/classes/dune index f8905ba47..0c171ca7c 100644 --- a/book/classes/dune +++ b/book/classes/dune @@ -1,7 +1,7 @@ (mdx (files README.md) - (packages + (libraries core - mdx + async_unix ppx_jane) (preludes prelude.ml)) diff --git a/book/classes/examples/dune.inc b/book/classes/examples/dune.inc index 4f8baa1fc..aa1269954 100644 --- a/book/classes/examples/dune.inc +++ b/book/classes/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias shapes) + (locks /global) (deps (source_tree ./correct/shapes) (package base) diff --git a/book/command-line-parsing/dune b/book/command-line-parsing/dune index f8905ba47..b6f86d454 100644 --- a/book/command-line-parsing/dune +++ b/book/command-line-parsing/dune @@ -1,7 +1,9 @@ (mdx (files README.md) - (packages + (locks /global) + (libraries core + core_unix mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/command-line-parsing/examples/dune.inc b/book/command-line-parsing/examples/dune.inc index 2f8fdba25..93bf3cdcf 100644 --- a/book/command-line-parsing/examples/dune.inc +++ b/book/command-line-parsing/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias cal_add_days) + (locks /global) (deps (source_tree ./correct/cal_add_days) (package core)) @@ -13,6 +14,7 @@ (rule (alias cal_add_interactive) + (locks /global) (deps (source_tree ./correct/cal_add_interactive) (package core) @@ -26,6 +28,7 @@ (rule (alias cal_add_interactive2) + (locks /global) (deps (source_tree ./correct/cal_add_interactive2) (package core)) @@ -38,6 +41,7 @@ (rule (alias cal_add_sub_days) + (locks /global) (deps (source_tree ./correct/cal_add_sub_days) (package core)) @@ -50,6 +54,7 @@ (rule (alias md5) + (locks /global) (deps (source_tree ./correct/md5) (package core)) @@ -62,6 +67,7 @@ (rule (alias md5_as_filename) + (locks /global) (deps (source_tree ./correct/md5_as_filename) (package core)) @@ -74,6 +80,7 @@ (rule (alias md5_let_syntax) + (locks /global) (deps (source_tree ./correct/md5_let_syntax) (package core)) @@ -86,6 +93,7 @@ (rule (alias md5_let_syntax2) + (locks /global) (deps (source_tree ./correct/md5_let_syntax2) (package core)) @@ -98,6 +106,7 @@ (rule (alias md5_multiarg) + (locks /global) (deps (source_tree ./correct/md5_multiarg) (package core)) @@ -110,6 +119,7 @@ (rule (alias md5_sequence) + (locks /global) (deps (source_tree ./correct/md5_sequence) (package core)) @@ -122,6 +132,7 @@ (rule (alias md5_succinct) + (locks /global) (deps (source_tree ./correct/md5_succinct) (package core)) @@ -134,6 +145,7 @@ (rule (alias md5_with_custom_arg) + (locks /global) (deps (source_tree ./correct/md5_with_custom_arg) (package core)) @@ -146,6 +158,7 @@ (rule (alias md5_with_default_file) + (locks /global) (deps (source_tree ./correct/md5_with_default_file) (package core)) @@ -158,6 +171,7 @@ (rule (alias md5_with_flags) + (locks /global) (deps (source_tree ./correct/md5_with_flags) (package core)) @@ -170,6 +184,7 @@ (rule (alias md5_with_optional_file) + (locks /global) (deps (source_tree ./correct/md5_with_optional_file) (package core)) diff --git a/book/compiler-backend/README.md b/book/compiler-backend/README.md index 0a1b22b0f..affeab90c 100644 --- a/book/compiler-backend/README.md +++ b/book/compiler-backend/README.md @@ -1050,7 +1050,7 @@ opam provides a compiler switch that compiles OCaml with the frame pointer activated: ```sh skip -$ opam switch create 4.13+fp ocaml-variants.4.13.1+options ocaml-option-fp +$ opam switch create 4.14+fp ocaml-variants.4.14.1+options ocaml-option-fp ``` Using the frame pointer changes the OCaml calling convention, but opam takes @@ -1111,7 +1111,7 @@ To use the debug library, just link your program with the $ ocamlopt -runtime-variant d -verbose -o hello.native hello.ml + as -o 'hello.o' '/tmp/build_cd0b96_dune/camlasmd3c336.s' + as -o '/tmp/build_cd0b96_dune/camlstartup9d55d0.o' '/tmp/build_cd0b96_dune/camlstartup2b2cd3.s' -+ gcc -O2 -fno-strict-aliasing -fwrapv -pthread -Wall -Wdeclaration-after-statement -fno-common -fexcess-precision=standard -fno-tree-vrp -ffunction-sections -Wl,-E -o 'hello.native' '-L/home/yminsky/.opam/rwo-4.13.1/lib/ocaml' '/tmp/build_cd0b96_dune/camlstartup9d55d0.o' '/home/yminsky/.opam/rwo-4.13.1/lib/ocaml/std_exit.o' 'hello.o' '/home/yminsky/.opam/rwo-4.13.1/lib/ocaml/stdlib.a' '/home/yminsky/.opam/rwo-4.13.1/lib/ocaml/libasmrund.a' -lm -ldl ++ gcc -O2 -fno-strict-aliasing -fwrapv -pthread -Wall -Wdeclaration-after-statement -fno-common -fexcess-precision=standard -fno-tree-vrp -ffunction-sections -Wl,-E -o 'hello.native' '-L/home/yminsky/.opam/rwo-4.14.1/lib/ocaml' '/tmp/build_cd0b96_dune/camlstartup9d55d0.o' '/home/yminsky/.opam/rwo-4.14.1/lib/ocaml/std_exit.o' 'hello.o' '/home/yminsky/.opam/rwo-4.14.1/lib/ocaml/stdlib.a' '/home/yminsky/.opam/rwo-4.14.1/lib/ocaml/libasmrund.a' -lm -ldl $ ./hello.native ### OCaml runtime: debug mode ### Initial minor heap size: 256k words diff --git a/book/compiler-backend/dune b/book/compiler-backend/dune index b3ce55acf..2a1d3318d 100644 --- a/book/compiler-backend/dune +++ b/book/compiler-backend/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/compiler-frontend/README.md b/book/compiler-frontend/README.md index 5044c787c..1d27dc516 100644 --- a/book/compiler-frontend/README.md +++ b/book/compiler-frontend/README.md @@ -1011,10 +1011,11 @@ into a `Hello` library. ```sh dir=examples/packing $ dune build $ cat _build/default/hello.ml-gen +(* generated by dune *) + (** @canonical Hello.A *) module A = Hello__A - (** @canonical Hello.B *) module B = Hello__B ``` diff --git a/book/compiler-frontend/dune b/book/compiler-frontend/dune index 5cf1868bb..20e770f57 100644 --- a/book/compiler-frontend/dune +++ b/book/compiler-frontend/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/concurrent-programming/dune b/book/concurrent-programming/dune index b0f4132f0..13e4fc7e5 100644 --- a/book/concurrent-programming/dune +++ b/book/concurrent-programming/dune @@ -1,10 +1,11 @@ (mdx (files README.md) - (packages + (libraries async + async_kernel + async_unix cohttp-async core - mdx ppx_jane textwrap yojson) diff --git a/book/concurrent-programming/examples/dune.inc b/book/concurrent-programming/examples/dune.inc index bd88396f8..16e985417 100644 --- a/book/concurrent-programming/examples/dune.inc +++ b/book/concurrent-programming/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias better_echo) + (locks /global) (deps (source_tree ./correct/better_echo) (package core) @@ -14,6 +15,7 @@ (rule (alias echo) + (locks /global) (deps (source_tree ./correct/echo) (package core) @@ -27,6 +29,7 @@ (rule (alias native_code_log_delays) + (locks /global) (deps (source_tree ./correct/native_code_log_delays) (package core) @@ -40,6 +43,7 @@ (rule (alias search) + (locks /global) (deps (source_tree ./correct/search) (package core) @@ -56,6 +60,7 @@ (rule (alias search_out_of_order) + (locks /global) (deps (source_tree ./correct/search_out_of_order) (package core) @@ -72,6 +77,7 @@ (rule (alias search_with_configurable_server) + (locks /global) (deps (source_tree ./correct/search_with_configurable_server) (package cohttp-async) @@ -86,6 +92,7 @@ (rule (alias search_with_error_handling) + (locks /global) (deps (source_tree ./correct/search_with_error_handling) (package cohttp-async) @@ -100,6 +107,7 @@ (rule (alias search_with_timeout) + (locks /global) (deps (source_tree ./correct/search_with_timeout) (package core) @@ -116,6 +124,7 @@ (rule (alias search_with_timeout_no_leak) + (locks /global) (deps (source_tree ./correct/search_with_timeout_no_leak) (package cohttp-async) @@ -130,6 +139,7 @@ (rule (alias search_with_timeout_no_leak_simple) + (locks /global) (deps (source_tree ./correct/search_with_timeout_no_leak_simple) (package cohttp-async) diff --git a/book/data-serialization/dune b/book/data-serialization/dune index f8905ba47..2a3f5faf6 100644 --- a/book/data-serialization/dune +++ b/book/data-serialization/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/data-serialization/examples/dune.inc b/book/data-serialization/examples/dune.inc index 0b76dab8b..f1c4f8eeb 100644 --- a/book/data-serialization/examples/dune.inc +++ b/book/data-serialization/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias read_foo) + (locks /global) (deps (source_tree ./correct/read_foo) (package core) @@ -14,6 +15,7 @@ (rule (alias read_foo_better_errors) + (locks /global) (deps (source_tree ./correct/read_foo_better_errors) (package core) @@ -27,6 +29,7 @@ (rule (alias sexp) + (locks /global) (deps (source_tree ./correct/sexp) (package base)) @@ -39,6 +42,7 @@ (rule (alias test_interval) + (locks /global) (deps (source_tree ./correct/test_interval) (package core) @@ -52,6 +56,7 @@ (rule (alias test_interval_override_of_sexp) + (locks /global) (deps (source_tree ./correct/test_interval_override_of_sexp) (package core) diff --git a/book/error-handling/README.md b/book/error-handling/README.md index 26db0577a..932e9e5e5 100644 --- a/book/error-handling/README.md +++ b/book/error-handling/README.md @@ -75,7 +75,7 @@ to find a key in one table isn't a failure of any sort: | _ -> mismatches );; val find_mismatches : - ('a, int) Hashtbl.Poly.t -> ('a, int) Hashtbl.Poly.t -> 'a list = + ('a, int) Base.Hashtbl.t -> ('a, int) Base.Hashtbl.t -> 'a list = ``` The use of options to encode errors underlines the fact that it's not clear diff --git a/book/error-handling/dune b/book/error-handling/dune index faec87999..b74c2706c 100644 --- a/book/error-handling/dune +++ b/book/error-handling/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (libraries base core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/error-handling/examples/dune.inc b/book/error-handling/examples/dune.inc index 7ba9f29bb..44a38b18b 100644 --- a/book/error-handling/examples/dune.inc +++ b/book/error-handling/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias blow_up) + (locks /global) (deps (source_tree ./correct/blow_up) (package base) @@ -14,6 +15,7 @@ (rule (alias exn_cost) + (locks /global) (deps (source_tree ./correct/exn_cost) (package core) diff --git a/book/files-modules-and-programs/dune b/book/files-modules-and-programs/dune index 4651cd4a5..d4c4f11d8 100644 --- a/book/files-modules-and-programs/dune +++ b/book/files-modules-and-programs/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (deps (package ocamlfind)) + (libraries core - mdx - ocamlfind ppx_jane) (preludes prelude.ml)) diff --git a/book/files-modules-and-programs/examples/dune.inc b/book/files-modules-and-programs/examples/dune.inc index 8529fbef0..935fc2e0b 100644 --- a/book/files-modules-and-programs/examples/dune.inc +++ b/book/files-modules-and-programs/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias abstract-username) + (locks /global) (deps (source_tree ./correct/abstract-username) (package base)) @@ -13,6 +14,7 @@ (rule (alias ext-option) + (locks /global) (deps (source_tree ./correct/ext-option) (package base)) @@ -25,6 +27,7 @@ (rule (alias freq-dune) + (locks /global) (deps (source_tree ./correct/freq-dune) (package base) @@ -38,6 +41,7 @@ (rule (alias freq-fast) + (locks /global) (deps (source_tree ./correct/freq-fast) (package base) @@ -51,6 +55,7 @@ (rule (alias freq-median) + (locks /global) (deps (source_tree ./correct/freq-median) (package base) @@ -64,6 +69,7 @@ (rule (alias freq-with-counter) + (locks /global) (deps (source_tree ./correct/freq-with-counter) (package base) @@ -77,6 +83,7 @@ (rule (alias freq-with-sig) + (locks /global) (deps (source_tree ./correct/freq-with-sig) (package base) @@ -90,6 +97,7 @@ (rule (alias freq-with-sig-abstract-fixed) + (locks /global) (deps (source_tree ./correct/freq-with-sig-abstract-fixed) (package base) diff --git a/book/first-class-modules/README.md b/book/first-class-modules/README.md index 0e9445bd6..517744547 100644 --- a/book/first-class-modules/README.md +++ b/book/first-class-modules/README.md @@ -573,7 +573,7 @@ instances and constructs a dispatch table from it: table;; val build_dispatch_table : (module Query_handler_instance) list -> - (string, (module Query_handler_instance)) Hashtbl.Poly.t = + (string, (module Query_handler_instance)) Base.Hashtbl.t = ``` Next, we'll need a function that dispatches to a handler using a @@ -593,7 +593,7 @@ dispatch table: | _ -> Or_error.error_string "malformed query";; val dispatch : - (string, (module Query_handler_instance)) Hashtbl.Poly.t -> + (string, (module Query_handler_instance)) Core.Hashtbl.t -> Sexp.t -> Sexp.t Or_error.t = ``` @@ -637,7 +637,7 @@ command-line interface: | `Continue msg -> printf "%s\n%!" msg; cli dispatch_table;; -val cli : (string, (module Query_handler_instance)) Hashtbl.Poly.t -> unit = +val cli : (string, (module Query_handler_instance)) Core.Hashtbl.t -> unit = ``` diff --git a/book/first-class-modules/dune b/book/first-class-modules/dune index 663e54777..971c0005d 100644 --- a/book/first-class-modules/dune +++ b/book/first-class-modules/dune @@ -1,4 +1,4 @@ (mdx (files README.md) - (packages core mdx ppx_jane) + (libraries core core_unix core_unix.error_checking_mutex base ppx_jane) (preludes prelude.ml)) diff --git a/book/first-class-modules/examples/dune.inc b/book/first-class-modules/examples/dune.inc index 1b907ba05..75eac16e5 100644 --- a/book/first-class-modules/examples/dune.inc +++ b/book/first-class-modules/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias query_handler_loader) + (locks /global) (deps (source_tree ./correct/query_handler_loader) (package core)) diff --git a/book/foreign-function-interface/dune b/book/foreign-function-interface/dune index 5f73b52ee..8e93307c4 100644 --- a/book/foreign-function-interface/dune +++ b/book/foreign-function-interface/dune @@ -1,10 +1,12 @@ (mdx (files README.md) - (packages + (deps (package ocaml-print-intf)) + (locks /global) + (libraries core + core_unix ctypes ctypes-foreign mdx - ocaml-print-intf ppx_jane) (preludes prelude.ml)) diff --git a/book/foreign-function-interface/examples/correct/ffi_datetime/.rwo-example b/book/foreign-function-interface/examples/correct/ffi_datetime/.rwo-example index b4964bd31..a813f0db7 100644 --- a/book/foreign-function-interface/examples/correct/ffi_datetime/.rwo-example +++ b/book/foreign-function-interface/examples/correct/ffi_datetime/.rwo-example @@ -1 +1 @@ -(packages core async ctypes) \ No newline at end of file +(packages core async ctypes ctypes-foreign) diff --git a/book/foreign-function-interface/examples/correct/ffi_hello/.rwo-example b/book/foreign-function-interface/examples/correct/ffi_hello/.rwo-example index b4964bd31..a813f0db7 100644 --- a/book/foreign-function-interface/examples/correct/ffi_hello/.rwo-example +++ b/book/foreign-function-interface/examples/correct/ffi_hello/.rwo-example @@ -1 +1 @@ -(packages core async ctypes) \ No newline at end of file +(packages core async ctypes ctypes-foreign) diff --git a/book/foreign-function-interface/examples/correct/ffi_ncurses/.rwo-example b/book/foreign-function-interface/examples/correct/ffi_ncurses/.rwo-example index b4964bd31..a813f0db7 100644 --- a/book/foreign-function-interface/examples/correct/ffi_ncurses/.rwo-example +++ b/book/foreign-function-interface/examples/correct/ffi_ncurses/.rwo-example @@ -1 +1 @@ -(packages core async ctypes) \ No newline at end of file +(packages core async ctypes ctypes-foreign) diff --git a/book/foreign-function-interface/examples/correct/ffi_ncurses_nointf/.rwo-example b/book/foreign-function-interface/examples/correct/ffi_ncurses_nointf/.rwo-example index b4964bd31..a813f0db7 100644 --- a/book/foreign-function-interface/examples/correct/ffi_ncurses_nointf/.rwo-example +++ b/book/foreign-function-interface/examples/correct/ffi_ncurses_nointf/.rwo-example @@ -1 +1 @@ -(packages core async ctypes) \ No newline at end of file +(packages core async ctypes ctypes-foreign) diff --git a/book/foreign-function-interface/examples/correct/ffi_qsort/.rwo-example b/book/foreign-function-interface/examples/correct/ffi_qsort/.rwo-example index b4964bd31..a813f0db7 100644 --- a/book/foreign-function-interface/examples/correct/ffi_qsort/.rwo-example +++ b/book/foreign-function-interface/examples/correct/ffi_qsort/.rwo-example @@ -1 +1 @@ -(packages core async ctypes) \ No newline at end of file +(packages core async ctypes ctypes-foreign) diff --git a/book/foreign-function-interface/examples/dune.inc b/book/foreign-function-interface/examples/dune.inc index 5f95561eb..7874415ee 100644 --- a/book/foreign-function-interface/examples/dune.inc +++ b/book/foreign-function-interface/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias ctypes) + (locks /global) (deps (source_tree ./correct/ctypes)) (action @@ -12,11 +13,13 @@ (rule (alias ffi_datetime) + (locks /global) (deps (source_tree ./correct/ffi_datetime) (package core) (package async) - (package ctypes)) + (package ctypes) + (package ctypes-foreign)) (action (system "dune build @all @runtest --root ./correct/ffi_datetime"))) @@ -26,11 +29,13 @@ (rule (alias ffi_hello) + (locks /global) (deps (source_tree ./correct/ffi_hello) (package core) (package async) - (package ctypes)) + (package ctypes) + (package ctypes-foreign)) (action (system "dune build @all @runtest --root ./correct/ffi_hello"))) @@ -40,11 +45,13 @@ (rule (alias ffi_ncurses) + (locks /global) (deps (source_tree ./correct/ffi_ncurses) (package core) (package async) - (package ctypes)) + (package ctypes) + (package ctypes-foreign)) (action (system "dune build @all @runtest --root ./correct/ffi_ncurses"))) @@ -54,11 +61,13 @@ (rule (alias ffi_ncurses_nointf) + (locks /global) (deps (source_tree ./correct/ffi_ncurses_nointf) (package core) (package async) - (package ctypes)) + (package ctypes) + (package ctypes-foreign)) (action (system "dune build @all @runtest --root ./correct/ffi_ncurses_nointf"))) @@ -68,11 +77,13 @@ (rule (alias ffi_qsort) + (locks /global) (deps (source_tree ./correct/ffi_qsort) (package core) (package async) - (package ctypes)) + (package ctypes) + (package ctypes-foreign)) (action (system "dune build @all @runtest --root ./correct/ffi_qsort"))) diff --git a/book/functors/dune b/book/functors/dune index 5cf1868bb..20e770f57 100644 --- a/book/functors/dune +++ b/book/functors/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/gadts/README.md b/book/gadts/README.md index 8db8bd49e..f4b383bcb 100644 --- a/book/gadts/README.md +++ b/book/gadts/README.md @@ -1375,7 +1375,7 @@ case can never be instantiated, and OCaml will tell you as much. Line 4, characters 7-14: Warning 56 [unreachable-case]: this match case is unreachable. Consider replacing it with a refutation case ' -> .' -val print_result : (int, Nothing.t) result -> unit = +val print_result : (int, Core.never_returns) result -> unit = ``` \noindent @@ -1387,7 +1387,7 @@ We can follow the advice above, and add a so-called *refutation case*. match x with | Ok x -> printf "%d\n" x | Error _ -> .;; -val print_result : (int, Nothing.t) result -> unit = +val print_result : (int, Core.never_returns) result -> unit = ``` The period in the final case tells the compiler that we believe this @@ -1399,7 +1399,7 @@ refutation case for you, so you don't need to write it out explicitly. # let print_result (x : (int, Nothing.t) Result.t) = match x with | Ok x -> printf "%d\n" x;; -val print_result : (int, Nothing.t) result -> unit = +val print_result : (int, Core.never_returns) result -> unit = ``` Narrowing with uninhabitable types can be useful when using a highly diff --git a/book/gadts/dune b/book/gadts/dune index 95f99cadb..6ea5a614f 100644 --- a/book/gadts/dune +++ b/book/gadts/dune @@ -1,4 +1,4 @@ (mdx (files README.md) - (packages async base core mdx ppx_jane) + (libraries async base core ppx_jane) (preludes prelude.ml)) diff --git a/book/garbage-collector/README.md b/book/garbage-collector/README.md index 07758f20f..1cd022380 100644 --- a/book/garbage-collector/README.md +++ b/book/garbage-collector/README.md @@ -169,7 +169,7 @@ the `Gc.set` function: ```ocaml env=tune # open Core;; # let c = Gc.get ();; -val c : Gc.Control.t = +val c : Core.Gc.control = {Core.Gc.Control.minor_heap_size = 262144; major_heap_increment = 15; space_overhead = 120; verbose = 0; max_overhead = 500; stack_limit = 1048576; allocation_policy = 2; window_size = 1; diff --git a/book/garbage-collector/dune b/book/garbage-collector/dune index 1775ea5ce..e04149665 100644 --- a/book/garbage-collector/dune +++ b/book/garbage-collector/dune @@ -1,10 +1,9 @@ (mdx (files README.md) - (packages + (libraries async core core_bench - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/guided-tour/dune b/book/guided-tour/dune index edf876b77..88551d8c0 100644 --- a/book/guided-tour/dune +++ b/book/guided-tour/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries base - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/guided-tour/examples/dune.inc b/book/guided-tour/examples/dune.inc index 2364261f2..5dd8af426 100644 --- a/book/guided-tour/examples/dune.inc +++ b/book/guided-tour/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias sum) + (locks /global) (deps (source_tree ./correct/sum) (package base) diff --git a/book/imperative-programming/README.md b/book/imperative-programming/README.md index c884ef87b..d9dba3c16 100644 --- a/book/imperative-programming/README.md +++ b/book/imperative-programming/README.md @@ -960,7 +960,7 @@ And now we can use this to try out some examples: # time (fun () -> edit_distance "OCaml" "ocaml");; Time: 0.655651092529 ms - : int = 2 -# time (fun () -> edit_distance "OCaml 4.13" "ocaml 4.13");; +# time (fun () -> edit_distance "OCaml 4.14" "ocaml 4.14");; Time: 2541.6533947 ms - : int = 2 ``` diff --git a/book/imperative-programming/dune b/book/imperative-programming/dune index f8905ba47..2a3f5faf6 100644 --- a/book/imperative-programming/dune +++ b/book/imperative-programming/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/imperative-programming/examples/dune.inc b/book/imperative-programming/examples/dune.inc index b8a79fe4c..faa2ea11d 100644 --- a/book/imperative-programming/examples/dune.inc +++ b/book/imperative-programming/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias dictionary) + (locks /global) (deps (source_tree ./correct/dictionary) (package base) @@ -15,6 +16,7 @@ (rule (alias dlist) + (locks /global) (deps (source_tree ./correct/dlist) (package base)) @@ -27,6 +29,7 @@ (rule (alias time_converter) + (locks /global) (deps (source_tree ./correct/time_converter) (package core)) @@ -39,6 +42,7 @@ (rule (alias time_converter2) + (locks /global) (deps (source_tree ./correct/time_converter2) (package core)) diff --git a/book/install.html b/book/install.html index f0dd48bc1..8249beeef 100644 --- a/book/install.html +++ b/book/install.html @@ -73,13 +73,13 @@

Initialize opam

Install the right compiler

-

Real World OCaml requires OCaml 4.13.1. You can use opam +

Real World OCaml requires OCaml 4.14.1. You can use opam switch to see which version of OCaml you have installed. If, as shown in the above invocation of switch, you have an older version installed, you can use opam to install a more up-to-date version:


-    opam switch create 4.13.1
+    opam switch create 4.14.1
     eval $(opam env)
 
diff --git a/book/json/dune b/book/json/dune index 5e12ae4e1..f4250829c 100644 --- a/book/json/dune +++ b/book/json/dune @@ -1,8 +1,9 @@ (mdx (files README.md) - (packages + (libraries core - mdx + core_unix + core_unix.error_checking_mutex ppx_jane yojson) (preludes prelude.ml)) diff --git a/book/lists-and-patterns/dune b/book/lists-and-patterns/dune index 90bde0025..0cabb2b62 100644 --- a/book/lists-and-patterns/dune +++ b/book/lists-and-patterns/dune @@ -1,6 +1,6 @@ (mdx (files README.md) - (packages + (libraries core core_bench mdx diff --git a/book/maps-and-hashtables/dune b/book/maps-and-hashtables/dune index f8905ba47..2a3f5faf6 100644 --- a/book/maps-and-hashtables/dune +++ b/book/maps-and-hashtables/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/maps-and-hashtables/examples/dune.inc b/book/maps-and-hashtables/examples/dune.inc index f550e5d81..f42ea9469 100644 --- a/book/maps-and-hashtables/examples/dune.inc +++ b/book/maps-and-hashtables/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias freq-fast) + (locks /global) (deps (source_tree ./correct/freq-fast) (package base) @@ -14,6 +15,7 @@ (rule (alias map_vs_hash) + (locks /global) (deps (source_tree ./correct/map_vs_hash) (package base) @@ -27,6 +29,7 @@ (rule (alias map_vs_hash2) + (locks /global) (deps (source_tree ./correct/map_vs_hash2) (package core_bench)) diff --git a/book/objects/dune b/book/objects/dune index 8bd00edc7..360b4b184 100644 --- a/book/objects/dune +++ b/book/objects/dune @@ -1,8 +1,7 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml diff --git a/book/parsing-with-ocamllex-and-menhir/dune b/book/parsing-with-ocamllex-and-menhir/dune index f8905ba47..2a3f5faf6 100644 --- a/book/parsing-with-ocamllex-and-menhir/dune +++ b/book/parsing-with-ocamllex-and-menhir/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/parsing-with-ocamllex-and-menhir/examples/dune.inc b/book/parsing-with-ocamllex-and-menhir/examples/dune.inc index 41ff07c8f..87cfaafcc 100644 --- a/book/parsing-with-ocamllex-and-menhir/examples/dune.inc +++ b/book/parsing-with-ocamllex-and-menhir/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias parsing-test) + (locks /global) (deps (source_tree ./correct/parsing-test) (package base) diff --git a/book/platform/README.md b/book/platform/README.md index 56f50c3bc..0e811c6e3 100644 --- a/book/platform/README.md +++ b/book/platform/README.md @@ -42,7 +42,7 @@ available: ```sh skip $ opam switch # switch compiler description - default ocaml.4.13.1 default + default ocaml.4.14.1 default ``` ::: @@ -128,11 +128,11 @@ You can use `opam switch list-available` to get a full list of all the compilers that are available. ``` -ocaml-system 4.13.1 The OCaml compiler +ocaml-system 4.14.1 The OCaml compiler (system version, from outside of opam) -ocaml-base-compiler 4.13.1 Official release 4.13.1 -ocaml-variants 4.13.1+options Official release of OCaml 4.13.1 +ocaml-base-compiler 4.14.1 Official release 4.14.1 +ocaml-variants 4.14.1+options Official release of OCaml 4.14.1 ``` You'll find many more versions present than the snippet above, but notice that @@ -145,11 +145,11 @@ The only thing needed to create a system switch is to have the right version of OCaml already installed (e.g. via `apt` or Homebrew) and to pass the same version to the switch creation as an additional argument. -For example, if you have OCaml 4.13.1 installed, then running this +For example, if you have OCaml 4.14.1 installed, then running this command will use the system compiler: ``` -$ opam switch create . 4.13.1 +$ opam switch create . 4.14.1 ``` On the other hand, if you didn't have that system compiler installed, then the @@ -164,7 +164,7 @@ If you always want to locally install a particular compiler, then you can refine the package description: ``` -$ opam switch create . ocaml-base-compiler.4.13.1 +$ opam switch create . ocaml-base-compiler.4.14.1 ``` Sometimes, you will also need to add custom configuration options to @@ -174,7 +174,7 @@ presence of various `ocaml-option` packages to activate configuration flags. For example, to build a compiler with `flambda`, you would: ```sh skip -$ opam switch create . ocaml-variants.4.13.1+options ocaml-option-flambda +$ opam switch create . ocaml-variants.4.14.1+options ocaml-option-flambda ``` You can specify multiple `ocaml-option` packages to cover all the @@ -717,7 +717,7 @@ jobs: - ubuntu-latest - windows-latest ocaml-compiler: - - 4.13.x + - 4.14.x runs-on: ${{ matrix.os }} steps: - name: Checkout code @@ -733,7 +733,7 @@ jobs: This workflow file will run your project on OCaml installations on Windows, macOS and Linux, using the latest patch release of OCaml -4.13. Notice that it also runs the test cases you have defined +4.14. Notice that it also runs the test cases you have defined earlier on all those different operating systems as well. You can do an awful lot of customization of these continuous integration workflows, so refer to the online documentation for more options. diff --git a/book/platform/dune b/book/platform/dune index fb82feb53..827a58fda 100644 --- a/book/platform/dune +++ b/book/platform/dune @@ -1,8 +1,4 @@ (mdx (files README.md) - (packages - base - mdx - ) + (libraries base) (preludes prelude.ml)) - diff --git a/book/platform/examples/dune.inc b/book/platform/examples/dune.inc index 6fdb6e0ad..fae34e63f 100644 --- a/book/platform/examples/dune.inc +++ b/book/platform/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias hello) + (locks /global) (deps (source_tree ./correct/hello) (package base) diff --git a/book/prologue/README.md b/book/prologue/README.md index 61bc0ccf7..6dcd2cbff 100644 --- a/book/prologue/README.md +++ b/book/prologue/README.md @@ -255,7 +255,7 @@ software systems. *Real World OCaml* uses some tools that we've developed while writing this book. Some of these resulted in improvements to the OCaml compiler, which means that you will need to ensure that you have an -up-to-date development environment (using the 4.13.1 version of the +up-to-date development environment (using the 4.14.1 version of the compiler). The installation process is largely automated through the opam package manager. Instructions on how to set it up and what packages to install can be found at [the installation diff --git a/book/prologue/dune b/book/prologue/dune index 0695f8ee5..acb270fb9 100644 --- a/book/prologue/dune +++ b/book/prologue/dune @@ -1,3 +1,2 @@ (mdx - (files README.md) - (packages mdx)) + (files README.md)) diff --git a/book/records/dune b/book/records/dune index af5c0c17a..56c76069c 100644 --- a/book/records/dune +++ b/book/records/dune @@ -1,8 +1,9 @@ (mdx (files README.md) - (packages + (libraries core core_unix + core_unix.error_checking_mutex mdx ppx_jane re) diff --git a/book/runtime-memory-layout/dune b/book/runtime-memory-layout/dune index c24dc99e4..759cfe42f 100644 --- a/book/runtime-memory-layout/dune +++ b/book/runtime-memory-layout/dune @@ -1,6 +1,4 @@ (mdx (files README.md) - (packages - mdx - ocaml-compiler-libs) + (deps (package ocaml-compiler-libs)) (preludes prelude.ml)) diff --git a/book/testing/dune b/book/testing/dune index 0992bf3d2..007768f33 100644 --- a/book/testing/dune +++ b/book/testing/dune @@ -1,11 +1,10 @@ (mdx (files README.md) - (packages + (libraries base base_quickcheck core lambdasoup - mdx patdiff ppx_jane uri) diff --git a/book/testing/examples/dune.inc b/book/testing/examples/dune.inc index 5c523a907..3b5fc4639 100644 --- a/book/testing/examples/dune.inc +++ b/book/testing/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias bigger_quickcheck_test) + (locks /global) (deps (source_tree ./correct/bigger_quickcheck_test) (package base) @@ -18,6 +19,7 @@ (rule (alias bigger_quickcheck_test_with_ppx) + (locks /global) (deps (source_tree ./correct/bigger_quickcheck_test_with_ppx) (package base) @@ -34,6 +36,7 @@ (rule (alias echo_test_delay) + (locks /global) (deps (source_tree ./correct/echo_test_delay) (package core) @@ -48,6 +51,7 @@ (rule (alias echo_test_reconnect) + (locks /global) (deps (source_tree ./correct/echo_test_reconnect) (package core) @@ -62,6 +66,7 @@ (rule (alias manual_property_test) + (locks /global) (deps (source_tree ./correct/manual_property_test) (package base) @@ -78,6 +83,7 @@ (rule (alias multi_block_expect_test) + (locks /global) (deps (source_tree ./correct/multi_block_expect_test) (package base) @@ -92,6 +98,7 @@ (rule (alias rate_limiter_fixed) + (locks /global) (deps (source_tree ./correct/rate_limiter_fixed) (package core) @@ -109,6 +116,7 @@ (rule (alias rate_limiter_show_bug) + (locks /global) (deps (source_tree ./correct/rate_limiter_show_bug) (package core) @@ -126,6 +134,7 @@ (rule (alias simple_expect_test) + (locks /global) (deps (source_tree ./correct/simple_expect_test) (package base) @@ -142,6 +151,7 @@ (rule (alias simple_inline_test) + (locks /global) (deps (source_tree ./correct/simple_inline_test) (package base) @@ -158,6 +168,7 @@ (rule (alias soup_test_corrected) + (locks /global) (deps (source_tree ./correct/soup_test_corrected) (package base) @@ -176,6 +187,7 @@ (rule (alias soup_test_fixed) + (locks /global) (deps (source_tree ./correct/soup_test_fixed) (package base) @@ -194,6 +206,7 @@ (rule (alias trivial_expect_test_fixed) + (locks /global) (deps (source_tree ./correct/trivial_expect_test_fixed) (package base) diff --git a/book/variables-and-functions/dune b/book/variables-and-functions/dune index f8905ba47..2a3f5faf6 100644 --- a/book/variables-and-functions/dune +++ b/book/variables-and-functions/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml)) diff --git a/book/variants/dune b/book/variants/dune index 7c8995197..917cdb58b 100644 --- a/book/variants/dune +++ b/book/variants/dune @@ -1,7 +1,6 @@ (mdx (files README.md) - (packages + (libraries core - mdx ppx_jane) (preludes prelude.ml old_termcolor.ml)) diff --git a/book/variants/examples/dune.inc b/book/variants/examples/dune.inc index acc2efa8d..af8f84960 100644 --- a/book/variants/examples/dune.inc +++ b/book/variants/examples/dune.inc @@ -1,6 +1,7 @@ (rule (alias variants-termcol) + (locks /global) (deps (source_tree ./correct/variants-termcol) (package base)) @@ -13,6 +14,7 @@ (rule (alias variants-termcol-fixed) + (locks /global) (deps (source_tree ./correct/variants-termcol-fixed) (package base)) diff --git a/dune-project b/dune-project index 09de596e9..19e501dae 100644 --- a/dune-project +++ b/dune-project @@ -1,7 +1,7 @@ -(lang dune 2.9) +(lang dune 3.6) (name rwo) -(using mdx 0.1) +(using mdx 0.3) (formatting disabled) @@ -24,6 +24,7 @@ second edition book. See https://realworldocaml.org/") async_graphics atdgen base + (base-bytes (="base")) (cmdliner (>= 1.1.0)) cohttp-async conf-ncurses diff --git a/duniverse/base/.github/workflows/workflow.yml b/duniverse/base/.github/workflows/workflow.yml new file mode 100644 index 000000000..e8126d9bc --- /dev/null +++ b/duniverse/base/.github/workflows/workflow.yml @@ -0,0 +1,49 @@ +name: Main workflow + +on: + pull_request: + push: + schedule: + - cron: '0 1 * * SAT' + +concurrency: + group: ci-${{ github.ref }} + cancel-in-progress: true + +jobs: + Tests: + strategy: + fail-fast: false + matrix: + os: [macos-latest, ubuntu-latest, windows-latest] + ocaml: + - ocaml-base-compiler.5.0.0~alpha0 + - 4.14.0 + include: + - {os: ubuntu-latest, ocaml: 4.13.1} + - {os: ubuntu-latest, ocaml: 4.12.1} + - {os: ubuntu-latest, ocaml: 4.11.2} + exclude: + - {os: windows-latest, ocaml: ocaml-base-compiler.5.0.0~alpha0} + + runs-on: ${{ matrix.os }} + + steps: + - name: Checkout code + uses: actions/checkout@v3 + + - name: Setup OCaml ${{ matrix.ocaml }} + uses: ocaml/setup-ocaml@v2 + with: + cache-prefix: v1-${{ matrix.os }}-${{ matrix.ocaml }} + dune-cache: true + ocaml-compiler: ${{ matrix.ocaml }} + + - name: Build dependencies + run: opam install . --deps-only --with-test + + - name: Build library + run: opam exec -- dune build + + - name: Run test suite + run: opam exec -- dune runtest diff --git a/duniverse/base/README.org b/duniverse/base/README.org index bdfa1bda7..e11fbdc63 100644 --- a/duniverse/base/README.org +++ b/duniverse/base/README.org @@ -1,5 +1,7 @@ * Base +[[https://github.com/janestreet/base/actions][https://github.com/janestreet/base/actions/workflows/workflow.yml/badge.svg]] + Base is a standard library for OCaml. It provides a standard set of general purpose modules that are well-tested, performant, and fully-portable across any environment that can run OCaml code. Unlike diff --git a/duniverse/base/base.opam b/duniverse/base/base.opam index 180c93694..4c67dfab6 100644 --- a/duniverse/base/base.opam +++ b/duniverse/base/base.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.15.0" +version: "v0.15.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/base" diff --git a/duniverse/base/shadow-stdlib/gen/mapper.mll b/duniverse/base/shadow-stdlib/gen/mapper.mll index a1d7c23c3..3b9915c70 100644 --- a/duniverse/base/shadow-stdlib/gen/mapper.mll +++ b/duniverse/base/shadow-stdlib/gen/mapper.mll @@ -2,15 +2,6 @@ open StdLabels open Printf -module String = struct - [@@@warning "-32-3"] - let capitalize_ascii = String.capitalize - let uncapitalize_ascii = String.uncapitalize - let uppercase_ascii = String.uppercase - let lowercase_ascii = String.lowercase - include String -end - let deprecated_msg ~is_exn what = sprintf "[%sdeprecated \"\\\n\ diff --git a/duniverse/base/src/bytes0.ml b/duniverse/base/src/bytes0.ml index 666918461..01abb18e2 100644 --- a/duniverse/base/src/bytes0.ml +++ b/duniverse/base/src/bytes0.ml @@ -21,8 +21,8 @@ module Primitives = struct external get : bytes -> int -> char = "%bytes_safe_get" external length : bytes -> int = "%bytes_length" external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" - - include Bytes_set_primitives + external set : bytes -> int -> char -> unit = "%bytes_safe_set" + external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" (* [unsafe_blit_string] is not exported in the [stdlib] so we export it here *) external unsafe_blit_string diff --git a/duniverse/base/src/dune b/duniverse/base/src/dune index 04f42d55b..785c1a9d7 100644 --- a/duniverse/base/src/dune +++ b/duniverse/base/src/dune @@ -1,5 +1,5 @@ -(rule (targets bytes_set_primitives.ml) - (deps (:first_dep select-bytes-set-primitives/select.ml)) +(rule (targets random_repr.ml) + (deps (:first_dep select-random-repr/select.ml)) (action (run %{ocaml} %{first_dep} -ocaml-version %{ocaml_version} -o %{targets}))) diff --git a/duniverse/base/src/float.ml b/duniverse/base/src/float.ml index fe517a625..4ed62243e 100644 --- a/duniverse/base/src/float.ml +++ b/duniverse/base/src/float.ml @@ -417,12 +417,14 @@ let round_up = ceil let round_towards_zero t = if t >= 0. then round_down t else round_up t (* see the comment above [round_nearest_lb] and [round_nearest_ub] for an explanation *) -let round_nearest t = +let[@ocaml.inline] round_nearest_inline t = if t > round_nearest_lb && t < round_nearest_ub then floor (add_half_for_round_nearest t) else t +. 0. ;; +let round_nearest t = (round_nearest_inline [@ocaml.inlined always]) t + let round_nearest_half_to_even t = if t <= round_nearest_lb || t >= round_nearest_ub then t +. 0. @@ -487,7 +489,7 @@ let int63_round_down_exn t = ;; let int63_round_nearest_portable_alloc_exn t0 = - let t = (round_nearest [@ocaml.inlined always]) t0 in + let t = (round_nearest_inline [@ocaml.inlined always]) t0 in if t > 0. then if t <= int63_round_ubound diff --git a/duniverse/base/src/import0.ml b/duniverse/base/src/import0.ml index f680d2108..95e82c8b2 100644 --- a/duniverse/base/src/import0.ml +++ b/duniverse/base/src/import0.ml @@ -45,6 +45,8 @@ type 'a ref = 'a Caml.ref = { mutable contents : 'a } (* Reshuffle [Caml] so that we choose the modules using labels when available. *) module Caml = struct + include Caml + module Arg = Caml.Arg (** @canonical Caml.Arg *) module Array = Caml.StdLabels.Array (** @canonical Caml.StdLabels.Array *) @@ -109,8 +111,6 @@ module Caml = struct module Stack = Caml.Stack (** @canonical Caml.Stack *) - module Stream = Caml.Stream [@ocaml.warning "-3"] (** @canonical Caml.Stream *) - module String = Caml.StdLabels.String (** @canonical Caml.StdLabels.String *) module Sys = Caml.Sys (** @canonical Caml.Sys *) @@ -119,8 +119,6 @@ module Caml = struct module Unit = Caml.Unit (** @canonical Caml.Unit *) - include Pervasives [@ocaml.warning "-3"] - exception Not_found = Caml.Not_found end diff --git a/duniverse/base/src/random.ml b/duniverse/base/src/random.ml index 029b722cd..a0553d23d 100644 --- a/duniverse/base/src/random.ml +++ b/duniverse/base/src/random.ml @@ -1,5 +1,4 @@ open! Import -module Array = Array0 module Int = Int0 module Char = Char0 @@ -55,21 +54,7 @@ module State = struct Lazy.from_val (Caml.Random.State.make_self_init ()) ;; - module Repr = struct - type t = - { st : int array - ; mutable idx : int - } - - let of_state : Caml.Random.State.t -> t = Caml.Obj.magic - end - - let assign t1 t2 = - let t1 = Repr.of_state (Lazy.force t1) in - let t2 = Repr.of_state (Lazy.force t2) in - Array.blit ~src:t2.st ~src_pos:0 ~dst:t1.st ~dst_pos:0 ~len:(Array.length t1.st); - t1.idx <- t2.idx - ;; + let assign = Random_repr.assign let full_init t seed = assign t (make seed) @@ -249,22 +234,23 @@ module State = struct ;; end -let default = State.default -let bits () = State.bits default -let int x = State.int default x -let int32 x = State.int32 default x -let nativeint x = State.nativeint default x -let int64 x = State.int64 default x -let float x = State.float default x -let int_incl x y = State.int_incl default x y -let int32_incl x y = State.int32_incl default x y -let nativeint_incl x y = State.nativeint_incl default x y -let int64_incl x y = State.int64_incl default x y -let float_range x y = State.float_range default x y -let bool () = State.bool default -let char () = State.char default -let ascii () = State.ascii default -let full_init seed = State.full_init default seed +let default = Random_repr.make_default State.default + +let bits () = State.bits (Random_repr.get_state default) +let int x = State.int (Random_repr.get_state default) x +let int32 x = State.int32 (Random_repr.get_state default) x +let nativeint x = State.nativeint (Random_repr.get_state default) x +let int64 x = State.int64 (Random_repr.get_state default) x +let float x = State.float (Random_repr.get_state default) x +let int_incl x y = State.int_incl (Random_repr.get_state default) x y +let int32_incl x y = State.int32_incl (Random_repr.get_state default) x y +let nativeint_incl x y = State.nativeint_incl (Random_repr.get_state default) x y +let int64_incl x y = State.int64_incl (Random_repr.get_state default) x y +let float_range x y = State.float_range (Random_repr.get_state default) x y +let bool () = State.bool (Random_repr.get_state default) +let char () = State.char (Random_repr.get_state default) +let ascii () = State.ascii (Random_repr.get_state default) +let full_init seed = State.full_init (Random_repr.get_state default) seed let init seed = full_init [| seed |] let self_init ?allow_in_tests () = full_init (random_seed ?allow_in_tests ()) -let set_state s = State.assign default s +let set_state s = State.assign (Random_repr.get_state default) s diff --git a/duniverse/base/src/select-bytes-set-primitives/select.ml b/duniverse/base/src/select-bytes-set-primitives/select.ml deleted file mode 100644 index 20cfcbecd..000000000 --- a/duniverse/base/src/select-bytes-set-primitives/select.ml +++ /dev/null @@ -1,20 +0,0 @@ -let () = - let ver, output = - try - match Sys.argv with - | [|_; "-ocaml-version"; v; "-o"; fn|] -> - (Scanf.sscanf v "%d.%d" (fun major minor -> (major, minor)), - fn) - | _ -> raise Exit - with _ -> - failwith "bad command line arguments" - in - let prefix = - if ver >= (4, 04) then "bytes" else "string" - in - let oc = open_out output in - Printf.fprintf oc {| -external set : %s -> int -> char -> unit = "%%%s_safe_set" -external unsafe_set : %s -> int -> char -> unit = "%%%s_unsafe_set" -|} prefix prefix prefix prefix; - close_out oc diff --git a/duniverse/base/src/select-random-repr/select.ml b/duniverse/base/src/select-random-repr/select.ml new file mode 100644 index 000000000..3f2074ba7 --- /dev/null +++ b/duniverse/base/src/select-random-repr/select.ml @@ -0,0 +1,59 @@ +let () = + let ver, output = + try + match Sys.argv with + | [|_; "-ocaml-version"; v; "-o"; fn|] -> + (Scanf.sscanf v "%d.%d" (fun major minor -> (major, minor)), + fn) + | _ -> raise Exit + with _ -> + failwith "bad command line arguments" + in + let oc = open_out output in + if ver >= (5, 0) then + Printf.fprintf oc {| +module Repr = struct + open Caml.Bigarray + + type t = (int64, int64_elt, c_layout) Array1.t + + let of_state : Caml.Random.State.t -> t = Caml.Obj.magic +end + +let assign dst src = + let dst = Repr.of_state (Lazy.force dst) in + let src = Repr.of_state (Lazy.force src) in + Caml.Bigarray.Array1.blit src dst + +let make_default default = + let split_from_parent v = + Caml.Lazy.map_val Caml.Random.State.split v + in + Caml.Domain.DLS.new_key ~split_from_parent (fun () -> default) + +let get_state random_key = Caml.Domain.DLS.get random_key +|} + else + Printf.fprintf oc {| +module Array = Array0 + +module Repr = struct + type t = + { st : int array + ; mutable idx : int + } + + let of_state : Caml.Random.State.t -> t = Caml.Obj.magic +end + +let assign t1 t2 = + let t1 = Repr.of_state (Lazy.force t1) in + let t2 = Repr.of_state (Lazy.force t2) in + Array.blit ~src:t2.st ~src_pos:0 ~dst:t1.st ~dst_pos:0 ~len:(Array.length t1.st); + t1.idx <- t2.idx + +let make_default default = default + +let[@inline always] get_state state = state +|}; + close_out oc diff --git a/duniverse/base/src/string.ml b/duniverse/base/src/string.ml index 0ee495a71..1f5048952 100644 --- a/duniverse/base/src/string.ml +++ b/duniverse/base/src/string.ml @@ -1,7 +1,9 @@ open! Import module Array = Array0 -module Bytes = Bytes0 include String0 +module Bytes = Bytes0 +(* This alias is necessary despite [String0] defining [Bytes = Bytes0], in order to + convince ocamldep that this file doesn't depend on bytes.ml. *) let invalid_argf = Printf.invalid_argf let raise_s = Error.raise_s diff --git a/duniverse/base/src/string0.ml b/duniverse/base/src/string0.ml index ea8e3d5cf..069de9c71 100644 --- a/duniverse/base/src/string0.ml +++ b/duniverse/base/src/string0.ml @@ -16,14 +16,15 @@ ocamldep from mistakenly causing a file to depend on [Base.String]. *) open! Import0 +module Bytes = Bytes0 module Sys = Sys0 module String = struct external get : string -> int -> char = "%string_safe_get" external length : string -> int = "%string_length" external unsafe_get : string -> int -> char = "%string_unsafe_get" - - include Bytes_set_primitives + external set : bytes -> int -> char -> unit = "%bytes_safe_set" + external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" end include String @@ -32,7 +33,13 @@ let max_length = Sys.max_string_length let ( ^ ) = ( ^ ) let capitalize = Caml.String.capitalize_ascii let compare = Caml.String.compare -let[@warning "-3"] copy = Caml.String.copy + +let copy x = + Bytes.unsafe_to_string + ~no_mutation_while_string_reachable: + (Bytes.of_string x) +;; + let escaped = Caml.String.escaped let lowercase = Caml.String.lowercase_ascii let make = Caml.String.make diff --git a/duniverse/base/src/type_equal.ml b/duniverse/base/src/type_equal.ml index e004cd811..dad04f7b2 100644 --- a/duniverse/base/src/type_equal.ml +++ b/duniverse/base/src/type_equal.ml @@ -74,15 +74,6 @@ module Composition_preserves_injectivity (M1 : Injective) (M2 : Injective) = str let strip e = M1.strip (M2.strip e) end -module Obj = struct - module Extension_constructor = struct - [@@@ocaml.warning "-3"] - - let id = Caml.Obj.extension_id - let of_val = Caml.Obj.extension_constructor - end -end - module Id = struct module Uid = Int @@ -100,7 +91,8 @@ module Id = struct [@@@end] let sexp_of_t _sexp_of_a t = - `type_witness (Obj.Extension_constructor.id (Obj.Extension_constructor.of_val t)) + `type_witness + (Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val t)) |> sexp_of_type_witness_int ;; end @@ -126,7 +118,7 @@ module Id = struct ;; let uid (type a) (module M : S with type t = a) = - Obj.Extension_constructor.id (Obj.Extension_constructor.of_val M.Key) + Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val M.Key) ;; (* We want a constant allocated once that [same] can return whenever it gets the same diff --git a/duniverse/core/core.opam b/duniverse/core/core.opam index eff6296e8..1143ab95d 100644 --- a/duniverse/core/core.opam +++ b/duniverse/core/core.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.15.0" +version: "v0.15.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/core" @@ -12,7 +12,7 @@ build: [ ] depends: [ "ocaml" {>= "4.11.0"} - "base" {>= "v0.15" & < "v0.16"} + "base" {>= "v0.15.1" & < "v0.16"} "base_bigstring" {>= "v0.15" & < "v0.16"} "base_quickcheck" {>= "v0.15" & < "v0.16"} "bin_prot" {>= "v0.15" & < "v0.16"} diff --git a/duniverse/core/core/src/core_pervasives.ml b/duniverse/core/core/src/core_pervasives.ml index 88faf0dd0..1f3143d29 100644 --- a/duniverse/core/core/src/core_pervasives.ml +++ b/duniverse/core/core/src/core_pervasives.ml @@ -18,3 +18,10 @@ external raise : exn -> 'a = "%reraise" let __FUNCTION__ = "<__FUNCTION__ not supported before OCaml 4.12>" [%%endif] + +[%%if ocaml_version >= (5, 0, 0)] + +external ( & ) : bool -> bool -> bool = "%sequand" +external ( or ) : bool -> bool -> bool = "%sequor" + +[%%endif] diff --git a/duniverse/core/core/src/ephemeron.ml b/duniverse/core/core/src/ephemeron.ml index 98c89ba4a..52d6930fc 100644 --- a/duniverse/core/core/src/ephemeron.ml +++ b/duniverse/core/core/src/ephemeron.ml @@ -1,29 +1 @@ -open! Import -open Std_internal -module Ephemeron = Caml.Ephemeron.K1 - -type ('a, 'b) t = ('a Heap_block.t, 'b Heap_block.t) Ephemeron.t - -let create = Ephemeron.create - -let set_key t = function - | None -> Ephemeron.unset_key t - | Some v -> Ephemeron.set_key t v -;; - -let get_key = Ephemeron.get_key - -let set_data t = function - | None -> Ephemeron.unset_data t - | Some v -> Ephemeron.set_data t v -;; - -let get_data = Ephemeron.get_data -let is_key_some t = Ephemeron.check_key t -let is_key_none t = not (is_key_some t) -let is_data_some t = Ephemeron.check_data t -let is_data_none t = not (is_data_some t) - -let sexp_of_t sexp_of_a sexp_of_b t = - [%sexp_of: a Heap_block.t option * b Heap_block.t option] (get_key t, get_data t) -;; +include Caml.Ephemeron diff --git a/duniverse/core/core/src/ephemeron.mli b/duniverse/core/core/src/ephemeron.mli index 59b288bef..019fa416c 100644 --- a/duniverse/core/core/src/ephemeron.mli +++ b/duniverse/core/core/src/ephemeron.mli @@ -1,26 +1 @@ -(** An ephemeron is a pair of pointers, one to a "key" and one to "data". - - The key pointer is a weak pointer: the garbage collector doesn't follow it when - determining liveness. The garbage collector follows an ephemeron's data pointer iff - the key is alive. If the garbage collector nulls an ephemeron's weak pointer then it - also nulls the data pointer. Ephemerons are more powerful than weak pointers because - they express conjunction of liveness -- the data in an ephemeron is live iff both the - key {e and} the ephemeron are live. See "Ephemerons: A New Finalization Mechanism", - Barry Hayes 1997. - - This module is like the OCaml standard library module [Ephemerons.K1], except that it - requires that the keys and data are heap blocks. *) - -open! Import - -type ('a, 'b) t [@@deriving sexp_of] - -val create : unit -> _ t -val set_key : ('a, _) t -> 'a Heap_block.t option -> unit -val get_key : ('a, _) t -> 'a Heap_block.t option -val set_data : (_, 'b) t -> 'b Heap_block.t option -> unit -val get_data : (_, 'b) t -> 'b Heap_block.t option -val is_key_some : _ t -> bool -val is_key_none : _ t -> bool -val is_data_some : _ t -> bool -val is_data_none : _ t -> bool +include module type of Caml.Ephemeron diff --git a/duniverse/core/core/src/gc.ml b/duniverse/core/core/src/gc.ml index bbc17bc72..4e402a769 100644 --- a/duniverse/core/core/src/gc.ml +++ b/duniverse/core/core/src/gc.ml @@ -110,6 +110,8 @@ module Stable = struct end module Control = struct + [%%if ocaml_version < (5, 0, 0)] + module V1 = struct [@@@ocaml.warning "-3"] @@ -128,6 +130,29 @@ module Stable = struct } [@@deriving bin_io, compare, equal, sexp] end + + [%% else] + + module V1 = struct + [@@@ocaml.warning "-3"] + + type t = Caml.Gc.control = + { minor_heap_size : int + ; major_heap_increment : int + ; space_overhead : int + ; verbose : int + ; max_overhead : int + ; stack_limit : int + ; allocation_policy : int + ; window_size : int + ; custom_major_ratio : int + ; custom_minor_ratio : int + ; custom_minor_max_size : int + } + [@@deriving bin_io, compare, equal, sexp] + end + + [%%endif] end end @@ -236,6 +261,8 @@ module Stat = struct end module Control = struct + [%%if ocaml_version < (5, 0, 0)] + module T = struct [@@@ocaml.warning "-3"] @@ -255,6 +282,29 @@ module Control = struct [@@deriving compare, sexp_of, fields] end + [%% else] + + module T = struct + [@@@ocaml.warning "-3"] + + type t = Caml.Gc.control = + { minor_heap_size : int + ; major_heap_increment : int + ; space_overhead : int + ; verbose : int + ; max_overhead : int + ; stack_limit : int + ; allocation_policy : int + ; window_size : int + ; custom_major_ratio : int + ; custom_minor_ratio : int + ; custom_minor_max_size : int + } + [@@deriving compare, sexp_of, fields] + end + + [%% endif] + include T include Comparable.Make_plain (T) end @@ -339,13 +389,9 @@ external major_words : unit -> int = "core_gc_major_words" [@@noalloc] external promoted_words : unit -> int = "core_gc_promoted_words" [@@noalloc] external minor_collections : unit -> int = "core_gc_minor_collections" [@@noalloc] external major_collections : unit -> int = "core_gc_major_collections" [@@noalloc] -external heap_words : unit -> int = "core_gc_heap_words" [@@noalloc] -external heap_chunks : unit -> int = "core_gc_heap_chunks" [@@noalloc] external compactions : unit -> int = "core_gc_compactions" [@@noalloc] -external top_heap_words : unit -> int = "core_gc_top_heap_words" [@@noalloc] external major_plus_minor_words : unit -> int = "core_gc_major_plus_minor_words" external allocated_words : unit -> int = "core_gc_allocated_words" -external run_memprof_callbacks : unit -> unit = "core_gc_run_memprof_callbacks" let zero = Sys.opaque_identity (int_of_string "0") @@ -466,11 +512,9 @@ module For_testing = struct (* Memprof.stop does not guarantee that all memprof callbacks are run (some may be delayed if they happened during C code and there has been no allocation since), so we explictly flush them *) - run_memprof_callbacks (); Caml.Gc.Memprof.stop (); x | exception e -> - run_memprof_callbacks (); Caml.Gc.Memprof.stop (); raise e in diff --git a/duniverse/core/core/src/gc.mli b/duniverse/core/core/src/gc.mli index 30aa3202c..7b3ed5128 100644 --- a/duniverse/core/core/src/gc.mli +++ b/duniverse/core/core/src/gc.mli @@ -123,6 +123,8 @@ type stat = Stat.t *) module Control : sig + [%%if ocaml_version < (5, 0, 0)] + type t = { mutable minor_heap_size : int (** The size (in words) of the minor heap. Changing this parameter will @@ -227,6 +229,115 @@ module Control : sig } [@@deriving sexp_of, fields] + [%% else] + + + type t = + { minor_heap_size : int + (** The size (in words) of the minor heap. Changing this parameter will + trigger a minor collection. + + Default: 262144 words / 1MB (32bit) / 2MB (64bit). + *) + ; major_heap_increment : int + (** How much to add to the major heap when increasing it. If this + number is less than or equal to 1000, it is a percentage of + the current heap size (i.e. setting it to 100 will double the heap + size at each increase). If it is more than 1000, it is a fixed + number of words that will be added to the heap. + + Default: 15%. + *) + ; space_overhead : int + (** The major GC speed is computed from this parameter. + This is the memory that will be "wasted" because the GC does not + immediately collect unreachable blocks. It is expressed as a + percentage of the memory used for live data. + The GC will work more (use more CPU time and collect + blocks more eagerly) if [space_overhead] is smaller. + + Default: 80. *) + ; verbose : int + (** This value controls the GC messages on standard error output. + It is a sum of some of the following flags, to print messages + on the corresponding events: + - [0x001] Start of major GC cycle. + - [0x002] Minor collection and major GC slice. + - [0x004] Growing and shrinking of the heap. + - [0x008] Resizing of stacks and memory manager tables. + - [0x010] Heap compaction. + - [0x020] Change of GC parameters. + - [0x040] Computation of major GC slice size. + - [0x080] Calling of finalisation functions. + - [0x100] Bytecode executable search at start-up. + - [0x200] Computation of compaction triggering condition. + + Default: 0. *) + ; max_overhead : int + (** Heap compaction is triggered when the estimated amount + of "wasted" memory is more than [max_overhead] percent of the + amount of live data. If [max_overhead] is set to 0, heap + compaction is triggered at the end of each major GC cycle + (this setting is intended for testing purposes only). + If [max_overhead >= 1000000], compaction is never triggered. + + Default: 500. *) + ; stack_limit : int + (** The maximum size of the stack (in words). This is only + relevant to the byte-code runtime, as the native code runtime + uses the operating system's stack. + + Default: 1048576 words / 4MB (32bit) / 8MB (64bit). *) + ; allocation_policy : int + (** The policy used for allocating in the heap. Possible + values are 0 and 1. 0 is the next-fit policy, which is + quite fast but can result in fragmentation. 1 is the + first-fit policy, which can be slower in some cases but + can be better for programs with fragmentation problems. + + Default: 0. *) + ; window_size : int + (** The size of the window used by the major GC for smoothing + out variations in its workload. This is an integer between + 1 and 50. + + Default: 1. @since 4.03.0 *) + ; custom_major_ratio : int + (** Target ratio of floating garbage to major heap size for + out-of-heap memory held by custom values located in the major + heap. The GC speed is adjusted to try to use this much memory + for dead values that are not yet collected. Expressed as a + percentage of major heap size. The default value keeps the + out-of-heap floating garbage about the same size as the + in-heap overhead. + Note: this only applies to values allocated with + [caml_alloc_custom_mem] (e.g. bigarrays). + Default: 44. + @since 4.08.0 *) + ; custom_minor_ratio : int + (** Bound on floating garbage for out-of-heap memory held by + custom values in the minor heap. A minor GC is triggered when + this much memory is held by custom values located in the minor + heap. Expressed as a percentage of minor heap size. + Note: this only applies to values allocated with + [caml_alloc_custom_mem] (e.g. bigarrays). + Default: 100. + @since 4.08.0 *) + ; custom_minor_max_size : int + (** Maximum amount of out-of-heap memory for each custom value + allocated in the minor heap. When a custom value is allocated + on the minor heap and holds more than this many bytes, only + this value is counted against [custom_minor_ratio] and the + rest is directly counted against [custom_major_ratio]. + Note: this only applies to values allocated with + [caml_alloc_custom_mem] (e.g. bigarrays). + Default: 8192 bytes. + @since 4.08.0 *) + } + [@@deriving sexp_of, fields] + + [%% endif] + include Comparable.S_plain with type t := t end @@ -267,10 +378,7 @@ external major_words : unit -> int = "core_gc_major_words" [@@noalloc] external promoted_words : unit -> int = "core_gc_promoted_words" [@@noalloc] external minor_collections : unit -> int = "core_gc_minor_collections" [@@noalloc] external major_collections : unit -> int = "core_gc_major_collections" [@@noalloc] -external heap_words : unit -> int = "core_gc_heap_words" [@@noalloc] -external heap_chunks : unit -> int = "core_gc_heap_chunks" [@@noalloc] external compactions : unit -> int = "core_gc_compactions" [@@noalloc] -external top_heap_words : unit -> int = "core_gc_top_heap_words" [@@noalloc] (** This function returns [major_words () + minor_words ()]. It exists purely for speed (one call into C rather than two). Like [major_words] and [minor_words], diff --git a/duniverse/core/core/src/gc_stubs.c b/duniverse/core/core/src/gc_stubs.c index 4b5f1108e..f54c5f45c 100644 --- a/duniverse/core/core/src/gc_stubs.c +++ b/duniverse/core/core/src/gc_stubs.c @@ -45,26 +45,12 @@ CAMLprim value core_gc_major_collections(value unit __attribute__((unused))) return Val_long(caml_stat_major_collections); } -CAMLprim value core_gc_heap_words(value unit __attribute__((unused))) -{ - return Val_long(caml_stat_heap_wsz); -} - -CAMLprim value core_gc_heap_chunks(value unit __attribute__((unused))) -{ - return Val_long(caml_stat_heap_chunks); -} CAMLprim value core_gc_compactions(value unit __attribute__((unused))) { return Val_long(caml_stat_compactions); } -CAMLprim value core_gc_top_heap_words(value unit __attribute__((unused))) -{ - return Val_long(caml_stat_top_heap_wsz); -} - CAMLprim value core_gc_major_plus_minor_words(value unit __attribute__((unused))) { return Val_long(minor_words() + major_words()); @@ -74,10 +60,3 @@ CAMLprim value core_gc_allocated_words(value unit __attribute__((unused))) { return Val_long(minor_words() + major_words() - promoted_words()); } - -CAMLprim value core_gc_run_memprof_callbacks(value unit __attribute__((unused))) -{ - value exn = caml_memprof_handle_postponed_exn(); - caml_raise_if_exception(exn); - return Val_unit; -} diff --git a/duniverse/core/core/src/md5_stubs.c b/duniverse/core/core/src/md5_stubs.c index 403f095b8..c425588a0 100644 --- a/duniverse/core/core/src/md5_stubs.c +++ b/duniverse/core/core/src/md5_stubs.c @@ -1,3 +1,4 @@ +#define CAML_INTERNALS #include #include #include @@ -7,10 +8,10 @@ #include #include -#define CAML_INTERNALS #if __GNUC__ < 8 #pragma GCC diagnostic ignored "-pedantic" #endif + #include #include #undef CAML_INTERNALS diff --git a/duniverse/core_unix/bigstring_unix/src/bigstring_unix_stubs.c b/duniverse/core_unix/bigstring_unix/src/bigstring_unix_stubs.c index 6c98d989c..7d1ca3016 100644 --- a/duniverse/core_unix/bigstring_unix/src/bigstring_unix_stubs.c +++ b/duniverse/core_unix/bigstring_unix/src/bigstring_unix_stubs.c @@ -46,7 +46,7 @@ #include "ocaml_utils.h" #include "unix_utils.h" -#include "socketaddr.h" +#include #include #include "recvmmsg.h" diff --git a/duniverse/core_unix/bigstring_unix/src/dune b/duniverse/core_unix/bigstring_unix/src/dune index e3b6aacc2..4311754b2 100644 --- a/duniverse/core_unix/bigstring_unix/src/dune +++ b/duniverse/core_unix/bigstring_unix/src/dune @@ -5,6 +5,3 @@ (rule (targets config.h) (deps) (action (bash "cp %{lib:jst-config:config.h} ."))) - -(rule (targets socketaddr.h) (deps) - (action (bash "cp %{lib:core_unix:socketaddr.h} ."))) \ No newline at end of file diff --git a/duniverse/core_unix/bigstring_unix/src/recvmmsg.c b/duniverse/core_unix/bigstring_unix/src/recvmmsg.c index 664b6c1ea..b488ae8da 100644 --- a/duniverse/core_unix/bigstring_unix/src/recvmmsg.c +++ b/duniverse/core_unix/bigstring_unix/src/recvmmsg.c @@ -7,7 +7,7 @@ #include "config.h" #include "ocaml_utils.h" #include "unix_utils.h" -#include "socketaddr.h" +#include #include "recvmmsg.h" #ifdef JSC_RECVMMSG diff --git a/duniverse/core_unix/core_thread/src/pthread_np_stubs.c b/duniverse/core_unix/core_thread/src/pthread_np_stubs.c index 8d036fb87..b5bdc50fd 100644 --- a/duniverse/core_unix/core_thread/src/pthread_np_stubs.c +++ b/duniverse/core_unix/core_thread/src/pthread_np_stubs.c @@ -66,4 +66,9 @@ CAMLprim value pthread_np_getaffinity_self() } CAMLreturn(v_cpus); } + +#else + +void avoid_empty_translation_unit_compilation_error_in_core_unix_core_thread(void) {} + #endif /* JSC_PTHREAD_NP */ diff --git a/duniverse/core_unix/core_unix.opam b/duniverse/core_unix/core_unix.opam index cccc67349..a34aa6a33 100644 --- a/duniverse/core_unix/core_unix.opam +++ b/duniverse/core_unix/core_unix.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.15.0" +version: "v0.15.2" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/core_unix" @@ -23,7 +23,7 @@ depends: [ "timezone" {>= "v0.15" & < "v0.16"} "base-threads" "dune" {>= "2.0.0"} - "spawn" {>= "v0.12"} + "spawn" {>= "v0.15"} ] synopsis: "Unix-specific portions of Core" description: " diff --git a/duniverse/core_unix/core_unix/src/core_unix_stubs.c b/duniverse/core_unix/core_unix/src/core_unix_stubs.c index 31728035f..8250bd387 100644 --- a/duniverse/core_unix/core_unix/src/core_unix_stubs.c +++ b/duniverse/core_unix/core_unix/src/core_unix_stubs.c @@ -1091,7 +1091,7 @@ CAMLprim value core_unix_if_indextoname(value v_index) else return caml_copy_string(name); } -#include "socketaddr.h" +#include /* Keep this in sync with the type Core_unix.Mcast_action.t */ #define VAL_MCAST_ACTION_ADD (Val_int(0)) @@ -1206,11 +1206,17 @@ enum option_type { TYPE_UNIX_ERROR = 4 }; -extern value unix_getsockopt_aux( +#include +#if OCAML_VERSION_MAJOR < 5 +#define caml_unix_getsockopt_aux unix_getsockopt_aux +#define caml_unix_setsockopt_aux unix_setsockopt_aux +#endif + +extern value caml_unix_getsockopt_aux( char *name, enum option_type ty, int level, int option, value v_socket); -extern value unix_setsockopt_aux( +extern value caml_unix_setsockopt_aux( char *name, enum option_type ty, int level, int option, value v_socket, value v_status); @@ -1218,13 +1224,13 @@ extern value unix_setsockopt_aux( CAMLprim value core_unix_mcast_get_ttl(value v_socket) { return - unix_getsockopt_aux("getsockopt", TYPE_INT, IPPROTO_IP, IP_MULTICAST_TTL, v_socket); + caml_unix_getsockopt_aux("getsockopt", TYPE_INT, IPPROTO_IP, IP_MULTICAST_TTL, v_socket); } CAMLprim value core_unix_mcast_set_ttl(value v_socket, value v_ttl) { return - unix_setsockopt_aux( "setsockopt", TYPE_INT, IPPROTO_IP, IP_MULTICAST_TTL, v_socket, v_ttl); + caml_unix_setsockopt_aux( "setsockopt", TYPE_INT, IPPROTO_IP, IP_MULTICAST_TTL, v_socket, v_ttl); } CAMLprim value core_unix_mcast_set_ifname(value v_socket, value v_ifname) @@ -1238,7 +1244,7 @@ CAMLprim value core_unix_mcast_set_ifname(value v_socket, value v_ifname) /* Now setsockopt to publish on the interface using the address. */ return - unix_setsockopt_aux("setsockopt", + caml_unix_setsockopt_aux("setsockopt", TYPE_INT, IPPROTO_IP, IP_MULTICAST_IF, v_socket, @@ -1248,13 +1254,13 @@ CAMLprim value core_unix_mcast_set_ifname(value v_socket, value v_ifname) CAMLprim value core_unix_mcast_get_loop(value v_socket) { return - unix_getsockopt_aux("getsockopt", TYPE_BOOL, IPPROTO_IP, IP_MULTICAST_LOOP, v_socket); + caml_unix_getsockopt_aux("getsockopt", TYPE_BOOL, IPPROTO_IP, IP_MULTICAST_LOOP, v_socket); } CAMLprim value core_unix_mcast_set_loop(value v_socket, value v_loop) { return - unix_setsockopt_aux( "setsockopt", TYPE_BOOL, IPPROTO_IP, IP_MULTICAST_LOOP, v_socket, v_loop); + caml_unix_setsockopt_aux( "setsockopt", TYPE_BOOL, IPPROTO_IP, IP_MULTICAST_LOOP, v_socket, v_loop); } /* Scheduling */ @@ -1282,7 +1288,7 @@ CAMLprim value core_unix_sched_setscheduler( #warning "_POSIX_PRIORITY_SCHEDULING not present; sched_setscheduler undefined" CAMLprim value core_unix_sched_setscheduler( value __unused v_pid, value __unused v_policy, value __unused v_priority) -{ invalid_argument("sched_setscheduler unimplemented"); } +{ caml_invalid_argument("sched_setscheduler unimplemented"); } #endif diff --git a/duniverse/core_unix/core_unix/src/dune b/duniverse/core_unix/core_unix/src/dune index 163ac224a..e39826897 100644 --- a/duniverse/core_unix/core_unix/src/dune +++ b/duniverse/core_unix/core_unix/src/dune @@ -3,9 +3,9 @@ signal_unix spawn) (c_flags (:standard -D_LARGEFILE64_SOURCE) ()) (c_names nss_stubs timespec core_unix_stubs core_unix_time_stubs) - (preprocessor_deps config.h) (install_c_headers socketaddr) + (preprocessor_deps config.h) (preprocess (pps ppx_jane))) (rule (targets config.h thread_id.h) (deps) (action - (bash "cp %{lib:jst-config:config.h} %{lib:jst-config:thread_id.h} ."))) \ No newline at end of file + (bash "cp %{lib:jst-config:config.h} %{lib:jst-config:thread_id.h} ."))) diff --git a/duniverse/core_unix/core_unix/src/socketaddr.h b/duniverse/core_unix/core_unix/src/socketaddr.h deleted file mode 100644 index 967feba20..000000000 --- a/duniverse/core_unix/core_unix/src/socketaddr.h +++ /dev/null @@ -1,34 +0,0 @@ -#include -#include -#include -#include -#include -#include - -union sock_addr_union { - struct sockaddr s_gen; - struct sockaddr_un s_unix; - struct sockaddr_in s_inet; -#ifdef HAS_IPV6 - struct sockaddr_in6 s_inet6; -#endif -}; - -#ifdef HAS_SOCKLEN_T -typedef socklen_t socklen_param_type; -#else -typedef int socklen_param_type; -#endif - -extern void get_sockaddr (value mladdr, - union sock_addr_union * addr /*out*/, - socklen_param_type * addr_len /*out*/); -CAMLexport value alloc_sockaddr (union sock_addr_union * addr /*in*/, - socklen_param_type addr_len, int close_on_error); -CAMLexport value alloc_inet_addr (struct in_addr * inaddr); -#define GET_INET_ADDR(v) (*((struct in_addr *) (v))) - -#ifdef HAS_IPV6 -CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr); -#define GET_INET6_ADDR(v) (*((struct in6_addr *) (v))) -#endif diff --git a/duniverse/core_unix/linux_ext/src/linux_ext_stubs.c b/duniverse/core_unix/linux_ext/src/linux_ext_stubs.c index a9983e8b6..cf49dec02 100644 --- a/duniverse/core_unix/linux_ext/src/linux_ext_stubs.c +++ b/duniverse/core_unix/linux_ext/src/linux_ext_stubs.c @@ -99,11 +99,17 @@ enum option_type { TYPE_UNIX_ERROR = 4 }; -extern value unix_getsockopt_aux( +#include +#if OCAML_VERSION_MAJOR < 5 +#define caml_unix_getsockopt_aux unix_getsockopt_aux +#define caml_unix_setsockopt_aux unix_setsockopt_aux +#endif + +extern value caml_unix_getsockopt_aux( char *name, enum option_type ty, int level, int option, value v_socket); -extern value unix_setsockopt_aux( +extern value caml_unix_setsockopt_aux( char *name, enum option_type ty, int level, int option, value v_socket, value v_status); @@ -112,7 +118,7 @@ CAMLprim value core_linux_gettcpopt_bool_stub(value v_socket, value v_option) { int option = linux_tcpopt_bool[Int_val(v_option)]; return - unix_getsockopt_aux("getsockopt", TYPE_BOOL, SOL_TCP, option, v_socket); + caml_unix_getsockopt_aux("getsockopt", TYPE_BOOL, SOL_TCP, option, v_socket); } CAMLprim value @@ -120,7 +126,7 @@ core_linux_settcpopt_bool_stub(value v_socket, value v_option, value v_status) { int option = linux_tcpopt_bool[Int_val(v_option)]; return - unix_setsockopt_aux( + caml_unix_setsockopt_aux( "setsockopt", TYPE_BOOL, SOL_TCP, option, v_socket, v_status); } @@ -798,6 +804,6 @@ CAMLprim value core_linux_setxattr(value v_path, value v_name, value v_value, va #else -typedef int avoid_empty_translation_unit_compilation_error; +void avoid_empty_translation_unit_compilation_error_in_core_unix_linux_ext(void) {} #endif /* JSC_LINUX_EXT */ diff --git a/duniverse/core_unix/unix_pseudo_terminal/src/unix_pseudo_terminal_stubs.c b/duniverse/core_unix/unix_pseudo_terminal/src/unix_pseudo_terminal_stubs.c index cb8beb26b..f912ccf8f 100644 --- a/duniverse/core_unix/unix_pseudo_terminal/src/unix_pseudo_terminal_stubs.c +++ b/duniverse/core_unix/unix_pseudo_terminal/src/unix_pseudo_terminal_stubs.c @@ -92,4 +92,8 @@ CAMLprim value unix_ptsname(value mlfd) CAMLreturn (mlname); } +#else + +void avoid_empty_translation_unit_compilation_error_in_core_unix_pseudo_terminal(void) {} + #endif /* JSC_UNIX_PTY */ diff --git a/duniverse/dune_/.dockerignore b/duniverse/dune_/.dockerignore new file mode 100644 index 000000000..b4a21d565 --- /dev/null +++ b/duniverse/dune_/.dockerignore @@ -0,0 +1,4 @@ +_build +_boot +dune.exe +result diff --git a/duniverse/dune_/.gitattributes b/duniverse/dune_/.gitattributes index d81ec281a..a7900a839 100755 --- a/duniverse/dune_/.gitattributes +++ b/duniverse/dune_/.gitattributes @@ -1,6 +1,7 @@ -*.ml* text eol=lf +*.ml* text eol=lf linguist-language=OCaml *.rst text eol=lf *.c text eol=lf +*.t text eol=lf -linguist-detectable dune text eol=lf dune.inc text eol=lf .gitignore text eol=lf diff --git a/duniverse/dune_/.github/workflows/workflow.yml b/duniverse/dune_/.github/workflows/workflow.yml index a42182728..b84d994bb 100644 --- a/duniverse/dune_/.github/workflows/workflow.yml +++ b/duniverse/dune_/.github/workflows/workflow.yml @@ -1,11 +1,20 @@ -name: Main workflow +name: CI on: - push - pull_request + - workflow_dispatch + +concurrency: + group: "${{ github.workflow }} @ ${{ github.event.pull_request.head.label || github.head_ref || github.ref }}" + cancel-in-progress: true + +permissions: + contents: read jobs: build: + name: Build strategy: fail-fast: false matrix: @@ -20,24 +29,10 @@ jobs: # 4.02.x and 4.07.x in other environments ocaml-compiler: - 4.14.x - skip_test: - - false include: - ocaml-compiler: 4.13.x os: ubuntu-latest skip_test: true - - ocaml-compiler: 4.12.x - os: ubuntu-latest - skip_test: true - - ocaml-compiler: 4.11.x - os: ubuntu-latest - skip_test: true - - ocaml-compiler: 4.10.x - os: ubuntu-latest - skip_test: true - - ocaml-compiler: 4.09.x - os: ubuntu-latest - skip_test: true - ocaml-compiler: 4.08.x os: ubuntu-latest skip_test: true @@ -80,10 +75,10 @@ jobs: # dune doesn't have any additional dependencies so we can build it right # away this makes it possible to see build errors as soon as possible - - run: opam exec -- make dune.exe + - run: opam exec -- make _boot/dune.exe # Ensure Dune can build itself - - run: opam exec -- ./dune.exe build -p dune --profile dune-bootstrap + - run: opam exec -- make bootstrap - name: Install deps on Unix run: | @@ -103,15 +98,42 @@ jobs: run: opam exec -- make test-windows if: ${{ matrix.os == 'windows-latest' && matrix.skip_test == false }} - - name: Test source is well formatted - run: opam exec -- make fmt - if: ${{ matrix.os == 'ubuntu-latest' && matrix.ocaml-compiler == '4.14.x' }} - - name: Build configurator run: opam install ./dune-configurator.opam if: ${{ matrix.configurator == true }} - lint-fmt: + nix: + name: Nix + strategy: + fail-fast: false + matrix: + os: + - macos-latest + - ubuntu-latest + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v3 + - uses: cachix/install-nix-action@v18 + - run: nix build + + fmt: + name: Format + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: cachix/install-nix-action@v18 + - run: nix develop .#fmt -c make fmt + + doc: + name: Documentation + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + - uses: cachix/install-nix-action@v18 + - run: nix develop .#doc -c make doc + + coq: + name: Coq 8.16.0 runs-on: ubuntu-latest steps: - name: Checkout code @@ -122,7 +144,12 @@ jobs: ocaml-compiler: 4.14.x opam-pin: false opam-depext: false + dune-cache: true + + - name: Install Coq + run: opam install coq.8.16.0 coq-native - - name: Install ocamlformat - run: opam exec -- make install-ocamlformat - - run: opam exec -- make fmt + - run: opam exec -- make test-coq + env: + # We disable the Dune cache when running the tests + DUNE_CACHE: disabled diff --git a/duniverse/dune_/.gitignore b/duniverse/dune_/.gitignore index 756295d59..024427dff 100644 --- a/duniverse/dune_/.gitignore +++ b/duniverse/dune_/.gitignore @@ -3,8 +3,6 @@ _build /_boot _perf *.install -.merlin -*.corrected # vim swap files *.swp @@ -20,9 +18,9 @@ _perf .git-ps .duneboot.* -/boot/*.cm* -dune.exe Makefile.dev src/dune_rules/setup.ml +result .DS_Store +nix/profiles/ diff --git a/duniverse/dune_/CHANGES.md b/duniverse/dune_/CHANGES.md index 9c0acb607..6d97ff38b 100644 --- a/duniverse/dune_/CHANGES.md +++ b/duniverse/dune_/CHANGES.md @@ -1,3 +1,177 @@ +3.6.1 (2022-11-24) +------------------ + +- Fix status line enabled when ANSI colors are forced. (#6503, @MisterDA) + +- Fix build with MSVC compiler (#6517, @nojb) + +- Do not shadow library interface modules (#6549, fixes #6545, @rgrinberg) + +3.6.0 (2022-11-14) +------------------ + +- Forbid multiple instances of dune running concurrently in the same workspace. + (#6360, fixes #236, @rgrinberg) + +- Allow promoting into source directories specified by `subdir` (#6404, fixes + #3502, @rgrinberg) + +- Make dune describe workspace return the correct root path + (#6380, fixes #6379, @esope) + +- Introduce a `$ dune ocaml top-module` subcommand to load modules directly + without sealing them behind the signature. (#5940, @rgrinberg) + +- [ctypes] do not mangle user written names in the ctypes stanza (#6374, fixes + #5561, @rgrinberg) + +- Support `CLICOLOR` and `CLICOLOR_FORCE` to enable/disable/force ANSI + colors. (#6340, fixes #6323, @MisterDA). + +- Forbid private libraries with `(package ..)` set from depending on private + libraries that don't belong to a package (#6385, fixes #6153, @rgrinberg) + +- Allow `Byte_complete` binaries to be installable (#4873, @AltGr, @rgrinberg) + +- Revive `$ dune external-lib-deps` under `$ dune describe external-lib-deps`. + (#6045, @moyodiallo) + +- Fix running inline tests in bytecode mode (#5622, fixes #5515, @dariusf) + +- [ctypes] always re-run `pkg-config` because we aren't tracking its external + dependencies (#6052, @rgrinberg) + +- [ctypes] remove dependency on configurator in the generated rules (#6052, + @rgrinberg) + +- Build progress status now shows number of failed jobs (#6242, @Alizter) + +- Allow absolute build directories to find public executables. For example, + those specified with `(deps %{bin:...})` (#6326, @anmonteiro) + +- Create a fake socket file `_build/.rpc/dune` on windows to allow rpc clients + to connect using the build directory. (#6329, @rgrinberg) + +- Prevent crash if absolute paths are used in the install stanza and in + recursive globs. These cases now result in a user error. (#6331, @gridbugs) + +- Add `(glob_files )` and `(glob_files_rec )` terms to the `files` + field of the `install` stanza (#6250, closes #6018, @gridbugs) + +- Allow `:standard` in the `(modules)` field of the `coq.pp` stanza (#6229, + fixes #2414, @Alizter) + +- Fix passing of flags to dune coq top (#6369, fixes #6366, @Alizter) + +- Extend the promotion CLI to a `dune promotion` group: `dune promote` is moved + to `dune promotion apply` (the former still works) and the new `dune promotion + diff` command can be used to just display the promotion without applying it. + (#6160, fixes #5368, @emillon) + +3.5.0 (2022-10-19) +------------------ + +- macOS: Handle unknown fsevents without crashing (#6217, @rgrinberg) + +- Enable file watching on MacOS SDK < 10.13. (#6218, @rgrinberg) + +- Sandbox running cinaps actions starting from cinaps 1.1 (#6176, @rgrinberg) + +- Add a `runtime_deps` field in the `cinaps` stanza to specify runtime + dependencies for running the cinaps preprocessing action (#6175, @rgrinberg) + +- Shadow alias module `Foo__` when building a library `Foo` (#6126, @rgrinberg) + +- Extend dune describe to include the root path of the workspace and the + relative path to the build directory. (#6136, @reubenrowe) + +- Allow dune describe workspace to accept directories as arguments. + The provided directories restrict the worskpace description to those + directories. (#6107, fixes #3893, @esope) + +- Add a terminal persistence mode that attempts to clear the terminal history. + It is enabled by setting terminal persistence to + `clear-on-rebuild-and-flush-history` (#6065, @rgrinberg) + +- Disallow generating targets in sub directories in inferred rules. The check to + forbid this was accidentally done only for manually specified targets (#6031, + @rgrinberg) + +- Do not ignore rules marked `(promote (until-clean))` when + `--ignore-promoted-rules` (or `-p`) is passed. (#6010, fixes #4401, @emillon) + +- Dune no longer considers .aux files as targets during Coq compilation. This + means that .aux files are no longer cached. (#6024, fixes #6004, @alizter) + +- Cinaps actions are now sandboxed by default (#6062, @rgrinberg) + +- Allow rules producing directory targets to be not sandboxed (#6056, + @rgrinberg) + +- Introduce a `dirs` field in the `install` stanza to install entire + directories (#5097, fixes #5059, @rgrinberg) + +- Menhir rules are now sandboxed by default (#6076, @rgrinberg) + +- Allow rules producing directory targets to create symlinks (#6077, fixes + #5945, @rgrinberg) + +- Inline tests are now sandboxed by default (#6079, @rgrinberg) + +- Fix build-info version when used with flambda (#6089, fixes #6075, @jberdine) + +- Add an `(include )` term to the `include_dirs` field for adding + directories to the include paths sourced from a file. (#6058, fixes #3993, + @gridbugs) + +- Support `(extra_objects ...)` field in `(executable ...)` and `(library + ...)` stanzas (#6084, fixes #4129, @gridbugs) + +- Fix compilation of Dune under esy on Windows (#6109, fixes #6098, @nojb) + +- Improve error message when parsing several licenses in `(license)` (#6114, + fixes #6103, @emillon) + +- odoc rules now about `ODOC_SYNTAX` and will rerun accordingly (#6010, fixes + #1117, @emillon) + +- dune install: copy files in an atomic way (#6150, @emillon) + +- Add `%{coq:...}` macro for accessing data about the configuration about Coq. + For instance `%{coq:version}` (#6049, @Alizter) + +- update vendored copy of cmdliner to 1.1.1. This improves the built-in + documentation for command groups such as `dune ocaml`. (#6038, @emillon, + #6169, @shonfeder) + +- The test suite for Coq now requires Coq >= 8.16 due to changes in the + plugin loading mechanism upstream (which now uses `Findlib`). + +- Starting with Coq build language 0.6, theories can be built without importing + Coq's standard library by including `(stdlib no)`. + (#6165 #6164, fixes #6163, @ejgallego @Alizter @LasseBlaauwbroek) + +- on macOS, sign executables produced by artifact substitution (#6137, #6231, + fixes #5650, fixes #6226, @emillon) + +- Added an (aliases ...) field to the (rules ...) stanza which allows the + specification of multiple aliases per rule (#6194, @Alizter) + +- The `(coq.theory ...)` stanza will now ensure that for each declared `(plugin + ...)`, the `META` file for it is built before calling `coqdep`. This enables + the use of the new `Findlib`-based loading method in Coq 8.16; however as of + Coq 8.16.0, Coq itself has some bugs preventing this to work yet. (#6167 , + workarounds #5767, @ejgallego) + +- Allow include statement in install stanza (#6139, fixes #256, @gridbugs) + +- Handle CSI n K code in ANSI escape codes from commands. (#6214, fixes #5528, + @emillon) + +- Add a new experimental feature `mode_specific_stubs` that allows the + specification of different flags and sources for foreign stubs depending on + the build mode (#5649, @voodoos) + 3.4.1 (26-07-2022) ------------------ @@ -86,7 +260,7 @@ - The `coq.theory` stanza now produces rules for running `coqdoc`. Given a theory named `mytheory`, the directory targets `mytheory.html/` and `mytheory.tex/` or additionally the aliases `@doc` and `@doc-latex` will - build the HTML and LaTeX documentation repsectively. (#5695, fixes #3760, + build the HTML and LaTeX documentation respectively. (#5695, fixes #3760, @Alizter) - Coq theories marked as `(boot)` cannot depend on other theories @@ -413,7 +587,7 @@ simpler and more reproducible (#4281, @jeremiedimino) - Remove the `external-lib-deps` command. This command was only - approximative and the cost of maintainance was getting too high. We + approximative and the cost of maintenance was getting too high. We removed it to make room for new more important features (#4298, @jeremiedimino) @@ -1395,7 +1569,7 @@ variable. (#2588, fix #2568, @rgrinberg) - Add a `forbidden_libraries` field to prevent some library from being - linked in an executable. This help detecting who accidently pulls in + linked in an executable. This help detecting who accidentally pulls in `unix` for instance (#2570, @diml) - Fix incorrect error message when a variable is expanded in static context: @@ -1408,7 +1582,7 @@ - Drop support for `jbuild` and `jbuild-ignore` files (#2607, @diml) -- Add a `dune-action-plugin` library for describing dependencies direcly in +- Add a `dune-action-plugin` library for describing dependencies directly in the executable source. Programs that use this feature can be run by a new action (dynamic-run ...). (#2635, @staronj, @aalekseyev) @@ -1614,6 +1788,9 @@ targets, and a switch `(explicit_js_mode)` to require this mode in order to declare JS targets corresponding to executables. (#1941, @nojb) +- Allow unwrapped implementations of public libraries to introduce new public + modules (@rgrinberg) + 1.10.0 (04/06/2019) ------------------- @@ -1691,7 +1868,7 @@ - Fix `chdir` on external and source paths. Dune will also fail gracefully if the external or source path does not exist (#2165, fixes #2158, @rgrinberg) -- Support the `.cc` extension fro C++ sources (#2195, fixes #83, @rgrinberg) +- Support the `.cc` extension for C++ sources (#2195, fixes #83, @rgrinberg) - Run `ocamlformat` relative to the context root. This improves the locations of errors. (#2196, fixes #1370, @rgrinberg) diff --git a/duniverse/dune_/CONTRIBUTING.md b/duniverse/dune_/CONTRIBUTING.md index 7a52d7896..c23e7a32f 100644 --- a/duniverse/dune_/CONTRIBUTING.md +++ b/duniverse/dune_/CONTRIBUTING.md @@ -4,10 +4,13 @@ developed at [Jane Street][js] and is now maintained by Jane Street, community. Contributions to Dune are welcome and should be submitted via GitHub -pull requests against the `main` branch. Dune is distributed under -the MIT license and contributors are required to sign their work in -order to certify that they have the right to submit it under this -license. See the following section for more details. +pull requests against the `main` branch. See [./doc/hacking.rst][hack] +for a guide to getting started on the code base. + +Dune is distributed under the MIT license and contributors are +required to sign their work in order to certify that they have the +right to submit it under this license. See the following section for +more details. Signing contributions --------------------- @@ -71,6 +74,7 @@ your commit automatically with `git commit -s`. [dco]: http://developercertificate.org/ [js]: https://www.janestreet.com/ [ocl]: http://ocamllabs.io/ +[hack]: ./doc/hacking.rst Coding style ------------ diff --git a/duniverse/dune_/Makefile b/duniverse/dune_/Makefile index 2679bee35..fb96137bf 100644 --- a/duniverse/dune_/Makefile +++ b/duniverse/dune_/Makefile @@ -4,23 +4,19 @@ PREFIX_ARG := $(if $(PREFIX),--prefix $(PREFIX),) LIBDIR_ARG := $(if $(LIBDIR),--libdir $(LIBDIR),) DESTDIR_ARG := $(if $(DESTDIR),--destdir $(DESTDIR),) INSTALL_ARGS := $(PREFIX_ARG) $(LIBDIR_ARG) $(DESTDIR_ARG) -BIN := ./dune.exe +BIN := ./_boot/dune.exe # Dependencies used for testing dune, when developed locally and # when tested in CI TEST_DEPS := \ lwt \ -bisect_ppx \ cinaps \ -coq-native \ -"coq>=8.14.0" \ core_bench \ "csexp>=1.3.0" \ js_of_ocaml \ js_of_ocaml-compiler \ "mdx>=2.1.0" \ menhir \ -"merlin>=3.4.0" \ ocamlfind \ ocamlformat.$$(awk -F = '$$1 == "version" {print $$2}' .ocamlformat) \ "odoc>=2.0.1" \ @@ -29,7 +25,8 @@ ppx_inline_test \ ppxlib \ result \ ctypes \ -"utop>=2.6.0" +"utop>=2.6.0" \ +"melange>=0.3.0" # Dependencies recommended for developing dune locally, # but not wanted in CI @@ -46,10 +43,10 @@ help: .PHONY: release release: $(BIN) - @$(BIN) build -p dune --profile dune-bootstrap + @$(BIN) build @install -p dune --profile dune-bootstrap -dune.exe: bootstrap.ml boot/libs.ml boot/duneboot.ml - @ocaml bootstrap.ml +$(BIN): + @ocaml boot/bootstrap.ml dev: $(BIN) $(BIN) build @install @@ -71,6 +68,9 @@ reinstall: uninstall install install-ocamlformat: opam install -y ocamlformat.$$(awk -F = '$$1 == "version" {print $$2}' .ocamlformat) +dev-depext: + opam depext -y $(TEST_DEPS) + dev-deps: opam install -y $(TEST_DEPS) @@ -93,22 +93,25 @@ test-js: $(BIN) $(BIN) build @runtest-js test-coq: $(BIN) - $(BIN) build @runtest-coq + DUNE_COQ_TEST=enable $(BIN) build @runtest-coq + +test-melange: $(BIN) + $(BIN) build @runtest-melange test-all: $(BIN) - $(BIN) build @runtest @runtest-js @runtest-coq + $(BIN) build @runtest @runtest-js @runtest-coq @runtest-melange .PHONY: check check: $(BIN) - $(BIN) build @check + @$(BIN) build @check .PHONY: fmt fmt: $(BIN) - $(BIN) fmt + @$(BIN) fmt .PHONY: promote promote: $(BIN) - $(BIN) promote + @$(BIN) promote .PHONY: accept-corrections accept-corrections: promote @@ -117,21 +120,19 @@ all-supported-ocaml-versions: $(BIN) $(BIN) build @install @runtest --workspace dune-workspace.dev --root . .PHONY: clean -clean: $(BIN) - $(BIN) clean || true - rm -rf _boot dune.exe +clean: + rm -rf _boot _build $(BIN) distclean: clean rm -f src/dune_rules/setup.ml .PHONY: doc doc: - sphinx-build doc doc/_build + sphinx-build -W doc doc/_build # livedoc-deps: you may need to [pip3 install sphinx-autobuild] and [pip3 install sphinx-rtd-theme] livedoc: - cd doc && sphinx-autobuild . _build \ - --port 8888 -q --host $(shell hostname) --re-ignore '\.#.*' + cd doc && sphinx-autobuild . _build --port 8888 -q --re-ignore '\.#.*' update-jbuilds: $(BIN) $(BIN) build @doc/runtest --auto-promote @@ -145,8 +146,8 @@ ifeq (dune,$(firstword $(MAKECMDGOALS))) endif .PHONY: bench -bench: release - @$(BIN) exec -- ./bench/bench.exe _build/default/dune.exe +bench: $(BIN) + @$(BIN) exec -- ./bench/bench.exe $(BIN) .PHONY: dune dune: $(BIN) @@ -166,7 +167,14 @@ dune-release: dune-release opam pkg dune-release opam submit -# see nix/default.nix for details -.PHONY: nix/opam-selection.nix -nix/opam-selection.nix: Makefile - nix-shell -A resolve ./ +.PHONY: docker-build-image +docker-build-image: + docker build -f docker/dev.Dockerfile -t dune . + +.PHONY: docker-compose +docker-compose: + docker compose -f docker/dev.yml run dune bash + +.PHONY: bootstrap +bootstrap: + $(BIN) build @install -p dune --profile dune-bootstrap diff --git a/duniverse/dune_/README.md b/duniverse/dune_/README.md index e20aa88f8..7143fd5cd 100644 --- a/duniverse/dune_/README.md +++ b/duniverse/dune_/README.md @@ -120,7 +120,7 @@ $ make install If you do not have `make`, you can do the following: ```sh -$ ocaml bootstrap.ml +$ ocaml boot/bootstrap.ml $ ./dune.exe build -p dune --profile dune-bootstrap $ ./dune.exe install dune ``` diff --git a/duniverse/dune_/bench/bench.ml b/duniverse/dune_/bench/bench.ml index 7f7878219..64d3b376d 100644 --- a/duniverse/dune_/bench/bench.ml +++ b/duniverse/dune_/bench/bench.ml @@ -121,7 +121,7 @@ let () = let dir = Temp.create Dir ~prefix:"dune" ~suffix:"bench" in Sys.chdir (Path.to_string dir); Path.as_external dir |> Option.value_exn |> Path.set_root; - Path.Build.set_build_dir (Path.Build.Kind.of_string "_build"); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build"); let module Scheduler = Dune_engine.Scheduler in let config = { Scheduler.Config.concurrency = 10 @@ -152,7 +152,7 @@ let () = ] } ; { Output.name = "Misc" - ; metrics = [ ("Size of dune.exe", `Int size, "bytes") ] + ; metrics = [ ("Size of _boot/dune.exe", `Int size, "bytes") ] } ] in diff --git a/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml b/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml index ae8e57d68..272304228 100644 --- a/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml +++ b/duniverse/dune_/bench/micro/dune_bench/scheduler_bench.ml @@ -15,7 +15,7 @@ let config = let setup = lazy (Path.set_root (Path.External.cwd ()); - Path.Build.set_build_dir (Path.Build.Kind.of_string "_build")) + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build")) let prog = Option.value_exn (Bin.which ~path:(Env.path Env.initial) "true") diff --git a/duniverse/dune_/bench/micro/fiber_bench.ml b/duniverse/dune_/bench/micro/fiber_bench.ml index a5f4159cc..96a34670c 100644 --- a/duniverse/dune_/bench/micro/fiber_bench.ml +++ b/duniverse/dune_/bench/micro/fiber_bench.ml @@ -13,6 +13,15 @@ let%bench_fun "bind" = in loop n) +let%bench_fun "create ivar and immediately read" = + fun () -> + let ivar = Fiber.Ivar.create () in + Fiber.run + ~iter:(fun () -> + let open Nonempty_list in + [ Fiber.Fill (ivar, ()) ]) + (Fiber.Ivar.read ivar) + let%bench_fun "ivar" = fun () -> let ivar = ref (Fiber.Ivar.create ()) in diff --git a/duniverse/dune_/perf.sh b/duniverse/dune_/bench/perf.sh similarity index 96% rename from duniverse/dune_/perf.sh rename to duniverse/dune_/bench/perf.sh index ad17e6da0..d251efe54 100755 --- a/duniverse/dune_/perf.sh +++ b/duniverse/dune_/bench/perf.sh @@ -1,6 +1,6 @@ #!/usr/bin/env bash -# Run this script simply as ./perf.sh from the root directory. +# Run this script simply as ./bench/perf.sh from the root directory. set -e diff --git a/duniverse/dune_/bin/build_cmd.ml b/duniverse/dune_/bin/build_cmd.ml index 5dc61b984..a67336d78 100644 --- a/duniverse/dune_/bin/build_cmd.ml +++ b/duniverse/dune_/bin/build_cmd.ml @@ -77,17 +77,22 @@ let run_build_system ~common ~request = Fiber.return ()) let run_build_command_poll_eager ~(common : Common.t) ~config ~request : unit = - Import.Scheduler.go_with_rpc_server_and_console_status_reporting ~common - ~config (fun () -> Scheduler.Run.poll (run_build_system ~common ~request)) + Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config + (fun () -> Scheduler.Run.poll (run_build_system ~common ~request)) let run_build_command_poll_passive ~(common : Common.t) ~config ~request:_ : unit = (* CR-someday aalekseyev: It would've been better to complain if [request] is non-empty, but we can't check that here because [request] is a function.*) let open Fiber.O in - let rpc = Common.rpc common in - Import.Scheduler.go_with_rpc_server_and_console_status_reporting ~common - ~config (fun () -> + let rpc = + match Common.rpc common with + | `Allow server -> server + | `Forbid_builds -> + Code_error.raise "rpc server must be allowed in passive mode" [] + in + Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config + (fun () -> Scheduler.Run.poll_passive ~get_build_request: (let+ (Build (targets, ivar)) = @@ -115,7 +120,7 @@ let run_build_command ~(common : Common.t) ~config ~request = | No -> run_build_command_once) ~common ~config ~request -let runtest = +let runtest_info = let doc = "Run tests." in let man = [ `S "DESCRIPTION" @@ -131,22 +136,24 @@ let runtest = ] ] in + Cmd.info "runtest" ~doc ~man ~envs:Common.envs + +let runtest_term = let name_ = Arg.info [] ~docv:"DIR" in - let term = - let+ common = Common.term - and+ dirs = Arg.(value & pos_all string [ "." ] name_) in - let config = Common.init common in - let request (setup : Import.Main.build_system) = - Action_builder.all_unit - (List.map dirs ~f:(fun dir -> - let dir = Path.(relative root) (Common.prefix_target common dir) in - Alias.in_dir ~name:Dune_engine.Alias.Name.runtest ~recursive:true - ~contexts:setup.contexts dir - |> Alias.request)) - in - run_build_command ~common ~config ~request + let+ common = Common.term + and+ dirs = Arg.(value & pos_all string [ "." ] name_) in + let config = Common.init common in + let request (setup : Import.Main.build_system) = + Action_builder.all_unit + (List.map dirs ~f:(fun dir -> + let dir = Path.(relative root) (Common.prefix_target common dir) in + Alias.in_dir ~name:Dune_engine.Alias.Name.runtest ~recursive:true + ~contexts:setup.contexts dir + |> Alias.request)) in - (term, Term.info "runtest" ~doc ~man) + run_build_command ~common ~config ~request + +let runtest = Cmd.v runtest_info runtest_term let build = let doc = @@ -182,7 +189,7 @@ let build = in run_build_command ~common ~config ~request in - (term, Term.info "build" ~doc ~man) + Cmd.v (Cmd.info "build" ~doc ~man ~envs:Common.envs) term let fmt = let doc = "Format source code." in @@ -207,4 +214,4 @@ let fmt = in run_build_command ~common ~config ~request in - (term, Term.info "fmt" ~doc ~man) + Cmd.v (Cmd.info "fmt" ~doc ~man ~envs:Common.envs) term diff --git a/duniverse/dune_/bin/build_cmd.mli b/duniverse/dune_/bin/build_cmd.mli index 9cbe8c49e..3d8391cf3 100644 --- a/duniverse/dune_/bin/build_cmd.mli +++ b/duniverse/dune_/bin/build_cmd.mli @@ -1,13 +1,9 @@ -open Dune_engine +open Import -val run_build_command : - common:Common.t - -> config:Dune_config.t - -> request:(Dune_rules.Main.build_system -> unit Action_builder.t) - -> unit +val runtest : unit Cmd.t -val runtest : unit Cmdliner.Term.t * Cmdliner.Term.info +val runtest_term : unit Term.t -val build : unit Cmdliner.Term.t * Cmdliner.Term.info +val build : unit Cmd.t -val fmt : unit Cmdliner.Term.t * Cmdliner.Term.info +val fmt : unit Cmd.t diff --git a/duniverse/dune_/bin/cache.ml b/duniverse/dune_/bin/cache.ml index 4c2b3f2c4..b31bebf1a 100644 --- a/duniverse/dune_/bin/cache.ml +++ b/duniverse/dune_/bin/cache.ml @@ -13,12 +13,21 @@ let man = functionality soon. |} ; `S "ACTIONS" ; `P {|$(b,trim) trim the shared cache to free space.|} + ; `S "EXAMPLES" + ; `Pre + {|Trimming the Dune cache to 1 GB. + + \$ dune cache trim --trimmed-size=1GB |} + ; `Pre + {|Trimming 500 MB from the Dune cache. + + \$ dune cache trim --size=500MB |} ; `Blocks Common.help_secs ] let doc = "Manage the shared cache of build artifacts" -let info = Term.info name ~doc ~man +let info = Cmd.info name ~doc ~man let trim ~trimmed_size ~size = Log.init_disabled (); @@ -36,7 +45,7 @@ let trim ~trimmed_size ~size = | Error s -> User_error.raise [ Pp.text s ] | Ok { trimmed_bytes } -> User_message.print - (User_message.make [ Pp.textf "Freed %Li bytes" trimmed_bytes ]) + (User_message.make [ Pp.textf "Freed %s" (Bytes_unit.pp trimmed_bytes) ]) type mode = | Trim @@ -75,16 +84,16 @@ let term = value & opt (some bytes) None & info ~docv:"BYTES" [ "trimmed-size" ] - ~doc:"size to trim from the cache") + ~doc:"Size to trim from the cache.") and+ size = Arg.( value & opt (some bytes) None - & info ~docv:"BYTES" [ "size" ] ~doc:"size to trim the cache to") + & info ~docv:"BYTES" [ "size" ] ~doc:"Size to trim the cache to.") in match mode with | Some Trim -> `Ok (trim ~trimmed_size ~size) | Some Start_deprecated | Some Stop_deprecated -> deprecated_error () | None -> `Help (`Pager, Some name) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/cache.mli b/duniverse/dune_/bin/cache.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/cache.mli +++ b/duniverse/dune_/bin/cache.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/clean.ml b/duniverse/dune_/bin/clean.ml index dd2c63601..002058a6d 100644 --- a/duniverse/dune_/bin/clean.ml +++ b/duniverse/dune_/bin/clean.ml @@ -18,8 +18,9 @@ let command = useless but with some FS this also causes [dune clean] to fail (cf https://github.com/ocaml/dune/issues/2964). *) let _config = Common.init common ~log_file:No_log_file in + Dune_util.Global_lock.lock_exn ~timeout:None; Dune_engine.Target_promotion.files_in_source_tree_to_delete () - |> Path.Set.iter ~f:Path.unlink_no_err; + |> Path.Source.Set.iter ~f:(fun p -> Path.unlink_no_err (Path.source p)); Path.rm_rf Path.build_dir in - (term, Term.info "clean" ~doc ~man) + Cmd.v (Cmd.info "clean" ~doc ~man) term diff --git a/duniverse/dune_/bin/clean.mli b/duniverse/dune_/bin/clean.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/clean.mli +++ b/duniverse/dune_/bin/clean.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/common.ml b/duniverse/dune_/bin/common.ml index b8d05a0da..1a6c5174f 100644 --- a/duniverse/dune_/bin/common.ml +++ b/duniverse/dune_/bin/common.ml @@ -1,10 +1,12 @@ open Stdune module Config = Dune_util.Config +module Console = Dune_console module Colors = Dune_rules.Colors module Clflags = Dune_engine.Clflags module Graph = Dune_graph.Graph module Package = Dune_engine.Package module Profile = Dune_rules.Profile +module Cmd = Cmdliner.Cmd module Term = Cmdliner.Term module Manpage = Cmdliner.Manpage module Only_packages = Dune_rules.Only_packages @@ -22,6 +24,7 @@ type t = ; debug_findlib : bool ; debug_backtraces : bool ; debug_artifact_substitution : bool + ; debug_load_dir : bool ; debug_digests : bool ; wait_for_filesystem_clock : bool ; root : Workspace_root.t @@ -34,7 +37,7 @@ type t = ; build_dir : string ; no_print_directory : bool ; store_orig_src_dir : bool - ; rpc : Dune_rpc_impl.Server.t Lazy.t + ; rpc : [ `Allow of Dune_rpc_impl.Server.t Lazy.t | `Forbid_builds ] ; default_target : Arg.Dep.t (* For build & runtest only *) ; watch : Watch_mode_config.t ; print_metrics : bool @@ -72,7 +75,12 @@ let default_target t = t.default_target let prefix_target t s = t.root.reach_from_root_prefix ^ s -let rpc t = Lazy.force t.rpc +let rpc t = + match t.rpc with + | `Forbid_builds -> `Forbid_builds + | `Allow rpc -> `Allow (Lazy.force rpc) + +let forbid_builds t = { t with rpc = `Forbid_builds } let stats t = t.stats @@ -141,7 +149,7 @@ let print_entering_message c = let init ?log_file c = if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir; Path.set_root (normalize_path (Path.External.cwd ())); - Path.Build.set_build_dir (Path.Build.Kind.of_string c.build_dir); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string c.build_dir); (* We need to print this before reading the workspace file, so that the editor can interpret errors in the workspace file. *) print_entering_message c; @@ -154,7 +162,7 @@ let init ?log_file c = in let config = Dune_config.adapt_display config - ~output_is_a_tty:(Lazy.force Ansi_color.stderr_supports_color) + ~output_is_a_tty:(Lazy.force Ansi_color.output_is_a_tty) in Dune_config.init config; Dune_util.Log.init () ?file:log_file; @@ -187,6 +195,7 @@ let init ?log_file c = Clflags.debug_findlib := c.debug_findlib; Clflags.debug_backtraces c.debug_backtraces; Clflags.debug_artifact_substitution := c.debug_artifact_substitution; + Clflags.debug_load_dir := c.debug_load_dir; Clflags.debug_digests := c.debug_digests; Clflags.debug_fs_cache := c.cache_debug_flags.fs_cache; Clflags.wait_for_filesystem_clock := c.wait_for_filesystem_clock; @@ -503,7 +512,7 @@ module Options_implied_by_dash_p = struct last & opt_all (some profile) [ None ] & info [ "profile" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_PROFILE") + ~env:(Cmd.Env.info ~doc "DUNE_PROFILE") ~doc: (Printf.sprintf "Select the build profile, for instance $(b,dev) or \ @@ -558,7 +567,7 @@ let shared_with_config_file = & opt (some (enum all)) None & info [ "sandbox" ] ~env: - (Arg.env_var + (Cmd.Env.info ~doc:"Sandboxing mode to use by default. (see --sandbox)" "DUNE_SANDBOX") ~doc: @@ -594,7 +603,7 @@ let shared_with_config_file = Arg.( value & opt (some (enum Dune_config.Cache.Enabled.all)) None - & info [ "cache" ] ~docs ~env:(Arg.env_var ~doc "DUNE_CACHE") ~doc) + & info [ "cache" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE") ~doc) and+ cache_storage_mode = let doc = Printf.sprintf "Dune cache storage mode (%s). Default is `%s'." @@ -606,7 +615,7 @@ let shared_with_config_file = value & opt (some (enum Dune_config.Cache.Storage_mode.all)) None & info [ "cache-storage-mode" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_CACHE_STORAGE_MODE") + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_STORAGE_MODE") ~doc) and+ cache_check_probability = let doc = @@ -622,7 +631,7 @@ let shared_with_config_file = & info [ "cache-check-probability" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_CACHE_CHECK_PROBABILITY") + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_CHECK_PROBABILITY") ~doc) and+ action_stdout_on_success = Arg.( @@ -745,6 +754,11 @@ let term ~default_root_is_cwd = & info [ "debug-artifact-substitution" ] ~docs ~doc:"Print debugging info about artifact substitution") + and+ debug_load_dir = + Arg.( + value & flag + & info [ "debug-load-dir" ] ~docs + ~doc:"Print debugging info about directory loading") and+ debug_digests = Arg.( value & flag @@ -782,7 +796,7 @@ let term ~default_root_is_cwd = value & opt (some path) None & info [ "workspace" ] ~docs ~docv:"FILE" ~doc - ~env:(Arg.env_var ~doc "DUNE_WORKSPACE")) + ~env:(Cmd.Env.info ~doc "DUNE_WORKSPACE")) and+ promote = one_of (let+ auto = @@ -796,7 +810,7 @@ let term ~default_root_is_cwd = Option.some_if auto Clflags.Promote.Automatically) (let+ disable = let doc = "Disable all promotion rules" in - let env = Arg.env_var ~doc "DUNE_DISABLE_PROMOTION" in + let env = Cmd.Env.info ~doc "DUNE_DISABLE_PROMOTION" in Arg.(value & flag & info [ "disable-promotion" ] ~docs ~env ~doc) in Option.some_if disable Clflags.Promote.Never) @@ -884,7 +898,7 @@ let term ~default_root_is_cwd = value & opt (some string) None & info [ "build-dir" ] ~docs ~docv:"FILE" - ~env:(Arg.env_var ~doc "DUNE_BUILD_DIR") + ~env:(Cmd.Env.info ~doc "DUNE_BUILD_DIR") ~doc) and+ diff_command = let doc = @@ -895,7 +909,7 @@ let term ~default_root_is_cwd = value & opt (some string) None & info [ "diff-command" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_DIFF_COMMAND") + ~env:(Cmd.Env.info ~doc "DUNE_DIFF_COMMAND") ~doc) and+ stats_trace_file = Arg.( @@ -917,7 +931,7 @@ let term ~default_root_is_cwd = & info [ "store-orig-source-dir" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_STORE_ORIG_SOURCE_DIR") + ~env:(Cmd.Env.info ~doc "DUNE_STORE_ORIG_SOURCE_DIR") ~doc) and+ () = build_info and+ instrument_with = @@ -930,7 +944,7 @@ let term ~default_root_is_cwd = value & opt (some (list lib_name)) None & info [ "instrument-with" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_INSTRUMENT_WITH") + ~env:(Cmd.Env.info ~doc "DUNE_INSTRUMENT_WITH") ~docv:"BACKENDS" ~doc) and+ file_watcher = let doc = @@ -1003,15 +1017,31 @@ let term ~default_root_is_cwd = at_exit (fun () -> Dune_stats.close stats); stats) in - let rpc = lazy (Dune_rpc_impl.Server.create ~root:root.dir stats) in + let rpc = + `Allow + (lazy + (let registry = + match watch with + | Yes _ -> `Add + | No -> `Skip + in + let lock_timeout = + match watch with + | Yes Passive -> Some 1.0 + | _ -> None + in + Dune_rpc_impl.Server.create ~lock_timeout ~registry ~root:root.dir + stats)) + in if store_digest_preimage then Dune_engine.Reversible_digest.enable (); if print_metrics then ( Memo.Perf_counters.enable (); - Metrics.enable ()); + Dune_metrics.enable ()); { debug_dep_path ; debug_findlib ; debug_backtraces ; debug_artifact_substitution + ; debug_load_dir ; debug_digests ; wait_for_filesystem_clock ; capture_outputs = not no_buffer @@ -1053,6 +1083,21 @@ let term_with_default_root_is_cwd = term ~default_root_is_cwd:true let term = term ~default_root_is_cwd:false +let envs = + Cmd.Env. + [ info + ~doc: + "If different than $(b,0), ANSI colors are supported and should be \ + used when the program isn’t piped. If equal to $(b,0), don’t output \ + ANSI color escape codes" + "CLICOLOR" + ; info + ~doc: + "If different than $(b,0), ANSI colors should be enabled no matter \ + what." + "CLICOLOR_FORCE" + ] + let config_from_config_file = Options_implied_by_dash_p.config_term let context_arg ~doc = diff --git a/duniverse/dune_/bin/common.mli b/duniverse/dune_/bin/common.mli index bbcb4764a..b805153c5 100644 --- a/duniverse/dune_/bin/common.mli +++ b/duniverse/dune_/bin/common.mli @@ -4,7 +4,15 @@ val capture_outputs : t -> bool val root : t -> Workspace_root.t -val rpc : t -> Dune_rpc_impl.Server.t +val rpc : + t + -> [ `Allow of Dune_rpc_impl.Server.t + (** Will run rpc if in watch mode and acquire the build lock *) + | `Forbid_builds + (** Promise not to build anything. For now, this isn't checked *) + ] + +val forbid_builds : t -> t val stats : t -> Dune_stats.t option @@ -52,6 +60,8 @@ val term : t Cmdliner.Term.t val term_with_default_root_is_cwd : t Cmdliner.Term.t +val envs : Cmdliner.Cmd.Env.info list + (** Set whether Dune should print the "Entering directory ''" message *) val set_print_directory : t -> bool -> t diff --git a/duniverse/dune_/bin/coq.ml b/duniverse/dune_/bin/coq.ml index c0cbee382..b6465e270 100644 --- a/duniverse/dune_/bin/coq.ml +++ b/duniverse/dune_/bin/coq.ml @@ -6,6 +6,6 @@ let sub_commands_synopsis = Common.command_synopsis [ "coq top FILE -- ARGS" ] let man = [ `Blocks sub_commands_synopsis ] -let info = Term.info ~doc ~man "coq" +let info = Cmd.info ~doc ~man "coq" -let group = (Term.Group.Group [ in_group Coqtop.command ], info) +let group = Cmd.group info [ Coqtop.command ] diff --git a/duniverse/dune_/bin/coq.mli b/duniverse/dune_/bin/coq.mli index 8c539d338..d4c5902fc 100644 --- a/duniverse/dune_/bin/coq.mli +++ b/duniverse/dune_/bin/coq.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/duniverse/dune_/bin/coqtop.ml b/duniverse/dune_/bin/coqtop.ml index 24dad3d3d..3acd7b21b 100644 --- a/duniverse/dune_/bin/coqtop.ml +++ b/duniverse/dune_/bin/coqtop.ml @@ -15,12 +15,13 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "top" ~doc ~man +let info = Cmd.info "top" ~doc ~man let term = let+ common = Common.term and+ context = - Common.context_arg ~doc:{|Run the Coq toplevel in this build context.|} + let doc = "Run the Coq toplevel in this build context." in + Common.context_arg ~doc and+ coqtop = let doc = "Run the given toplevel command instead of the default." in Arg.(value & opt string "coqtop" & info [ "toplevel" ] ~docv:"CMD" ~doc) @@ -30,6 +31,8 @@ let term = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in let config = Common.init common in + let root = Common.root common in + let prefix_target = Common.prefix_target common in let coqtop, argv, env = Scheduler.go ~common ~config (fun () -> let open Fiber.O in @@ -40,7 +43,6 @@ let term = (* Try to compute a relative path if we got an absolute path. *) let coq_file_arg = if Filename.is_relative coq_file_arg then - let root = Common.root common in Path.relative Path.root (root.reach_from_root_prefix ^ coq_file_arg) |> Path.to_string else @@ -58,75 +60,80 @@ let term = | Some s -> s in let coq_file_build = - let p = Common.prefix_target common coq_file_arg in + let p = prefix_target coq_file_arg in Path.Build.relative context.build_dir p in let dir = let dir = Filename.dirname coq_file_arg in - let p = Common.prefix_target common dir in + let p = prefix_target dir in Path.Build.relative context.build_dir p in let* coqtop, args = + Build_system.run_exn @@ fun () -> let open Memo.O in - Build_system.run_exn (fun () -> - let* (tr : Dune_rules.Dir_contents.triage) = - Dune_rules.Dir_contents.triage sctx ~dir + let* (tr : Dune_rules.Dir_contents.triage) = + Dune_rules.Dir_contents.triage sctx ~dir + in + let dir = + match tr with + | Group_part dir -> dir + | Standalone_or_root _ -> dir + in + let* dc = Dune_rules.Dir_contents.get sctx ~dir in + let* coq_src = Dune_rules.Dir_contents.coq dc in + let coq_module = + let source = coq_file_build in + match Dune_rules.Coq_sources.find_module ~source coq_src with + | Some m -> snd m + | None -> + let hints = + [ Pp.textf "is the file part of a stanza?" + ; Pp.textf "has the file been written to disk?" + ] in - let dir = - match tr with - | Group_part dir -> dir - | Standalone_or_root _ -> dir - in - let* dc = Dune_rules.Dir_contents.get sctx ~dir in - let* coq_src = Dune_rules.Dir_contents.coq dc in - let coq_module = - let source = coq_file_build in - match Dune_rules.Coq_sources.find_module ~source coq_src with - | Some m -> snd m - | None -> - let hints = - [ Pp.textf "is the file part of a stanza?" - ; Pp.textf "has the file been written to disk?" - ] - in - User_error.raise ~hints - [ Pp.textf "cannot find file: %s" coq_file_arg ] - in - let stanza = - Dune_rules.Coq_sources.lookup_module coq_src coq_module - in - let* args, boot_type = - match stanza with - | None -> - User_error.raise - [ Pp.textf "file not part of any stanza: %s" coq_file_arg ] - | Some (`Theory theory) -> - Dune_rules.Coq_rules.coqtop_args_theory ~sctx ~dir - ~dir_contents:dc theory coq_module - | Some (`Extraction extr) -> - Dune_rules.Coq_rules.coqtop_args_extraction ~sctx ~dir - ~dir_contents:dc extr - in - let* (_ : unit * Dep.Fact.t Dep.Map.t) = - let deps = - let boot_type = Resolve.Memo.return boot_type in - Dune_rules.Coq_rules.deps_of ~dir ~boot_type coq_module - in - Action_builder.run deps Eager - in - let* (args, _) : string list * Dep.Fact.t Dep.Map.t = - let args = - let dir = Path.external_ Path.External.initial_cwd in - Dune_rules.Command.expand ~dir (S args) - in - Action_builder.run args.build Eager - in - let* prog = - Super_context.resolve_program sctx ~dir ~loc:None coqtop + User_error.raise ~hints + [ Pp.textf "cannot find file: %s" coq_file_arg ] + in + let stanza = + Dune_rules.Coq_sources.lookup_module coq_src coq_module + in + let* args, boot_type = + match stanza with + | None -> + User_error.raise + [ Pp.textf "file not part of any stanza: %s" coq_file_arg ] + | Some (`Theory theory) -> + Dune_rules.Coq_rules.coqtop_args_theory ~sctx ~dir + ~dir_contents:dc theory coq_module + | Some (`Extraction extr) -> + Dune_rules.Coq_rules.coqtop_args_extraction ~sctx ~dir + ~dir_contents:dc extr + in + let* (_ : unit * Dep.Fact.t Dep.Map.t) = + let deps = + let boot_type = Resolve.Memo.return boot_type in + Dune_rules.Coq_rules.deps_of ~dir ~boot_type coq_module + in + Action_builder.run deps Eager + in + let* (args, _) : string list * Dep.Fact.t Dep.Map.t = + let args = + let dir = Path.external_ Path.External.initial_cwd in + let args = + Action_builder.map + ~f:(fun x -> Dune_rules.Command.Args.S x) + args in - let prog = Action.Prog.ok_exn prog in - let+ (_ : Digest.t) = Build_system.build_file prog in - (Path.to_string prog, args)) + Dune_rules.Command.expand ~dir (Dyn args) + in + Action_builder.run args.build Eager + in + let* prog = + Super_context.resolve_program sctx ~dir ~loc:None coqtop + in + let prog = Action.Prog.ok_exn prog in + let+ () = Build_system.build_file prog in + (Path.to_string prog, args) in let argv = let topfile = Path.to_absolute_filename (Path.build coq_file_build) in @@ -137,4 +144,4 @@ let term = in restore_cwd_and_execve common coqtop argv env -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/coqtop.mli b/duniverse/dune_/bin/coqtop.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/coqtop.mli +++ b/duniverse/dune_/bin/coqtop.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/describe.ml b/duniverse/dune_/bin/describe.ml index 3d70999a3..c8e812d22 100644 --- a/duniverse/dune_/bin/describe.ml +++ b/duniverse/dune_/bin/describe.ml @@ -26,7 +26,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "describe" ~doc ~man +let info = Cmd.info "describe" ~doc ~man (** whether to sanitize absolute paths of workspace items, and their UIDs, to ensure reproducible tests *) @@ -110,7 +110,7 @@ module Descr = struct (** Description of executables *) module Exe = struct type t = - { names : string list (** names of the executble *) + { names : string list (** names of the executable *) ; requires : Digest.t list (** list of direct dependencies to libraries, identified by their digests *) @@ -175,11 +175,15 @@ module Descr = struct type t = | Executables of Exe.t | Library of Lib.t + | Root of Path.t + | Build_context of Path.t let map_path t ~f = match t with | Executables exe -> Executables (Exe.map_path exe ~f) | Library lib -> Library (Lib.map_path lib ~f) + | Root r -> Root (f r) + | Build_context c -> Build_context (f c) (** Conversion to the [Dyn.t] type *) let to_dyn options : t -> Dyn.t = function @@ -187,6 +191,10 @@ module Descr = struct Variant ("executables", [ Exe.to_dyn options exe_descr ]) | Library lib_descr -> Variant ("library", [ Lib.to_dyn options lib_descr ]) + | Root root -> + Variant ("root", [ String (Path.to_absolute_filename root) ]) + | Build_context build_ctxt -> + Variant ("build_context", [ String (Path.to_string build_ctxt) ]) end (** Description of a workspace: a list of items *) @@ -288,7 +296,9 @@ module Crawl = struct let source ml_kind = Option.map (Module.source m ~ml_kind) ~f:Module.File.path in - let cmt ml_kind = Obj_dir.Module.cmt_file obj_dir m ~ml_kind in + let cmt ml_kind = + Dune_rules.Obj_dir.Module.cmt_file obj_dir m ~ml_kind ~cm_kind:(Ocaml Cmi) + in { Descr.Mod.name = Module.name m ; impl = source Impl ; intf = source Intf @@ -404,14 +414,45 @@ module Crawl = struct in Some (Descr.Item.Library lib_descr) + (** [source_path_is_in_dirs dirs p] tests whether the source path [p] is a + descendant of some of the provided directory [dirs]. If [dirs = None], + then it always succeeds. If [dirs = Some l], then a matching directory is + search in the list [l]. *) + let source_path_is_in_dirs dirs (p : Path.Source.t) = + match dirs with + | None -> true + | Some dirs -> + List.exists ~f:(fun dir -> Path.Source.is_descendant p ~of_:dir) dirs + + (** Tests whether a dune file is located in a path that is a descendant of + some directory *) + let dune_file_is_in_dirs dirs (dune_file : Dune_file.t) = + source_path_is_in_dirs dirs dune_file.dir + + (** Tests whether a library is located in a path that is a descendant of some + directory *) + let lib_is_in_dirs dirs (lib : Lib.t) = + source_path_is_in_dirs dirs + (Path.drop_build_context_exn @@ Lib_info.best_src_dir @@ Lib.info lib) + + (** Builds a workspace item for the root path *) + let root () = Descr.Item.Root Path.root + + (** Builds a workspace item for the build directory path *) + let build_ctxt (context : Context.t) : Descr.Item.t = + Descr.Item.Build_context (Path.build context.build_dir) + (** Builds a workspace description for the provided dune setup and context *) - let workspace options + let workspace options dirs ({ Dune_rules.Main.conf; contexts = _; scontexts } : Dune_rules.Main.build_system) (context : Context.t) : Descr.Workspace.t Memo.t = let sctx = Context_name.Map.find_exn scontexts context.name in let open Memo.O in - let* dune_files = Dune_load.Dune_files.eval conf.dune_files ~context in + let* dune_files = + Dune_load.Dune_files.eval conf.dune_files ~context + >>| List.filter ~f:(dune_file_is_in_dirs dirs) + in let* exes, exe_libs = (* the list of workspace items that describe executables, and the list of their direct library dependencies *) @@ -438,7 +479,9 @@ module Crawl = struct let* scope = Scope.DB.find_by_project ctx project in Scope.libs scope |> Lib.DB.all) >>| Lib.Set.union_all + >>| Lib.Set.filter ~f:(lib_is_in_dirs dirs) in + let+ libs = (* the executables' libraries, and the project's libraries *) Lib.Set.union exe_libs project_libs @@ -446,7 +489,9 @@ module Crawl = struct >>= Memo.parallel_map ~f:(library ~options sctx) >>| List.filter_opt in - exes @ libs + let root = root () in + let build_ctxt = build_ctxt context in + root :: build_ctxt :: (exes @ libs) end (** The following module is responsible sanitizing the output of @@ -483,12 +528,20 @@ module Sanitize_for_tests = struct with | None -> path | Some p -> p) + | Path.In_source_tree p -> + (* Replace the workspace root with a fixed string *) + let p = + let new_root = Filename.(concat dir_sep "WORKSPACE_ROOT") in + if Path.Source.is_root p then new_root + else Filename.(concat new_root (Path.Source.to_string p)) + in + Path.external_ (Path.External.of_string p) | path -> - (* if the path to rename is not external, it should not be changed *) + (* Otherwise, it should not be changed *) path in (* now, we rename the UIDs in the [requires] field , while reversing the - list of items, so taht we get back the original ordering *) + list of items, so that we get back the original ordering *) List.map ~f:(Descr.Item.map_path ~f:rename_path) items (** Sanitizes a workspace description when options ask to do so, or performs @@ -527,6 +580,168 @@ module Opam_files = struct Dyn.Tuple [ String (Path.to_string opam_file); String contents ])) end +module External_lib_deps = struct + include struct + open Dune_rules + module Lib_dep = Lib_dep + module Preprocess = Preprocess + module Lib = Lib + module Lib_info = Lib_info + module Scope = Scope + module Dune_file = Dune_file + end + + module Kind = struct + type t = + | Required + | Optional + + let to_dyn : t -> Dyn.t = function + | Required -> String "required" + | Optional -> String "optional" + + let merge x y = + match (x, y) with + | Optional, Optional -> Optional + | _ -> Required + end + + type external_lib_dep = + { name : Lib_name.t + ; kind : Kind.t + } + + type lib_deps = + { dir : Path.Source.t + ; deps : Lib_dep.t list + ; pps : Preprocess.With_instrumentation.t Preprocess.Per_module.t + } + + let is_external db name = + let open Memo.O in + let+ lib = Lib.DB.find_even_when_hidden db name in + match lib with + | None -> true + | Some t -> ( + match Lib_info.status (Lib.info t) with + | Installed_private | Public _ | Private _ -> false + | Installed -> true) + + let libs (context : Context.t) (build_system : Dune_rules.Main.build_system) = + let { Dune_rules.Main.conf; contexts = _; _ } = build_system in + let open Memo.O in + let+ dune_files = + Dune_rules.Dune_load.Dune_files.eval conf.dune_files ~context + in + List.concat_map dune_files ~f:(fun (dune_file : Dune_file.t) -> + List.concat_map dune_file.stanzas ~f:(fun stanza -> + let dir = dune_file.dir in + match stanza with + | Dune_file.Executables exes -> + [ { deps = exes.buildable.libraries + ; dir + ; pps = exes.buildable.preprocess + } + ] + | Dune_file.Library lib -> + [ { deps = lib.buildable.libraries + ; dir + ; pps = lib.buildable.preprocess + } + ] + | _ -> [])) + + let external_lib_pps db preprocess = + let open Memo.O in + let* pps = + Resolve.Memo.read_memo + (Preprocess.Per_module.with_instrumentation preprocess + ~instrumentation_backend:(Lib.DB.instrumentation_backend db)) + >>| Preprocess.Per_module.pps + in + Memo.parallel_map + ~f:(fun (_, name) -> + let+ is_external = is_external db name in + if is_external then Some { name; kind = Kind.Required } else None) + pps + >>| List.filter_opt + + let external_resolve db name kind = + let open Memo.O in + let+ is_external = is_external db name in + if is_external then Some { name; kind } else None + + let external_lib_deps db lib_deps = + Memo.parallel_map lib_deps ~f:(fun { deps; dir; pps } -> + let open Memo.O in + let* libs = + deps + |> Memo.parallel_map ~f:(fun lib -> + match lib with + | Lib_dep.Direct (_, name) | Lib_dep.Re_export (_, name) -> ( + let+ v = external_resolve db name Kind.Required in + match v with + | Some x -> [ x ] + | None -> []) + | Lib_dep.Select select -> + select.choices + |> Memo.parallel_map + ~f:(fun (choice : Lib_dep.Select.Choice.t) -> + Lib_name.Set.to_string_list choice.required + @ Lib_name.Set.to_string_list choice.forbidden + |> Memo.parallel_map ~f:(fun name -> + let name = Lib_name.of_string name in + external_resolve db name Kind.Optional) + >>| List.filter_map ~f:(fun x -> x)) + >>| List.concat) + >>| List.concat + in + let+ pps = external_lib_pps db pps in + (dir, libs @ pps)) + + let libs_to_lib_map libs = + List.fold_left ~init:Lib_name.Map.empty libs ~f:(fun acc_map lib -> + Lib_name.Map.update acc_map lib.name ~f:(fun n -> + match n with + | Some k -> Some (Kind.merge k lib.kind) + | None -> Some lib.kind)) + + let libs_dir_to_map libs_dir = + List.fold_left ~init:Path.Source.Map.empty libs_dir + ~f:(fun acc_map (dir, libs) -> + match Path.Source.Map.find acc_map dir with + | None -> Path.Source.Map.add_exn acc_map dir (libs_to_lib_map libs) + | Some libs_map -> + Path.Source.Map.set acc_map dir + (Lib_name.Map.union libs_map (libs_to_lib_map libs) + ~f:(fun _ k1 k2 -> Some (Kind.merge k1 k2)))) + + let external_resolved_libs setup super_context = + let open Memo.O in + let context = Super_context.context super_context in + let* scope = Scope.DB.find_by_dir context.build_dir in + let db = Scope.libs scope in + let* libs = libs context setup in + external_lib_deps db libs + + let to_dyn context_name external_resolved_libs = + Dyn.Tuple + [ Dyn.String context_name + ; external_resolved_libs |> libs_dir_to_map + |> Path.Source.Map.filter ~f:(fun m -> not (Lib_name.Map.is_empty m)) + |> Path.Source.Map.to_dyn (fun libs -> + Lib_name.Map.to_dyn Kind.to_dyn libs) + ] + + let get setup super_context = + let open Memo.O in + let context_name = + Super_context.context super_context + |> Context.name |> Dune_engine.Context_name.to_string + in + external_resolved_libs setup super_context >>| to_dyn context_name +end + module Preprocess = struct let pp_with_ocamlc sctx project pp_file = let open Dune_engine in @@ -578,7 +793,7 @@ module Preprocess = struct let pp_file = file |> Path.map_extension ~f:(fun ext -> ".pp" ^ ext) in Build_system.file_exists pp_file >>= function | true -> - let* _digest = Build_system.build_file pp_file in + let* () = Build_system.build_file pp_file in let+ project = Dune_engine.Source_tree.root () >>| Dune_engine.Source_tree.Dir.project in @@ -586,7 +801,7 @@ module Preprocess = struct | false -> ( Build_system.file_exists file >>= function | true -> - let+ _digest = Build_system.build_file file in + let+ () = Build_system.build_file file in Error file | false -> User_error.raise [ Pp.textf "%s does not exist" (Path.to_string file) ]) @@ -610,11 +825,13 @@ end without hassle. *) module What = struct type t = - | Workspace + | Workspace of { dirs : string list option } + | External_lib_deps | Opam_files | Pp of string - let default = Workspace + (** By default, describe the whole workspace *) + let default = Workspace { dirs = None } (* The list of command names, their args, their documentation, and their parser *) @@ -622,9 +839,18 @@ module What = struct (string * string list * string * t Dune_lang.Decoder.t) list = let open Dune_lang.Decoder in [ ( "workspace" - , [] - , "prints a description of the workspace's structure" - , return Workspace ) + , [ "DIRS" ] + , "prints a description of the workspace's structure. If some \ + directories DIRS are provided, then only those directories of the \ + workspace are considered." + , let+ dirs = repeat relative_file in + (* [None] means that all directories should be accepted, + whereas [Some l] means that only the directories in the + list [l] should be accepted. The checks on whether the + paths exist and whether they are directories are performed + later in the [describe] function. *) + let dirs = if List.is_empty dirs then None else Some dirs in + Workspace { dirs } ) ; ( "opam-files" , [] , "prints information about the Opam files that have been discovered" @@ -632,7 +858,13 @@ module What = struct ; ( "pp" , [ "FILE" ] , "builds a given FILE and prints the preprocessed output" - , filename >>| fun s -> Pp s ) + , let+ s = filename in + Pp s ) + ; ( "external-lib-deps" + , [] + , "Print out external libraries needed to build the project. It's an \ + approximated set of libraries." + , return External_lib_deps ) ] (* The list of documentation strings (one for each command) *) @@ -666,14 +898,38 @@ module What = struct in Dune_lang.Decoder.parse parse Univ_map.empty ast - let describe t options setup super_context = + let describe t options (common : Common.t) setup super_context = let some = Memo.map ~f:(fun x -> Some x) in match t with | Opam_files -> Opam_files.get () |> some - | Workspace -> + | External_lib_deps -> External_lib_deps.get setup super_context |> some + | Workspace { dirs } -> let context = Super_context.context super_context in let open Memo.O in - Crawl.workspace options setup context + let* dirs = + (* prefix directories with the workspace root, so that the + command also works correctly when it is run from a + subdirectory *) + Memo.Option.map dirs + ~f: + (Memo.List.map ~f:(fun dir -> + let p = + Path.Source.(relative root) (Common.prefix_target common dir) + in + let s = Path.source p in + if not @@ Path.exists s then + User_error.raise + [ Pp.textf "No such file or directory: %s" + (Path.to_string s) + ]; + if not @@ Path.is_directory s then + User_error.raise + [ Pp.textf "File exists, but is not a directory: %s" + (Path.to_string s) + ]; + Memo.return p)) + in + Crawl.workspace options dirs setup context >>| Sanitize_for_tests.Workspace.sanitize context >>| Descr.Workspace.to_dyn options |> some @@ -799,14 +1055,14 @@ let term : unit Term.t = Import.Main.find_scontext_exn setup ~name:context_name in let+ res = - Build_system.run (fun () -> - What.describe what options setup super_context) + Build_system.run_exn (fun () -> + What.describe what options common setup super_context) in match res with - | Error `Already_reported | Ok None -> () - | Ok (Some res) -> ( + | None -> () + | Some res -> ( match format with | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn res) | Sexp -> print_as_sexp res)) -let command : unit Term.t * Term.info = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/describe.mli b/duniverse/dune_/bin/describe.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/describe.mli +++ b/duniverse/dune_/bin/describe.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/diagnostics.ml b/duniverse/dune_/bin/diagnostics.ml index 83cfc5871..19cd68807 100644 --- a/duniverse/dune_/bin/diagnostics.ml +++ b/duniverse/dune_/bin/diagnostics.ml @@ -52,10 +52,10 @@ let exec () = let info = let doc = "fetch and return errors from the current build" in - Term.info "diagnostics" ~doc + Cmd.info "diagnostics" ~doc let term = let+ (common : Common.t) = Common.term in Rpc.client_term common exec -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/diagnostics.mli b/duniverse/dune_/bin/diagnostics.mli index 8e37776fc..8c78dc310 100644 --- a/duniverse/dune_/bin/diagnostics.mli +++ b/duniverse/dune_/bin/diagnostics.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/dune b/duniverse/dune_/bin/dune index 4f406a9ea..e11bf9e5f 100644 --- a/duniverse/dune_/bin/dune +++ b/duniverse/dune_/bin/dune @@ -10,7 +10,10 @@ dune_lang fiber stdune + dune_console unix + dune_metrics + dune_digest dune_cache dune_cache_storage dune_graph @@ -47,7 +50,7 @@ (rule (action - (copy ../dune.exe dune.exe)) + (copy ../_boot/dune.exe dune.exe)) (enabled_if (= %{profile} dune-bootstrap))) diff --git a/duniverse/dune_/bin/dune_init.ml b/duniverse/dune_/bin/dune_init.ml index 05074582a..37efa0cf1 100644 --- a/duniverse/dune_/bin/dune_init.ml +++ b/duniverse/dune_/bin/dune_init.ml @@ -10,27 +10,6 @@ module Dialect = Dune_engine.Dialect syntax tree (CST) a good deal. *) module Cst = Dune_lang.Cst -module Kind = struct - type t = - | Executable - | Library - | Project - | Test - - let to_string = function - | Executable -> "executable" - | Library -> "library" - | Project -> "project" - | Test -> "test" - - let commands = - [ ("executable", Executable) - ; ("library", Library) - ; ("project", Project) - ; ("test", Test) - ] -end - (** Abstractions around the kinds of files handled during initialization *) module File = struct type dune = diff --git a/duniverse/dune_/bin/dune_init.mli b/duniverse/dune_/bin/dune_init.mli index 746e6bcff..142a15d9a 100644 --- a/duniverse/dune_/bin/dune_init.mli +++ b/duniverse/dune_/bin/dune_init.mli @@ -2,19 +2,6 @@ open! Stdune -(** Supported kinds of components for initialization *) -module Kind : sig - type t = - | Executable - | Library - | Project - | Test - - val to_string : t -> string - - val commands : (string * t) list -end - (** The context in which the initialization is executed *) module Init_context : sig type t = diff --git a/duniverse/dune_/bin/exec.ml b/duniverse/dune_/bin/exec.ml index b596a7495..4a2e47515 100644 --- a/duniverse/dune_/bin/exec.ml +++ b/duniverse/dune_/bin/exec.ml @@ -30,7 +30,7 @@ let man = ] ] -let info = Term.info "exec" ~doc ~man +let info = Cmd.info "exec" ~doc ~man let term = let+ common = Common.term @@ -66,7 +66,7 @@ let term = prog ] else - let+ _digest = Build_system.build_file p in + let+ () = Build_system.build_file p in p in let not_found () = @@ -132,4 +132,4 @@ let term = in restore_cwd_and_execve common prog argv env -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/exec.mli b/duniverse/dune_/bin/exec.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/exec.mli +++ b/duniverse/dune_/bin/exec.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/external_lib_deps.ml b/duniverse/dune_/bin/external_lib_deps.ml index f7ff2bd3d..f636de96f 100644 --- a/duniverse/dune_/bin/external_lib_deps.ml +++ b/duniverse/dune_/bin/external_lib_deps.ml @@ -14,7 +14,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "external-lib-deps" ~doc ~man +let info = Cmd.info "external-lib-deps" ~doc ~man let term = Term.ret @@ -25,4 +25,4 @@ let term = and+ _ = Arg.(value & flag & info [ "sexp" ] ~doc:{|unused|}) in `Error (false, "This subcommand is no longer implemented.") -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/external_lib_deps.mli b/duniverse/dune_/bin/external_lib_deps.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/external_lib_deps.mli +++ b/duniverse/dune_/bin/external_lib_deps.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/format_dune_file.ml b/duniverse/dune_/bin/format_dune_file.ml index 483bc1d5c..752e77167 100644 --- a/duniverse/dune_/bin/format_dune_file.ml +++ b/duniverse/dune_/bin/format_dune_file.ml @@ -12,7 +12,7 @@ let man = formatting" section in the manual.|} ] -let info = Term.info "format-dune-file" ~doc ~man +let info = Cmd.info "format-dune-file" ~doc ~man let format_file ~version ~input = let with_input = @@ -50,4 +50,4 @@ let term = let input = Option.map ~f:Arg.Path.path path_opt in format_file ~version ~input -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/format_dune_file.mli b/duniverse/dune_/bin/format_dune_file.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/format_dune_file.mli +++ b/duniverse/dune_/bin/format_dune_file.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/help.ml b/duniverse/dune_/bin/help.ml index 8b3a9f9d1..025fdf9fc 100644 --- a/duniverse/dune_/bin/help.ml +++ b/duniverse/dune_/bin/help.ml @@ -102,7 +102,7 @@ let man = ; Common.footer ] -let info = Term.info "help" ~doc ~man +let info = Cmd.info "help" ~doc ~man ~envs:Common.envs let term = Term.ret @@ -124,4 +124,4 @@ let term = |> String.concat ~sep:"\n" |> print_endline; `Ok () -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/help.mli b/duniverse/dune_/bin/help.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/help.mli +++ b/duniverse/dune_/bin/help.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/import.ml b/duniverse/dune_/bin/import.ml index aa1dc5d7f..7ecb622cb 100644 --- a/duniverse/dune_/bin/import.ml +++ b/duniverse/dune_/bin/import.ml @@ -1,41 +1,54 @@ open Stdune -open Dune_engine -module Term = Cmdliner.Term -module Manpage = Cmdliner.Manpage + +include struct + open Dune_engine + module Build_config = Build_config + module Build_system = Build_system + module Load_rules = Load_rules + module Package = Package + module Hooks = Hooks + module Action_builder = Action_builder + module Action = Action + module Dep = Dep + module Action_to_sh = Action_to_sh + module Dpath = Dpath + module Findlib = Dune_rules.Findlib + module Dune_package = Dune_rules.Dune_package + module Install = Dune_rules.Install + module Section = Section + module Diff_promotion = Diff_promotion + module Dune_project = Dune_project + module Cached_digest = Cached_digest + module Targets = Targets +end + +include struct + open Dune_rules + module Super_context = Super_context + module Context = Context + module Config = Dune_util.Config + module Lib_name = Lib_name + module Workspace = Workspace + module Profile = Profile + module Resolve = Resolve +end + +include struct + open Cmdliner + module Term = Term + module Manpage = Manpage + module Cmd = Cmd +end + +module Digest = Dune_digest +module Metrics = Dune_metrics +module Console = Dune_console module Stanza = Dune_lang.Stanza -module Super_context = Dune_rules.Super_context -module Context = Dune_rules.Context -module Config = Dune_util.Config -module Lib_name = Dune_rules.Lib_name -module Build_config = Dune_engine.Build_config -module Build_system = Dune_engine.Build_system -module Load_rules = Dune_engine.Load_rules -module Findlib = Dune_rules.Findlib -module Package = Dune_engine.Package -module Dune_package = Dune_rules.Dune_package -module Hooks = Dune_engine.Hooks -module Action_builder = Dune_engine.Action_builder -module Action = Dune_engine.Action -module Dep = Dune_engine.Dep -module Action_to_sh = Dune_engine.Action_to_sh -module Dpath = Dune_engine.Dpath -module Install = Dune_rules.Install -module Section = Dune_engine.Section -module Diff_promotion = Dune_engine.Diff_promotion -module Colors = Dune_rules.Colors -module Dune_project = Dune_engine.Dune_project -module Workspace = Dune_rules.Workspace -module Cached_digest = Dune_engine.Cached_digest -module Targets = Dune_engine.Targets -module Profile = Dune_rules.Profile -module Resolve = Dune_rules.Resolve module Log = Dune_util.Log module Dune_rpc = Dune_rpc_private module Graph = Dune_graph.Graph include Common.Let_syntax -let in_group (t, info) = (Term.Group.Term t, info) - module Main : sig include module type of struct include Dune_rules.Main @@ -47,7 +60,7 @@ end = struct let setup () = let open Fiber.O in - let* scheduler = Scheduler.t () in + let* scheduler = Dune_engine.Scheduler.t () in Console.Status_line.set (Live (fun () -> @@ -59,12 +72,14 @@ end = struct | Building { Build_system.Progress.number_of_rules_executed = done_ ; number_of_rules_discovered = total + ; number_of_rules_failed = failed } -> Pp.verbatim - (sprintf "Done: %u%% (%u/%u, %u left) (jobs: %u)" + (sprintf "Done: %u%% (%u/%u, %u left%s) (jobs: %u)" (if total = 0 then 0 else done_ * 100 / total) done_ total (total - done_) - (Scheduler.running_jobs_count scheduler)))); + (if failed = 0 then "" else sprintf ", %u failed" failed) + (Dune_engine.Scheduler.running_jobs_count scheduler)))); Fiber.return (Memo.of_thunk get) end @@ -77,6 +92,7 @@ module Scheduler = struct | false -> ( match dune_config.terminal_persistence with | Clear_on_rebuild -> Console.reset () + | Clear_on_rebuild_and_flush_history -> Console.reset_flush_history () | Preserve -> let message = sprintf "********** NEW BUILD (%s) **********" @@ -90,7 +106,7 @@ module Scheduler = struct ])) let on_event dune_config _config = function - | Scheduler.Run.Event.Tick -> Console.Status_line.refresh () + | Run.Event.Tick -> Console.Status_line.refresh () | Source_files_changed { details_hum } -> maybe_clear_screen ~details_hum dune_config | Build_interrupted -> @@ -103,9 +119,7 @@ module Scheduler = struct | Restarting_current_build | Build_succeeded__now_waiting_for_changes | Build_failed__now_waiting_for_changes -> - { Build_system.Progress.number_of_rules_discovered = 0 - ; number_of_rules_executed = 0 - } + Build_system.Progress.init | Building progress -> progress in Pp.seq @@ -125,6 +139,12 @@ module Scheduler = struct (Constant (Pp.seq message (Pp.verbatim ", waiting for filesystem changes..."))) + let rpc server = + { Dune_engine.Rpc.run = Dune_rpc_impl.Server.run server + ; stop = Dune_rpc_impl.Server.stop server + ; ready = Dune_rpc_impl.Server.ready server + } + let go ~(common : Common.t) ~config:dune_config f = let stats = Common.stats common in let config = @@ -132,10 +152,22 @@ module Scheduler = struct Dune_config.for_scheduler dune_config stats ~insignificant_changes ~signal_watcher:`Yes in - Scheduler.Run.go config ~on_event:(on_event dune_config) f + let f = + match Common.rpc common with + | `Allow server -> + fun () -> Dune_engine.Rpc.with_background_rpc (rpc server) f + | `Forbid_builds -> f + in + Run.go config ~on_event:(on_event dune_config) f let go_with_rpc_server_and_console_status_reporting ~(common : Common.t) ~config:dune_config run = + let server = + match Common.rpc common with + | `Allow server -> rpc server + | `Forbid_builds -> + Code_error.raise "rpc must be enabled in polling mode" [] + in let stats = Common.stats common in let config = let insignificant_changes = Common.insignificant_changes common in @@ -143,11 +175,13 @@ module Scheduler = struct ~signal_watcher:`Yes in let file_watcher = Common.file_watcher common in - let rpc = Common.rpc common in let run () = - Fiber.fork_and_join_unit (fun () -> Dune_rpc_impl.Server.run rpc) run + let open Fiber.O in + Dune_engine.Rpc.with_background_rpc server @@ fun () -> + let* () = Dune_engine.Rpc.ensure_ready () in + run () in - Scheduler.Run.go config ~file_watcher ~on_event:(on_event dune_config) run + Run.go config ~file_watcher ~on_event:(on_event dune_config) run end let restore_cwd_and_execve (common : Common.t) prog argv env = @@ -161,9 +195,12 @@ let restore_cwd_and_execve (common : Common.t) prog argv env = (* Adapted from https://github.com/ocaml/opam/blob/fbbe93c3f67034da62d28c8666ec6b05e0a9b17c/src/client/opamArg.ml#L759 *) -let command_alias cmd name = - let term, info = cmd in - let orig = Term.name info in +let command_alias ?orig_name cmd term name = + let orig = + match orig_name with + | Some s -> s + | None -> Cmd.name cmd + in let doc = Printf.sprintf "An alias for $(b,%s)." orig in let man = [ `S "DESCRIPTION" @@ -174,4 +211,4 @@ let command_alias cmd name = ; `Blocks Common.help_secs ] in - (term, Term.info name ~docs:"COMMAND ALIASES" ~doc ~man) + Cmd.v (Cmd.info name ~docs:"COMMAND ALIASES" ~doc ~man) term diff --git a/duniverse/dune_/bin/init.ml b/duniverse/dune_/bin/init.ml index 6fa65f643..cf62a9f64 100644 --- a/duniverse/dune_/bin/init.ml +++ b/duniverse/dune_/bin/init.ml @@ -4,20 +4,6 @@ open Dune_init (** {1 Helper functions} *) -(** {2 Validation} *) - -(* TODO(shonfeder): Remove when nested subcommands are available *) -let validate_component_options kind unsupported_options = - let report_invalid_option = function - | _, false -> () (* The option wasn't supplied *) - | option_name, true -> - User_error.raise - [ Pp.textf "The `%s' component does not support the `--%s' option" - (Kind.to_string kind) option_name - ] - in - List.iter ~f:report_invalid_option unsupported_options - (** {2 Cmdliner Argument Converters} *) let atom_parser s = @@ -68,93 +54,17 @@ let print_completion kind name = Console.print_user_message (User_message.make [ Pp.tag User_message.Style.Ok (Pp.verbatim "Success") - ++ Pp.textf ": initialized %s component named " (Kind.to_string kind) + ++ Pp.textf ": initialized %s component named " kind ++ Pp.tag User_message.Style.Kwd (Pp.verbatim (Dune_lang.Atom.to_string name)) ]) (** {1 CLI} *) -let doc = "Initialize dune components" - -let synopsis = - Common.command_synopsis - [ "init proj NAME [PATH] [OPTION]... " - ; "init exec NAME [PATH] [OPTION]... " - ; "init lib NAME [PATH] [OPTION]... " - ; "init test NAME [PATH] [OPTION]... " - ] - -let man = - [ `Blocks synopsis - ; `S "DESCRIPTION" - ; `P - {|$(b,dune init COMPONENT NAME [PATH] [OPTION]...) initializes a new dune - configuration for a component of the kind specified by $(b,COMPONENT), - named $(b,NAME), with fields determined by the supplied $(b,OPTION)s.|} - ; `P - {|If the optional $(b,PATH) is provided, the component will be created - there. Otherwise, it is created in the current working directory.|} - ; `P - {|The command can be used to add stanzas to existing dune files and for - creating new dune files and composing basic component templates.|} - ; `P {|Supported $(b,COMPONENT)s:|} - ; `I - ( "$(b,project)" - , {|A project is a predefined composition of components arranged in a - standard directory structure. The kind of project initialized is - determined by the value of the $(b,--kind) flag and defaults to an - executable project, composed of a library, an executable, and a test - component.|} - ) - ; `I ("$(b,executable)", {|A binary executable.|}) - ; `I ("$(b,library)", {|An OCaml library.|}) - ; `I - ( "$(b,test)" - , {|A separate test harness. (For inline tests, use the - $(b,--inline-tests) flag along with the other component kinds.)|} - ) - ; `P - {|Any prefix of the $(b,COMPONENT) kind names can be supplied in place of - full name (as illustrated in the synopsis).|} - ; `P - {|For more details, see https://dune.readthedocs.io/en/stable/usage.html#initializing-components|} - ; Common.examples - [ ( {|Generate a project skeleton for an executable named `myproj' in a - new directory named `myproj', depending on the bos library and - using inline tests along with ppx_inline_test |} - , {|dune init proj myproj --libs bos --ppx ppx_inline_test --inline-tests|} - ) - ; ( {|Configure an executable component named `myexe' in a dune file in the - current directory|} - , {|dune init exe myexe|} ) - ; ( {|Configure a library component named `mylib' in a dune file in the ./src - directory depending on the core and cmdliner libraries, the ppx_let - and ppx_inline_test preprocessors, and declared as using inline - tests|} - , {|dune init lib mylib src --libs core,cmdliner --ppx ppx_let,ppx_inline_test --inline-tests|} - ) - ; ( {|Configure a test component named `mytest' in a dune file in the - ./test directory that depends on `mylib'|} - , {|dune init test mytest test --libs mylib|} ) - ] - ] - -let info = Term.info "init" ~doc ~man - -let term = - let+ common_term = Common.term_with_default_root_is_cwd - and+ kind = - (* TODO(shonfeder): Replace with nested subcommand once we have support for - that *) - let docv = "COMPONENT" in - Arg.(required & pos 0 (some (enum Kind.commands)) None & info [] ~docv) - and+ name = +let common : Component.Options.Common.t Term.t = + let+ name = let docv = "NAME" in - Arg.(required & pos 1 (some component_name_conv) None & info [] ~docv) - and+ path = - let docv = "PATH" in - Arg.(value & pos 2 (some string) None & info [] ~docv) + Arg.(required & pos 0 (some component_name_conv) None & info [] ~docv) and+ libraries = let docv = "LIBRARIES" in let doc = @@ -167,86 +77,167 @@ let term = "A comma separated list of ppx preprocessors used by the component" in Arg.(value & opt (list atom_conv) [] & info [ "ppx" ] ~docv ~doc) - and+ public = - (* TODO(shonfeder): Move to subcommands {lib, exe} once implemented *) - let docv = "PUBLIC_NAME" in - let doc = - "If called with an argument, make the component public under the given \ - PUBLIC_NAME. If supplied without an argument, use NAME." - in - Arg.( - value - & opt ~vopt:(Some Component.Options.Use_name) (some public_name_conv) None - & info [ "public" ] ~docv ~doc) - and+ inline_tests = - (* TODO(shonfeder): Move to subcommand [lib] once implemented *) - let docv = "USE_INLINE_TESTS" in - let doc = - "Whether to use inline tests. Only applicable for $(b,library) and \ - $(b,project) components." - in - Arg.(value & flag & info [ "inline-tests" ] ~docv ~doc) - and+ template = - let docv = "PROJECT_KIND" in - let doc = - "The kind of project to initialize. Valid options are $(b,e[xecutable]) \ - or $(b,l[ibrary]). Defaults to $(b,executable). Only applicable for \ - $(b,project) components." - in - Arg.( - value - & opt (some (enum Component.Options.Project.Template.commands)) None - & info [ "kind" ] ~docv ~doc) - and+ pkg = - let docv = "PACKAGE_MANAGER" in - let doc = - "Which package manager to use. Valid options are $(b,o[pam]) or \ - $(b,e[sy]). Defaults to $(b,opam). Only applicable for $(b,project) \ - components." - in - Arg.( - value - & opt (some (enum Component.Options.Project.Pkg.commands)) None - & info [ "pkg" ] ~docv ~doc) + in + { Component.Options.Common.name; libraries; pps } + +let context : Init_context.t Term.t = + let+ common_term = Common.term_with_default_root_is_cwd + and+ path = + let docv = "PATH" in + Arg.(value & pos 1 (some string) None & info [] ~docv) in let config = Common.init common_term in - Dune_engine.Clflags.on_missing_dune_project_file := Dune_engine.Clflags.Ignore; - let open Component in - let context = - Scheduler.go ~common:common_term ~config (fun () -> - Memo.run (Init_context.make path)) + Scheduler.go ~common:common_term ~config (fun () -> + Memo.run (Init_context.make path)) + +let public : Component.Options.public_name option Term.t = + let docv = "PUBLIC_NAME" in + let doc = + "If called with an argument, make the component public under the given \ + PUBLIC_NAME. If supplied without an argument, use NAME." + in + Arg.( + value + & opt ~vopt:(Some Component.Options.Use_name) (some public_name_conv) None + & info [ "public" ] ~docv ~doc) + +let inline_tests : bool Term.t = + let docv = "USE_INLINE_TESTS" in + let doc = + "Whether to use inline tests. Only applicable for $(b,library) and \ + $(b,project) components." + in + Arg.(value & flag & info [ "inline-tests" ] ~docv ~doc) + +let opt_default ~default term = Term.(const (Option.value ~default) $ term) + +let executable = + let doc = "A binary executable." in + let man = [] in + let kind = "executable" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context + and+ common = common + and+ public = public in + Component.init (Executable { context; common; options = { public } }); + print_completion kind common.name + +let library = + let doc = "An OCaml library." in + let man = [] in + let kind = "library" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context + and+ common = common + and+ public = public + and+ inline_tests = inline_tests in + Component.init + (Library { context; common; options = { public; inline_tests } }); + print_completion kind common.name + +let test = + let doc = + "A test harness. (For inline tests, use the $(b,--inline-tests) flag along \ + with the other component kinds.)" + in + let man = [] in + let kind = "test" in + Cmd.v (Cmd.info kind ~doc ~man) + @@ let+ context = context + and+ common = common in + Component.init (Test { context; common; options = () }); + print_completion kind common.name + +let project = + let open Component.Options in + let doc = + "A project is a predefined composition of components arranged in a \ + standard directory structure. The kind of project initialized is \ + determined by the value of the $(b,--kind) flag and defaults to an \ + executable project, composed of a library, an executable, and a test \ + component." + in + let man = [] in + Cmd.v (Cmd.info "project" ~doc ~man) + @@ let+ context = context + and+ common = common + and+ inline_tests = inline_tests + and+ template = + let docv = "PROJECT_KIND" in + let doc = + "The kind of project to initialize. Valid options are \ + $(b,e[xecutable]) or $(b,l[ibrary]). Defaults to $(b,executable). \ + Only applicable for $(b,project) components." + in + opt_default ~default:Project.Template.Exec + Arg.( + value + & opt (some (enum Project.Template.commands)) None + & info [ "kind" ] ~docv ~doc) + and+ pkg = + let docv = "PACKAGE_MANAGER" in + let doc = + "Which package manager to use. Valid options are $(b,o[pam]) or \ + $(b,e[sy]). Defaults to $(b,opam). Only applicable for $(b,project) \ + components." + in + opt_default ~default:Project.Pkg.Opam + Arg.( + value + & opt (some (enum Project.Pkg.commands)) None + & info [ "pkg" ] ~docv ~doc) + in + Component.init + (Project { context; common; options = { template; inline_tests; pkg } }); + print_completion "project" common.name + +let group = + let doc = "Command group for initializing dune components" in + let synopsis = + Common.command_synopsis + [ "init proj NAME [PATH] [OPTION]... " + ; "init exec NAME [PATH] [OPTION]... " + ; "init lib NAME [PATH] [OPTION]... " + ; "init test NAME [PATH] [OPTION]... " + ] + in + let man = + [ `Blocks synopsis + ; `S "DESCRIPTION" + ; `P + {|$(b,dune init COMPONENT NAME [PATH] [OPTION]...) initializes a new dune + configuration for a component of the kind specified by the subcommand + $(b,COMPONENT), named $(b,NAME), with fields determined by the supplied + $(b,OPTION)s.|} + ; `P + {|Run a subcommand with $(b, --help) for for details on it's supported arguments|} + ; `P + {|If the optional $(b,PATH) is provided, the component will be created + there. Otherwise, it is created in the current working directory.|} + ; `P + {|Any prefix of a $(b,COMMAND)'s name can be supplied in place of + full name (as illustrated in the synopsis).|} + ; `P + {|For more details, see https://dune.readthedocs.io/en/stable/usage.html#initializing-components|} + ; Common.examples + [ ( {|Generate a project skeleton for an executable named `myproj' in a + new directory named `myproj', depending on the bos library and + using inline tests along with ppx_inline_test |} + , {|dune init proj myproj --libs bos --ppx ppx_inline_test --inline-tests|} + ) + ; ( {|Configure an executable component named `myexe' in a dune file in the + current directory|} + , {|dune init exe myexe|} ) + ; ( {|Configure a library component named `mylib' in a dune file in the ./src + directory depending on the core and cmdliner libraries, the ppx_let + and ppx_inline_test preprocessors, and declared as using inline + tests|} + , {|dune init lib mylib src --libs core,cmdliner --ppx ppx_let,ppx_inline_test --inline-tests|} + ) + ; ( {|Configure a test component named `mytest' in a dune file in the + ./test directory that depends on `mylib'|} + , {|dune init test mytest test --libs mylib|} ) + ] + ] in - let common : Options.Common.t = { name; libraries; pps } in - let given_public = Option.is_some public in - let given_pkg = Option.is_some pkg in - let given_template = Option.is_some template in - let pkg = Option.value pkg ~default:Options.Project.Pkg.Opam in - let template = Option.value template ~default:Options.Project.Template.Exec in - (* for the [kind] of initialization *) - let check_unsupported_options = validate_component_options kind in - (match kind with - | Kind.Executable -> - check_unsupported_options - [ ("inline-tests", inline_tests) - ; ("kind", given_template) - ; ("pkg", given_pkg) - ]; - init @@ Executable { context; common; options = { public } } - | Kind.Library -> - check_unsupported_options [ ("kind", given_template); ("pkg", given_pkg) ]; - init @@ Library { context; common; options = { public; inline_tests } } - | Kind.Project -> - check_unsupported_options [ ("public", given_public) ]; - init - @@ Project { context; common; options = { inline_tests; pkg; template } } - | Kind.Test -> - check_unsupported_options - [ ("public", given_public) - ; ("inline-tests", inline_tests) - ; ("kind", given_template) - ; ("pkg", given_pkg) - ]; - init @@ Test { context; common; options = () }); - print_completion kind name - -let command = (term, info) + Cmd.group (Cmd.info "init" ~doc ~man) [ executable; project; library; test ] diff --git a/duniverse/dune_/bin/init.mli b/duniverse/dune_/bin/init.mli index 6d988967f..d4c5902fc 100644 --- a/duniverse/dune_/bin/init.mli +++ b/duniverse/dune_/bin/init.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val group : unit Cmd.t diff --git a/duniverse/dune_/bin/install_uninstall.ml b/duniverse/dune_/bin/install_uninstall.ml index 3bde614f8..826439fea 100644 --- a/duniverse/dune_/bin/install_uninstall.ml +++ b/duniverse/dune_/bin/install_uninstall.ml @@ -303,20 +303,23 @@ module File_ops_real (W : Workspace) : File_operations = struct let copy_file ~src ~dst ~executable ~special_file ~package ~(conf : Dune_rules.Artifact_substitution.conf) = let chmod = if executable then fun _ -> 0o755 else fun _ -> 0o644 in - let ic, oc = Io.setup_copy ~chmod ~src ~dst () in - Fiber.finalize - ~finally:(fun () -> - Io.close_both (ic, oc); - Fiber.return ()) - (fun () -> - match (special_file : Special_file.t option) with - | Some META -> copy_special_file ~src ~package ~ic ~oc ~f:process_meta - | Some Dune_package -> - copy_special_file ~src ~package ~ic ~oc - ~f:(process_dune_package ~get_location:conf.get_location) - | None -> - Dune_rules.Artifact_substitution.copy ~conf ~input_file:src - ~input:(input ic) ~output:(output oc)) + match (special_file : Special_file.t option) with + | Some sf -> + let ic, oc = Io.setup_copy ~chmod ~src ~dst () in + Fiber.finalize + ~finally:(fun () -> + Io.close_both (ic, oc); + Fiber.return ()) + (fun () -> + let f = + match sf with + | META -> process_meta + | Dune_package -> + process_dune_package ~get_location:conf.get_location + in + copy_special_file ~src ~package ~ic ~oc ~f) + | None -> + Dune_rules.Artifact_substitution.copy_file ~conf ~src ~dst ~chmod () let remove_file_if_exists dst = if Path.exists dst then ( @@ -366,7 +369,7 @@ module Sections = struct | All | Only of Section.Set.t - let sections_conv : Section.t list Cmdliner.Arg.converter = + let sections_conv = let all = Section.all |> Section.Set.to_list |> List.map ~f:(fun section -> (Section.to_string section, section)) @@ -429,7 +432,7 @@ let install_uninstall ~what = value & opt (some string) None & info [ "prefix" ] - ~env:(env_var "DUNE_INSTALL_PREFIX") + ~env:(Cmd.Env.info "DUNE_INSTALL_PREFIX") ~docv:"PREFIX" ~doc: "Directory where files are copied. For instance binaries are \ @@ -439,7 +442,7 @@ let install_uninstall ~what = Arg.( value & opt (some string) None - & info [ "destdir" ] ~env:(env_var "DESTDIR") ~docv:"PATH" + & info [ "destdir" ] ~env:(Cmd.Env.info "DESTDIR") ~docv:"PATH" ~doc:"This directory is prepended to all installed paths.") and+ libdir_from_command_line = Arg.( @@ -544,6 +547,7 @@ let install_uninstall ~what = "Select context to install from. By default, install files from \ all defined contexts.") and+ sections = Sections.term in + let common = Common.forbid_builds common in let config = Common.init ~log_file:No_log_file common in Scheduler.go ~common ~config (fun () -> let open Fiber.O in @@ -674,7 +678,7 @@ let install_uninstall ~what = let conf = Dune_rules.Artifact_substitution.conf_for_install ~relocatable ~default_ocamlpath:context.default_ocamlpath - ~stdlib_dir:context.stdlib_dir ~roots + ~stdlib_dir:context.stdlib_dir ~roots ~context in Fiber.sequential_iter entries_per_package ~f:(fun (package, entries) -> @@ -693,9 +697,12 @@ let install_uninstall ~what = match special_file with | _ when not create_install_files -> Fiber.return true - | None -> - Dune_rules.Artifact_substitution.test_file - ~src:entry.src () + | None -> ( + let open Dune_rules.Artifact_substitution in + let+ status = test_file ~src:entry.src () in + match status with + | Some_substitution -> true + | No_substitution -> false) | Some Special_file.META | Some Special_file.Dune_package -> Fiber.return true @@ -737,9 +744,10 @@ let install_uninstall ~what = |> List.rev |> List.iter ~f:(Ops.remove_dir_if_exists ~if_non_empty:Warn)) in - ( term - , Cmdliner.Term.info (cmd_what what) ~doc - ~man:Manpage.(`S s_synopsis :: (synopsis @ Common.help_secs)) ) + Cmd.v + (Cmd.info (cmd_what what) ~doc + ~man:Manpage.(`S s_synopsis :: (synopsis @ Common.help_secs))) + term let install = install_uninstall ~what:Install diff --git a/duniverse/dune_/bin/install_uninstall.mli b/duniverse/dune_/bin/install_uninstall.mli index cc1a0b689..207596609 100644 --- a/duniverse/dune_/bin/install_uninstall.mli +++ b/duniverse/dune_/bin/install_uninstall.mli @@ -1,3 +1,5 @@ -val install : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import -val uninstall : unit Cmdliner.Term.t * Cmdliner.Term.info +val install : unit Cmd.t + +val uninstall : unit Cmd.t diff --git a/duniverse/dune_/bin/installed_libraries.ml b/duniverse/dune_/bin/installed_libraries.ml index 4ba93b00a..921ffe76d 100644 --- a/duniverse/dune_/bin/installed_libraries.ml +++ b/duniverse/dune_/bin/installed_libraries.ml @@ -3,7 +3,7 @@ open Import let doc = "Print out libraries installed on the system." -let info = Term.info "installed-libraries" ~doc +let info = Cmd.info "installed-libraries" ~doc let term = let+ common = Common.term @@ -71,4 +71,4 @@ let term = in fun () -> Memo.run (run ())) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/installed_libraries.mli b/duniverse/dune_/bin/installed_libraries.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/installed_libraries.mli +++ b/duniverse/dune_/bin/installed_libraries.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/internal.ml b/duniverse/dune_/bin/internal.ml index 34e331c1e..89947c6aa 100644 --- a/duniverse/dune_/bin/internal.ml +++ b/duniverse/dune_/bin/internal.ml @@ -1,13 +1,12 @@ open Import let latest_lang_version = - ( (let+ () = Term.const () in + Cmd.v + (Cmd.info "latest-lang-version") + (let+ () = Term.const () in print_endline (Dune_lang.Syntax.greatest_supported_version Stanza.syntax |> Dune_lang.Syntax.Version.to_string)) - , Term.info "latest-lang-version" ) let group = - ( Term.Group.Group - [ in_group Internal_dump.command; in_group latest_lang_version ] - , Term.info "internal" ) + Cmd.group (Cmd.info "internal") [ Internal_dump.command; latest_lang_version ] diff --git a/duniverse/dune_/bin/internal.mli b/duniverse/dune_/bin/internal.mli index 8c539d338..d4c5902fc 100644 --- a/duniverse/dune_/bin/internal.mli +++ b/duniverse/dune_/bin/internal.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/duniverse/dune_/bin/internal_dump.ml b/duniverse/dune_/bin/internal_dump.ml index 5940ec44e..33cc98113 100644 --- a/duniverse/dune_/bin/internal_dump.ml +++ b/duniverse/dune_/bin/internal_dump.ml @@ -1,4 +1,3 @@ -open Stdune open Import module Persistent = Dune_util.Persistent @@ -11,7 +10,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "dump" ~doc ~man +let info = Cmd.info "dump" ~doc ~man let term = let+ common = Common.term @@ -24,4 +23,4 @@ let term = in Console.print [ Dyn.pp (D.to_dyn data) ] -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/internal_dump.mli b/duniverse/dune_/bin/internal_dump.mli index 8e37776fc..8c78dc310 100644 --- a/duniverse/dune_/bin/internal_dump.mli +++ b/duniverse/dune_/bin/internal_dump.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/main.ml b/duniverse/dune_/bin/main.ml index f16cd0674..a101b2608 100644 --- a/duniverse/dune_/bin/main.ml +++ b/duniverse/dune_/bin/main.ml @@ -1,14 +1,14 @@ open! Stdune open Import -let all : _ Term.Group.t list = +let all : _ Cmdliner.Cmd.t list = let terms = [ Installed_libraries.command ; External_lib_deps.command ; Build_cmd.build ; Build_cmd.runtest ; Build_cmd.fmt - ; command_alias Build_cmd.runtest "test" + ; command_alias Build_cmd.runtest Build_cmd.runtest_term "test" ; Clean.command ; Install_uninstall.install ; Install_uninstall.uninstall @@ -16,8 +16,7 @@ let all : _ Term.Group.t list = ; Subst.command ; Print_rules.command ; Utop.command - ; Init.command - ; Promote.command + ; Promotion.promote ; Printenv.command ; Help.command ; Format_dune_file.command @@ -29,9 +28,16 @@ let all : _ Term.Group.t list = ; Shutdown.command ; Diagnostics.command ] - |> List.map ~f:in_group in - let groups = [ Ocaml_cmd.group; Coq.group; Rpc.group; Internal.group ] in + let groups = + [ Ocaml_cmd.group + ; Coq.group + ; Rpc.group + ; Internal.group + ; Init.group + ; Promotion.group + ] + in terms @ groups (* Short reminders for the most used and useful commands *) @@ -45,56 +51,56 @@ let common_commands_synopsis = ; "init project NAME [PATH] [--libs=l1,l2 --ppx=p1,p2 --inline-tests]" ] -let default = +let info = let doc = "composable build system for OCaml" in - let term = - Term.ret - @@ let+ _ = Common.term in - `Help (`Pager, None) - in - ( term - , Term.info "dune" ~doc - ~version: - (match Build_info.V1.version () with - | None -> "n/a" - | Some v -> Build_info.V1.Version.to_string v) - ~man: - [ `Blocks common_commands_synopsis - ; `S "DESCRIPTION" - ; `P - {|Dune is a build system designed for OCaml projects only. It + Cmd.info "dune" ~doc ~envs:Common.envs + ~version: + (match Build_info.V1.version () with + | None -> "n/a" + | Some v -> Build_info.V1.Version.to_string v) + ~man: + [ `Blocks common_commands_synopsis + ; `S "DESCRIPTION" + ; `P + {|Dune is a build system designed for OCaml projects only. It focuses on providing the user with a consistent experience and takes care of most of the low-level details of OCaml compilation. All you have to do is provide a description of your project and Dune will do the rest. |} - ; `P - {|The scheme it implements is inspired from the one used inside Jane + ; `P + {|The scheme it implements is inspired from the one used inside Jane Street and adapted to the open source world. It has matured over a long time and is used daily by hundreds of developers, which means that it is highly tested and productive. |} - ; `Blocks Common.help_secs - ; Common.examples - [ ("Initialise a new project named `foo'", "dune init project foo") - ; ("Build all targets in the current source tree", "dune build") - ; ("Run the executable named `bar'", "dune exec bar") - ; ("Run all tests in the current source tree", "dune runtest") - ; ("Install all components defined in the project", "dune install") - ; ("Remove all build artefacts", "dune clean") - ] - ] ) + ; `Blocks Common.help_secs + ; Common.examples + [ ("Initialise a new project named `foo'", "dune init project foo") + ; ("Build all targets in the current source tree", "dune build") + ; ("Run the executable named `bar'", "dune exec bar") + ; ("Run all tests in the current source tree", "dune runtest") + ; ("Install all components defined in the project", "dune install") + ; ("Remove all build artefacts", "dune clean") + ] + ] + +let cmd = Cmd.group info all + +let exit_and_flush code = + Console.finish (); + exit code let () = - Colors.setup_err_formatter_colors (); + Dune_rules.Colors.setup_err_formatter_colors (); try - match Term.Group.eval default all ~catch:false with - | `Error _ -> exit 1 - | _ -> exit 0 + match Cmd.eval_value cmd ~catch:false with + | Ok _ -> exit_and_flush 0 + | Error _ -> exit_and_flush 1 with - | Scheduler.Run.Shutdown.E Requested -> exit 0 - | Scheduler.Run.Shutdown.E (Signal _) -> exit 130 + | Scheduler.Run.Shutdown.E Requested -> exit_and_flush 0 + | Scheduler.Run.Shutdown.E (Signal _) -> exit_and_flush 130 | exn -> let exn = Exn_with_backtrace.capture exn in Dune_util.Report_error.report exn; - exit 1 + exit_and_flush 1 diff --git a/duniverse/dune_/bin/ocaml_cmd.ml b/duniverse/dune_/bin/ocaml_cmd.ml index 8457c1feb..0444e3318 100644 --- a/duniverse/dune_/bin/ocaml_cmd.ml +++ b/duniverse/dune_/bin/ocaml_cmd.ml @@ -1,12 +1,12 @@ open Import -let info = Term.info "ocaml" +let info = Cmd.info "ocaml" let group = - ( Term.Group.Group - [ in_group Utop.command - ; in_group Ocaml_merlin.command - ; in_group Ocaml_merlin.Dump_dot_merlin.command - ; in_group Top.command - ] - , info ) + Cmdliner.Cmd.group info + [ Utop.command + ; Ocaml_merlin.command + ; Ocaml_merlin.Dump_dot_merlin.command + ; Top.command + ; Top.module_command + ] diff --git a/duniverse/dune_/bin/ocaml_cmd.mli b/duniverse/dune_/bin/ocaml_cmd.mli index 8c539d338..d4c5902fc 100644 --- a/duniverse/dune_/bin/ocaml_cmd.mli +++ b/duniverse/dune_/bin/ocaml_cmd.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/duniverse/dune_/bin/ocaml_merlin.ml b/duniverse/dune_/bin/ocaml_merlin.ml index 6996b57bf..c1d0694bf 100644 --- a/duniverse/dune_/bin/ocaml_merlin.ml +++ b/duniverse/dune_/bin/ocaml_merlin.ml @@ -192,7 +192,7 @@ let man = ; Common.footer ] -let info = Term.info "ocaml-merlin" ~doc ~man +let info = Cmd.info "ocaml-merlin" ~doc ~man let term = let+ common = Common.term @@ -207,14 +207,16 @@ let term = debugging purposes only and should not be considered as a stable \ output.") in - let common = Common.set_print_directory common false in + let common = + Common.set_print_directory common false |> Common.forbid_builds + in let config = Common.init common ~log_file:No_log_file in Scheduler.go ~common ~config (fun () -> match dump_config with | Some s -> Server.dump s | None -> Server.start ()) -let command = (term, info) +let command = Cmd.v info term module Dump_dot_merlin = struct let doc = "Print Merlin configuration" @@ -230,7 +232,7 @@ module Dump_dot_merlin = struct ; Common.footer ] - let info = Term.info "dump-dot-merlin" ~doc ~man + let info = Cmd.info "dump-dot-merlin" ~doc ~man let term = let+ common = Common.term @@ -249,5 +251,5 @@ module Dump_dot_merlin = struct | Some s -> Server.dump_dot_merlin s | None -> Server.dump_dot_merlin ".") - let command = (term, info) + let command = Cmd.v info term end diff --git a/duniverse/dune_/bin/ocaml_merlin.mli b/duniverse/dune_/bin/ocaml_merlin.mli index da88812c8..15026f93d 100644 --- a/duniverse/dune_/bin/ocaml_merlin.mli +++ b/duniverse/dune_/bin/ocaml_merlin.mli @@ -1,5 +1,7 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t module Dump_dot_merlin : sig - val command : unit Cmdliner.Term.t * Cmdliner.Term.info + val command : unit Cmd.t end diff --git a/duniverse/dune_/bin/print_rules.ml b/duniverse/dune_/bin/print_rules.ml index 572945fb2..cee1e57e2 100644 --- a/duniverse/dune_/bin/print_rules.ml +++ b/duniverse/dune_/bin/print_rules.ml @@ -25,7 +25,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "rules" ~doc ~man +let info = Cmd.info "rules" ~doc ~man let print_rule_makefile ppf (rule : Dune_engine.Reflection.Rule.t) = let action = @@ -50,21 +50,18 @@ let print_rule_sexp ppf (rule : Dune_engine.Reflection.Rule.t) = let sexp_of_action action = Action.for_shell action |> Action.For_shell.encode in - let paths ps = Dune_lang.Encoder.list Dpath.encode (Path.Set.to_list ps) in - let file_targets = rule.targets.files in - if not (Path.Build.Set.is_empty rule.targets.dirs) then - User_error.raise - [ Pp.text - "Printing rules with directory targets is currently not supported" - ]; + let paths ps = + Dune_lang.Encoder.list Dpath.Build.encode (Path.Build.Set.to_list ps) + in let sexp = Dune_lang.Encoder.record (List.concat [ [ ("deps", Dep.Set.encode rule.deps) ; ( "targets" - , paths - (Path.Build.Set.to_list file_targets - |> Path.set_of_build_paths_list) ) + , Dune_lang.Encoder.record + [ ("files", paths rule.targets.files) + ; ("directories", paths rule.targets.dirs) + ] ) ] ; (match rule.context with | None -> [] @@ -140,4 +137,4 @@ let term = | None -> print stdout | Some fn -> Io.with_file_out fn ~f:print)) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/print_rules.mli b/duniverse/dune_/bin/print_rules.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/print_rules.mli +++ b/duniverse/dune_/bin/print_rules.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/printenv.ml b/duniverse/dune_/bin/printenv.ml index 2cf4a7bfb..931bf1dd7 100644 --- a/duniverse/dune_/bin/printenv.ml +++ b/duniverse/dune_/bin/printenv.ml @@ -9,7 +9,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "printenv" ~doc ~man +let info = Cmd.info "printenv" ~doc ~man let dump sctx ~dir = let open Action_builder.O in @@ -88,4 +88,4 @@ let term = (Dune_engine.Context_name.to_string name) (pp ~fields) env)) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/printenv.mli b/duniverse/dune_/bin/printenv.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/printenv.mli +++ b/duniverse/dune_/bin/printenv.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/promote.ml b/duniverse/dune_/bin/promote.ml deleted file mode 100644 index 792bc0dbe..000000000 --- a/duniverse/dune_/bin/promote.ml +++ /dev/null @@ -1,42 +0,0 @@ -open Stdune -open Import - -let command = - let doc = "Promote files from the last run" in - let man = - [ `S "DESCRIPTION" - ; `P - {|Considering all actions of the form $(b,(diff a b)) that failed - in the last run of dune, $(b,dune promote) does the following: - - If $(b,a) is present in the source tree but $(b,b) isn't, $(b,b) is - copied over to $(b,a) in the source tree. The idea behind this is that - you might use $(b,(diff file.expected file.generated)) and then call - $(b,dune promote) to promote the generated file. - |} - ; `Blocks Common.help_secs - ] - in - let term = - let+ common = Common.term - and+ files = - Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") - in - let _config = Common.init common in - Diff_promotion.promote_files_registered_in_last_run - (match files with - | [] -> All - | _ -> - let files = - List.map files ~f:(fun fn -> - Path.Source.of_string (Common.prefix_target common fn)) - in - let on_missing fn = - User_warning.emit - [ Pp.textf "Nothing to promote for %s." - (Path.Source.to_string_maybe_quoted fn) - ] - in - These (files, on_missing)) - in - (term, Term.info "promote" ~doc ~man) diff --git a/duniverse/dune_/bin/promote.mli b/duniverse/dune_/bin/promote.mli deleted file mode 100644 index 6d988967f..000000000 --- a/duniverse/dune_/bin/promote.mli +++ /dev/null @@ -1 +0,0 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info diff --git a/duniverse/dune_/bin/promotion.ml b/duniverse/dune_/bin/promotion.ml new file mode 100644 index 000000000..e3a54239d --- /dev/null +++ b/duniverse/dune_/bin/promotion.ml @@ -0,0 +1,74 @@ +open Stdune +open Import + +let files_to_promote ~common files : Diff_promotion.files_to_promote = + match files with + | [] -> All + | _ -> + let files = + List.map files ~f:(fun fn -> + Path.Source.of_string (Common.prefix_target common fn)) + in + let on_missing fn = + User_warning.emit + [ Pp.textf "Nothing to promote for %s." + (Path.Source.to_string_maybe_quoted fn) + ] + in + These (files, on_missing) + +module Apply = struct + let info = + let doc = "Promote files from the last run" in + let man = + [ `S Cmdliner.Manpage.s_description + ; `P + {|Considering all actions of the form $(b,(diff a b)) that failed + in the last run of dune, $(b,dune promotion apply) does the following: + + If $(b,a) is present in the source tree but $(b,b) isn't, $(b,b) is + copied over to $(b,a) in the source tree. The idea behind this is that + you might use $(b,(diff file.expected file.generated)) and then call + $(b,dune promote) to promote the generated file. + |} + ; `Blocks Common.help_secs + ] + in + Cmd.info ~doc ~man "apply" + + let term = + let+ common = Common.term + and+ files = + Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") + in + let _config = Common.init common in + let files_to_promote = files_to_promote ~common files in + Diff_promotion.promote_files_registered_in_last_run files_to_promote + + let command = Cmd.v info term +end + +module Diff = struct + let info = Cmd.info ~doc:"List promotions to be applied" "diff" + + let term = + let+ common = Common.term + and+ files = + Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") + in + let config = Common.init common in + let files_to_promote = files_to_promote ~common files in + Scheduler.go ~common ~config (fun () -> + Diff_promotion.display files_to_promote) + + let command = Cmd.v info term +end + +let info = + Cmd.info ~doc:"Control how changes are propagated back to source code." + "promotion" + +let group = Cmd.group info [ Apply.command; Diff.command ] + +let promote = + command_alias ~orig_name:"promotion apply" Apply.command Apply.term "promote" diff --git a/duniverse/dune_/bin/promotion.mli b/duniverse/dune_/bin/promotion.mli new file mode 100644 index 000000000..405bd44b5 --- /dev/null +++ b/duniverse/dune_/bin/promotion.mli @@ -0,0 +1,5 @@ +open Import + +val group : unit Cmd.t + +val promote : unit Cmd.t diff --git a/duniverse/dune_/bin/rpc.ml b/duniverse/dune_/bin/rpc.ml index 3e76d6399..92ef12cd0 100644 --- a/duniverse/dune_/bin/rpc.ml +++ b/duniverse/dune_/bin/rpc.ml @@ -7,6 +7,7 @@ let active_server () = | None -> User_error.raise [ Pp.text "rpc server not running" ] let client_term common f = + let common = Common.forbid_builds common in let common = Common.set_print_directory common false in let config = Common.init ~log_file:No_log_file common in Scheduler.go ~common ~config f @@ -74,7 +75,7 @@ let establish_client_session ~wait = match connection with | Ok conn -> Some conn | Error message -> - Console.print_user_message message; + if not wait then Console.print_user_message message; None) in establish_connection_or_raise ~wait once @@ -130,9 +131,9 @@ module Status = struct let info = let doc = "show active connections" in - Term.info "status" ~doc + Cmd.info "status" ~doc - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end module Build = struct @@ -163,9 +164,9 @@ module Build = struct "build a given target (requires dune to be running in passive watching \ mode)" in - Term.info "build" ~doc + Cmd.info "build" ~doc - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end module Ping = struct @@ -189,13 +190,13 @@ module Ping = struct let info = let doc = "Ping the build server running in the current directory" in - Term.info "ping" ~doc + Cmd.info "ping" ~doc let term = let+ (common : Common.t) = Common.term in client_term common exec - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end let info = @@ -206,6 +207,6 @@ let info = ; `Blocks Common.help_secs ] in - Term.info "rpc" ~doc ~man + Cmd.info "rpc" ~doc ~man -let group = (Term.Group.Group [ Status.term; Build.term; Ping.term ], info) +let group = Cmd.group info [ Status.cmd; Build.cmd; Ping.cmd ] diff --git a/duniverse/dune_/bin/rpc.mli b/duniverse/dune_/bin/rpc.mli index 0b4b6db51..6ff422917 100644 --- a/duniverse/dune_/bin/rpc.mli +++ b/duniverse/dune_/bin/rpc.mli @@ -7,4 +7,4 @@ val active_server : unit -> Dune_rpc.Where.t val client_term : Common.t -> (unit -> 'a Fiber.t) -> 'a -val group : unit Term.Group.t +val group : unit Cmdliner.Cmd.t diff --git a/duniverse/dune_/bin/shutdown.ml b/duniverse/dune_/bin/shutdown.ml index 9e9820200..3439d150e 100644 --- a/duniverse/dune_/bin/shutdown.ml +++ b/duniverse/dune_/bin/shutdown.ml @@ -22,10 +22,10 @@ let exec common = let info = let doc = "cancel and shutdown any builds in the current workspace" in - Term.info "shutdown" ~doc + Cmd.info "shutdown" ~doc let term = let+ (common : Common.t) = Common.term in Rpc.client_term common exec -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/shutdown.mli b/duniverse/dune_/bin/shutdown.mli index 8e37776fc..8c78dc310 100644 --- a/duniverse/dune_/bin/shutdown.mli +++ b/duniverse/dune_/bin/shutdown.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/subst.ml b/duniverse/dune_/bin/subst.ml index 0360b6e67..255c643f9 100644 --- a/duniverse/dune_/bin/subst.ml +++ b/duniverse/dune_/bin/subst.ml @@ -364,7 +364,7 @@ let subst () = | None -> Fiber.return () | Some kind -> Memo.run (subst { kind; root = Path.root }) -(** A string that is "3.4.1" but not expanded by [dune subst] *) +(** A string that is "3.6.1" but not expanded by [dune subst] *) let literal_version = "%%" ^ "VERSION%%" let doc = "Substitute watermarks in source files." @@ -418,7 +418,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "subst" ~doc ~man +let info = Cmd.info "subst" ~doc ~man let term = let+ () = Common.build_info @@ -431,7 +431,8 @@ let term = in Dune_engine.Clflags.debug_backtraces debug_backtraces; Path.set_root (Path.External.cwd ()); - Path.Build.set_build_dir (Path.Build.Kind.of_string Common.default_build_dir); + Path.Build.set_build_dir + (Path.Outside_build_dir.of_string Common.default_build_dir); Dune_config.init config; Log.init_disabled (); Dune_engine.Scheduler.Run.go @@ -440,4 +441,4 @@ let term = ~signal_watcher:`No) subst -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/subst.mli b/duniverse/dune_/bin/subst.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/subst.mli +++ b/duniverse/dune_/bin/subst.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/top.ml b/duniverse/dune_/bin/top.ml index 1c6b7e892..db24d9621 100644 --- a/duniverse/dune_/bin/top.ml +++ b/duniverse/dune_/bin/top.ml @@ -15,7 +15,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "top" ~doc ~man +let info = Cmd.info "top" ~doc ~man let link_deps sctx link = let open Memo.O in @@ -23,6 +23,14 @@ let link_deps sctx link = Dune_rules.Lib_flags.link_deps sctx t Dune_rules.Link_mode.Byte) >>| List.concat +let files_to_load_of_requires sctx requires = + let open Memo.O in + let* files = link_deps sctx requires in + let+ () = Memo.parallel_iter files ~f:Build_system.build_file in + List.filter files ~f:(fun p -> + let ext = Path.extension p in + ext = Ocaml.Mode.compiled_lib_ext Byte || ext = Ocaml.Cm_kind.ext Cmo) + let term = let+ common = Common.term and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR") @@ -58,19 +66,170 @@ let term = let include_paths = Dune_rules.Lib_flags.L.toplevel_include_paths requires in - let* files = link_deps sctx requires in - let+ () = - Memo.parallel_iter files ~f:(fun file -> - let+ (_ : Digest.t) = Build_system.build_file file in - ()) - in - let files_to_load = - List.filter files ~f:(fun p -> - let ext = Path.extension p in - ext = Ocaml.Mode.compiled_lib_ext Byte - || ext = Ocaml.Cm_kind.ext Cmo) - in - Dune_rules.Toplevel.print_toplevel_init_file ~include_paths - ~files_to_load)) + let+ files_to_load = files_to_load_of_requires sctx requires in + Dune_rules.Toplevel.print_toplevel_init_file + { include_paths + ; files_to_load + ; uses = [] + ; pp = None + ; ppx = None + ; code = [] + })) + +let command = Cmd.v info term + +module Module = struct + let doc = + "Print a list of toplevel directives for loading a module into the topevel." + + let man = + [ `S "DESCRIPTION" + ; `P doc + ; `P + "The module's source is evaluated in the toplevel without being sealed \ + by the mli." + ; `P + {|The output of $(b,dune toplevel-init-file) should be evaluated in a toplevel + to make the module available there.|} + ; `Blocks Common.help_secs + ] + + let info = Cmd.info "top-module" ~doc ~man + + let module_directives sctx mod_ = + let ctx = Super_context.context sctx in + let src = Path.Build.append_source ctx.build_dir mod_ in + let dir = Path.Build.parent_exn src in + let open Memo.O in + let module_name = + let name = src |> Path.Build.basename |> Filename.chop_extension in + match Dune_rules.Module_name.of_string_user_error (Loc.none, name) with + | Ok s -> s + | Error e -> raise (User_error.E e) + in + let* expander = Super_context.expander sctx ~dir in + let* top_module_info = Dune_rules.Top_module.find_module sctx mod_ in + match top_module_info with + | None -> User_error.raise [ Pp.text "no module found" ] + | Some (module_, cctx, merlin) -> + let module Compilation_context = Dune_rules.Compilation_context in + let module Obj_dir = Dune_rules.Obj_dir in + let module Top_module = Dune_rules.Top_module in + let* requires = + let* requires = Compilation_context.requires_link cctx in + Dune_rules.Resolve.read_memo requires + in + let private_obj_dir = Top_module.private_obj_dir ctx mod_ in + let include_paths = + let libs = Dune_rules.Lib_flags.L.toplevel_include_paths requires in + Path.Set.add libs (Path.build (Obj_dir.byte_dir private_obj_dir)) + in + let files_to_load () = + let+ libs, modules = + Memo.fork_and_join + (fun () -> files_to_load_of_requires sctx requires) + (fun () -> + let cmis () = + let glob = + Dune_engine.File_selector.of_glob + ~dir:(Path.build (Obj_dir.byte_dir private_obj_dir)) + (Dune_lang.Glob.of_string_exn Loc.none "*.cmi") + in + let+ (_ : Dep.Fact.Files.t) = Build_system.build_pred glob in + () + in + let cmos () = + let obj_dir = Compilation_context.obj_dir cctx in + let dep_graph = (Compilation_context.dep_graphs cctx).impl in + let* modules = + let graph = + Dune_rules.Dep_graph.top_closed_implementations dep_graph + [ module_ ] + in + let+ modules, _ = Action_builder.run graph Eager in + modules + in + let cmos = + let module Module = Dune_rules.Module in + let module Module_name = Dune_rules.Module_name in + let module_obj_name = Module.obj_name module_ in + List.filter_map modules ~f:(fun m -> + let obj_dir = + if + Module_name.Unique.equal module_obj_name + (Module.obj_name m) + then private_obj_dir + else obj_dir + in + Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml Cmo) + |> Option.map ~f:Path.build) + in + let+ (_ : Dep.Facts.t) = + Build_system.build_deps (Dep.Set.of_files cmos) + in + cmos + in + Memo.fork_and_join_unit cmis cmos) + in + libs @ modules + in + let pps () = + let module Merlin = Dune_rules.Merlin in + let pps = Merlin.pp_config merlin sctx ~expander in + let+ pps, _ = Action_builder.run pps Eager in + let pp = Dune_rules.Module_name.Per_item.get pps module_name in + match pp with + | None -> (None, None) + | Some pp_flags -> ( + let args = Merlin.Processed.pp_args pp_flags in + match Merlin.Processed.pp_kind pp_flags with + | Pp -> (Some args, None) + | Ppx -> (None, Some args)) + in + let+ (pp, ppx), files_to_load = Memo.fork_and_join pps files_to_load in + let code = + let modules = Dune_rules.Compilation_context.modules cctx in + let opens_ = + Dune_rules.Module_compilation.open_modules modules module_ + in + List.map opens_ ~f:(fun name -> + sprintf "open %s" (Dune_rules.Module_name.to_string name)) + in + { Dune_rules.Toplevel.files_to_load + ; pp + ; ppx + ; include_paths + ; uses = [] + ; code + } + + let term = + let+ common = Common.term + and+ module_path = + Arg.(value & pos 0 string "" & Arg.info [] ~docv:"MODULE") + and+ ctx_name = + Common.context_arg ~doc:{|Select context where to build/run utop.|} + in + let config = Common.init common in + Scheduler.go ~common ~config (fun () -> + let open Fiber.O in + let* setup = Import.Main.setup () in + Build_system.run_exn (fun () -> + let open Memo.O in + let* setup = setup in + let sctx = + Dune_engine.Context_name.Map.find setup.scontexts ctx_name + |> Option.value_exn + in + let+ directives = + let module_path = + let root = Common.root common in + Path.Source.relative Path.Source.root + (root.reach_from_root_prefix ^ module_path) + in + module_directives sctx module_path + in + Dune_rules.Toplevel.print_toplevel_init_file directives)) +end -let command = (term, info) +let module_command = Cmd.v Module.info Module.term diff --git a/duniverse/dune_/bin/top.mli b/duniverse/dune_/bin/top.mli index 6d988967f..744aa2ecf 100644 --- a/duniverse/dune_/bin/top.mli +++ b/duniverse/dune_/bin/top.mli @@ -1 +1,5 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t + +val module_command : unit Cmd.t diff --git a/duniverse/dune_/bin/upgrade.ml b/duniverse/dune_/bin/upgrade.ml index ff49b00cf..c990f78cc 100644 --- a/duniverse/dune_/bin/upgrade.ml +++ b/duniverse/dune_/bin/upgrade.ml @@ -11,11 +11,11 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "upgrade" ~doc ~man +let info = Cmd.info "upgrade" ~doc ~man let term = let+ common = Common.term in let config = Common.init common in Scheduler.go ~common ~config (fun () -> Dune_upgrader.upgrade ()) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/upgrade.mli b/duniverse/dune_/bin/upgrade.mli index 6d988967f..8c78dc310 100644 --- a/duniverse/dune_/bin/upgrade.mli +++ b/duniverse/dune_/bin/upgrade.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/duniverse/dune_/bin/utop.ml b/duniverse/dune_/bin/utop.ml index 050a7e05c..2ac13a13a 100644 --- a/duniverse/dune_/bin/utop.ml +++ b/duniverse/dune_/bin/utop.ml @@ -11,7 +11,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "utop" ~doc ~man +let info = Cmd.info "utop" ~doc ~man let term = let+ common = Common.term @@ -43,7 +43,7 @@ let term = (String.maybe_quoted dir) ] | true -> - let+ (_ : Digest.t) = Build_system.build_file utop_target in + let+ () = Build_system.build_file utop_target in let sctx = Import.Main.find_scontext_exn setup ~name:ctx_name in (sctx, Path.to_string utop_target))) in @@ -51,4 +51,4 @@ let term = restore_cwd_and_execve common utop_path (utop_path :: args) (Super_context.context_env sctx) -let command = (term, info) +let command = Cmd.v info term diff --git a/duniverse/dune_/bin/utop.mli b/duniverse/dune_/bin/utop.mli index 6d988967f..54b771881 100644 --- a/duniverse/dune_/bin/utop.mli +++ b/duniverse/dune_/bin/utop.mli @@ -1 +1 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +val command : unit Cmdliner.Cmd.t diff --git a/duniverse/dune_/bootstrap.ml b/duniverse/dune_/boot/bootstrap.ml similarity index 98% rename from duniverse/dune_/bootstrap.ml rename to duniverse/dune_/boot/bootstrap.ml index 3dc74a61c..d9b7f9242 100644 --- a/duniverse/dune_/bootstrap.ml +++ b/duniverse/dune_/boot/bootstrap.ml @@ -6,7 +6,7 @@ open Printf let min_supported_natively = (4, 08, 0) -let verbose, keep_generated_files, debug = +let _verbose, keep_generated_files, _debug = let anon s = raise (Arg.Bad (sprintf "don't know what to do with %s\n" s)) in let verbose = ref false in let keep_generated_files = ref false in diff --git a/duniverse/dune_/configure.ml b/duniverse/dune_/boot/configure.ml similarity index 100% rename from duniverse/dune_/configure.ml rename to duniverse/dune_/boot/configure.ml diff --git a/duniverse/dune_/boot/dune b/duniverse/dune_/boot/dune index 3e3b39be3..d1176939c 100644 --- a/duniverse/dune_/boot/dune +++ b/duniverse/dune_/boot/dune @@ -9,8 +9,13 @@ (executable (name duneboot) + (modules :standard \ configure bootstrap) (libraries unix)) +(executable + (name bootstrap) + (modules bootstrap)) + ;; For unused value warnings. We don't write a plain empty ;; duneboot.mli to simplify ../bootstrap.ml diff --git a/duniverse/dune_/boot/duneboot.ml b/duniverse/dune_/boot/duneboot.ml index 4140f0c48..5f7e4e7f0 100644 --- a/duniverse/dune_/boot/duneboot.ml +++ b/duniverse/dune_/boot/duneboot.ml @@ -990,7 +990,7 @@ let sort_files dependencies ~main = let common_build_args name ~external_includes ~external_libraries = List.concat - [ [ "-o"; Filename.concat ".." (name ^ ".exe"); "-g" ] + [ [ "-o"; Filename.concat "../_boot" (name ^ ".exe"); "-g" ] ; (match Config.mode with | Byte -> [ Config.output_complete_obj_arg ] | Native -> []) @@ -1081,15 +1081,18 @@ let build_with_single_command ~ocaml_config:_ ~dependencies ~c_files ~link_flags let rec rm_rf fn = match Unix.lstat fn with | { st_kind = S_DIR; _ } -> - List.iter (readdir fn) ~f:rm_rf; + clear fn; Unix.rmdir fn | _ -> Unix.unlink fn | exception Unix.Unix_error (ENOENT, _, _) -> () +and clear dir = List.iter (readdir dir) ~f:rm_rf + (** {2 Bootstrap process} *) let main () = - rm_rf build_dir; - Unix.mkdir build_dir 0o777; + (try clear build_dir with Sys_error _ -> ()); + (try Unix.mkdir build_dir 0o777 + with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); Config.ocaml_config () >>= fun ocaml_config -> assemble_libraries task >>= fun libraries -> let c_files = diff --git a/duniverse/dune_/boot/libs.ml b/duniverse/dune_/boot/libs.ml index 523bbb0db..806d9d4e2 100644 --- a/duniverse/dune_/boot/libs.ml +++ b/duniverse/dune_/boot/libs.ml @@ -14,7 +14,10 @@ let local_libraries = ; ("vendor/incremental-cycles/src", Some "Incremental_cycles", false, None) ; ("src/dag", Some "Dag", false, None) ; ("src/fiber", Some "Fiber", false, None) + ; ("src/dune_console", Some "Dune_console", false, None) ; ("src/memo", Some "Memo", false, None) + ; ("src/dune_metrics", Some "Dune_metrics", false, None) + ; ("src/dune_digest", Some "Dune_digest", false, None) ; ("src/dune_sexp", Some "Dune_sexp", false, None) ; ("src/ocaml-config", Some "Ocaml_config", false, None) ; ("src/ocaml", Some "Ocaml", false, None) diff --git a/duniverse/dune_/chrome-trace.opam b/duniverse/dune_/chrome-trace.opam index 2417416bd..8cec8a9ef 100644 --- a/duniverse/dune_/chrome-trace.opam +++ b/duniverse/dune_/chrome-trace.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Chrome trace event generation library" @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "odoc" {with-doc} ] diff --git a/duniverse/dune_/configure b/duniverse/dune_/configure index eb093a553..efc50aa3f 100755 --- a/duniverse/dune_/configure +++ b/duniverse/dune_/configure @@ -1,2 +1,2 @@ #!/bin/sh -exec ocaml configure.ml "$@" +exec ocaml boot/configure.ml "$@" diff --git a/duniverse/dune_/default.nix b/duniverse/dune_/default.nix deleted file mode 100644 index 04ceadd2b..000000000 --- a/duniverse/dune_/default.nix +++ /dev/null @@ -1,32 +0,0 @@ -# standalone derivation, for nix-build, nix-shell, etc -{ pkgs ? import { }, opam2nix ? import ./nix/opam2nix.nix -, shell ? false }: - -let opam = pkgs.callPackage ./nix { inherit opam2nix; }; - -in (pkgs.stdenv.mkDerivation rec { - name = "dune"; - - src = if shell then - null - else - with builtins; - filterSource (path: _: - !elem (baseNameOf path) [ - ".git" - "result" - "_build" - "nix" - "_boot" - "_opam" - ]) ./.; - - buildInputs = [ opam.ocaml opam.opam.ocamlfind pkgs.gnumake ]; - - buildFlags = "release"; - - dontAddPrefix = true; - - installFlags = - [ "PREFIX=${placeholder "out"}" "LIBDIR=$(OCAMLFIND_DESTDIR)" ]; -}) // { resolve = opam.resolve; } diff --git a/duniverse/dune_/doc/concepts.rst b/duniverse/dune_/doc/concepts.rst index 7ee09776f..0e47c0f94 100644 --- a/duniverse/dune_/doc/concepts.rst +++ b/duniverse/dune_/doc/concepts.rst @@ -15,8 +15,8 @@ Typically, any given project will define a single scope. Libraries and executables that aren't meant to be installed will be visible inside this scope only. -Because scopes are exclusive, if you wish to include your current project's -dependencies in your workspace, you can copy them in a ``vendor`` directory, +Because scopes are exclusive, if you wish to include your current project's +dependencies in your workspace, you can copy them in a ``vendor`` directory, or any name of your choice. Dune will look for them there rather than in the installed world, and there will be no overlap between the various scopes. @@ -51,11 +51,11 @@ future so that one may write: (flags (if (>= %{ocaml_version} 4.06) ...)) -This restriction will allow you to add this feature without introducing +This restriction will allow you to add this feature without introducing breaking changes. If you want to write a list where the first element doesn't start with ``-``, you can simply quote it: ``("x" y z)``. -Most fields using the ordered set language also support :ref:`variables`. +Most fields using the ordered set language also support :ref:`variables`. Variables are expanded after the set language is interpreted. .. _blang: @@ -80,8 +80,8 @@ After an expression is evaluated, it must be exactly the string ``true`` or ``false`` to be considered as a Boolean. Any other value will be treated as an error. -Below is a simple example of a condition expressing that the build -has a flambda compiler, with the help of variable expansion, and is +Below is a simple example of a condition expressing that the build +has a Flambda compiler, with the help of variable expansion, and is targeting OSX: .. code:: lisp @@ -141,7 +141,7 @@ Dune supports the following variables: the value of ``workspace_root`` isn't constant and depends on whether your project is vendored or not. - ``CC`` is the C compiler command line (list made of the compiler - name followed by its flags) that will be used to compile foreign code. + name followed by its flags) that will be used to compile foreign code. For more details about its content, please see :ref:`this section `. - ``CXX`` is the C++ compiler command line being used in the current build context. @@ -186,6 +186,7 @@ Dune supports the following variables: variable ````, or ```` if it does not exist. For example, ``%{env:BIN=/usr/bin}``. Available since Dune 1.4.0. +- There are some Coq-specific variables detailed in :ref:`coq-variables`. In addition, ``(action ...)`` fields support the following special variables: @@ -206,11 +207,11 @@ In addition, ``(action ...)`` fields support the following special variables: ...)`` or ``(system ...)``. - ``bin-available:`` expands to ``true`` or ``false``, depending on whether ```` is available or not. -- ``lib::`` expands to the file's installation path +- ``lib::`` expands to the file's installation path ```` in the library ````. If ```` is available in the current workspace, the local file will be used, otherwise the one from the installed world will be used. -- ``lib-private::`` expands to the file's build path +- ``lib-private::`` expands to the file's build path ```` in the library ````. Both public and private library names are allowed as long as they refer to libraries within the same project. - ``libexec::`` is the same as ``lib:...``, except @@ -366,7 +367,7 @@ preferred to ones that are part of the installed world. Alternative Dependencies ------------------------ -Sometimes, one doesn't want to depend on a specific library but rather +Sometimes, one doesn't want to depend on a specific library but rather on whatever is already installed, e.g., to use a different backend, depending on the target. @@ -610,7 +611,7 @@ Dependencies in ``dune`` files can be specified using one of the following: - ``none``: the action must run in the build directory - ``preserve_file_kind``: the action needs the files it reads to look like normal files (so Dune won't use symlinks for sandboxing) -- ``(include )`` read the s-expression in ```` and intepret it as +- ``(include )`` read the s-expression in ```` and interpret it as additional dependencies. The s-expression is expected to be a list of the same constructs enumerated here. @@ -661,6 +662,9 @@ Dune supports globbing files in a single directory via ``(glob_files - anything after the last ``/``, or everything if the glob contains no ``/``, is interpreted using the glob syntax +Absolute paths are permitted in the ``(glob_files ...)`` term only. It's an error to pass +an absolute path (i.e., a path beginning with a ``/``) to ``(glob_files_rec ...)```. + The glob syntax is interpreted as follows: - ``\`` matches exactly ````, even if it's a special character @@ -675,6 +679,46 @@ The glob syntax is interpreted as follows: - ``{,,...,}`` matches any string that is matched by one of ````, ````, etc. +.. list-table:: Glob syntax examples + :header-rows: 1 + + * - Syntax + - Files matched + - Files not matched + * - ``x`` + - ``x`` + - ``y`` + * - ``\*`` + - ``*`` + - ``x`` + * - ``file*.txt`` + - ``file1.txt``, ``file2.txt`` + - ``f.txt`` + * - ``*.txt`` + - ``f.txt`` + - ``.hidden.txt`` + * - ``a**`` + - ``aml`` + - ``a.ml`` + * - ``**`` + - ``a/b``, ``a.b`` + - (none) + * - ``a?.txt`` + - ``a1.txt``, ``a2.txt`` + - ``b1.txt``, ``a10.txt`` + * - ``f[xyz].txt`` + - ``fx.txt``, ``fy.txt``, ``fz.txt`` + - ``f2.txt``, ``f.txt`` + * - ``f[!xyz].txt`` + - ``f2.txt``, ``fa.txt`` + - ``fx.txt``, ``f.txt`` + * - ``a.{ml,mli}`` + - ``a.ml``, ``a.mli`` + - ``a.txt``, ``b.ml`` + * - ``../a.{ml,mli}`` + - ``../a.ml``, ``../a.mli`` + - ``a.ml`` + .. _ocaml-flags: OCaml Flags @@ -784,9 +828,9 @@ the destination file. More precisely, it inserts the following line: # 1 "" -Most languages recognize such lines and update their current location +Most languages recognize such lines and update their current location to report errors in the original file rather than the -copy. This is important beause the copy exists only under the ``_build`` +copy. This is important because the copy exists only under the ``_build`` directory, and in order for editors to jump to errors when parsing the output of the build system, errors must point to files that exist in the source tree. In the beta versions of Dune, ``copy#`` was @@ -849,7 +893,7 @@ Sandboxing The user actions that run external commands (``run``, ``bash``, ``system``) are opaque to Dune, so Dune has to rely on manual specification of dependencies and targets. One problem with manual specification is that it's error-prone. -It's often hard to know in advance what files the command will read, +It's often hard to know in advance what files the command will read, and knowing a correct set of dependencies is very important for build reproducibility and incremental build correctness. @@ -1033,7 +1077,8 @@ repository. You can use the following workflow to update your test: - Update the code of your test. - Run ``dune runtest``. The diff action will fail and a diff will be printed. -- Check the diff to make sure it's what you expect. +- Check the diff to make sure it's what you expect. This diff can be displayed + again by running ``dune promotion diff``. - Run ``dune promote``. This will copy the generated ``data.out`` file to ``data.expected`` directly in the source tree. @@ -1151,12 +1196,12 @@ Executables Similarly to libraries, to attach an executable to a package simply add a ``public_name`` field to your ``executable`` stanza or a -``public_names`` field for ``executables`` stanzas. Designate this -name to match the available executables through the installed ``PATH`` -(i.e., the name users must type in their shell to execute +``public_names`` field for ``executables`` stanzas. Designate this +name to match the available executables through the installed ``PATH`` +(i.e., the name users must type in their shell to execute the program), because Dune cannot guess an executable's relevant package -from its public name. It's also necessary to add a ``package`` field -unless the project contains a single package, in which case the executable +from its public name. It's also necessary to add a ``package`` field +unless the project contains a single package, in which case the executable will be attached to this package. For instance: @@ -1186,12 +1231,13 @@ an :ref:`install` stanza. .. _foreign-sources-and-archives: -Foreign Sources and Archives -============================ +Foreign Sources, Archives and Objects +===================================== Dune provides basic support for including foreign source files as well as archives of foreign object files into OCaml projects via the -``foreign_stubs`` and ``foreign_archives`` fields. +``foreign_stubs`` and ``foreign_archives`` fields. Individual object +files can also be included via the ``extra_objects`` field. .. _foreign-stubs: @@ -1239,16 +1285,59 @@ Here is a complete list of supported subfields: - ``include_dirs`` are tracked as dependencies and passed to the compiler via the ``-I`` flag. You can use :ref:`variables` in this field and refer to a library source directory using the ``(lib library-name)`` syntax. - For example, ``(include_dirs dir1 (lib lib1) (lib lib2) dir2)`` specifies + Additionally, the syntax ``(include filename)`` can be used to specify a file + containing additional arguments to ``(include_dirs ...)``. The named file can + either contain a single path to be added to this list of include directories, + or an S-expression listing additional ``(include_dirs ...)`` arguments (the + ``(lib ...)`` and ``(include ...)`` syntax is also supported in files included + in this way). + For example, ``(include_dirs dir1 (lib lib1) (lib lib2) (include inc1) dir2)`` specifies the directory ``dir1``, the source directories of ``lib1`` and ``lib2``, - and the directory ``dir2``, in this order. The contents of included - directories are tracked recursively, e.g., if you use ``(include_dir dir)`` - and have headers ``dir/base.h`` and ``dir/lib/lib.h``, they both will - be tracked as dependencies. -- ``extra_deps`` specifies any other dependencies that should be tracked. - This is useful when dealing with ``#include`` statements that escape into - a parent directory like ``#include "../a.h"``. + the list of directories contained in the file ``inc1``, + and the directory ``dir2``, in this order. + Some examples of possible contents of the file ``inc1`` are: + + - ``dir3`` which would add ``dir3`` to the list of include directories + - ``((lib lib3) dir4 (include inc2))`` which would add the source directory of + the library ``lib3``, the directory ``dir4``, and the result of recursively + including the contents of the file ``inc2``. + The contents of included directories are tracked recursively, e.g., if you + use ``(include_dir dir)`` and have headers ``dir/base.h`` and + ``dir/lib/lib.h``, they both will be tracked as dependencies. + - ``extra_deps`` specifies any other dependencies that should be tracked. + This is useful when dealing with ``#include`` statements that escape into + a parent directory like ``#include "../a.h"``. + + +Mode-Dependent Stubs +^^^^^^^^^^^^^^^^^^^^ + +Since Dune 3.5, it is possible to use different foreign stubs when building in +`native` or `byte` mode. This feature needs to be activated by adding ``(using +mode_specific_stubs 0.1)`` in the ``dune-project`` file. + +Then it is allowed to use the ``mode`` field when describing ``foreign_stubs``. +If the same stub is defined twice, Dune will automatically chose the correct one. +This allows the use of different sets of flags or even different source files +from which the stubs are built. +.. code:: scheme + + (executable + (name main) + (modes native byte_complete) + (foreign_stubs + (language c) + (mode byte) + (names c_stubs)) + (foreign_stubs + (language c) + (mode native) + (flags :standard -DNATIVE_CODE) ; A flag specific to native builds + (names c_stubs))) ; This could be the name of an implementation + ; specific to native builds + +Note that, as of version ``0.1`` of this extension, this mechanism does not work for ``foreign_archives``. .. _foreign-archives: @@ -1299,6 +1388,39 @@ Foreign archives are particularly useful when embedding a library written in a foreign language and/or built with another build system. See :ref:`foreign-sandboxing` for more details. + +.. _extra-objects: + +Extra Objects +------------- + +It's possible to specify native object files to be packaged with OCaml +libraries or linked into OCaml executables. Do this by using the +``extra_objects`` field of the ``library`` or ``executable`` stanzas. +For example: + +.. code:: lisp + + (executable + (public_name main) + (extra_objects foo bar)) + + (rule + (targets foo.o bar.o) + (deps foo.c bar.c) + (action (run ocamlopt %{deps}))) + +This example builds an executable which is linked against a pair of native +object files, ``foo.o`` and ``bar.o``. The ``extra_objects`` field takes a +list of object names, which correspond to the object file names with their path +and extension omitted. + +In this example, the sources corresponding to the objects (``foo.c`` and +``bar.c``) are assumed to be present in the same directory as the OCaml source +code, and a custom ``rule`` is used to compile the C source code into object +files using ``ocamlopt``. This is not necessary; one can instead compile foreign +object files manually and place them next to the OCaml source code. + .. _flags-flow: Flags diff --git a/duniverse/dune_/doc/conf.py b/duniverse/dune_/doc/conf.py index 4eca0d22e..5194e61c4 100644 --- a/duniverse/dune_/doc/conf.py +++ b/duniverse/dune_/doc/conf.py @@ -46,7 +46,7 @@ master_doc = 'index' # General information about the project. -project = 'dune' +project = 'Dune' copyright = u'2017, Jérémie Dimino' author = u'Jérémie Dimino' @@ -55,7 +55,7 @@ # # This is also used if you do content translation via gettext catalogs. # Usually you set "language" from the command line for these cases. -language = None +language = "en" # List of patterns, relative to source directory, that match files and # directories to ignore when looking for source files. @@ -118,7 +118,7 @@ # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ - (master_doc, 'dune.tex', 'dune Documentation', + (master_doc, 'dune.tex', 'Dune Documentation', u'Jérémie Dimino', 'manual'), ] @@ -128,7 +128,7 @@ # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ - (master_doc, 'dune', 'dune Documentation', + (master_doc, 'dune', 'Dune Documentation', [author], 1) ] @@ -139,7 +139,7 @@ # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ - (master_doc, 'dune', 'dune Documentation', + (master_doc, 'dune', 'Dune Documentation', author, 'dune', 'One line description of project.', 'Miscellaneous'), ] diff --git a/duniverse/dune_/doc/coq.rst b/duniverse/dune_/doc/coq.rst index c6e99d342..9e8126fb1 100644 --- a/duniverse/dune_/doc/coq.rst +++ b/duniverse/dune_/doc/coq.rst @@ -19,6 +19,9 @@ names share a common prefix. The module names reflect the directory hierarchy. A *Coq plugin* is an OCaml :ref:`library` that Coq can load dynamically at runtime. Plugins are typically linked with the Coq OCaml API. +Since Coq 8.16, plugins need to be "public" libraries in Dune's terminology, +that is to say, they must declare a ``public_name`` field. + A *Coq project* is an informal term for a :ref:`dune-project` containing a collection of Coq theories and plugins. @@ -30,7 +33,7 @@ version` in the :ref:`dune-project` file. For example, adding .. code:: scheme - (using coq 0.4) + (using coq 0.7) to a :ref:`dune-project` file enables using the ``coq.theory`` stanza and other ``coq.*`` stanzas. See the :ref:`Dune Coq language` section for more @@ -53,6 +56,7 @@ stanza: (modules ) (plugins ) (flags ) + (stdlib ) (mode ) (theories )) @@ -83,24 +87,32 @@ The semantics of the fields are: the theory, similar to its OCaml counterpart. Modules are specified in Coq notation. That is to say, ``A/b.v`` is written ``A.b`` in this field. -- If ``package`` is present, Dune generates install rules for the ``.vo`` files - of the theory. ``pkg_name`` must be a valid package name. +- If the ``package`` field is present, Dune generates install rules for the + ``.vo`` files of the theory. ``pkg_name`` must be a valid package name. Note that :ref:`Coq lang 1.0` will use the Coq legacy install setup, where all packages share a common root namespace and install directory, ``lib/coq/user-contrib/``, as is customary in the Make-based Coq package ecosystem. - For compatibility, Dune also installs, under the ``user-contrib`` prefix, the - ``.cmxs`` files that appear in ````. + For compatibility, Dune also installs, under the ``user-contrib`` + prefix, the ``.cmxs`` files that appear in ````. This + will be dropped in future versions. - ```` are passed to ``coqc`` as command-line options. ``:standard`` is taken from the value set in the ``(coq (flags ))`` field in ``env`` profile. See :ref:`dune-env` for more information. -- The path to the installed locations of the ```` is passed to - ``coqdep`` and ``coqc`` using Coq's ``-I`` flag. This allows a Coq theory to - depend on OCaml plugins. +- ```` can either be ``yes`` or ``no``, currently defaulting to + ``yes``. When set to ``no``, Coq's standard library won't be visible from this + theory, which means the ``Coq`` prefix won't be bound, and + ``Coq.Init.Prelude`` won't be imported by default. + +- If the ``plugins`` field is present, Dune will pass the corresponding flags to + Coq so that ``coqdep`` and ``coqc`` can find the corresponding OCaml libraries + declared in ````. This allows a Coq theory to depend on OCaml + plugins. Starting with ``(lang coq 0.6)``, ```` must contain + public library names. - Your Coq theory can depend on other theories by specifying them in the ```` field. Dune then passes to Coq the corresponding flags for @@ -112,13 +124,13 @@ The semantics of the fields are: Doing so can be as simple as placing a Coq project within the scope of another. This process is termed *composition*. See the :ref:`interproject - composition` example. - + composition` example. + Interproject composition allows for a fine granularity of dependencies. In practice, this means that Dune will only build the parts of a dependency that are needed. This means that building a project depending on another will not trigger a rebuild of the whole of the latter. - + Interproject composition has been available since :ref:`Coq lang 0.4`. @@ -208,12 +220,14 @@ Limitations .. _limitation-mlpack: - A ``foo.mlpack`` file must the present in directories of locally defined - plugins for things to work. This is a limitation of ``coqdep``. + plugins for things to work. ``coqdep`` will recognize a plugin by looking at + the existence of an ``.mlpack`` file, as it cannot access (for now) Dune's + library database. This is a limitation of ``coqdep``. See the :ref:`example + plugin` or the `this template + `_. -- Building a theory and a plugin in the same directory can lead to issues with - the presence of the META file. We recommend the following: - - A separate directory for the files of each :ref:`coq-theory` stanza defined. - - A separate directory for source files of a plugin. + This limitation will be lifted soon, as newer ``coqdep`` can use + findlib's database to check the existence of OCaml libraries. .. _coq-lang: @@ -225,7 +239,7 @@ file: .. code:: scheme - (using coq 0.4) + (using coq 0.7) The supported Coq language versions (not the version of Coq) are: @@ -235,6 +249,8 @@ The supported Coq language versions (not the version of Coq) are: - ``0.3``: Support for ``(mode native)`` requires Coq >= 8.10 (and Dune >= 2.9 for Coq >= 8.14). - ``0.4``: Support for interproject composition of theories. +- ``0.5``: ``(libraries ...)`` field deprecated in favor of ``(plugins ...)`` field. +- ``0.6``: Support for ``(stdlib no)``. .. _coq-lang-1.0: @@ -267,7 +283,7 @@ process by using the ``coq.extraction`` stanza: - ``(extracted_modules )`` is an exhaustive list of OCaml modules extracted. -- ```` are ``flags``, ``theories``, and ``plugins``. All of +- ```` are ``flags``, ``stdlib``, ``theories``, and ``plugins``. All of these fields have the same meaning as in the ``coq.theory`` stanza. The extracted sources can then be used in ``executable`` or ``library`` stanzas @@ -288,21 +304,15 @@ coq.pp Authors of Coq plugins often need to write ``.mlg`` files to extend the Coq grammar. Such files are preprocessed with the ``coqpp`` binary. To help plugin -authors avoid writing boilerplate, we provide a ``(coqpp ...)`` stanza: +authors avoid writing boilerplate, we provide a ``(coq.pp ...)`` stanza: .. code:: scheme - (coq.pp (modules )) + (coq.pp + (modules )) -which, for each ``g_mod`` in ````, is equivalent to the following -rule: - -.. code:: lisp - - (rule - (targets g_mod.ml) - (deps (:mlg-file g_mod.mlg)) - (action (run coqpp %{mlg-file}))) +This will run the ``coqpp`` binary on all the ``.mlg`` files in +````. .. _examples: @@ -321,8 +331,8 @@ Let us start with a simple project. First, make sure we have a .. code:: scheme - (lang dune 3.4) - (using coq 0.4) + (lang dune 3.6) + (using coq 0.7) Next we need a :ref:`dune` file with a :ref:`coq-theory` stanza: @@ -509,6 +519,110 @@ documentation targets, we can use the ``@doc`` alias as in ``dune build @doc``. If we want to build all the LaTeX documentation then we use the ``@doc-latex`` alias instead. +.. _example plugin: + +Coq Plugin Project +~~~~~~~~~~~~~~~~~~ + +Let us build a simple Coq plugin to demonstrate how Dune can handle this setup. + +.. code:: + + . + ├── dune-project + ├── src + │ ├── dune + │ ├── hello_world.ml + │ ├── my_plugin.mlpack + │ └── syntax.mlg + └── theories + ├── dune + └── UsingMyPlugin.v + +Our :ref:`dune-project` will need to have a package for the plugin to sit in, +otherwise Coq will not be able to find it. + +.. code:: scheme + + (lang dune 3.6) + (using coq 0.7) + + (package + (name my-coq-plugin) + (synopsis "My Coq Plugin") + (depends coq-core)) + +Now we have two directories, ``src/`` and ``theories/`` each with their own +:ref:`dune file`. Let us begin with the plugin :ref:`dune +file`: + +.. code:: scheme + + (library + (name my_plugin) + (public_name my-coq-plugin.plugin) + (synopsis "My Coq Plugin") + (flags :standard -rectypes -w -27) + (libraries coq-core.vernac)) + + (coq.pp + (modules syntax)) + +Here we define a library using the :ref:`library` stanza. Importantly, we +declared which external libraries we rely on and gave the library a +``public_name``, as starting with Coq 8.16, Coq will identify plugins using +their corresponding findlib public name. + +The :ref:`coq-pp` stanza allows ``src/syntax.mlg`` to be preprocessed, which for +reference looks like: + +.. code:: ocaml + + DECLARE PLUGIN "my-coq-plugin.plugin" + + VERNAC COMMAND EXTEND CallToC CLASSIFIED AS QUERY + | [ "Hello" ] -> { Feedback.msg_notice Pp.(str Hello_world.hello_world) } + END + +Together with ``hello_world.ml``: + +.. code:: ocaml + + let hello_world = "hello world!" + +They make up the plugin. There is one more important ingredient here and that is +the ``my_plugin.mlpack`` file, needed to signal ``coqdep`` the existence of +``my_plugin`` in this directory. An empty file suffices. See :ref:`this note on +.mlpack files`. + +The file for ``theories/`` is a standard :ref:`coq-theory` stanza with an +included ``libraries`` field allowing Dune to see ``my-coq-plugin.plugin`` as a +dependency. + +.. code:: scheme + + (coq.theory + (name MyPlugin) + (package my-coq-plugin) + (plugins my-coq-plugin.plugin)) + +Finally, our .v file will look something like this: + +.. code:: coq + + (* For Coq < 8.16 *) + Declare ML Module "my_plugin". + + (* For Coq = 8.16 *) + Declare ML Module "my_plugin:my-coq-plugin.plugin". + + (* At some point Coq 8.17 or 8.18 will transition to the syntax below, check Coq's manual *) + Declare ML Module "my-coq-plugin.plugin". + + Hello. + +Running ``dune build`` will build everything correctly. + .. _running-coq-top: Running a Coq Toplevel @@ -543,3 +657,25 @@ Limitations * When new dependencies are added to a file (via a Coq ``Require`` vernacular command), it is in principle required to save the file and restart to Coq toplevel process. + +.. _coq-variables: + +Coq-Specific Variables +---------------------- + +There are some special variables that can be used to access data about the Coq +configuration. These are: + +- ``%{coq:version}`` the version of Coq. +- ``%{coq:version.major}`` the major version of Coq (e.g., ``8.15.2`` gives + ``8``). +- ``%{coq:version.minor}`` the minor version of Coq (e.g., ``8.15.2`` gives + ``15``). +- ``%{coq:version.suffix}`` the suffix version of Coq (e.g., ``8.15.2`` gives + ``.2`` and ``8.15+rc1`` gives ``+rc1``). +- ``%{coq:ocaml-version}`` the version of OCaml used to compile Coq. +- ``%{coq:coqlib}`` the output of ``COQLIB`` from ``coqc -config``. +- ``%{coq:coq_native_compiler_default}`` the output of + ``COQ_NATIVE_COMPILER_DEFAULT`` from ``coqc -config``. + +See :ref:`variables` for more information on variables supported by Dune. diff --git a/duniverse/dune_/doc/dev/rpc-versioning.md b/duniverse/dune_/doc/dev/rpc-versioning.md index a3eb8d676..79b752b7b 100644 --- a/duniverse/dune_/doc/dev/rpc-versioning.md +++ b/duniverse/dune_/doc/dev/rpc-versioning.md @@ -139,7 +139,7 @@ not currently checked. Next is a version of the initial handshake protocol to be used. This takes the form of a single `int`. In the future, if the initial -negotation protocol changes, this value can be adjusted and checked to +negotiation protocol changes, this value can be adjusted and checked to account for this. ### Error handling diff --git a/duniverse/dune_/doc/dune-files.rst b/duniverse/dune_/doc/dune-files.rst index 0a850de77..15fbee866 100644 --- a/duniverse/dune_/doc/dune-files.rst +++ b/duniverse/dune_/doc/dune-files.rst @@ -14,7 +14,7 @@ contents of all configuration files read by Dune and looks like: .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) Additionally, they can contains the following stanzas. @@ -31,18 +31,18 @@ adding a line in the ``dune-project`` file, such as: (using ) -Here, ```` is the name of the plugin that -defines this stanza and ```` describes the configuration language's version. -Note that this version has nothing to do with the version of the -associated tool or library. In particular, adding a ``using`` stanza will not -result in a build dependency in the generated ``.opam`` file. See -:ref:`generate_opam_files `. +Here, ```` is the name of the plugin that defines this stanza and +```` describes the configuration language's version. Note that this +version has nothing to do with the version of the associated tool or library. In +particular, adding a ``using`` stanza will not result in a build dependency in +the generated ``.opam`` file. See :ref:`generate_opam_files +`. name ---- -Sets the name of the project. It's used by :ref:`dune subst ` -and error messages. +Sets the name of the project. It's used by :ref:`dune subst ` and +error messages. .. code:: scheme @@ -60,7 +60,7 @@ Sets the version of the project: cram ---- -Enable or disable cram-style tests for the project. See :ref:`cram-tests` for +Enable or disable Cram-style tests for the project. See :ref:`cram-tests` for details. .. code:: scheme @@ -74,28 +74,26 @@ Where status is either ``enable`` or ``disable``. implicit_transitive_deps ------------------------ -By default, Dune allows transitive dependencies of dependencies used -when compiling OCaml; however, this setting can be controlled per -project: +By default, Dune allows transitive dependencies of dependencies used when +compiling OCaml; however, this setting can be controlled per project: .. code:: scheme (implicit_transitive_deps ) -When set to ``false``, all dependencies directly used by a library -or an executable must be added in the ``libraries`` field. We -recommend users experiment with this mode and report any problems. +When set to ``false``, all dependencies directly used by a library or an +executable must be added in the ``libraries`` field. We recommend users +experiment with this mode and report any problems. Note that you must use ``threads.posix`` instead of ``threads`` when using this -mode. This isn't an important limitation, as ``threads.vm`` are deprecated -anyways. +mode. This isn't an important limitation, as ``threads.vm`` is deprecated +anyway. -In some situations, it's desirable to selectively preserve the -behavior of transitive dependencies' availability to users of a -library. For example, if we define a library ``foo_more``, that -extends ``foo``, we might want ``foo_more`` users to immediately -have ``foo`` available as well. To do this, we must define the -dependency on ``foo`` as re-exported: +In some situations, it can be desirable to selectively preserve the behavior of +transitive dependencies' availability a library's users. For example, if we +define a library ``foo_more`` that extends ``foo``, we might want ``foo_more`` +users to immediately have ``foo`` available as well. To do this, we must define +the dependency on ``foo`` as re-exported: .. code:: scheme @@ -108,8 +106,8 @@ dependency on ``foo`` as re-exported: wrapped_executables ------------------- -Executables are made of compilation units whose names may collide with libraries' -compilation units. To avoid this possibility, Dune prefixes these +Executables are made of compilation units whose names may collide with +libraries' compilation units. To avoid this possibility, Dune prefixes these compilation unit names with ``Dune__exe__``. This is entirely transparent to users except when such executables are debugged. In which case, the mangled names will be visible in the debugger. @@ -143,8 +141,8 @@ interface files for executables and tests that don't already have them: (executables_implicit_empty_intf true) -This option is enabled by default starting with Dune lang 3.0, so -empty interface files are no longer needed. +This option is enabled by default starting with Dune lang 3.0, so empty +interface files are no longer needed. .. _explicit-js-mode: @@ -154,7 +152,7 @@ explicit_js_mode Traditionally, JavaScript targets were defined for every bytecode executable. This wasn't very precise and didn't interact well with the ``@all`` alias. -You can opt out of this behaviour by using: +You can opt out of this behavior by using: .. code:: scheme @@ -165,14 +163,14 @@ When this mode is enabled, an explicit ``js`` mode needs to be added to the compilation. Explicit JS targets declared like this will be attached to the ``@all`` alias. -Starting with Dune 2.0, this behaviour is the default, and there is no way to +Starting with Dune 2.0, this behavior is the default, and there is no way to disable it. expand_aliases_in_sandbox ------------------------- -When a sandboxed action depends on a alias, copy the expansion of the -alias inside the sandbox. For instance, in the following example: +When a sandboxed action depends on an alias, copy the expansion of the alias +inside the sandbox. For instance, in the following example: .. code:: scheme @@ -183,20 +181,19 @@ alias inside the sandbox. For instance, in the following example: (cram (deps (alias foo))) -File `x` will be visible inside the cram test if and only if this -option is enabled. This option is a better default in general, however -it currently causes cram tests to run noticeably slower. So it is -disabled by default until the performance issue with cram test is -fixed. +File `x` will be visible inside the Cram test if and only if this option is +enabled. This option is a better default in general; however, it currently +causes Cram tests to run noticeably slower. So it is disabled by default until +the performance issue with Cram test is fixed. .. _dialect: dialect ------- -A dialect is an alternative frontend to OCaml (such as ReasonML). It's -described by a pair of file extensions, one corresponding to interfaces and one -to implementations. +A dialect is an alternative frontend to OCaml (such as ReasonML). It's described +by a pair of file extensions, one corresponding to interfaces and one to +implementations. A dialect can use the standard OCaml syntax, or it can specify an action to convert from a custom syntax to a binary OCaml abstract syntax tree. @@ -221,39 +218,39 @@ way to specify custom file extensions for OCaml code. ```` is the name of the dialect being defined. It must be unique in a given project. -For interfaces and implementations, ``(extension )`` specifies the file extension used for this dialect. -The extension string must not contain any dots +For interfaces and implementations, ``(extension )`` specifies the file +extension used for this dialect. The extension string must not contain any dots and be unique in a given project (so that a given extension can be mapped back to a corresponding dialect). ```` are: -- Run ``(preprocess )`` to produce a valid OCaml - abstract syntax tree. It's expected to read the file given in the variable - named ``input-file`` and output a *binary* abstract syntax tree on its - standard output. See :ref:`preprocessing-actions` for more information. +- Run ``(preprocess )`` to produce a valid OCaml abstract syntax tree. + It's expected to read the file given in the variable named ``input-file`` and + output a *binary* abstract syntax tree on its standard output. See + :ref:`preprocessing-actions` for more information. - If the field isn't present, it's assumed that the corresponding source code - is already valid OCaml code and can be passed to the OCaml compiler as-is. + If the field isn't present, it's assumed that the corresponding source code is + already valid OCaml code and can be passed to the OCaml compiler as-is. -- Run ``(format )`` to format source code for this - dialect. The action is expected to read the file given in the variable named - ``input-file`` and output the formatted source code on its standard - output. For more information. See :ref:`formatting-main` for more information. +- Run ``(format )`` to format source code for this dialect. The action + is expected to read the file given in the variable named ``input-file`` and + output the formatted source code on its standard output. For more information. + See :ref:`formatting-main` for more information. - If the field is not present, then ``(preprocess )`` is also not present - (so that the dialect consists of valid OCaml code). In that case, the - dialect will be formatted as any other OCaml code by default. Otherwise no special - formatting will be done. + If the field is not present, then ``(preprocess )`` is also not + present (so that the dialect consists of valid OCaml code). In that case, the + dialect will be formatted as any other OCaml code by default. Otherwise no + special formatting will be done. .. _formatting: formatting ---------- -Starting in Dune 2.0, :ref:`formatting-main` is automatically enabled. This can be -controlled by using +Starting in Dune 2.0, :ref:`formatting-main` is automatically enabled. This can +be controlled by using .. code:: scheme @@ -292,8 +289,8 @@ generate_opam_files ------------------- Dune is able to use metadata specified in the ``dune-project`` file to generate -``.opam`` files (see :ref:`opam-generation`). To enable this integration, add the -following field to the ``dune-project`` file: +``.opam`` files (see :ref:`opam-generation`). To enable this integration, add +the following field to the ``dune-project`` file: .. code:: scheme @@ -339,16 +336,16 @@ With these fields, every time one calls Dune to execute some rules (either via ``dune build``, ``dune runtest``, or something else), the opam files get generated. -Some or all of these fields may be overridden for each package of the project, see -:ref:`package`. +Some or all of these fields may be overridden for each package of the project, +see :ref:`package`. .. _package: package ------- -Package specific information is specified in the ``(package )`` stanza. -It contains the following fields: +Package specific information is specified in the ``(package )`` +stanza. It contains the following fields: - ``(name )`` is the name of the package. This must be specified. @@ -366,21 +363,22 @@ It contains the following fields: - ``(deprecated_package_names )`` is a list of names that can be used with the :ref:`deprecated-library-name` stanza to migrate legacy libraries - from other build systems that don't follow Dune's convention of prefixing - the library's public name with the package name. + from other build systems that don't follow Dune's convention of prefixing the + library's public name with the package name. - ``(license )``, ``(authors )``, ``(maintainers )``, ``(source )``, ``(bug_reports )``, ``(homepage - )``, and ``(documentation )`` are the same (and take precedence over) - the corresponding global fields. These fields have been available since Dune 2.0. + )``, and ``(documentation )`` are the same (and take precedence + over) the corresponding global fields. These fields have been available since + Dune 2.0. - ``(sites (
) ...)`` define a site named ```` in the section ``
``. -Adding libraries to different packages is done via the ``public_name`` field. See -:ref:`library` section for details. +Adding libraries to different packages is done via the ``public_name`` field. +See :ref:`library` section for details. -The list of dependencies ```` is modeled after opam's own +The list of dependencies ```` is modelled after opam's own language. The syntax is a list of the following elements: .. code:: @@ -432,8 +430,8 @@ accept_alternative_dune_file_name Since Dune 3.0, it's possible to use the alternative filename ``dune-file`` instead of ``dune`` to specify the build. This may be useful to avoid problems -with ``dune`` files that have the executable permission in a directory -in the ``PATH``, which can unwittingly happen in Windows. +with ``dune`` files that have the executable permission in a directory in the +``PATH``, which can unwittingly happen in Windows. The feature must be enabled explicitly by adding the following field to ``dune-project``: @@ -482,8 +480,8 @@ in the future. library ------- -The ``library`` stanza must be used to describe OCaml libraries. The -format of library stanzas is as follows: +The ``library`` stanza must be used to describe OCaml libraries. The format of +library stanzas is as follows: .. code:: scheme @@ -491,89 +489,87 @@ format of library stanzas is as follows: (name ) ) -```` is the real name of the library. It determines the -names of the archive files generated for the library as well as the -module name under which the library will be available, unless -``(wrapped false)`` is used (see below). It must be a valid OCaml -module name, but it doesn't need to start with an uppercase letter. +```` is the real name of the library. It determines the names of +the archive files generated for the library as well as the module name under +which the library will be available, unless ``(wrapped false)`` is used (see +below). It must be a valid OCaml module name, but it doesn't need to start with +an uppercase letter. -For instance, the modules of a library named ``foo`` will be -available as ``Foo.XXX``, outside of ``foo`` itself; however, it is -allowed to write an explicit ``Foo`` module, which will -be the library interface. You are free to expose only the -modules you want. +For instance, the modules of a library named ``foo`` will be available as +``Foo.XXX``, outside of ``foo`` itself; however, it is allowed to write an +explicit ``Foo`` module, which will be the library interface. You are free to +expose only the modules you want. -Please note: by default, libraries and other things that consume -OCaml/Reason modules only consume modules from the directory where the -stanza appear. In order to declare a multi-directory library, you need -to use the :ref:`include_subdirs` stanza. +Please note: by default, libraries and other things that consume OCaml/Reason +modules only consume modules from the directory where the stanza appear. In +order to declare a multi-directory library, you need to use the +:ref:`include_subdirs` stanza. ```` are: -- ``(public_name )`` - the name under which the library can be - referred as a dependency when it's not part of the current workspace, - i.e., when it's installed. Without a ``(public_name ...)`` field, the library - won't be installed by Dune. The public name must start with the package - name it's part of and optionally followed by a dot, then anything else you - want. The package name must also be one of the packages that Dune knows about, - as determined by the :ref:`opam-files` +- ``(public_name )`` - the name under which the library can be referred as + a dependency when it's not part of the current workspace, i.e., when it's + installed. Without a ``(public_name ...)`` field, the library won't be + installed by Dune. The public name must start with the package name it's part + of and optionally followed by a dot, then anything else you want. The package + name must also be one of the packages that Dune knows about, as determined by + the :ref:`opam-files` -- ``(package )`` installs a private library under the specified package. - Such a library is now usable by public libraries defined in the same project. - The Findlib name for this library will be ``.__private__.``; - however, the library's interface will be hidden from consumers outside the - project. +- ``(package )`` installs a private library under the specified + package. Such a library is now usable by public libraries defined in the same + project. The Findlib name for this library will be + ``.__private__.``; however, the library's interface will be + hidden from consumers outside the project. - ``(synopsis )`` should give a one-line description of the library. This is used by tools that list installed libraries - ``(modules )`` specifies what modules are part of the library. By default, Dune will use all the ``.ml/.re`` files in the same directory as the - ``dune`` file. This includes ones present in the file system as well - as ones generated by user rules. You can restrict this list by using a - ``(modules )`` field. ```` uses the :ref:`ordered-set-language`, - where elements are module names and don't need to start with an uppercase - letter. For instance, to exclude module ``Foo``, use ``(modules (:standard \ - foo))`` + ``dune`` file. This includes ones present in the file system as well as ones + generated by user rules. You can restrict this list by using a ``(modules + )`` field. ```` uses the :ref:`ordered-set-language`, where + elements are module names and don't need to start with an uppercase letter. + For instance, to exclude module ``Foo``, use ``(modules (:standard \ foo))`` - ``(libraries )`` specifies the library's dependencies. See the section about :ref:`library-deps` for more details. - ``(wrapped )`` specifies whether the library modules should be - available only through the top-level library module, or if they should all be exposed - at the top level. The default is ``true``, and it's highly recommended to keep - it this way. Because OCaml top-level modules must all be unique when linking - an executables, polluting the top-level namespace will make your library - unusable with other libraries if there is a module name clash. This option is - only intended for libraries that manually prefix all their modules by the - library name and to ease porting of existing projects to Dune. + available only through the top-level library module, or if they should all be + exposed at the top level. The default is ``true``, and it's highly recommended + to keep it this way. Because OCaml top-level modules must all be unique when + linking an executables, polluting the top-level namespace will make your + library unusable with other libraries if there is a module name clash. This + option is only intended for libraries that manually prefix all their modules + by the library name and to ease porting of existing projects to Dune. - ``(wrapped (transition ))`` is the same as ``(wrapped true)``, except - it will also generate unwrapped (not prefixed by the library name) - modules to preserve compatibility. This is useful for libraries that would - like to transition from ``(wrapped false)`` to ``(wrapped true)`` without - breaking compatibility for users. The deprecation notices for the unwrapped - modules will include ````. + it will also generate unwrapped (not prefixed by the library name) modules to + preserve compatibility. This is useful for libraries that would like to + transition from ``(wrapped false)`` to ``(wrapped true)`` without breaking + compatibility for users. The deprecation notices for the unwrapped modules + will include ````. - ``(preprocess )`` specifies how to preprocess files when - needed. The default is ``no_preprocessing``, and other options are described in the - :ref:`preprocessing-spec` section. + needed. The default is ``no_preprocessing``, and other options are described + in the :ref:`preprocessing-spec` section. -- ``(preprocessor_deps ())`` specifies extra preprocessor dependencies - preprocessor, i.e., if the preprocessor reads a generated file. The - specification of dependencies is described in the :ref:`deps-field` +- ``(preprocessor_deps ())`` specifies extra preprocessor + dependencies preprocessor, i.e., if the preprocessor reads a generated file. + The specification of dependencies is described in the :ref:`deps-field` section. -- ``(optional)`` - if present, it indicates that the library should only be built - and installed if all the dependencies are available, either in the workspace - or in the installed world. Use this to provide extra features without - adding hard dependencies to your project +- ``(optional)`` - if present, it indicates that the library should only be + built and installed if all the dependencies are available, either in the + workspace or in the installed world. Use this to provide extra features + without adding hard dependencies to your project - ``(foreign_stubs )`` specifies foreign source files, e.g., - C or C++ stubs, to be compiled and packaged together with the library. See - the section :ref:`foreign-sources-and-archives` for more details. This field - replaces the now-deleted fields ``c_names``, ``c_flags``, ``cxx_names``, - and ``cxx_flags``. + C or C++ stubs, to be compiled and packaged together with the library. See the + section :ref:`foreign-sources-and-archives` for more details. This field + replaces the now-deleted fields ``c_names``, ``c_flags``, ``cxx_names``, and + ``cxx_flags``. - ``(foreign_archives )`` specifies archives of foreign object files to be packaged with the library. See the section @@ -584,29 +580,29 @@ to use the :ref:`include_subdirs` stanza. that must be installed, you must list them in this field, without the ``.h`` extension. -- ``(modes )`` is for modes which should be built by default. The - most common use for this feature is to disable native compilation - when writing libraries for the OCaml toplevel. The following modes - are available: ``byte``, ``native``, and ``best``. ``best`` is - ``native`` or ``byte`` when native compilation isn't available. - -- ``(no_dynlink)`` disables dynamic linking of the library. This is for - advanced use only. By default, you shouldn't set this option. - -- ``(kind )`` sets the type of library. The default is ``normal``, but other - available choices are ``ppx_rewriter`` and ``ppx_deriver``. They must be set - when the library is intended to be used as a ppx rewriter or a ``[@@deriving - ...]`` plugin. The reason ``ppx_rewriter`` and ``ppx_deriver`` are split - is historical, and hopefully we won't need two options soon. Both ppx kinds - support an optional field: ``(cookies )``, where ```` is a - list of pairs ``( )`` with ```` being the cookie name and - ```` a string that supports :ref:`variables` evaluated - by each preprocessor invocation (note: libraries that share - cookies with the same name should agree on their expanded value). - -- ``(ppx_runtime_libraries ())`` is for when the library is a ``ppx - rewriter`` or a ``[@@deriving ...]`` plugin, and has runtime dependencies. You - need to specify these runtime dependencies here. +- ``(modes )`` is for modes which should be built by default. The most + common use for this feature is to disable native compilation when writing + libraries for the OCaml toplevel. The following modes are available: ``byte``, + ``native`` and ``best``. ``best`` is ``native`` or ``byte`` when native + compilation isn't available. + +- ``(no_dynlink)`` disables dynamic linking of the library. This is for advanced + use only. By default, you shouldn't set this option. + +- ``(kind )`` sets the type of library. The default is ``normal``, but + other available choices are ``ppx_rewriter`` and ``ppx_deriver``. They must be + set when the library is intended to be used as a PPX rewriter or a + ``[@@deriving ...]`` plugin. The reason ``ppx_rewriter`` and ``ppx_deriver`` + are split is historical, and hopefully we won't need two options soon. Both + PPX kinds support an optional field: ``(cookies )``, where + ```` is a list of pairs ``( )`` with ```` being + the cookie name and ```` a string that supports :ref:`variables` + evaluated by each preprocessor invocation (note: libraries that share cookies + with the same name should agree on their expanded value). + +- ``(ppx_runtime_libraries ())`` is for when the library is a + ``ppx rewriter`` or a ``[@@deriving ...]`` plugin, and has runtime + dependencies. You need to specify these runtime dependencies here. - ``(virtual_deps ()``. Sometimes opam packages enable a specific feature only if another package is installed. For instance, the case of @@ -620,30 +616,27 @@ to use the :ref:`include_subdirs` stanza. - For ``flags``, ``ocamlc_flags``, and ``ocamlopt_flags``, see the section about :ref:`ocaml-flags` -- ``(library_flags ())`` is a list of flags passed to - ``ocamlc`` and ``ocamlopt`` when building the library archive files. You can - use this to specify ``-linkall``, for instance. ```` is a list of - strings supporting :ref:`variables`. +- ``(library_flags ())`` is a list of flags passed to ``ocamlc`` and + ``ocamlopt`` when building the library archive files. You can use this to + specify ``-linkall``, for instance. ```` is a list of strings + supporting :ref:`variables`. - ``(c_library_flags )`` specifies the flags passed to the C compiler when constructing the library archive file for the C stubs. ```` uses - the :ref:`ordered-set-language` and supports ``(:include ...)`` forms. When you - write bindings for a C library named ``bar``, you should typically write - ``-lbar`` here, or whatever flags are necessary to link against this - library. - -- ``(modules_without_implementation )`` specifies a list of - modules that have only a ``.mli`` or ``.rei`` but no ``.ml`` or - ``.re`` file. Such modules are usually referred as *mli only - modules*. They are not officially supported by the OCaml compiler, - however they are commonly used. Such modules must only define - types. Since it isn't reasonably possible for Dune to check - this is the case, Dune requires the user to explicitly list - such modules to avoid surprises. Note that the - ``modules_without_implementation`` field isn't merged in ``modules``, which - represents the total set of modules in a library. If a directory has more - than one stanza, and thus a ``modules`` field must be specified, ```` - still needs to be added in ``modules``. + the :ref:`ordered-set-language` and supports ``(:include ...)`` forms. When + you write bindings for a C library named ``bar``, you should typically write + ``-lbar`` here, or whatever flags are necessary to link against this library. + +- ``(modules_without_implementation )`` specifies a list of modules + that have only a ``.mli`` or ``.rei`` but no ``.ml`` or ``.re`` file. Such + modules are usually referred as *mli only modules*. They are not officially + supported by the OCaml compiler; however, they are commonly used. Such modules + must only define types. Since it isn't reasonably possible for Dune to check + this is the case, Dune requires the user to explicitly list such modules to + avoid surprises. Note that the ``modules_without_implementation`` field isn't + merged in ``modules``, which represents the total set of modules in a library. + If a directory has more than one stanza, and thus a ``modules`` field must be + specified, ```` still needs to be added in ``modules``. - ``(private_modules )`` specifies a list of modules that will be marked as private. Private modules are inaccessible from outside the libraries @@ -652,50 +645,49 @@ to use the :ref:`include_subdirs` stanza. directory has more than one stanza and thus a ``modules`` field must be specified, ```` still need to be added in ``modules``. -- ``(allow_overlapping_dependencies)`` allows external dependencies to - overlap with libraries that are present in the workspace +- ``(allow_overlapping_dependencies)`` allows external dependencies to overlap + with libraries that are present in the workspace. -- ``(enabled_if )`` conditionally disables - a library. A disabled library cannot be built and will not be - installed. The condition is specified using the :ref:`blang`, and the - field allows for the ``%{os_type}`` variable, which is expanded to - the type of OS being targeted by the current build. Its value is - the same as the value of the ``os_type`` parameter in the output of - ``ocamlc -config`` +- ``(enabled_if )`` conditionally disables a library. A + disabled library cannot be built and will not be installed. The condition is + specified using the :ref:`blang`, and the field allows for the ``%{os_type}`` + variable, which is expanded to the type of OS being targeted by the current + build. Its value is the same as the value of the ``os_type`` parameter in the + output of ``ocamlc -config``. - ``(inline_tests)`` enables inline tests for this library. They can be configured through options using ``(inline_tests )``. See :ref:`inline_tests` for a reference of corresponding options. -- ``(root_module )`` this field instructs dune to generate a module that +- ``(root_module )`` this field instructs Dune to generate a module that will contain module aliases for every library specified in dependencies. This is useful whenever a library is shadowed by a local module. The library may then still be accessible via this root module -- ``(ctypes )`` instructs dune to use ctypes stubgen to process +- ``(ctypes )`` instructs Dune to use ctypes stubgen to process your type and function descriptions for binding system libraries, vendored libraries, or other foreign code. See :ref:`ctypes-stubgen` for a full - reference. This field is available since the 3.0 version of the dune language. + reference. This field is available since the 3.0 version of the Dune language. - ``(empty_module_interface_if_absent)`` causes the generation of empty interfaces for every module that does not have an interface file already. Useful when modules are used solely for their side-effects. This field is - available since the 3.0 version of the dune language. + available since the 3.0 version of the Dune language. -Note that when binding C libraries, dune doesn't provide special support for -tools such as ``pkg-config``, however it integrates easily with -:ref:`configurator` by -using ``(c_flags (:include ...))`` and ``(c_library_flags (:include ...))``. +Note that when binding C libraries, Dune doesn't provide special support for +tools such as ``pkg-config``; however, it integrates easily with +:ref:`configurator` by using ``(c_flags (:include ...))`` and ``(c_library_flags +(:include ...))``. .. _foreign_library: foreign_library --------------- -The ``foreign_library`` stanza describes archives of separately compiled -foreign object files that can be packaged with an OCaml library or linked -into an OCaml executable. See :ref:`foreign-sources-and-archives` for -further details and examples. +The ``foreign_library`` stanza describes archives of separately compiled foreign +object files that can be packaged with an OCaml library or linked into an OCaml +executable. See :ref:`foreign-sources-and-archives` for further details and +examples. .. _jsoo-field: @@ -707,14 +699,14 @@ options using ``(js_of_ocaml ())``. ```` are all optional: -- ``(flags )`` to specify flags passed to ``js_of_ocaml compile``. This field - supports ``(:include ...)`` forms +- ``(flags )`` to specify flags passed to ``js_of_ocaml compile``. This + field supports ``(:include ...)`` forms -- ``(build_runtime_flags )`` to specify flags passed to ``js_of_ocaml build-runtime``. This field - supports ``(:include ...)`` forms +- ``(build_runtime_flags )`` to specify flags passed to ``js_of_ocaml + build-runtime``. This field supports ``(:include ...)`` forms -- ``(link_flags )`` to specify flags passed to ``js_of_ocaml link``. This field - supports ``(:include ...)`` forms +- ``(link_flags )`` to specify flags passed to ``js_of_ocaml link``. This + field supports ``(:include ...)`` forms - ``(javascript_files ())`` to specify ``js_of_ocaml`` JavaScript runtime files. @@ -732,9 +724,8 @@ See :ref:`jsoo` for more information. deprecated_library_name ----------------------- -The ``deprecated_library_name`` stanza enables redirecting an old -deprecated name after a library has been renamed. It's syntax is as -follows: +The ``deprecated_library_name`` stanza enables redirecting an old deprecated +name after a library has been renamed. It's syntax is as follows: .. code:: scheme @@ -742,25 +733,25 @@ follows: (old_public_name ) (new_public_name )) -When a developer uses the old public name in a list of library -dependencies, it will be transparently replaced by the new name. Note -that it's not necessary for the new name to exist at definition time, -as it is only resolved at the point where the old name is used. +When a developer uses the old public name in a list of library dependencies, it +will be transparently replaced by the new name. Note that it's not necessary for +the new name to exist at definition time, as it is only resolved at the point +where the old name is used. The ``old_public_name`` can also be one of the names declared in the ``deprecated_package_names`` field of the package declaration in the ``dune-project`` file. In this case, the "old" library is understood to be a library whose name is not prefixed by the package name. Such a library cannot be -defined in Dune, but other build systems allow it. This feature is meant to -help migration from those systems. +defined in Dune, but other build systems allow it. This feature is meant to help +migration from those systems. .. _executable: executable ---------- -The ``executable`` stanza must be used to describe an executable. The -format of executable stanzas is as follows: +The ``executable`` stanza must be used to describe an executable. The format of +executable stanzas is as follows: .. code:: scheme @@ -769,33 +760,31 @@ format of executable stanzas is as follows: ) ```` is a module name that contains the executable's main entry point. -There can be additional modules in the current directory; -you only need to specify the entry point. Given an ``executable`` -stanza with ``(name )``, Dune will know how to build -``.exe``. If requested, it will also know how to build -``.bc`` and ``.bc.js`` (Dune 2.0 and up also need specific +There can be additional modules in the current directory; you only need to +specify the entry point. Given an ``executable`` stanza with ``(name )``, +Dune will know how to build ``.exe``. If requested, it will also know how +to build ``.bc`` and ``.bc.js`` (Dune 2.0 and up also need specific configuration (see the ``modes`` optional field below). -``.exe`` is a native code executable, ``.bc`` is a bytecode executable -which requires ``ocamlrun`` to run, and ``.bc.js`` is a JavaScript -generated using ``js_of_ocaml``. +``.exe`` is a native code executable, ``.bc`` is a bytecode +executable which requires ``ocamlrun`` to run, and ``.bc.js`` is a +JavaScript generated using ``js_of_ocaml``. -Please note: in case native compilation is not available, ``.exe`` -will be a custom bytecode executable, in the sense of -``ocamlc -custom``. This means it's a native executable that embeds -the ``ocamlrun`` virtual machine as well as the bytecode, so you -can always rely on ``.exe`` being available. Moreover, it is -usually preferable to use ``.exe`` in custom rules or when -calling the executable by hand because running a bytecode -executable often requires loading shared libraries that are locally -built. This requires additional setup, such as setting specific -environment variables, which Dune doesn't do at the moment. +Please note: in case native compilation is not available, ``.exe`` will be +a custom bytecode executable, in the sense of ``ocamlc -custom``. This means +it's a native executable that embeds the ``ocamlrun`` virtual machine as well as +the bytecode, so you can always rely on ``.exe`` being available. +Moreover, it is usually preferable to use ``.exe`` in custom rules or when +calling the executable by hand because running a bytecode executable often +requires loading shared libraries that are locally built. This requires +additional setup, such as setting specific environment variables, which Dune +doesn't do at the moment. -Native compilation isn't available when there is no ``ocamlopt`` -binary at the same place as ``ocamlc`` was found. +Native compilation isn't available when there is no ``ocamlopt`` binary at the +same place as ``ocamlc`` was found. -Executables can also be linked as object or shared object files. See -`linking modes`_ for more information. +Executables can also be linked as object or shared object files. See `linking +modes`_ for more information. Starting from Dune 3.0, it's possible to automatically generate empty interface files for executables. See `executables_implicit_empty_intf`_. @@ -817,34 +806,34 @@ files for executables. See `executables_implicit_empty_intf`_. - ``(package )`` if there is a ``(public_name ...)`` field, this specifies the package the executables are part of it. -- ``(libraries )`` specifies the library dependencies. - See the section about :ref:`library-deps` for more details. +- ``(libraries )`` specifies the library dependencies. See + the section about :ref:`library-deps` for more details. - ``(link_flags )`` specifies additional flags to pass to the linker. This field supports ``(:include ...)`` forms. - ``(link_deps ())`` specifies the dependencies used only by the - linker, i.e., when using a version script. See the :ref:`deps-field` - section for more details. + linker, i.e., when using a version script. See the :ref:`deps-field` section + for more details. -- ``(modules )`` specifies which modules in the current directory - Dune should consider when building this executable. Modules not listed - here will be ignored and cannot be used inside the executable described by - the current stanza. It is interpreted in the same way as the ``(modules - ...)`` field of `library`_. +- ``(modules )`` specifies which modules in the current directory Dune + should consider when building this executable. Modules not listed here will be + ignored and cannot be used inside the executable described by the current + stanza. It is interpreted in the same way as the ``(modules ...)`` field of + `library`_. - ``(root_module )`` specifies a ``root_module`` that collects all listed dependencies in ``libraries``. See the documentation for ``root_module`` in the library stanza. -- ``(modes ())`` sets the `linking modes`_. The default is - ``(exe)``. Before Dune 2.0, it formerly was ``(byte exe)``. +- ``(modes ())`` sets the `linking modes`_. The default is ``(exe)``. + Before Dune 2.0, it formerly was ``(byte exe)``. - ``(preprocess )`` is the same as the ``(preprocess ...)`` field of `library`_. -- ``(preprocessor_deps ())`` is the same as the ``(preprocessor_deps ...)`` field of `library`_. +- ``(preprocessor_deps ())`` is the same as the - ``js_of_ocaml``: See the section about :ref:`jsoo-field` @@ -854,32 +843,33 @@ files for executables. See `executables_implicit_empty_intf`_. - ``(modules_without_implementation )`` is the same as the corresponding field of `library`_. -- ``(allow_overlapping_dependencies)`` is the same as the - corresponding field of `library`_. +- ``(allow_overlapping_dependencies)`` is the same as the corresponding field of + `library`_. - ``(optional)`` is the same as the corresponding field of `library`_. -- ``(enabled_if )`` is the same as the corresponding field of `library`_. +- ``(enabled_if )`` is the same as the corresponding field of + `library`_. -- ``(promote )`` allows promoting the linked executables to - the source tree. The options are the same as for the :ref:`rule - promote mode `. Adding ``(promote (until-clean))`` to an - ``executable`` stanza will cause Dune to copy the ``.exe`` files to - the source tree and use ``dune clean`` to delete them. +- ``(promote )`` allows promoting the linked executables to the source + tree. The options are the same as for the :ref:`rule promote mode `. + Adding ``(promote (until-clean))`` to an ``executable`` stanza will cause Dune + to copy the ``.exe`` files to the source tree and use ``dune clean`` to delete + them. -- ``(foreign_stubs )`` specifies foreign source - files, e.g., C or C++ stubs, to be linked into the executable. See the - section :ref:`foreign-sources-and-archives` for more details. +- ``(foreign_stubs )`` specifies foreign source files, e.g., + C or C++ stubs, to be linked into the executable. See the section + :ref:`foreign-sources-and-archives` for more details. -- ``(foreign_archives )`` specifies archives of - foreign object files to be linked into the executable. See the section +- ``(foreign_archives )`` specifies archives of foreign + object files to be linked into the executable. See the section :ref:`foreign-archives` for more details. -- ``(forbidden_libraries )`` ensures that the given - libraries are not linked in the resulting executable. If they end up - being pulled in, either through a direct or transitive dependency, - Dune fails with an error message explaining how the library was - pulled in. This field has been available since Dune 2.0. +- ``(forbidden_libraries )`` ensures that the given libraries are not + linked in the resulting executable. If they end up being pulled in, either + through a direct or transitive dependency, Dune fails with an error message + explaining how the library was pulled in. This field has been available since + Dune 2.0. - ``(embed_in_plugin_libraries )`` specifies a list of libraries to link statically when using the ``plugin`` linking mode. By default, no @@ -887,10 +877,10 @@ files for executables. See `executables_implicit_empty_intf`_. flag if some of the libraries listed here are not referenced from any of the plugin modules. -- ``(ctypes )`` instructs dune to use ctypes stubgen to process +- ``(ctypes )`` instructs Dune to use ctypes stubgen to process your type and function descriptions for binding system libraries, vendored libraries, or other foreign code. See :ref:`ctypes-stubgen` for a full - reference. This field is available since the 3.0 version of the dune language. + reference. This field is available since the 3.0 version of the Dune language. - ``(empty_module_interface_if_absent)`` causes the generation of empty interfaces for every module that does not have an interface file already. @@ -900,29 +890,29 @@ files for executables. See `executables_implicit_empty_intf`_. Linking Modes ~~~~~~~~~~~~~ -The ``modes`` field allows selecting which linking modes will be used -to link executables. Each mode is a pair ``( -)``, where ```` describes whether the -bytecode or native code backend of the OCaml compiler should be used -and ```` describes what kind of file should be produced. +The ``modes`` field allows selecting which linking modes will be used to link +executables. Each mode is a pair ``( )``, where +```` describes whether the bytecode or native code backend of +the OCaml compiler should be used and ```` describes what kind of +file should be produced. -```` must be ``byte``, ``native``, or ``best``, where -``best`` is ``native`` with a fallback to bytecode when native -compilation isn't available. +```` must be ``byte``, ``native``, or ``best``, where ``best`` +is ``native`` with a fallback to bytecode when native compilation isn't +available. ```` is one of: - ``c`` for producing OCaml bytecode embedded in a C file - ``exe`` for normal executables -- ``object`` for producing static object files that can be manually - linked into C applications -- ``shared_object`` for producing object files that can be dynamically - loaded into an application. This mode can be used to write a plugin - in OCaml for a non-OCaml application. +- ``object`` for producing static object files that can be manually linked into + C applications +- ``shared_object`` for producing object files that can be dynamically loaded + into an application. This mode can be used to write a plugin in OCaml for a + non-OCaml application. - ``js`` for producing JavaScript from bytecode executables, see :ref:`explicit-js-mode`. -- ``plugin`` for producing a plugin (``.cmxs`` if native or ``.cma`` - if bytecode). +- ``plugin`` for producing a plugin (``.cmxs`` if native or ``.cma`` if + bytecode). For instance the following ``executables`` stanza will produce bytecode executables and native shared objects: @@ -953,74 +943,72 @@ For instance, the following ``modes`` fields are all equivalent: (best object) (best shared_object))) -Lastly, use the special mode ``byte_complete`` for -building a bytecode executable as a native self-contained -executable, i.e., an executable that doesn't require the ``ocamlrun`` -program to run and doesn't require the C stubs to be installed as -shared object files. +Lastly, use the special mode ``byte_complete`` for building a bytecode +executable as a native self-contained executable, i.e., an executable that +doesn't require the ``ocamlrun`` program to run and doesn't require the C stubs +to be installed as shared object files. The extensions for the various linking modes are chosen as follows: -=========================== ================= -linking mode extensions ---------------------------- ----------------- -byte .bc -native/best .exe -byte_complete .bc.exe -(byte object) .bc%{ext_obj} -(native/best object) .exe%{ext_obj} -(byte shared_object) .bc%{ext_dll} -(native/best shared_object) %{ext_dll} -c .bc.c -js .bc.js -(best plugin) %{ext_plugin} -(byte plugin) .cma -(native plugin) .cmxs -=========================== ================= - -``%{ext_obj}`` and ``%{ext_dll}`` are the extensions for object -and shared object files. Their value depends on the OS. For instance, -on Unix ``%{ext_obj}`` is usually ``.o`` and ``%{ext_dll}`` is usually -``.so``, while on Windows ``%{ext_obj}`` is ``.obj`` and ``%{ext_dll}`` -is ``.dll``. - -Up to version 3.0 of the Dune language, when ``byte`` is specified but -none of ``native``, ``exe``, or ``byte_complete`` are specified, Dune -implicitly adds a linking mode that's the same as ``byte_complete``, -but it uses the extension ``.exe``. ``.bc`` files require addition al -files at runtime that aren't currently tracked by Dune, so don't -run ``.bc`` files during the build. Run the ``.bc.exe`` or -``.exe`` ones instead, as these are self-contained. - -Lastly, note that ``.bc`` executables cannot contain C stubs. If your -executable contains C stubs you may want to use ``(modes exe)``. +.. =========================== ================= +.. linking mode extensions +.. --------------------------- ----------------- +.. byte .bc +.. native/best .exe +.. byte_complete .bc.exe +.. (byte object) .bc%{ext_obj} +.. (native/best object) .exe%{ext_obj} +.. (byte shared_object) .bc%{ext_dll} +.. (native/best shared_object) %{ext_dll} +.. c .bc.c +.. js .bc.js +.. (best plugin) %{ext_plugin} +.. (byte plugin) .cma +.. (native plugin) .cmxs +.. =========================== ================= + +``%{ext_obj}`` and ``%{ext_dll}`` are the extensions for object and shared +object files. Their value depends on the OS. For instance, on Unix +``%{ext_obj}`` is usually ``.o`` and ``%{ext_dll}`` is usually ``.so``, while on +Windows ``%{ext_obj}`` is ``.obj`` and ``%{ext_dll}`` is ``.dll``. + +Up to version 3.0 of the Dune language, when ``byte`` is specified but none of +``native``, ``exe``, or ``byte_complete`` are specified, Dune implicitly adds a +linking mode that's the same as ``byte_complete``, but it uses the extension +``.exe``. ``.bc`` files require additional files at runtime that aren't +currently tracked by Dune, so they don't run ``.bc`` files during the build. Run +the ``.bc.exe`` or ``.exe`` ones instead, as these are self-contained. + +Lastly, note that ``.bc`` executables cannot contain C stubs. If your executable +contains C stubs you may want to use ``(modes exe)``. executables ----------- There is a very subtle difference in the naming of these stanzas. One is -``executables``, plural, and the other is ``executable``, singular. -The ``executables`` stanza is the same as the ``executable`` stanza except that -it's used to describe several executables sharing the same configuration, so the -plura ``executables`` stanza is used to describe more than one executable. +``executables``, plural, and the other is ``executable``, singular. The +``executables`` stanza is the same as the ``executable`` stanza except that it's +used to describe several executables sharing the same configuration, so the +plural ``executables`` stanza is used to describe more than one executable. It shares the same fields as the ``executable`` stanza, except that instead of -``(name ...)`` and ``(public_name ...)`` you must use the plural versions as well: +``(name ...)`` and ``(public_name ...)`` you must use the plural versions as +well: -- ``(names )`` where ```` is a list of entry point names. Compare with - ``executable`` where you only need to specify the modules containing the entry point - of each executable. +- ``(names )`` where ```` is a list of entry point names. Compare + with ``executable``, where you only need to specify the modules containing the + entry point of each executable. -- ``(public_names )`` describes under what name to install each executable. - The list of names must be of the same length as the list in the +- ``(public_names )`` describes under what name to install each + executable. The list of names must be of the same length as the list in the ``(names ...)`` field. Moreover, you can use ``-`` for executables that shouldn't be installed. rule ---- -The ``rule`` stanza is used to create custom user rules. It tells Dune how -to generate a specific set of files from a specific set of dependencies. +The ``rule`` stanza is used to create custom user rules. It tells Dune how to +generate a specific set of files from a specific set of dependencies. The syntax is as follows: @@ -1030,8 +1018,8 @@ The syntax is as follows: (action ) ) -```` is what you run to produce the targets from the dependencies. -See the :ref:`user-actions` section for more details. +```` is what you run to produce the targets from the dependencies. See +the :ref:`user-actions` section for more details. ```` are: @@ -1041,26 +1029,29 @@ See the :ref:`user-actions` section for more details. ``(targets)`` can be omitted if it can be inferred from the action. See `inferred rules`_. -- ``(deps )``, to specify the dependencies of the - rule. See the :ref:`deps-field` section for more details. +- ``(deps )`` specifies the dependencies of the rule. See the + :ref:`deps-field` section for more details. -- ``(mode )``, to specify how to handle the targets. See `modes`_ - for details. +- ``(mode )`` specifies how to handle the targets. See `modes`_ for + details. - ``(fallback)`` is deprecated and is the same as ``(mode fallback)``. -- ``(locks ())`` specifies that the action must be run while - holding the following locks. See the :ref:`locks` section for more details. +- ``(locks ())`` specifies that the action must be run while holding + the following locks. See the :ref:`locks` section for more details. + +- ``(alias )`` specifies this rule's alias. Building this alias + means building the targets of this rule. -- ``(alias )`` specifies this rule's alias. Building this - alias means building the targets of this rule. +- ``(aliases )`` specifies many aliases for this rule. -- ``(package )`` specifies this rule's package. This rule - will be unavailable when installing other packages in release mode. +- ``(package )`` specifies this rule's package. This rule will be + unavailable when installing other packages in release mode. - ``(enabled_if )`` specifies the Boolean condition that must - be true for the rule to be considered. The condition is specified using the :ref:`blang`, and - the field allows for :ref:`variables` to appear in the expressions. + be true for the rule to be considered. The condition is specified using the + :ref:`blang`, and the field allows for :ref:`variables` to appear in the + expressions. Please note: contrary to makefiles or other build systems, user rules currently don't support patterns, such as a rule to produce ``%.y`` from ``%.x`` for any @@ -1069,24 +1060,22 @@ given ``%``. This might be supported in the future. modes ~~~~~ -By default, a rule's target must not exist in the source tree because -Dune will error out when this is the case; however, it's possible to change -this behavior using the ``mode`` field. The following modes are available: +By default, a rule's target must not exist in the source tree because Dune will +error out when this is the case; however, it's possible to change this behavior +using the ``mode`` field. The following modes are available: - ``standard`` - the standard mode. -- ``fallback`` - in this mode, when the targets are already present in - the source tree, Dune will ignore the rule. It's an error if - only a subset of the targets are present in the tree. Fallback rules are - commonly used to generate default configuration files that - may be generated by a configure script. +- ``fallback`` - in this mode, when the targets are already present in the + source tree, Dune will ignore the rule. It's an error if only a subset of the + targets are present in the tree. Fallback rules are commonly used to generate + default configuration files that may be generated by a configure script. .. _promote: -- ``promote`` or ``(promote )`` - in this mode, the files - in the source tree will be ignored. Once the rule has been executed, - the targets will be copied back to the source tree. - The following options are available: +- ``promote`` or ``(promote )`` - in this mode, the files in the source + tree will be ignored. Once the rule has been executed, the targets will be + copied back to the source tree. The following options are available: - ``(until-clean)`` means that ``dune clean`` will remove the promoted files from the source tree. @@ -1094,23 +1083,23 @@ this behavior using the ``mode`` field. The following modes are available: the current directory. This feature has been available since Dune 1.8. - ``(only )`` means that only a subset of the targets should be promoted. The argument is similar to the argument of :ref:`(dirs ...) - `, specified using the :ref:`predicate-lang`. This feature - has been available since Dune 1.10. + `, specified using the :ref:`predicate-lang`. This feature has + been available since Dune 1.10. There are two use cases for ``promote`` rules. The first one is when the -generated code is easier to review than the generator, so it's easier -to commit the generated code and review it. The second is to cut down -dependencies during releases. By passing ``--ignore-promoted-rules`` -to Dune, rules with ``(mode promote)`` will be ignored, and the source -files will be used instead. The ``-p/--for-release-of-packages`` flag -implies ``--ignore-promote-rules``. However, rules that promote only -a subset of their targets via ``(only ...)`` are never ignored. +generated code is easier to review than the generator, so it's easier to commit +the generated code and review it. The second is to cut down dependencies during +releases. By passing ``--ignore-promoted-rules`` to Dune, rules with ``(mode +promote)`` will be ignored, and the source files will be used instead. The +``-p/--for-release-of-packages`` flag implies ``--ignore-promote-rules``. +However, rules that promote only a subset of their targets via ``(only ...)`` +are never ignored. Inferred Rules ~~~~~~~~~~~~~~ -When using the action DSL (see :ref:`user-actions`), the dependencies -and targets are usually obvious. +When using the action DSL (see :ref:`user-actions`), the dependencies and +targets are usually obvious. For instance: @@ -1121,10 +1110,9 @@ For instance: (deps a) (action (copy %{deps} %{target}))) -In this example, the dependencies and targets are obvious by inspecting -the action. When this is the case, you can use the -following shorter syntax and have Dune infer dependencies and -targets for you: +In this example, the dependencies and targets are obvious by inspecting the +action. When this is the case, you can use the following shorter syntax and have +Dune infer dependencies and targets for you: .. code:: scheme @@ -1136,9 +1124,8 @@ For instance: (rule (copy a b)) -Note that in Dune, targets must always be known -statically. For instance, this ``(rule ...)`` -stanza is rejected by Dune: +Note that in Dune, targets must always be known statically. For instance, this +``(rule ...)`` stanza is rejected by Dune: .. code:: lisp @@ -1226,7 +1213,8 @@ This will enable support for Menhir stanzas in the current project. If the language version is absent, Dune will automatically add this line with the latest Menhir version once a Menhir stanza is used anywhere. -The basic form for defining menhir-git_ parsers (analogous to :ref:`ocamlyacc`) is: +The basic form for defining menhir-git_ parsers (analogous to :ref:`ocamlyacc`) +is: .. code:: scheme @@ -1242,12 +1230,12 @@ The basic form for defining menhir-git_ parsers (analogous to :ref:`ocamlyacc`) - ``(flags ...)`` is used to pass extra flags to Menhir. -- ``(infer )`` is used to enable Menhir with type - inference. This option is enabled by default with Menhir language 2.0. +- ``(infer )`` is used to enable Menhir with type inference. This option + is enabled by default with Menhir language 2.0. -Menhir supports writing the grammar and automation to the ``.cmly`` file. Therefore, -if this is flag is passed to Menhir, Dune will know to introduce a ``.cmly`` -target for the module. +Menhir supports writing the grammar and automation to the ``.cmly`` file. +Therefore, if this is flag is passed to Menhir, Dune will know to introduce a +``.cmly`` target for the module. .. _menhir-git: https://gitlab.inria.fr/fpottier/menhir @@ -1255,9 +1243,8 @@ target for the module. cinaps ------ -A ``cinaps`` stanza is available to support the ``cinaps`` tool. See -the `cinaps website `_ for more -details. +A ``cinaps`` stanza is available to support the ``cinaps`` tool. See the +`cinaps website `_ for more details. .. _documentation-stanza: @@ -1274,14 +1261,14 @@ comments. Where ```` are: -- ``(package )`` defines the package this documentation should be attached to. If - this is absent, Dune will try to infer it based on the location of the +- ``(package )`` defines the package this documentation should be attached + to. If this is absent, Dune will try to infer it based on the location of the stanza. - ``(mld_files )``: the ```` field follows the :ref:`ordered-set-language`. This is a set of extensionless MLD file basenames - attached to the package, where ``:standard`` refers to all the - ``.mld`` files in the stanza's directory. + attached to the package, where ``:standard`` refers to all the ``.mld`` files + in the stanza's directory. For more information, see :ref:`documentation`. @@ -1290,8 +1277,8 @@ For more information, see :ref:`documentation`. alias ----- -The ``alias`` stanza adds dependencies to an alias or specifies an action -to run to construct the alias. +The ``alias`` stanza adds dependencies to an alias or specifies an action to run +to construct the alias. The syntax is as follows: @@ -1312,20 +1299,21 @@ The syntax is as follows: ```` are: - ````, an action for constructing the alias. See the - :ref:`user-actions` section for more details. Note that this is removed in Dune - 2.0, so users must port their code to use the - ``rule`` stanza with the ``alias`` field instead. + :ref:`user-actions` section for more details. Note that this is removed in + Dune 2.0, so users must port their code to use the ``rule`` stanza with the + ``alias`` field instead. - ``(package )`` indicates that this alias stanza is part of package ```` and should be filtered out if ```` is filtered out from the command line, either with ``--only-packages `` or ``-p ``. -- ``(locks ())`` specifies that the action must be run while - holding the following locks. See the :ref:`locks` section for more details. +- ``(locks ())`` specifies that the action must be run while holding + the following locks. See the :ref:`locks` section for more details. - ``(enabled_if )`` specifies the Boolean condition that must - be true for the tests to run. The condition is specified using the :ref:`blang`, and - the field allows for :ref:`variables` to appear in the expressions. + be true for the tests to run. The condition is specified using the + :ref:`blang`, and the field allows for :ref:`variables` to appear in the + expressions. The typical use of the ``alias`` stanza is to define tests: @@ -1351,10 +1339,10 @@ Dune supports installing packages on the system, i.e., copying freshly built artifacts from the workspace to the system. The ``install`` stanza takes three pieces of information: -- the list of files to install -- the package to attach these files. (This field is optional if your - project contains a single package.) -- the section in which the files will be installed +- The list of files to install. +- The package to attach these files. This field is optional if your project + contains a single package. +- The section in which the files will be installed. For instance: @@ -1365,30 +1353,30 @@ For instance: (section share) (package mypackage)) -Indicate that the file ``hello.txt`` in the current directory is to be -installed in ``/share/mypackage``. +Indicate that the file ``hello.txt`` in the current directory is to be installed +in ``/share/mypackage``. The following sections are available: -- ``lib`` installs by default to ``/lib//`` -- ``lib_root`` installs by default to ``/lib/`` +- ``lib`` installs by default to ``/lib//``. +- ``lib_root`` installs by default to ``/lib/``. - ``libexec`` installs by default to ``/lib//`` with the - executable bit set + executable bit set. - ``libexec_root`` installs by default to ``/lib/`` with the executable - bit set -- ``bin`` installs by default to ``/bin/`` with the executable bit set -- ``sbin`` installs by default to ``/sbin/`` with the executable bit set -- ``toplevel`` installs by default to ``/lib/toplevel/`` -- ``share`` installs by default to ``/share//`` -- ``share_root`` installs by default to ``/share/`` -- ``etc`` installs by default to ``/etc//`` -- ``doc`` installs by default to ``/doc//`` -- ``stublibs`` installs by default to ``/lib/stublibs/`` with the - executable bit set -- ``man`` installs by default relative to ``/man`` with the destination - directory extracted from the extension of the source file (so that - installing ``foo.1`` is equivalent to a destination of - ``man1/foo.1``) + bit set. +- ``bin`` installs by default to ``/bin/`` with the executable bit set. +- ``sbin`` installs by default to ``/sbin/`` with the executable bit + set. +- ``toplevel`` installs by default to ``/lib/toplevel/``. +- ``share`` installs by default to ``/share//``. +- ``share_root`` installs by default to ``/share/``. +- ``etc`` installs by default to ``/etc//``. +- ``stublibs`` installs by default to ``/lib/stublibs/`` with the + executable bit set. +- ``doc`` installs by default to ``/doc//``. +- ``man`` installs by default, relative to ``/man`` with the destination + directory extracted from the source file extension. For example, installing + ``foo.1`` is equivalent to a destination of ``man1/foo.1``. - ``misc`` requires files to specify an absolute destination. It will only work when used with opam and the user will be prompted before the installation when it's done via opam. It is deprecated. @@ -1396,11 +1384,11 @@ The following sections are available: ````. If the prefix isn't the same as the one used when installing ````, ```` won't find the files. -Normally, Dune uses the file's basename to determine -the file's name once installed; however, you can change that -by using the form ``( as )`` in the -``files`` field. For instance, to install a file ``mylib.el`` as -``/emacs/site-lisp/mylib.el``, you must write the following: +Normally, Dune uses the file's basename to determine the file's name once +installed; however, you can change that by using the form ``( as +)`` in the ``files`` field. For instance, to install a file +``mylib.el`` as ``/emacs/site-lisp/mylib.el``, you must write the +following: .. code:: scheme @@ -1413,24 +1401,86 @@ installed in. If the section above is documented as "with the executable bit set", they are installed with mode ``0o755`` (``rwxr-xr-x``); otherwise they are installed with mode ``0o644`` (``rw-r--r--``). +Note that all files in the install stanza must be specified by relative paths +only. It is an error to specify files by absolute paths. + +Including Files in the Install Stanza +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +You can include external files from the ``files`` and ``dirs`` fields of the +install stanza: + +.. code:: scheme + + (install + (files (include foo.sexp)) + (section share)) + +Here the file ``foo.sexp`` must contain a single S-expression list, whose +elements will be included in the list of files or directories to install. That +is, elements may be of the form: + +- ```` +- ``( as )`` +- ``(include )`` + +Included files may be generated by rules. Here is an example of a rule which +generates a file by listing all the files in a subdirectory ``resources``: + +.. code:: scheme + + (rule + (deps (source_tree resources)) + (action + (with-stdout-to foo.sexp + (system "echo '(' resources/* ')'")))) + +Globs in the Install Stanza +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +You can use globs to specify files to install by using the terms ``(glob_files +)`` and ``(glob_files_rec )`` inside the ``files`` field of the +install stanza (but not inside the ``dirs`` field). See the :ref:`glob ` +for details of the glob syntax. The ``(glob_files )`` term will expand its +argument within a single directory, whereas the ``(glob_files_rec )`` term +will recursively expand its argument within all subdirectories. + +For example: + +.. code:: scheme + + (install + (files (glob_files style/*.css) (glob_files_rec content/*.html)) + (section share)) + +This example will install: + +- All files matching ``*.css`` in the ``style`` directory. + +- All files matching ``*.html`` in the ``content`` directory, or any of its + descendant subdirectories. + +Note that the paths to files are preserved after installation. Suppose the +source directory contained the files ``style/foo.css`` and +``content/bar/baz.html``. The example above will place these files in +``share//style/foo.css`` and ``share//content/bar/baz.html`` +respectively. + Handling of the .exe Extension on Windows ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Under Microsoft Windows, executables must be suffixed with -``.exe``. Dune tries to ensure that executables are always -installed with this extension on Windows. +Under Microsoft Windows, executables must be suffixed with ``.exe``. Dune tries +to ensure that executables are always installed with this extension on Windows. -More precisely, when installing a file via an ``(install ...)`` -stanza, Dune implicitly adds the ``.exe`` extension to the destination, -if the source file has extension ``.exe`` or ``.bc`` and if it's not -already present +More precisely, when installing a file via an ``(install ...)`` stanza, Dune +implicitly adds the ``.exe`` extension to the destination, if the source file +has extension ``.exe`` or ``.bc`` and if it's not already present copy_files ---------- -The ``copy_files`` and ``copy_files#`` stanzas specify that -files from another directory could be copied to the current -directory, if needed. +The ``copy_files`` and ``copy_files#`` stanzas specify that files from another +directory could be copied to the current directory, if needed. The syntax is as follows: @@ -1440,41 +1490,41 @@ The syntax is as follows: (files )) -```` represents the set of files to copy. See the :ref:`glob -` for details. +```` represents the set of files to copy. See the :ref:`glob ` for +details. ```` are: -- ``(alias )`` is used to specify an alias to which to attach the targets. +- ``(alias )`` specifies an alias to which to attach the targets. -- ``(mode )`` is used to specify how to handle the targets. See `modes`_ - for details. +- ``(mode )`` specifies how to handle the targets. See `modes`_ for + details. - ``(enabled_if )`` conditionally disables this stanza. The condition is specified using the :ref:`blang`. -The short form +The short form: .. code:: scheme (copy_files ) -is equivalent to +is equivalent to: .. code:: scheme (copy_files (files )) -The difference between ``copy_files`` and ``copy_files#`` is the same -as the difference between the ``copy`` and ``copy#`` actions. See the +The difference between ``copy_files`` and ``copy_files#`` is the same as the +difference between the ``copy`` and ``copy#`` actions. See the :ref:`user-actions` section for more details. include ------- The ``include`` stanza allows including the contents of another file in the -current ``dune`` file. Currently, the included file cannot be generated and must be -present in the source tree. This feature is intended for use in conjunction +current ``dune`` file. Currently, the included file cannot be generated and must +be present in the source tree. This feature is intended for use in conjunction with promotion, when parts of a ``dune`` file are to be generated. For instance: @@ -1489,8 +1539,8 @@ For instance: (alias runtest) (action (diff dune.inc dune.inc.gen))) -With this ``dune`` file, running Dune as follows will replace the -``dune.inc`` file in the source tree by the generated one: +With this ``dune`` file, running Dune as follows will replace the ``dune.inc`` +file in the source tree by the generated one: .. code:: shell @@ -1510,21 +1560,21 @@ can define two tests at once with: (names mytest expect_test) ) -This defines an executable named ``mytest.exe`` that will be executed as -part of the ``runtest`` alias. If the directory also contains an +This defines an executable named ``mytest.exe`` that will be executed as part of +the ``runtest`` alias. If the directory also contains an ``expect_test.expected`` file, then ``expect_test`` will be used to define an expect test. That is, the test will be executed and its output will be compared to ``expect_test.expected``. -The optional fields supported are a subset of the alias and executables -fields. In particular, all fields except for ``public_names`` are supported from -the :ref:`executables stanza `. Alias fields apart from -``name`` are allowed. +The optional fields supported are a subset of the alias and executables fields. +In particular, all fields except for ``public_names`` are supported from the +:ref:`executables stanza `. Alias fields apart from ``name`` +are allowed. By default, the test binaries are run without options. The ``action`` field can -override the test binary invocation, i.e., if you're using -alcotest and wish to see all the test failures on the standard output. When -running Dune ``runtest`` you can use the following stanza: +override the test binary invocation, i.e., if you're using Alcotest and wish to +see all the test failures on the standard output. When running Dune ``runtest`` +you can use the following stanza: .. code:: lisp @@ -1566,72 +1616,68 @@ follows: ... ( )) -The first form ``( )`` that corresponds to the -selected build profile will be used to modify the environment in this -directory. You can use ``_`` to match any build profile. +The first form ``( )`` that corresponds to the selected build +profile will be used to modify the environment in this directory. You can use +``_`` to match any build profile. Fields supported in ```` are: - any OCaml flags field. See :ref:`ocaml-flags` for more details. -- ``(link_flags )`` to specify flags to ocaml when linking an - executable. See :ref:`executables stanza `. +- ``(link_flags )`` specifies flags to OCaml when linking an executable. + See :ref:`executables stanza `. -- ``(c_flags )`` and ``(cxx_flags )`` - to specify compilation flags for C and C++ stubs, respectively. - See `library`_ for more details. +- ``(c_flags )`` and ``(cxx_flags )`` specify compilation flags + for C and C++ stubs, respectively. See `library`_ for more details. -- ``(env-vars ( ) .. ( ))``, which will add the - corresponding variables to the environment in which the build commands are - executed and under which ``dune exec`` runs. +- ``(env-vars ( ) .. ( ))`` will add the corresponding + variables to the environment where the build commands are executed and are + used by ``dune exec``. - ``(menhir_flags ))`` specifies flags for Menhir stanzas. - ``(js_of_ocaml (flags )(build_runtime )(link_flags ))`` - to specify js_of_ocaml flags. see `jsoo-field`_ for more details. - -- ``(js_of_ocaml (compilation_mode ))``, where ```` is - either ``whole_program`` or ``separate``. This field controls - whether to use separate compilation or not. - -- ``(js_of_ocaml (runtest_alias ))`` is used to specify - the alias under which :ref:`inline_tests` and tests (`tests-stanza`_) - run for the `js` mode. - -- ``(binaries )``, where ```` is a list of entries - of the form ``( as )``. ``( as )`` - makes the binary ```` available in the command search as - just ````. For instance, in a ``(run ...)`` action, - ```` will resolve to this file path. You can also write just - the file path, in which case the name will be inferred from the - basename of ```` by dropping the ``.exe`` suffix, if it - exists. For example, ``(binaries bin/foo.exe (bin/main.exe as - bar))`` would add the commands ``foo`` and ``bar`` to the search - path. - -- ``(inline_tests )``, where ```` is either ``enabled``, ``disabled``, or - ``ignored``. This field has been available since Dune 1.11. It controls the variable's value - ``%{inline_tests}``, which is read by the inline test framework. - The default value is ``disabled`` for the ``release`` profile and ``enabled`` - otherwise. - -- ``(odoc )`` allows passing options to Odoc. See + specifies ``js_of_ocaml`` flags. See `jsoo-field`_ for more details. + +- ``(js_of_ocaml (compilation_mode ))`` controls whether to use separate + compilation or not where ```` is either ``whole_program`` or + ``separate``. + +- ``(js_of_ocaml (runtest_alias ))`` specifies the alias under which + :ref:`inline_tests` and tests (`tests-stanza`_) run for the `js` mode. + +- ``(binaries )``, where ```` is a list of entries of the + form ``( as )``. ``( as )`` makes the binary + ```` available in the command search as just ````. For + instance, in a ``(run ...)`` action, ```` will resolve to this + file path. You can also write just the file path, in which case the name will + be inferred from the basename of ```` by dropping the ``.exe`` + suffix, if it exists. For example, ``(binaries bin/foo.exe (bin/main.exe as + bar))`` would add the commands ``foo`` and ``bar`` to the search path. + +- ``(inline_tests )``, where ```` is either ``enabled``, + ``disabled``, or ``ignored``. This field has been available since Dune 1.11. + It controls the variable's value ``%{inline_tests}``, which is read by the + inline test framework. The default value is ``disabled`` for the ``release`` + profile and ``enabled`` otherwise. + +- ``(odoc )`` allows passing options to ``odoc``. See :ref:`odoc-options` for more details. -- ``(coq (flags ))`` allows passing options to Coq. See - :ref:`coq-theory` for more details. +- ``(coq (flags ))`` allows passing options to Coq. See :ref:`coq-theory` + for more details. -- ``(formatting )`` allows the user to set auto-formatting in the current - directory subtree (see :ref:`formatting`). +- ``(formatting )`` allows the user to set auto-formatting in the + current directory subtree (see :ref:`formatting`). .. _dune-subdirs: dirs (Since 1.6) ---------------- -The ``dirs`` stanza allows specifying the subdirectories Dune will -include in a build. The syntax is based on Dune's :ref:`predicate-lang` and allows -the user the following operations: +The ``dirs`` stanza allows specifying the subdirectories Dune will include in a +build. The syntax is based on Dune's :ref:`predicate-lang` and allows the user +the following operations: - The special value ``:standard`` which refers to the default set of used directories. These are the directories that don't start with ``.`` or ``_``. @@ -1646,25 +1692,25 @@ Examples: .. code:: lisp (dirs *) ;; include all directories - (dirs :standard \ ocaml) ;; include all directories except ocaml - (dirs :standard \ test* foo*) ;; exclude all directories that start with test or foo + (dirs :standard \ ocaml) ;; include all dirs except ocaml + (dirs :standard \ test* foo*) ;; exclude all dirs that start with test or foo -Dune will not scan a directory that isn't included in this stanza. -Any contained Dune (or other special) files won't be interpreted either and -will be treated as raw data. It is however possible to depend on files inside -ignored subdirectories. +Dune will not scan a directory that isn't included in this stanza. Any contained +``dune`` (or other special) files won't be interpreted either and will be +treated as raw data. It is however possible to depend on files inside ignored +subdirectories. .. _dune-data_only_dirs: data_only_dirs (Since 1.6) -------------------------- -Dune allows the user to treat directories as *data only*. ``dune`` files in these -directories won't be evaluated for their rules, but the contents of these +Dune allows the user to treat directories as *data only*. ``dune`` files in +these directories won't be evaluated for their rules, but the contents of these directories will still be usable as dependencies for other rules. -The syntax is the same as for the ``dirs`` stanza except that ``:standard`` -is empty by default. +The syntax is the same as for the ``dirs`` stanza except that ``:standard`` is +empty by default. Example: @@ -1702,10 +1748,10 @@ instead of this stanza. For example: vendored_dirs (Since 1.11) -------------------------- -Dune supports vendoring other Dune-based projects natively, since simply -copying a project into a subdirectory of your own project will work. Simply -doing that has a few limitations though. You can workaround those by explicitly -marking such directories as containing vendored code. +Dune supports vendoring other Dune-based projects natively, since simply copying +a project into a subdirectory of your own project will work. Simply doing that +has a few limitations though. You can workaround those by explicitly marking +such directories as containing vendored code. Example: @@ -1716,9 +1762,9 @@ Example: Dune will not resolve aliases in vendored directories. By default, it won't build all installable targets, run the tests, format, or lint the code located -in such a directory while still building your project's dependencies. -Libraries and executables in vendored directories will also be built with a ``-w --a`` flag to suppress all warnings and prevent pollution of your build output. +in such a directory while still building your project's dependencies. Libraries +and executables in vendored directories will also be built with a ``-w -a`` flag +to suppress all warnings and prevent pollution of your build output. .. _include_subdirs: @@ -1738,23 +1784,21 @@ Where ```` maybe be one of: - ``no``, the default - ``unqualified`` -When the ``include_subdirs`` stanza isn't present or ```` is -``no``, Dune considers subdirectories independent. When ```` -is ``unqualified``, Dune will assume that the current directory's -subdirectories are part of the same group of directories. In -particular, Dune will simultaneously scan all these directories when looking -for OCaml/Reason files. This allows you to split a library between -several directories. ``unqualified`` means that modules in +When the ``include_subdirs`` stanza isn't present or ```` is ``no``, Dune +considers subdirectories independent. When ```` is ``unqualified``, Dune +will assume that the current directory's subdirectories are part of the same +group of directories. In particular, Dune will simultaneously scan all these +directories when looking for OCaml/Reason files. This allows you to split a +library between several directories. ``unqualified`` means that modules in subdirectories are seen as if they were all in the same directory. In -particular, you cannot have two modules with the same name in two -different directories. We plan to add a ``qualified`` mode in -the future. +particular, you cannot have two modules with the same name in two different +directories. We plan to add a ``qualified`` mode in the future. -Note that subdirectories are included recursively, however the -recursion will stop when encountering a subdirectory that contains -another ``include_subdirs`` stanza. Additionally, it's not allowed -for a subdirectory of a directory with ``(include_subdirs )`` -where ```` is not ``no`` to contain one of the following stanzas: +Note that subdirectories are included recursively; however, the recursion will +stop when encountering a subdirectory that contains another ``include_subdirs`` +stanza. Additionally, it's not allowed for a subdirectory of a directory with +``(include_subdirs )`` where ```` is not ``no`` to contain one of the +following stanzas: - ``library`` - ``executable(s)`` @@ -1781,15 +1825,15 @@ run this toplevel with: $ dune exec ./tt.exe ``(preprocess (pps ...))`` is the same as the ``(preprocess (pps ...))`` field -of `library`_. Currently, ``action`` and ``future_syntax`` are not supported -in the toplevel. +of `library`_. Currently, ``action`` and ``future_syntax`` are not supported in +the toplevel. .. _subdir: subdir ------ -The ``subdir`` stanza can be used to evaluate stanzas in sub directories. This is +The ``subdir`` stanza can be used to evaluate stanzas in subdirectories. This is useful for generated files or to override stanzas in vendored directories without editing vendored ``dune`` files. @@ -1817,11 +1861,12 @@ MDX (Since 2.4) --------------- MDX is a tool that helps you keep your markdown documentation up-to-date by -checking that its code examples are correct. When setting an MDX -stanza, the checks MDX carries out are automatically attached to the -``runtest`` alias of the stanza's directory. +checking that its code examples are correct. When setting an MDX stanza, the MDX +checks are automatically attached to the ``runtest`` alias of the stanza's +directory. -See `MDX's repository `__ for more details. +See `MDX's repository `__ for more +details. You can define an MDX stanza to specify which files you want checked. @@ -1830,7 +1875,7 @@ Note that this feature is still experimental and needs to be enabled in your .. code:: scheme - (using mdx 0.2) + (using mdx 0.3) .. note:: Version ``0.2`` of the stanza requires mdx ``1.9.0``. @@ -1844,28 +1889,27 @@ The syntax is as follows: Where ```` are: - ``(files )`` are the files that you want MDX to check, described as a - list of globs (see the :ref:`Glob language specification ` ). - It defaults to ``*.md``. + list of globs (see the :ref:`Glob language specification ` ). It + defaults to ``*.md``. -- ``(deps )`` to specify the dependencies - of your documentation code blocks. See the :ref:`deps-field` section for more - details. +- ``(deps )`` to specify the dependencies of your documentation + code blocks. See the :ref:`deps-field` section for more details. -- ``(preludes )`` are the prelude files you want to pass to MDX. - See `MDX's documentation `__ for more +- ``(preludes )`` are the prelude files you want to pass to MDX. See + `MDX's documentation `__ for more details on preludes. -- ``(libraries )`` are libraries that should be - statically linked in the MDX test executable. +- ``(libraries )`` are libraries that should be statically linked in + the MDX test executable. -- ``(enabled_if )`` is the same as the corresponding field - of `library`_. +- ``(enabled_if )`` is the same as the corresponding field of + `library`_. - ``(package )`` specifies which package to attach this stanza to (similarly to when ``(package)`` is attached to a ``(rule)`` stanza). When - ``-p`` is passed, ``(mdx)`` stanzas with another package will be ignored. - Note that this feature is completely separate from ``(packages)``, which - specifies some dependencies. + ``-p`` is passed, ``(mdx)`` stanzas with another package will be ignored. Note + that this feature is completely separate from ``(packages)``, which specifies + some dependencies. - ``(locks )`` specifies that the action of running the tests holds the specified locks. See the :ref:`locks` section for more details. @@ -1873,13 +1917,13 @@ Where ```` are: Upgrading from Version 0.1 ~~~~~~~~~~~~~~~~~~~~~~~~~~ -- The 0.2 version of the stanza requires at least MDX 1.9.0. If you encounter - an error such as, ``ocaml-mdx: unknown command `dune-gen'``, then you should +- The 0.2 version of the stanza requires at least MDX 1.9.0. If you encounter an + error such as, ``ocaml-mdx: unknown command `dune-gen'``, then you should upgrade MDX. -- The field ``(packages )`` is deprecated in version 0.2. You can - use package items in the generic ``deps`` field instead: - ``(deps (package ) ... (package ))`` +- The field ``(packages )`` is deprecated in version 0.2. You can use + package items in the generic ``deps`` field instead: ``(deps (package + ) ... (package ))`` - Use the new ``libraries`` field to directly link libraries in the test executable and remove the need for ``#require`` directives in your @@ -1891,8 +1935,8 @@ plugin (Since 2.8) ------------------ Plugins are a way to load OCaml libraries at runtime. The ``plugin`` stanza -allows you to declare the plugin's name, in which :ref:`sites` should be -present, and which libraries it will load. +allows you to declare the plugin's name, which :ref:`sites` should be +present and which libraries it will load. .. code:: lisp @@ -1904,10 +1948,9 @@ present, and which libraries it will load. ```` are: -- ``(package )`` if there are more than one package defined in the - current scope, this specifies which package the - plugin will install. A plugin can be installed by one package in the site - of another package. +- ``(package )`` if there is more than one package defined in the + current scope, this specifies which package the plugin will install. A plugin + can be installed by one package in the site of another package. - ``(optional)`` will not declare the plugin if the libraries are not available. @@ -1919,12 +1962,13 @@ The loading of the plugin is done using the facilities generated by generate_sites_module (Since 2.8) --------------------------------- -Dune proposes some facilities for dealing with :ref:`sites` in a program. The -``generate_sites_module`` stanza will generate code for looking up the correct locations -of the sites directories and for loading plugins. It works after installation -with or without the relocation mode, inside Dune rules, when using Dune executables. -For promotion, it works only if the generated modules are solely in the executable (or -library statically linked) promoted; generated modules in plugins won't work. +Dune proposes some facilities for dealing with :ref:`sites` in a program. +The ``generate_sites_module`` stanza will generate code for looking up the +correct locations of the sites' directories and for loading plugins. It works +after installation with or without the relocation mode, inside Dune rules, and +when using Dune executables. For promotion, it works only if the generated +modules are solely in the executable (or library statically linked) promoted; +generated modules in plugins won't work. .. code:: lisp @@ -1932,27 +1976,29 @@ library statically linked) promoted; generated modules in plugins won't work. (module ) ) -The module's code is generated in the directory with the given name. The -code is populated according to the requested facilities. +The module's code is generated in the directory with the given name. The code is +populated according to the requested facilities. The available ```` are: -- ``sourceroot`` : adds in the generated module a value ``val sourceroot: string option``, - which contains the value of ``%{workspace_root}``, if the code have been built - locally. It could be used to keep the tool's configuration file locally when - executed with ``dune exec`` or after promotion. The value is ``None`` once it has been installed. +- ``sourceroot`` adds a value ``val sourceroot: string option`` in the generated + module, which contains the value of ``%{workspace_root}``, if the code has + been built locally. It could be used to keep the tool's configuration file + locally when executed with ``dune exec`` or after promotion. The value is + ``None`` once it has been installed. -- ``relocatable`` : adds in the generated module a value ``val relocatable: bool``, - which indicates if the binary has been installed in the relocatable mode +- ``relocatable`` adds a value ``val relocatable: bool`` in the generated + module, which indicates if the binary has been installed in the relocatable + mode. -- ``(sites )`` : adds in the submodule `Sites` of the generated module a value - ``val : string list`` for each ```` of ````. The - identifier isn't capitalized. +- ``(sites )`` adds a value ``val : string list`` for each + ```` of ```` in the submodule `Sites` of the generated module. + The identifier isn't capitalized. -- ``(plugins ( ) ...)``: adds in the submodule ``Plugins`` of the - generated module a submodule ```` with the following signature ``S``. The - identifier ```` is capitalized. +- ``(plugins ( ) ...)`` adds a submodule ```` with the + following signature ``S`` in the submodule ``Plugins`` of the generated module + . The identifier ```` is capitalized. .. code:: ocaml @@ -1970,10 +2016,10 @@ The available ```` are: (** load the specified plugin and its dependencies *) end -The generated module is a dependency on the library ``dune-site``, -and if the facilities ``(plugins ...)`` are used, it is a dependency on the library -``dune-site.plugins``. Those dependencies are not automatically added -to the library or executable which use the module (cf. :ref:`plugins`). +The generated module is a dependency on the library ``dune-site``, and if the +facilities ``(plugins ...)`` are used, it is a dependency on the library +``dune-site.plugins``. Those dependencies are not automatically added to the +library or executable which use the module (cf. :ref:`plugins`). .. _dune-workspace: @@ -1981,25 +2027,25 @@ dune-workspace ============== By default, a workspace has only one build context named ``default`` which -corresponds to the environment in which ``dune`` is run. You can define more +corresponds to the environment, in which ``dune`` is run. You can define more contexts by writing a ``dune-workspace`` file. You can point Dune to an explicit ``dune-workspace`` file with the ``--workspace`` option. For instance, it's good practice to write a -``dune-workspace.dev`` in your project with all the OCaml versions your -projects' support, so developers can test that the code builds with all -OCaml versions by simply running: +``dune-workspace.dev`` in your project with all the OCaml versions your projects +support, so developers can test that the code builds with all OCaml versions by +simply running: .. code:: bash $ dune build --workspace dune-workspace.dev @all @runtest -The ``dune-workspace`` file uses the S-expression syntax. This is what -a typical ``dune-workspace`` file looks like: +The ``dune-workspace`` file uses the S-expression syntax. This is what a typical +``dune-workspace`` file looks like: .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (context (opam (switch 4.07.1))) (context (opam (switch 4.08.1))) (context (opam (switch 4.11.1))) @@ -2034,14 +2080,15 @@ env The ``env`` stanza can be used to set the base environment for all contexts in this workspace. This environment has the lowest precedence of all other ``env`` -stanzas. The syntax for this stanza is the same as Dune's :ref:`dune-env` stanza. +stanzas. The syntax for this stanza is the same as Dune's :ref:`dune-env` +stanza. context ------- -The ``(context ...)`` stanza declares a build context. The argument -can be either ``default`` or ``(default)`` for the default build -context, or it can be the description of an opam switch, as follows: +The ``(context ...)`` stanza declares a build context. The argument can be +either ``default`` or ``(default)`` for the default build context, or it can be +the description of an opam switch, as follows: .. code:: scheme @@ -2050,64 +2097,57 @@ context, or it can be the description of an opam switch, as follows: ```` are: -- ``(name )`` is the subdirectory's name for ``_build``, - where this build's context artifacts will be stored. +- ``(name )`` is the subdirectory's name for ``_build``, where this + build's context artifacts will be stored. -- ``(root )`` is the opam root. By default, it will take - the opam root defined by the environment in which ``dune`` is - run, which is usually ``~/.opam``. +- ``(root )`` is the opam root. By default, it will take the opam + root defined by the environment in which ``dune`` is run, which is usually + ``~/.opam``. -- ``(merlin)`` instructs Dune to use this build context for - Merlin. +- ``(merlin)`` instructs Dune to use this build context for Merlin. -- ``(profile )`` sets a different profile for a build - context. This has precedence over the command-line option - ``--profile``. +- ``(profile )`` sets a different profile for a build context. This has + precedence over the command-line option ``--profile``. - ``(env )`` sets the environment for a particular context. This is of higher precedence than the root ``env`` stanza in the workspace file. This field has the same options as the :ref:`dune-env` stanza. -- ``(toolchain )`` sets a ``findlib`` toolchain for the context. +- ``(toolchain )`` sets a ``findlib`` toolchain for the + context. - ``(host )`` chooses a different context to build binaries that are meant to be executed on the host machine, such as preprocessors. -- ``(paths ( ) .. ( ))`` allows you to set the value of any - ``PATH``-like variables in this context. If ``PATH`` itself is modified in - this way, its value will be used to resolve workspace binaries, - including finding the compiler and related tools. These variables will also be - passed as part of the environment to any program launched by Dune. For - each variable, the value is specified using the :ref:`ordered-set-language`. - Relative paths are interpreted with respect to the workspace root. See - :ref:`finding-root`. - -- ``(fdo )`` builds this context with feedback-direct - optimizations. It requires `OCamlFDO - `__. ```` is a - path-interpreted relative to the workspace root (see - :ref:`finding-root`). ```` specifies which executable to - optimize. Users should define a different context for each target - executable built with FDO. The context name is derived - automatically from the default name and ````, unless - explicitly specified using the ``(name ...)`` field. For example, if - ```` is *src/foo.exe* in a default context, then the - name of the context is *default-fdo-foo* and the filename - that contains execution counters is *src/fdo.exe.fdo-profile*. This - feature is **experimental** and no backwards compatibility is - implied. - -- By default, Dune builds and installs dynamically-linked foreign - archives (usually named ``dll*.so``). It's possible to disable - this by setting by including - ``(disable_dynamically_linked_foreign_archives true)`` in the - workspace file, so bytecode executables will be built - with all foreign archives statically linked into the runtime system. +- ``(paths ( ) .. ( ))`` allows you to set the value of + any ``PATH``-like variables in this context. If ``PATH`` itself is modified in + this way, its value will be used to resolve workspace binaries, including + finding the compiler and related tools. These variables will also be passed as + part of the environment to any program launched by Dune. For each variable, + the value is specified using the :ref:`ordered-set-language`. Relative paths + are interpreted with respect to the workspace root. See :ref:`finding-root`. + +- ``(fdo )`` builds this context with feedback-direct optimizations. + It requires `OCamlFDO `__. + ```` is a path-interpreted relative to the workspace root (see + :ref:`finding-root`). ```` specifies which executable to optimize. + Users should define a different context for each target executable built with + FDO. The context name is derived automatically from the default name and + ````, unless explicitly specified using the ``(name ...)`` field. + For example, if ```` is *src/foo.exe* in a default context, then + the name of the context is *default-fdo-foo* and the filename that contains + execution counters is *src/fdo.exe.fdo-profile*. This feature is + **experimental** and no backwards compatibility is implied. + +- By default, Dune builds and installs dynamically-linked foreign archives + (usually named ``dll*.so``). It's possible to disable this by setting by + including ``(disable_dynamically_linked_foreign_archives true)`` in the + workspace file, so bytecode executables will be built with all foreign + archives statically linked into the runtime system. Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field in order to -setup cross compilation. See :ref:`cross-compilation` for more -information. +setup cross compilation. See :ref:`cross-compilation` for more information. Merlin reads compilation artifacts, and it can only read the compilation artifacts of a single context. Usually, you should use the artifacts from the diff --git a/duniverse/dune_/doc/dune.inc b/duniverse/dune_/doc/dune.inc index 2ba527ec9..4114e9550 100644 --- a/duniverse/dune_/doc/dune.inc +++ b/duniverse/dune_/doc/dune.inc @@ -1,4 +1,22 @@ +(rule + (with-stdout-to dune-promote.1 + (run dune promote --help=groff))) + +(install + (section man) + (package dune) + (files dune-promote.1)) + +(rule + (with-stdout-to dune-test.1 + (run dune test --help=groff))) + +(install + (section man) + (package dune) + (files dune-test.1)) + (rule (with-stdout-to dune-build.1 (run dune build --help=groff))) @@ -162,13 +180,13 @@ (files dune-printenv.1)) (rule - (with-stdout-to dune-promote.1 - (run dune promote --help=groff))) + (with-stdout-to dune-promotion.1 + (run dune promotion --help=groff))) (install (section man) (package dune) - (files dune-promote.1)) + (files dune-promotion.1)) (rule (with-stdout-to dune-rpc.1 @@ -251,12 +269,3 @@ (package dune) (files dune-utop.1)) -(rule - (with-stdout-to dune-test.1 - (run dune test --help=groff))) - -(install - (section man) - (package dune) - (files dune-test.1)) - diff --git a/duniverse/dune_/doc/faq.rst b/duniverse/dune_/doc/faq.rst index 3b248ffed..4fef7bf5f 100644 --- a/duniverse/dune_/doc/faq.rst +++ b/duniverse/dune_/doc/faq.rst @@ -120,5 +120,5 @@ file: val version : unit -> string val usage : unit -> unit -The ``ocaml_print-intf`` program has special support for Dune, so it will +The ``ocaml-print-intf`` program has special support for Dune, so it will automatically understand external dependencies. diff --git a/duniverse/dune_/doc/foreign-code.rst b/duniverse/dune_/doc/foreign-code.rst index 24d2d4dda..dc4a7907b 100644 --- a/duniverse/dune_/doc/foreign-code.rst +++ b/duniverse/dune_/doc/foreign-code.rst @@ -92,7 +92,7 @@ file: .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (using ctypes 0.1) diff --git a/duniverse/dune_/doc/hacking.rst b/duniverse/dune_/doc/hacking.rst index 4fd158526..f291701ab 100644 --- a/duniverse/dune_/doc/hacking.rst +++ b/duniverse/dune_/doc/hacking.rst @@ -3,10 +3,14 @@ Working on the Dune Codebase **************************** This section gives guidelines for working on Dune itself. Many of these are -general guidelines specific to Dune. However, given that Dune is a -large project developed by many different people, it's important to follow -these guidelines in order to keep the project in a good -state and pleasant to work on for everybody. +general guidelines specific to Dune. However, given that Dune is a large project +developed by many different people, it's important to follow these guidelines in +order to keep the project in a good state and pleasant to work on for everybody. + +.. contents:: Table of Contents + :depth: 1 + :local: + :backlinks: none Bootstrapping ============= @@ -16,17 +20,17 @@ In order to build itself, Dune uses a micro dune written as a single and instead has the configuration hard-coded in ``boot/libs.ml``. This latter file is automatically updated during development when we modify the ``dune`` files in the repository. ``boot/duneboot.ml`` itself is built with a single -invocation of ``ocamlopt`` or ``ocamlc`` via the ``bootstrap.ml`` ocaml script. +invocation of ``ocamlopt`` or ``ocamlc`` via the ``bootstrap.ml`` OCaml script. -``boot/duneboot.ml`` builds a ``dune.exe`` binary at the root of the source -tree and uses this binary to build everything else. +``boot/duneboot.ml`` builds a ``dune.exe`` binary at the root of the source tree +and uses this binary to build everything else. ``$ make dev`` takes care of bootstrapping if needed, but if you want to just run the bootstrapping step itself, build the ``dune.exe`` target with .. code:: sh - make dune.exe + make dev Once you've bootstrapped dune, you should be using it to develop dune itself. Here are the most common commands you'll be running: @@ -45,13 +49,13 @@ Writing Tests Most of our tests are written as expectation-style tests. While creating such tests, the developer writes some code and then lets the system insert the output -produced during the code execution. The system puts it right next -to the code in the source file. +produced during the code execution. The system puts it right next to the code in +the source file. -Once you write and commit a test, the system checks that the captured -output matches the one produced by a fresh code execution. When the two -don't match, the test fails. The system then displays a diff -between what was expected and what the code produced. +Once you write and commit a test, the system checks that the captured output +matches the one produced by a fresh code execution. When the two don't match, +the test fails. The system then displays a diff between what was expected and +what the code produced. We write both our unit tests and integration tests in this way. For unit tests, we use the ppx_expect_ framework, where we introduce tests via @@ -88,42 +92,71 @@ For integration tests, we use a system similar to `Cram tests Guidelines ---------- -As with any long running software project, code written by one person will -eventually be maintained by another. Just like normal code, it's -important to document tests, especially since test suites are most often -composed of many individual tests that must be understood on their own. +As with any long running software project, code written by one person will +eventually be maintained by another. Just like normal code, it's important to +document tests, especially since test suites are most often composed of many +individual tests that must be understood on their own. -A well-written test case should be easily understood. A reader should be able -to quickly understand what property the test is checking, how it's doing it, and +A well-written test case should be easily understood. A reader should be able to +quickly understand what property the test is checking, how it's doing it, and how to convince oneself that the test outcome is the right one. A well-written test makes it easier for future maintainers to understand the test and react when the test breaks. Most often, the code will need to be adapted to preserve -the existing behavior; however, in some rare cases, the test expectation will need -to be updated. +the existing behavior; however, in some rare cases, the test expectation will +need to be updated. It's crucial that each test case makes its purpose and logic crystal clear, so future maintainers know how to deal with it. When writing a test, we generally have a good idea of what we want to test. -Sometimes, we want to ensure a newly developed feature behaves as expected. -Other times, we want to add a reproduction case for a bug reported by a -user to ensure future changes won't reintroduce the faulty behaviour. Just -like when programming, we turn such an idea into code, which is a formal -language that a computer can understand. While another person reading this code -might be able to follow and understand what the code does step by step, it -isn't clear that they'll be able to reconstruct the original developer's idea. -Even worse, they might understand the code in a completely different way, which would lead -them to update it incorrectly. +Sometimes, we want to ensure a newly developed feature behaves as expected. +Other times, we want to add a reproduction case for a bug reported by a user to +ensure future changes won't reintroduce the faulty behaviour. Just like when +programming, we turn such an idea into code, which is a formal language that a +computer can understand. While another person reading this code might be able to +follow and understand what the code does step by step, it isn't clear that +they'll be able to reconstruct the original developer's idea. Even worse, they +might understand the code in a completely different way, which would lead them +to update it incorrectly. + +Setting Up Your Development Environment Using Nix +================================================= + +You can use Nix to setup the development environment. This can be done by +running ``nix develop`` in the root of the Dune repository. + +Note that Dune only takes OCaml as a dependency and the rest of the dependencies +are used when running the test suite. + +Running ``nix develop`` can take a while the first time, therefore it is +advisable to save the state in a profile. + +```sh +nix develop --profile nix/profiles/dune +``` + +And to load the profile: + +```sh +nix develop nix/profiles/dune +``` + +This profile might need to be updated from time to time, since the bootstrapped +version of Dune may become stale. This can be done by running the first command. + +You may also use `nix develop .#slim` for a dev environment with less +dependencies that is faster to build. Releasing Dune ============== -Dune's release process relies on dune-release_. Make sure you install and understand -how this software works before proceeding. Publishing a release consists of two steps: +Dune's release process relies on dune-release_. Make sure you install and +understand how this software works before proceeding. Publishing a release +consists of two steps: -* Updating ``CHANGES.md`` to reflect the version being published -* Running ``$ make opam-release`` to create the release tarball. Then publish it to - GitHub and submit it to opam. +* Updating ``CHANGES.md`` to reflect the version being published. +* Running ``$ make opam-release`` to create the release tarball. Then publish it + to GitHub and submit it to opam. Major & Feature Releases ------------------------ @@ -136,8 +169,8 @@ Point Releases -------------- Point releases increment the `z` in `x.y.z`. Such releases are done from the -respective `x.y` branch of the respective feature release. Once released, -be sure to update `CHANGES` in the `main` branch. +respective `x.y` branch of the respective feature release. Once released, be +sure to update `CHANGES` in the `main` branch. Adding Stanzas ============== @@ -154,10 +187,10 @@ to add a new stanza is: Versioning ---------- -Dune is incredibly strict with versioning of new features, modifications -visible to the user, and changes to existing rules. This means that any -added stanza must be guarded behind the version of the Dune language in which it -was introduced. For example: +Dune is incredibly strict with versioning of new features, modifications visible +to the user, and changes to existing rules. This means that any added stanza +must be guarded behind the version of the Dune language in which it was +introduced. For example: .. code:: ocaml @@ -166,8 +199,8 @@ was introduced. For example: and+ t = Cram_stanza.decode in [ Cram t ] ) -Here, Dune 2.7 introduced the Cram stanza, so the user must enable ``(lang -dune 2.7)`` in their ``dune`` project file to use it. +Here, Dune 2.7 introduced the Cram stanza, so the user must enable +``(lang dune 2.7)`` in their ``dune`` project file to use it. ``since`` isn't the only primitive for making sure that versions are respected. See ``Dune_lang.Syntax`` for other commonly used functions. @@ -178,17 +211,17 @@ Experimental & Independent Extensions Sometimes, Dune's versioning policy is too strict. For example, it doesn't work in the following situations: -- When most Dune independent extensions only exist inside Dune for - development convenience, e.g., build rules for Coq. Such extensions - would like to impose their own versioning policy. +- When most Dune independent extensions only exist inside Dune for development + convenience, e.g., build rules for Coq. Such extensions would like to impose + their own versioning policy. - When experimental features cannot guarantee Dune's strict backwards compatibility. Such features may dropped or modified at any time. -To handle both of these use cases, Dune allows the definition of new languages (with the -same syntax). These languages have their own versioning scheme and their own -stanzas (or fields). In Dune itself, ``Syntax.t`` represents such languages. -Here's an example of how the Coq syntax is defined: +To handle both of these use cases, Dune allows the definition of new languages +(with the same syntax). These languages have their own versioning scheme and +their own stanzas (or fields). In Dune itself, ``Syntax.t`` represents such +languages. Here's an example of how the Coq syntax is defined: .. code:: ocaml @@ -196,22 +229,22 @@ Here's an example of how the Coq syntax is defined: Dune_lang.Syntax.create ~name:"coq" ~desc:"the coq extension (experimental)" [ ((0, 1), `Since (1, 9)); ((0, 2), `Since (2, 5)) ] -The list provides which versions of the syntax are provided and which -version of Dune introduced them. +The list provides which versions of the syntax are provided and which version of +Dune introduced them. Such languages must be enabled in the ``dune`` project file separately: .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (using coq 0.2) If such extensions are experimental, it's recommended that they pass ``~experimental:true``, and that their versions are below 1.0. -We also recommend that such extensions introduce stanzas or fields of the -form ``ext_name.stanza_name`` or ``ext_name.field_name`` to clarify -which extensions provide a certain feature. +We also recommend that such extensions introduce stanzas or fields of the form +``ext_name.stanza_name`` or ``ext_name.field_name`` to clarify which extensions +provide a certain feature. Dune Rules ========== @@ -221,18 +254,18 @@ Creating Rules A Dune rule consists of 3 components: -- *Dependencies* that the rule may read when executed (files, aliases, etc.), +- *Dependencies* that the rule may read when executed (files, aliases, etc.), described by ``'a Action_builder.t`` values. -- *Targets* that the rule produces (files and/or directories), - described by ``'a Action_builder.With_targets.t'`` values. +- *Targets* that the rule produces (files and/or directories), described by + ``'a Action_builder.With_targets.t'`` values. -- *Action* that Dune must execute (external programs, redirects, etc.). - Actions are represented by ``Action.t`` values. +- *Action* that Dune must execute (external programs, redirects, etc.). Actions + are represented by ``Action.t`` values. Combined, one needs to produce an ``Action.t Action_builder.With_targets.t`` -value to create a rule. The rule may then be added by -``Super_context.add_rule`` or a related function. +value to create a rule. The rule may then be added by ``Super_context.add_rule`` +or a related function. To make this maximally convenient, there's a ``Command`` module to make it easier to create actions that run external commands and describe their targets @@ -251,9 +284,9 @@ algorithm that tries to load the rule that generates some target file `t`. - Look up the rule for `t` in this map. -To adhere to this loading scheme, we must generate our rules as part -of the callback that creates targets in that directory. See the ``Gen_rules`` -module for how this callback is constructed. +To adhere to this loading scheme, we must generate our rules as part of the +callback that creates targets in that directory. See the ``Gen_rules`` module +for how this callback is constructed. Documentation ============= @@ -279,3 +312,6 @@ For automatically updated builds, you can install sphinx-autobuild, and run .. _sphinx_rtd_theme: https://sphinx-rtd-theme.readthedocs.io/en/stable/ .. _sphinx-autobuild: https://pypi.org/project/sphinx-autobuild/ .. _dune-release: https://github.com/ocamllabs/dune-release + +Nix users may drop into a development shell with the necessary dependencies for +building docs ``nix develop .#doc``. diff --git a/duniverse/dune_/doc/index.rst b/duniverse/dune_/doc/index.rst index 6d96e5eb1..752c4fcad 100644 --- a/duniverse/dune_/doc/index.rst +++ b/duniverse/dune_/doc/index.rst @@ -3,36 +3,51 @@ You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. -Welcome to dune's documentation! +Welcome to Dune's Documentation! ================================ +.. We include the titles of the pages here to make sure they are in + alphabetical order. Eventually we should name the files and titles + similarly. + .. toctree:: + :caption: Getting Started and Core Concepts :maxdepth: 3 overview quick-start - usage dune-files concepts - tests - instrumentation + usage + +.. toctree:: + :caption: Reference + :maxdepth: 3 + + formatting + coq + cross-compilation foreign-code + caching + dune-libs + rpc documentation - jsoo sites + instrumentation + jsoo + lexical-conventions opam - variants - formatting - cross-compilation - dune-libs - coq advanced-topics - lexical-conventions + toplevel-integration + variants + tests + +.. toctree:: + :caption: Miscellaneous + :maxdepth: 3 + faq + goals known-issues migration - caching - toplevel-integration - rpc - goals hacking diff --git a/duniverse/dune_/doc/instrumentation.rst b/duniverse/dune_/doc/instrumentation.rst index c96f73e35..484e070b0 100644 --- a/duniverse/dune_/doc/instrumentation.rst +++ b/duniverse/dune_/doc/instrumentation.rst @@ -88,14 +88,14 @@ To enable an instrumentation backend globally, type the following in your .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (instrument_with bisect_ppx) or for each context individually: .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (context default) (context (default (name coverage) (instrument_with bisect_ppx))) (context (default (name profiling) (instrument_with landmarks))) diff --git a/duniverse/dune_/doc/jsoo.rst b/duniverse/dune_/doc/jsoo.rst index efd6e0192..04dd535b5 100644 --- a/duniverse/dune_/doc/jsoo.rst +++ b/duniverse/dune_/doc/jsoo.rst @@ -1,8 +1,8 @@ .. _jsoo: -********************** -JavaScript Compilation -********************** +*************************************** +JavaScript Compilation With Js_of_ocaml +*************************************** Js_of_ocaml_ is a compiler from OCaml to JavaScript. The compiler works by translating OCaml bytecode to JS files. The compiler can be installed with opam: diff --git a/duniverse/dune_/doc/opam.rst b/duniverse/dune_/doc/opam.rst index 6ae2e9ddc..b30325562 100644 --- a/duniverse/dune_/doc/opam.rst +++ b/duniverse/dune_/doc/opam.rst @@ -94,7 +94,7 @@ configuration will tell Dune to generate two opam files: ``cohttp.opam`` and .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (name cohttp) ; version field is optional (version 1.0.0) diff --git a/duniverse/dune_/doc/overview.rst b/duniverse/dune_/doc/overview.rst index b02891652..e3422c9db 100644 --- a/duniverse/dune_/doc/overview.rst +++ b/duniverse/dune_/doc/overview.rst @@ -5,115 +5,116 @@ Overview Introduction ============ -Dune is a build system for OCaml (with support for Reason and Coq). -It is not intended as a completely generic build system that's able -to build any project in any language. On the contrary, it makes -lots of choices in order to encourage a consistent development style. - -This scheme is inspired from the one used inside Jane Street and adapted -to the opam world. It has matured over a long time and is used daily by -hundreds of developers, which means that it is highly tested and -productive. - -When using Dune, you give very little, high-level information to -the build system, which in turn takes care of all the low-level -details from the compilation of your libraries, executables, and -documentation to the installation, setting up of tests, and setting up -development tools such as Merlin, etc. - -In addition to the normal features expected from an OCaml build system, -Dune provides a few additional ones that separate it from -the crowd: - -- You never need to tell Dune the location of things such as libraries. - Dune will discover them automatically. In particular, this - means that when you want to re-organize your project, you need nothing other - than to rename your directories, Dune will do the rest. - -- Things always work the same whether your dependencies are local or - installed on the system. In particular, this means that you can - insert the source for a project dependency in your working - copy, and Dune will start using it immediately. This makes Dune a - great choice for multi-project development. - -- Cross-platform: as long as your code is portable, Dune will be - able to cross-compile it (note that Dune is designed internally - to make this easy, but the actual support is not implemented yet) - -- Release directly from any revision: Dune needs no setup stage. To - release your project, simply point to a specific tag. Of course, you can - add some release steps if you'd like, but it isn't - necessary. - -The first section below defines some terms used in -this manual. The second section specifies the Dune metadata -format, and the third one describes how to use the ``dune`` command. +Dune is a build system for OCaml (with support for Reason and Coq). It is not +intended as a completely generic build system that's able to build any project +in any language. On the contrary, it makes lots of choices in order to encourage +a consistent development style. + +This scheme is inspired from the one used inside Jane Street and adapted to the +opam world. It has matured over a long time and is used daily by hundreds of +developers, which means that it is highly tested and productive. + +When using Dune, you give very little, high-level information to the build +system, which in turn takes care of all the low-level details from the +compilation of your libraries, executables, and documentation to the +installation, setting up of tests, and setting up development tools such as +Merlin, etc. + +In addition to the normal features expected from an OCaml build system, Dune +provides a few additional ones that separate it from the crowd: + +- You never need to tell Dune the location of things such as libraries. Dune + will discover them automatically. In particular, this means that when you + want to reorganise your project, you need nothing other than to rename your + directories, Dune will do the rest. + +- Things always work the same whether your dependencies are local or installed + on the system. In particular, this means that you can insert the source for a + project dependency in your working copy, and Dune will start using it + immediately. This makes Dune a great choice for multi-project development. + +- Cross-platform: as long as your code is portable, Dune will be able to + cross-compile it. Read more in the :ref:`cross-compilation` section. + +- Release directly from any revision: Dune needs no setup stage. To release + your project, simply point to a specific Git tag (named revision). Of course, + you can add some release steps if you'd like, but it isn't necessary. For + more information, please refer to `dune-release + `_. + +The first section below defines some terms used in this manual. The second +section specifies the Dune metadata format, and the third one describes how to +use the ``dune`` command. Terminology =========== -- **package**: a set of libraries and executables that - opam builds and installs as one +- **root**: the top-most directory in a GitHub repo, workspace, and project, + differentiated by variables such as `%{workspace_root}` and `%{project_root`. + Dune builds things from this directory. It knows how to build targets that + are descendants of the root. Anything outside of the tree starting from the + root is considered part of the **installed world**. Refer to + :ref:`finding-root` to learn how the workspace root is determined. -- **project**: a source tree, maybe containing one or more - packages +- **workspace**: the subtree starting from each root. It can contain any number + of projects that will be built simultaneously by Dune, and it must contain a + `dune-workspace` file. -- **root**: the directory from where Dune can build - things. Dune knows how to build targets that are descendants of - the root. Anything outside of the tree starting from the root is - considered part of the **installed world**. How the root is - determined is explained in :ref:`finding-root`. +- **project**: a collection of source files that must include a `dune-project` + file. It may also contain one or more packages. Each directory in the tree, + including the root, must have a `dune` file specifying how to build the files + in its directory. Projects can be shared between different applications. -- **workspace**: the subtree starting from the root. - It can contain any number of projects that will be built - simultaneously by Dune. +- **package**: a set of libraries and executables that opam builds and installs + as one. -- **installed world**: anything outside of the workspace, that Dune - takes for granted and doesn't know how to build +- **installed world**: anything outside of the workspace. Dune doesn't know how + to build things in the installed world. -- **installation**: the action of copying build artifacts or - other files from the ``/_build`` directory to the installed - world +- **installation**: the action of copying build artifacts or other files from + the ``/_build`` directory to the installed world. -- **scope**: determines where private items are - visible. Private items include libraries or binaries that will not - be installed. In Dune, scopes are subtrees rooted where at - least one ``.opam`` file is present. Moreover, scopes are - exclusive. Typically, every project defines a single scope. See - :ref:`scopes` for more details. +- **scope**: defined by any directory that contains at least one + `.opam` file. Typically, every project defines a single scope that + is a subtree starting from this directory. Moreover, scopes are separate from + your project's dependencies. The scope also determines where private items + are visible. Private items include libraries or binaries that will not be + installed. See :ref:`scopes` for more details. -- **build context**: a subdirectory of the - ``/_build`` directory. It contains all the build artifacts of - the workspace built against a specific configuration. Without - specific configuration from the user, there is always a ``default`` - build context, which corresponds to the environment in which Dune - executes. Build contexts can be specified by writing a - :ref:`dune-workspace` file. +- **build context**: a specific configuration written in a + :ref:`dune-workspace` file, which has a corresponding subdirectory in the + ``/_build`` directory. It contains all the workspace's build artifacts. + Without this specific configuration from the user, there is always a + ``default`` build context that corresponds to the executed Dune environment. - **build context root**: the root of a build context named ``foo`` is - ``/_build/`` - -- **alias**: a build target that doesn't produce any file and has - configurable dependencies. Aliases are per-directory. However, on the command - line, asking to build an alias in a given directory will trigger the - construction of the alias in all children directories recursively. Dune - defines several :ref:`builtin-aliases`. - -- **environment**: in Dune, each directory has an environment - attached to it. The environment determines the default values of - various parameters, such as the compilation flags. Inside a scope, - each directory inherits the environment from its parent. At the root - of every scope, a default environment is used. At any point, the + ``/_build/``. + +- **build target**: specified on the command line, e.g., `dune build + `. All targets that Dune knows how to build live in the + `_build` directory. + +- **alias**: a build target that doesn't produce any file and has configurable + dependencies. Targets starting with `@` on the command line are interpreted as + aliases (e.g., `dune build @src/runtest`). Aliases are per-directory. However, + asking to build an alias in a given directory will also trigger alias + construction in all children directories recursively. If no target is + specified, Dune builds the `default` alias. Dune defines several + :ref:`builtin-aliases`. + +- **environment**: determines the default values of various parameters, such as + the compilation flags. In Dune, each directory has an environment attached to + it. Inside a scope, each directory inherits the environment from its parent. + At the root of every scope, a default environment is used. At any point, the environment can be altered using an :ref:`dune-env` stanza. -- **build profile**: a global setting that influences various - defaults. It can be set from the command line using ``--profile - `` or from ``dune-workspace`` files. The following - profiles are standard: +- **build profile**: a global setting that influences various defaults. It can + be set from the command line using ``--profile `` or from + ``dune-workspace`` files. The following profiles are standard: - ``release`` which is the profile used for opam releases - - ``dev`` which is the default profile when none is set explicitly, it - has stricter warnings than the ``release`` one + - ``dev`` which is the default profile when none is set explicitly, it has + stricter warnings than the ``release`` one Project Layout ============== @@ -123,8 +124,8 @@ A typical Dune project will have a ``dune-project`` and one or more interesting things are: libraries, executables, tests, documents to install, etc. -We recommended organizing your project to have exactly one library -per directory. You can have several executables in the same directory, as long -as they share the same build configuration. If you'd like to have multiple +We recommended organising your project to have exactly one library per +directory. You can have several executables in the same directory, as long as +they share the same build configuration. If you'd like to have multiple executables with different configurations in the same directory, you will have to make an explicit module list for every executable using ``modules``. diff --git a/duniverse/dune_/doc/papers/ocaml-2021/memo.md b/duniverse/dune_/doc/papers/ocaml-2021/memo.md index e877f2752..03e151170 100644 --- a/duniverse/dune_/doc/papers/ocaml-2021/memo.md +++ b/duniverse/dune_/doc/papers/ocaml-2021/memo.md @@ -135,7 +135,7 @@ are keen to investigate how far we can take it in practice. Memo is still in active development and we welcome feedback from the OCaml community on how to make it better. While the current implementation is tied to Dune's lightweight concurrency library Fiber, the core functionality can be made -available as a functor over an arbitrary concurrency monad, making it useable +available as a functor over an arbitrary concurrency monad, making it usable with Async and Lwt. ## Acknowledgements diff --git a/duniverse/dune_/doc/quick-start.rst b/duniverse/dune_/doc/quick-start.rst index e1741fa88..4b2b6d09f 100644 --- a/duniverse/dune_/doc/quick-start.rst +++ b/duniverse/dune_/doc/quick-start.rst @@ -4,7 +4,24 @@ Quickstart This document gives simple usage examples of Dune. You can also look at `examples `__ for complete -examples of projects using Dune. +examples of projects using Dune with [CRAM stanzas](https://ocaml.org/p/craml/1.0.0). + + +Install Dune +============ + +The best way to install Dune is with opam: + +.. code:: shell + + opam install dune + +Then run ``eval $(opam env)`` to update the shell. When creating a new +directory or changing directories, run ``eval $(opam env)`` if you +get the `dune` command not found error. + +Now you're ready to create your first workspace and initialize projects. + Initializing Projects ===================== @@ -65,24 +82,26 @@ You can run your program with: dune exec project_name +This simple project will print "Hello World" in your shell. + The following itemization of the generated content isn't necessary to review at this point. But whenever you are ready, it will provide jump-off points from which you can dive deeper into Dune's capabilities: * The ``dune-project`` file specifies metadata about the project, including its name, packaging data (including dependencies), and information about the - authors and maintainers. You should open this in your editor to fill in the + authors and maintainers. Open this in your editor to fill in the placeholder values. See :ref:`dune-project` for details. * The ``test`` directory contains a skeleton for your project's tests. Add to the tests by editing ``test/project_name.ml``. See :ref:`writing-tests` for details on testing. -* The ``lib`` directory will hold the library you write to provide the core - functionality of your executable. Add modules to your library by creating new +* The ``lib`` directory will hold the library you write to provide your executable's core + functionality. Add modules to your library by creating new ``.ml`` files in this directory. See :ref:`library` for details on specifying libraries manually. * The ``bin`` directory holds a skeleton for the executable program. Within the modules in this directory, you can access the modules in your ``lib`` under - the namespace ``Project_name.Mod``, where ``Project_name`` is replaced with + the namespace ``project_name.Mod``, where ``project_name`` is replaced with the name of your project and ``Mod`` corresponds to the name of the file in the ``lib`` directory. You can run the executable with ``dune exec project_name``. See :ref:`hello-world-program` for an example of specifying @@ -91,7 +110,7 @@ which you can dive deeper into Dune's capabilities: ``dune-project`` file whenever you build your project. You shouldn't need to worry about this, but you can see :ref:`opam-generation` for details. * The ``dune`` files in each directory specify the component to be built with - the files in that directory. For details on dune files, see :ref:`dune-files`. + the files in that directory. For details on ``dune`` files, see :ref:`dune-files`. Initializing a Library ---------------------- @@ -144,12 +163,13 @@ All of the subcomponents generated are the same as those described in .. _hello-world-program: -Building a Hello World Program -============================== +Building a Hello World Program From Scratch +=========================================== +Create a new directory within a Dune project (:ref:`initializing-an-executable`). Since OCaml is a compiled language, first create a ``dune`` file in Nano, Vim, or your preferred text editor. Declare the ``hello_world`` executable by including following stanza -(shown below). Name this initial file ``dune`` and save it in a directory of your choice. +(shown below). Name this initial file ``dune`` and save it. .. code:: scheme @@ -169,18 +189,24 @@ Next, build your new program in a shell using this command: dune build hello_world.exe -The executable will create a directory called "build" and create the +The will create a directory called``_build`` and build the program: ``_build/default/hello_world.exe``. Note that native code executables will have the ``.exe`` extension on all platforms (including non-Windows systems). Finally, run it with the following command to see that it worked. In fact, the executable can both be built and run in a single -step with ``dune exec ./hello_world.exe``. +step: + +.. code:: bash + + dune exec -- ./hello_world.exe + +Voila! This should print "Hello, world!" in the command line. Please note: if you have Dune, opam, and OCaml installed, but you get an error that the ``dune`` command isn't recognized, it will be necessary -to run ``eval $(opam config env)`` to enable Dune in your directory. Find more +to run ``eval $(opam env)`` to enable Dune in your directory. Find more information in the `Dune ReadMe `. Verify OCaml installation with ``ocaml -version`` @@ -190,7 +216,7 @@ If you still get an error that the ``dune`` command isn't recognized, try runnin the following in this order: ``opam switch create . ocaml-base-compiler`` ``opam install merlin ocp-indent dune utop`` -Then run ``eval $(opam config env)`` again before trying to build and run +Then run ``eval $(opam env)`` again before trying to build and run your new hello_world.exe program. diff --git a/duniverse/dune_/doc/rpc.rst b/duniverse/dune_/doc/rpc.rst index 4ecdf5d2d..0c30c7cff 100644 --- a/duniverse/dune_/doc/rpc.rst +++ b/duniverse/dune_/doc/rpc.rst @@ -44,11 +44,10 @@ The library provides an API to do the following: Connecting ========== -To connect to dune's RPC server, ``$ dune rpc init`` must be ran. This command -will initiate a new RPC session communicating over `stdin`, `stdout`. When -instantiating the ``Client`` functor, a read/write ``Chan.t`` must be provided. -This ``Chan.t`` value should represent read/write from stdin/stdout -respectively. +To connect to Dune's RPC server, it needs to be started in watch mode. It is +possible to use ``dune build --passive-watch-mode`` to start an RPC server which +will listen for requests without starting a build by itself. Then ``dune rpc +build .`` will connect to it, trigger a build, and report status. .. _lwt: https://github.com/ocsigen/lwt .. _Dune_rpc: https://github.com/ocaml/dune/blob/main/otherlibs/dune-rpc/dune_rpc.mli diff --git a/duniverse/dune_/doc/sites.rst b/duniverse/dune_/doc/sites.rst index 55fddb22e..6cbe1df48 100644 --- a/duniverse/dune_/doc/sites.rst +++ b/duniverse/dune_/doc/sites.rst @@ -26,7 +26,7 @@ consists of a name and a :ref:`section` (e.g ``lib``, ``share``, .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (using dune_site 0.1) (name mygui) @@ -44,7 +44,7 @@ in the section ``share``. This package can add files to this ``site`` using the .. code:: scheme (install - (section (site mygui themes)) + (section (site (mygui themes))) (files (layout.css as default/layout.css) (ok.png as default/ok.png) @@ -95,29 +95,28 @@ Then inside ``mygui.ml`` module the locations can be recovered and used: (** Locations of the site for the themes *) let themes_locations : string list = Mysites.Sites.themes - - (** Merge the content of the directories in [dirs] *) - let rec readdirs dirs = - List.concat - (List.map - (fun dir -> Array.to_list (Sys.readdir dir)) - (List.filter Sys.file_exists dirs)) - - (** Get the lists of the available themes *) - let find_available_themes () : string list = lookup_dirs themes_locations - - (** Lookup a file in the directories *) - let rec lookup_file filename = function - | [] -> raise Not_found - | dir::dirs -> - let filename' = Filename.concat dir filename in - if Sys.file_exists filename' then filename' - else lookup_file filename dirs - + + (** Merge the contents of the directories in [dirs] *) + let lookup_dirs dirs = + List.filter Sys.file_exists dirs + |> List.map (fun dir -> Array.to_list (Sys.readdir dir)) + |> List.concat + + (** Get the available themes *) + let find_available_themes () = lookup_dirs themes_locations + + (** [lookup_file name dirs] finds the first file called [name] in [dirs] *) + let lookup_file filename dirs = + List.find_map + (fun dir -> + let filename' = Filename.concat dir filename in + if Sys.file_exists filename' then Some filename' else None) + dirs + (** [lookup_theme_file theme file] get the [file] of the [theme] *) let lookup_theme_file file theme = lookup_file (Filename.concat theme file) themes_locations - + let get_layout_css = lookup_theme_file "layout.css" let get_ok_ico = lookup_theme_file "ok.png" let get_ko_ico = lookup_theme_file "ko.png" @@ -140,7 +139,7 @@ install --relocatable --prefix $dir``. The files will be copied to the directory to its location. So even if the directory ``$dir`` is moved, ``themes_locations`` will be correct. -For installation trough opam, ``dune install`` must be invoked with the option +For installation through opam, ``dune install`` must be invoked with the option ``--create-install-files`` which creates an install file ``.install`` and copy the file that needs substitution to an intermediary directory. The ``.opam`` file generated by Dune :ref:`generate_opam_files` does the right @@ -226,7 +225,7 @@ Main Executable (C) .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (using dune_site 0.1) (name app) @@ -280,7 +279,7 @@ The Plugin "plugin1" .. code:: scheme - (lang dune 3.4) + (lang dune 3.6) (using dune_site 0.1) (generate_opam_files true) diff --git a/duniverse/dune_/doc/test/run.t b/duniverse/dune_/doc/test/run.t index d4e0fe256..dc46fd84f 100644 --- a/duniverse/dune_/doc/test/run.t +++ b/duniverse/dune_/doc/test/run.t @@ -13,4 +13,5 @@ is fine, but you then need to update the list of such exceptions below. ../formatting.rst:.. note:: This section applies only to projects with ``(lang dune 1.x)``. ../formatting.rst:In ``(lang dune 1.x)``, there is no default formatting. This feature is ../formatting.rst:(lang dune 2.0) + ../hacking.rst:``(lang dune 2.7)`` in their ``dune`` project file to use it. ../tests.rst: (lang dune 2.7) diff --git a/duniverse/dune_/doc/toplevel-integration.rst b/duniverse/dune_/doc/toplevel-integration.rst index 9b9b304a0..1cdc9eb28 100644 --- a/duniverse/dune_/doc/toplevel-integration.rst +++ b/duniverse/dune_/doc/toplevel-integration.rst @@ -25,6 +25,17 @@ you type in the toplevel will be rewritten with these PPX rewriters. This command became available with Dune 2.5.0. +It's also possible to load individual modules (since dune 3.4.0) for +interactive development. Use the following dune command: + +.. code:: ocaml + + # #use_output "dune ocaml top-module foo.ml";; + +This will print directives that will load ``foo.ml`` without sealing it behind +``foo.mli``. This is particularly useful for peeking and prodding at a module's +internals. + Note that the ``#use_output`` directive has only been available since OCaml 4.11. You can add the following snippet to your ``~/.ocamlinit`` file to make it available in older versions of OCaml: diff --git a/duniverse/dune_/doc/update-jbuild.sh b/duniverse/dune_/doc/update-jbuild.sh index 2db491c3a..0db9b7613 100755 --- a/duniverse/dune_/doc/update-jbuild.sh +++ b/duniverse/dune_/doc/update-jbuild.sh @@ -5,7 +5,7 @@ set -e -o pipefail CMDS=$(dune --help=plain | \ - sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+) ?.*/\1/p') + sed -n '/COMMAND ALIASES/,/COMMON OPTIONS/p' | sed -En 's/^ ([a-z-]+) ?.*/\1/p') for cmd in $CMDS; do cat <`` will be passed as arguments to the start ``utop``, with the libraries defined in ``lib`` and implicit bindings for toplevel expressions. +Dune also supports loading individual modules unsealed by their signatures into +the toplevel. This is accomplished by launching a toplevel and then asking dune +to return the toplevel directives needed to evaluate the module: + +.. code:: bash + + $ utop + # use_output "dune top-module path/to/module.ml";; + Requirements & Limitations -------------------------- @@ -421,6 +430,8 @@ Git, ``dune-release`` invokes this command to find out the version: $ git describe --always --dirty --abbrev=7 1.0+beta9-79-g29e9b37 +If no VCS is detected, ``dune subst`` will do nothing. + Projects using Dune usually only need ``dune-release`` for creating and publishing releases. However, they may still substitute the watermarks when the user pins the package. To help with this, diff --git a/duniverse/dune_/docker/dev.Dockerfile b/duniverse/dune_/docker/dev.Dockerfile new file mode 100644 index 000000000..2cd033ee4 --- /dev/null +++ b/duniverse/dune_/docker/dev.Dockerfile @@ -0,0 +1,10 @@ +# little dockerfile to debug CI issues +FROM ocaml/opam +RUN mkdir -p /home/opam/dune/_boot /home/opam/dune/_build && chown opam:opam /home/opam/dune/_boot /home/opam/dune/_build +COPY Makefile Makefile +COPY .ocamlformat .ocamlformat +RUN --mount=type=cache,target=/var/cache/apt sudo apt-get install -y pkg-config nodejs strace file && make dev-depext +# XXX not really correct as we should copy dune's source and pin it first. But +# this docker file is mostly useful for quickly figuring out CI issues, so we +# aren't too concerned +RUN opam update && make dev-deps && rm .ocamlformat Makefile diff --git a/duniverse/dune_/docker/dev.yml b/duniverse/dune_/docker/dev.yml new file mode 100644 index 000000000..bbad96d0d --- /dev/null +++ b/duniverse/dune_/docker/dev.yml @@ -0,0 +1,13 @@ +volumes: + _build: + _boot: +services: + dune: + image: dune + user: opam + tty: true + stdin_open: true + volumes: + - ../:/home/opam/dune + - _build:/home/opam/dune/_build/ + - _boot:/home/opam/dune/_boot/ diff --git a/duniverse/dune_/dune b/duniverse/dune_/dune index b5a49d787..65eae7048 100644 --- a/duniverse/dune_/dune +++ b/duniverse/dune_/dune @@ -1,3 +1,7 @@ +(dirs _boot :standard \ result) + +(data_only_dirs _boot) + (rule (copy dune-private-libs.opam.template dune-configurator.opam.template)) diff --git a/duniverse/dune_/dune-action-plugin.opam b/duniverse/dune_/dune-action-plugin.opam index d32c38b94..148ed4b2c 100644 --- a/duniverse/dune_/dune-action-plugin.opam +++ b/duniverse/dune_/dune-action-plugin.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "[experimental] API for writing dynamic Dune actions" @@ -18,12 +18,13 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "dune-glob" {= version} "csexp" {>= "1.5.0"} "ppx_expect" {with-test} "stdune" {= version} "dune-private-libs" {= version} + "dune-rpc" {= version} "base-unix" "odoc" {with-doc} ] diff --git a/duniverse/dune_/dune-build-info.opam b/duniverse/dune_/dune-build-info.opam index 173c56b63..9e5d90007 100644 --- a/duniverse/dune_/dune-build-info.opam +++ b/duniverse/dune_/dune-build-info.opam @@ -1,7 +1,7 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.4.1" -synopsis: "Embed build informations inside executable" +version: "3.6.1" +synopsis: "Embed build information inside executable" description: """ The build-info library allows to access information about how the executable was built, such as the version of the project at which it @@ -17,7 +17,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08"} "odoc" {with-doc} ] diff --git a/duniverse/dune_/dune-configurator.opam b/duniverse/dune_/dune-configurator.opam index 2792f7780..dff7d8de8 100644 --- a/duniverse/dune_/dune-configurator.opam +++ b/duniverse/dune_/dune-configurator.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.4.1" +version: "3.6.1" synopsis: "Helper library for gathering system configuration" description: """ dune-configurator is a small library that helps writing OCaml scripts that @@ -19,7 +19,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.04.0"} "base-unix" "csexp" {>= "1.5.0"} diff --git a/duniverse/dune_/dune-glob.opam b/duniverse/dune_/dune-glob.opam index 2f8fdb560..98b35afa5 100644 --- a/duniverse/dune_/dune-glob.opam +++ b/duniverse/dune_/dune-glob.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Glob string matching language supported by dune" @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "stdune" {= version} "dune-private-libs" {= version} "odoc" {with-doc} diff --git a/duniverse/dune_/dune-private-libs.opam b/duniverse/dune_/dune-private-libs.opam index 578cfed8e..432e1e89f 100644 --- a/duniverse/dune_/dune-private-libs.opam +++ b/duniverse/dune_/dune-private-libs.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Private libraries of Dune" @@ -18,7 +18,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "csexp" {>= "1.5.0"} "pp" {>= "1.1.0"} "dyn" {= version} diff --git a/duniverse/dune_/dune-project b/duniverse/dune_/dune-project index 0232ae685..7e3fc695e 100644 --- a/duniverse/dune_/dune-project +++ b/duniverse/dune_/dune-project @@ -1,9 +1,9 @@ -(lang dune 3.3) +(lang dune 3.5) ; ^^^ ; When changing the version, don't forget to regenerate *.opam files ; by running [dune build]. (name dune) -(version 3.4.1) +(version 3.6.1) (generate_opam_files true) @@ -53,7 +53,7 @@ for free. (package (name dune-build-info) - (synopsis "Embed build informations inside executable") + (synopsis "Embed build information inside executable") (depends (ocaml (>= 4.08))) (description "\ @@ -111,6 +111,7 @@ Among other things, dune-configurator allows one to: (ppx_expect :with-test) (stdune (= :version)) (dune-private-libs (= :version)) + (dune-rpc (= :version)) base-unix) (description "\ @@ -134,7 +135,7 @@ understood by dune language.")) (package (name dune-site) - (synopsis "Embed locations informations inside executable and libraries") + (synopsis "Embed locations information inside executable and libraries") (depends (dune-private-libs (= :version))) (description "")) diff --git a/duniverse/dune_/dune-rpc-lwt.opam b/duniverse/dune_/dune-rpc-lwt.opam index ebdfda622..edcc17846 100644 --- a/duniverse/dune_/dune-rpc-lwt.opam +++ b/duniverse/dune_/dune-rpc-lwt.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Communicate with dune using rpc and Lwt" @@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "dune-rpc" {= version} "result" {>= "1.5"} "csexp" {>= "1.5.0"} diff --git a/duniverse/dune_/dune-rpc.opam b/duniverse/dune_/dune-rpc.opam index d94f80c52..4fdb22e38 100644 --- a/duniverse/dune_/dune-rpc.opam +++ b/duniverse/dune_/dune-rpc.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Communicate with dune using rpc" @@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "csexp" "ordering" "dyn" diff --git a/duniverse/dune_/dune-site.opam b/duniverse/dune_/dune-site.opam index 95e36dd9e..81ddb8541 100644 --- a/duniverse/dune_/dune-site.opam +++ b/duniverse/dune_/dune-site.opam @@ -1,7 +1,7 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" -synopsis: "Embed locations informations inside executable and libraries" +synopsis: "Embed locations information inside executable and libraries" description: "" maintainer: ["Jane Street Group, LLC "] authors: ["Jane Street Group, LLC "] @@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "dune-private-libs" {= version} "odoc" {with-doc} ] diff --git a/duniverse/dune_/dune.exe b/duniverse/dune_/dune.exe new file mode 100755 index 000000000..529061c92 --- /dev/null +++ b/duniverse/dune_/dune.exe @@ -0,0 +1,2 @@ +#!/usr/bin/env sh +exec "$(dirname $0)/_boot/dune.exe" $@ diff --git a/duniverse/dune_/dune.opam b/duniverse/dune_/dune.opam index 1228e61a7..0ae071fe7 100644 --- a/duniverse/dune_/dune.opam +++ b/duniverse/dune_/dune.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Fast, portable, and opinionated build system" @@ -38,8 +38,8 @@ conflicts: [ ] dev-repo: "git+https://github.com/ocaml/dune.git" build: [ - ["ocaml" "bootstrap.ml" "-j" jobs] - ["./dune.exe" "build" "dune.install" "--release" "--profile" "dune-bootstrap" "-j" jobs] + ["ocaml" "boot/bootstrap.ml" "-j" jobs] + ["./_boot/dune.exe" "build" "dune.install" "--release" "--profile" "dune-bootstrap" "-j" jobs] ] depends: [ # Please keep the lower bound in sync with .github/workflows/workflow.yml, diff --git a/duniverse/dune_/dune.opam.template b/duniverse/dune_/dune.opam.template index b4def1ecf..4149cba8a 100644 --- a/duniverse/dune_/dune.opam.template +++ b/duniverse/dune_/dune.opam.template @@ -1,6 +1,6 @@ build: [ - ["ocaml" "bootstrap.ml" "-j" jobs] - ["./dune.exe" "build" "dune.install" "--release" "--profile" "dune-bootstrap" "-j" jobs] + ["ocaml" "boot/bootstrap.ml" "-j" jobs] + ["./_boot/dune.exe" "build" "dune.install" "--release" "--profile" "dune-bootstrap" "-j" jobs] ] depends: [ # Please keep the lower bound in sync with .github/workflows/workflow.yml, diff --git a/duniverse/dune_/dyn.opam b/duniverse/dune_/dyn.opam index 1e63835f9..fce7b643e 100644 --- a/duniverse/dune_/dyn.opam +++ b/duniverse/dune_/dyn.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.4.1" +version: "3.6.1" synopsis: "Dynamic type" description: "Dynamic type" maintainer: ["Jane Street Group, LLC "] @@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "ordering" {= version} "pp" {>= "1.1.0"} diff --git a/duniverse/dune_/editor-integration/emacs/dune-watch.el b/duniverse/dune_/editor-integration/emacs/dune-watch.el index 208688af6..c9f62cb9d 100644 --- a/duniverse/dune_/editor-integration/emacs/dune-watch.el +++ b/duniverse/dune_/editor-integration/emacs/dune-watch.el @@ -69,8 +69,8 @@ (defconst dune-watch-process-name "*dune-watch-process*" "Name of process used to run dune watch.") -(defconst dune-watch-header "********** NEW BUILD **********" - "Header of dune watch output.") +(defconst dune-watch-header "********** NEW BUILD" + "Prefix of the header of dune watch output.") (defconst dune-watch-read-prompt "dune task (default: %s): " "Prompt displayed to the user to dune task.") diff --git a/duniverse/dune_/example/hello_world.t/README.org b/duniverse/dune_/example/hello_world.t/README.org index 06d4b7fcf..677ef0bcd 100644 --- a/duniverse/dune_/example/hello_world.t/README.org +++ b/duniverse/dune_/example/hello_world.t/README.org @@ -5,7 +5,7 @@ The library is defined in =lib= and the executable in =bin=. It also defines a test in =test=. At the toplevel of the project, there is a =hello_world.opam= -file. This file is required so that =dune= knows that this is the +file. This file is required so that Dune knows that this is the =hello_world= project. To build everything that is meant to be installed in this project, diff --git a/duniverse/dune_/example/with-configure-step.t/README.org b/duniverse/dune_/example/with-configure-step.t/README.org index aa05a7719..2bec126b6 100644 --- a/duniverse/dune_/example/with-configure-step.t/README.org +++ b/duniverse/dune_/example/with-configure-step.t/README.org @@ -1,20 +1,20 @@ This project shows how to add a configure step to a project using -dune. +Dune. In order to keep things composable, it offers several way to configure the project: 1. with the classic =./configure =. When doing this, the configuration - script are run immediately and the resulting configuration is frozen for the - rest of the build + script are run immediately, and the resulting configuration is frozen for the + rest of the build. 2. by copying =config.defaults= to =config= and editing it. The configuration scripts will be run as part of the build using what is written in =config=. When =config= is edited, the configuration - scripts will be automatically re-run + scripts will be automatically rerun. 3. by doing nothing. The configuration scripts will be run as part of the build - using the default values provided in =config.defaults= + using the default values provided in =config.defaults=. Technically this is how it works: @@ -31,6 +31,6 @@ the toplevel =dune= file: - a rule to produce =config= by copying =config.default= - a rule to produce =config.full= by running =real_configure.ml= -The reason it all work as described is because if Dune knows how +This all works as described because if Dune knows how to build a file and this file is already present in the source tree, -it will always prefer the file that's already there +it will always prefer the file that's already there. diff --git a/duniverse/dune_/fiber.opam b/duniverse/dune_/fiber.opam index 0e33178b8..9bc4100a5 100644 --- a/duniverse/dune_/fiber.opam +++ b/duniverse/dune_/fiber.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Structured concurrency library" @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "stdune" {= version} "dyn" {= version} diff --git a/duniverse/dune_/flake.lock b/duniverse/dune_/flake.lock new file mode 100644 index 000000000..affba3718 --- /dev/null +++ b/duniverse/dune_/flake.lock @@ -0,0 +1,743 @@ +{ + "nodes": { + "alejandra": { + "inputs": { + "fenix": "fenix", + "flakeCompat": "flakeCompat", + "nixpkgs": [ + "melange", + "dream2nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1658427149, + "narHash": "sha256-ToD/1z/q5VHsLMrS2h96vjJoLho59eNRtknOUd19ey8=", + "owner": "kamadorueda", + "repo": "alejandra", + "rev": "f5a22afd2adfb249b4e68e0b33aa1f0fb73fb1be", + "type": "github" + }, + "original": { + "owner": "kamadorueda", + "repo": "alejandra", + "type": "github" + } + }, + "all-cabal-json": { + "flake": false, + "locked": { + "lastModified": 1665552503, + "narHash": "sha256-r14RmRSwzv5c+bWKUDaze6pXM7nOsiz1H8nvFHJvufc=", + "owner": "nix-community", + "repo": "all-cabal-json", + "rev": "d7c0434eebffb305071404edcf9d5cd99703878e", + "type": "github" + }, + "original": { + "owner": "nix-community", + "ref": "hackage", + "repo": "all-cabal-json", + "type": "github" + } + }, + "crane": { + "flake": false, + "locked": { + "lastModified": 1661875961, + "narHash": "sha256-f1h/2c6Teeu1ofAHWzrS8TwBPcnN+EEu+z1sRVmMQTk=", + "owner": "ipetkov", + "repo": "crane", + "rev": "d9f394e4e20e97c2a60c3ad82c2b6ef99be19e24", + "type": "github" + }, + "original": { + "owner": "ipetkov", + "repo": "crane", + "type": "github" + } + }, + "devshell": { + "flake": false, + "locked": { + "lastModified": 1663445644, + "narHash": "sha256-+xVlcK60x7VY1vRJbNUEAHi17ZuoQxAIH4S4iUFUGBA=", + "owner": "numtide", + "repo": "devshell", + "rev": "e3dc3e21594fe07bdb24bdf1c8657acaa4cb8f66", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "devshell", + "type": "github" + } + }, + "dream2nix": { + "inputs": { + "alejandra": "alejandra", + "all-cabal-json": "all-cabal-json", + "crane": "crane", + "devshell": "devshell", + "flake-utils-pre-commit": "flake-utils-pre-commit", + "ghc-utils": "ghc-utils", + "gomod2nix": "gomod2nix", + "mach-nix": "mach-nix", + "nixpkgs": [ + "melange", + "nixpkgs" + ], + "poetry2nix": "poetry2nix", + "pre-commit-hooks": "pre-commit-hooks" + }, + "locked": { + "lastModified": 1667429039, + "narHash": "sha256-Lu6da25JioHzerkLHAHSO9suCQFzJ/XBjkcGCIbasLM=", + "owner": "nix-community", + "repo": "dream2nix", + "rev": "5252794e58eedb02d607fa3187ffead7becc81b0", + "type": "github" + }, + "original": { + "owner": "nix-community", + "repo": "dream2nix", + "type": "github" + } + }, + "fenix": { + "inputs": { + "nixpkgs": [ + "melange", + "dream2nix", + "alejandra", + "nixpkgs" + ], + "rust-analyzer-src": "rust-analyzer-src" + }, + "locked": { + "lastModified": 1657607339, + "narHash": "sha256-HaqoAwlbVVZH2n4P3jN2FFPMpVuhxDy1poNOR7kzODc=", + "owner": "nix-community", + "repo": "fenix", + "rev": "b814c83d9e6aa5a28d0cf356ecfdafb2505ad37d", + "type": "github" + }, + "original": { + "owner": "nix-community", + "repo": "fenix", + "type": "github" + } + }, + "flake-compat": { + "flake": false, + "locked": { + "lastModified": 1627913399, + "narHash": "sha256-hY8g6H2KFL8ownSiFeMOjwPC8P0ueXpCVEbxgda3pko=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "12c64ca55c1014cdc1b16ed5a804aa8576601ff2", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-compat_2": { + "flake": false, + "locked": { + "lastModified": 1627913399, + "narHash": "sha256-hY8g6H2KFL8ownSiFeMOjwPC8P0ueXpCVEbxgda3pko=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "12c64ca55c1014cdc1b16ed5a804aa8576601ff2", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "flake-utils": { + "locked": { + "lastModified": 1667395993, + "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils-pre-commit": { + "locked": { + "lastModified": 1644229661, + "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_2": { + "locked": { + "lastModified": 1667395993, + "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_3": { + "locked": { + "lastModified": 1667395993, + "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_4": { + "locked": { + "lastModified": 1638122382, + "narHash": "sha256-sQzZzAbvKEqN9s0bzWuYmRaA03v40gaJ4+iL1LXjaeI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "74f7e4319258e287b0f9cb95426c9853b282730b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flake-utils_5": { + "locked": { + "lastModified": 1638122382, + "narHash": "sha256-sQzZzAbvKEqN9s0bzWuYmRaA03v40gaJ4+iL1LXjaeI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "74f7e4319258e287b0f9cb95426c9853b282730b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "flakeCompat": { + "flake": false, + "locked": { + "lastModified": 1650374568, + "narHash": "sha256-Z+s0J8/r907g149rllvwhb4pKi8Wam5ij0st8PwAh+E=", + "owner": "edolstra", + "repo": "flake-compat", + "rev": "b4a34015c698c7793d592d66adbab377907a2be8", + "type": "github" + }, + "original": { + "owner": "edolstra", + "repo": "flake-compat", + "type": "github" + } + }, + "ghc-utils": { + "flake": false, + "locked": { + "lastModified": 1662774800, + "narHash": "sha256-1Rd2eohGUw/s1tfvkepeYpg8kCEXiIot0RijapUjAkE=", + "ref": "refs/heads/master", + "rev": "bb3a2d3dc52ff0253fb9c2812bd7aa2da03e0fea", + "revCount": 1072, + "type": "git", + "url": "https://gitlab.haskell.org/bgamari/ghc-utils" + }, + "original": { + "type": "git", + "url": "https://gitlab.haskell.org/bgamari/ghc-utils" + } + }, + "gomod2nix": { + "flake": false, + "locked": { + "lastModified": 1627572165, + "narHash": "sha256-MFpwnkvQpauj799b4QTBJQFEddbD02+Ln5k92QyHOSk=", + "owner": "tweag", + "repo": "gomod2nix", + "rev": "67f22dd738d092c6ba88e420350ada0ed4992ae8", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "gomod2nix", + "type": "github" + } + }, + "mach-nix": { + "flake": false, + "locked": { + "lastModified": 1634711045, + "narHash": "sha256-m5A2Ty88NChLyFhXucECj6+AuiMZPHXNbw+9Kcs7F6Y=", + "owner": "DavHau", + "repo": "mach-nix", + "rev": "4433f74a97b94b596fa6cd9b9c0402104aceef5d", + "type": "github" + }, + "original": { + "id": "mach-nix", + "type": "indirect" + } + }, + "melange": { + "inputs": { + "dream2nix": "dream2nix", + "flake-utils": "flake-utils_2", + "nix-filter": "nix-filter", + "nixpkgs": "nixpkgs" + }, + "locked": { + "lastModified": 1667691652, + "narHash": "sha256-Mg9DQDk4m1otVXeR8sumtbzpAQaDCUUyc8o350dhP6Q=", + "owner": "melange-re", + "repo": "melange", + "rev": "d32fb9a210790274f37632b4b5b0d699e9c554fa", + "type": "github" + }, + "original": { + "owner": "melange-re", + "repo": "melange", + "type": "github" + } + }, + "mirage-opam-overlays": { + "flake": false, + "locked": { + "lastModified": 1661959605, + "narHash": "sha256-CPTuhYML3F4J58flfp3ZbMNhkRkVFKmBEYBZY5tnQwA=", + "owner": "dune-universe", + "repo": "mirage-opam-overlays", + "rev": "05f1c1823d891ce4d8adab91f5db3ac51d86dc0b", + "type": "github" + }, + "original": { + "owner": "dune-universe", + "repo": "mirage-opam-overlays", + "type": "github" + } + }, + "mirage-opam-overlays_2": { + "flake": false, + "locked": { + "lastModified": 1661959605, + "narHash": "sha256-CPTuhYML3F4J58flfp3ZbMNhkRkVFKmBEYBZY5tnQwA=", + "owner": "dune-universe", + "repo": "mirage-opam-overlays", + "rev": "05f1c1823d891ce4d8adab91f5db3ac51d86dc0b", + "type": "github" + }, + "original": { + "owner": "dune-universe", + "repo": "mirage-opam-overlays", + "type": "github" + } + }, + "nix-filter": { + "locked": { + "lastModified": 1666547822, + "narHash": "sha256-razwnAybPHyoAyhkKCwXdxihIqJi1G6e1XP4FQOJTEs=", + "owner": "numtide", + "repo": "nix-filter", + "rev": "1a3b735e13e90a8d2fd5629f2f8363bd7ffbbec7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "nix-filter", + "type": "github" + } + }, + "nixpkgs": { + "inputs": { + "flake-utils": [ + "melange", + "flake-utils" + ], + "nixpkgs": "nixpkgs_2" + }, + "locked": { + "lastModified": 1667674981, + "narHash": "sha256-0bR3zYJL5qv1wpZ9nIfYYDCz6HeZSgOa8JMwWjBUXEc=", + "owner": "anmonteiro", + "repo": "nix-overlays", + "rev": "a3ccabfd068ca45053acb3a75eecb374c8aa001b", + "type": "github" + }, + "original": { + "owner": "anmonteiro", + "repo": "nix-overlays", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1667612485, + "narHash": "sha256-VCotbpxHEs7Tiu/mXpfDcr9nj4UB7/1DkS6ZhND1xeY=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "c28018857a879dec571b6e8acf9f2a0f4bb362c6", + "type": "github" + }, + "original": { + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "c28018857a879dec571b6e8acf9f2a0f4bb362c6", + "type": "github" + } + }, + "nixpkgs_3": { + "locked": { + "lastModified": 1667639549, + "narHash": "sha256-frqZKSG/933Ctwl9voSZnXDwo8CqddXcjQhnCzwNqaM=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "cae3751e9f74eea29c573d6c2f14523f41c2821a", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_4": { + "locked": { + "lastModified": 1667639549, + "narHash": "sha256-frqZKSG/933Ctwl9voSZnXDwo8CqddXcjQhnCzwNqaM=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "cae3751e9f74eea29c573d6c2f14523f41c2821a", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_5": { + "locked": { + "lastModified": 1657802959, + "narHash": "sha256-9+JWARSdlL8KiH3ymnKDXltE1vM+/WEJ78F5B1kjXys=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "4a01ca36d6bfc133bc617e661916a81327c9bbc8", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_6": { + "locked": { + "lastModified": 1657802959, + "narHash": "sha256-9+JWARSdlL8KiH3ymnKDXltE1vM+/WEJ78F5B1kjXys=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "4a01ca36d6bfc133bc617e661916a81327c9bbc8", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "ocamllsp": { + "inputs": { + "flake-utils": "flake-utils_3", + "nixpkgs": "nixpkgs_4", + "opam-nix": "opam-nix", + "opam-repository": "opam-repository" + }, + "locked": { + "lastModified": 1667696763, + "narHash": "sha256-vTmdg58nqnU45UTlLOw8+lR1hHs7OccxPyCcrgbiwMk=", + "ref": "refs/heads/master", + "rev": "03ac987b681505822d31db0a2b99086562303de1", + "revCount": 1858, + "submodules": true, + "type": "git", + "url": "https://www.github.com/ocaml/ocaml-lsp" + }, + "original": { + "submodules": true, + "type": "git", + "url": "https://www.github.com/ocaml/ocaml-lsp" + } + }, + "opam-nix": { + "inputs": { + "flake-compat": "flake-compat", + "flake-utils": "flake-utils_4", + "mirage-opam-overlays": "mirage-opam-overlays", + "nixpkgs": "nixpkgs_5", + "opam-overlays": "opam-overlays", + "opam-repository": [ + "ocamllsp", + "opam-repository" + ], + "opam2json": "opam2json" + }, + "locked": { + "lastModified": 1667491541, + "narHash": "sha256-Yq/wEQC7fz4A5zIhu6fymheUJdWBKx/Te7PMMb7lS2w=", + "owner": "tweag", + "repo": "opam-nix", + "rev": "c3db5fdf0f2b4aba3f052a9b9b787303aa268a2f", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "opam-nix", + "type": "github" + } + }, + "opam-nix_2": { + "inputs": { + "flake-compat": "flake-compat_2", + "flake-utils": "flake-utils_5", + "mirage-opam-overlays": "mirage-opam-overlays_2", + "nixpkgs": "nixpkgs_6", + "opam-overlays": "opam-overlays_2", + "opam-repository": [ + "opam-repository" + ], + "opam2json": "opam2json_2" + }, + "locked": { + "lastModified": 1667491541, + "narHash": "sha256-Yq/wEQC7fz4A5zIhu6fymheUJdWBKx/Te7PMMb7lS2w=", + "owner": "tweag", + "repo": "opam-nix", + "rev": "c3db5fdf0f2b4aba3f052a9b9b787303aa268a2f", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "opam-nix", + "type": "github" + } + }, + "opam-overlays": { + "flake": false, + "locked": { + "lastModified": 1654162756, + "narHash": "sha256-RV68fUK+O3zTx61iiHIoS0LvIk0E4voMp+0SwRg6G6c=", + "owner": "dune-universe", + "repo": "opam-overlays", + "rev": "c8f6ef0fc5272f254df4a971a47de7848cc1c8a4", + "type": "github" + }, + "original": { + "owner": "dune-universe", + "repo": "opam-overlays", + "type": "github" + } + }, + "opam-overlays_2": { + "flake": false, + "locked": { + "lastModified": 1654162756, + "narHash": "sha256-RV68fUK+O3zTx61iiHIoS0LvIk0E4voMp+0SwRg6G6c=", + "owner": "dune-universe", + "repo": "opam-overlays", + "rev": "c8f6ef0fc5272f254df4a971a47de7848cc1c8a4", + "type": "github" + }, + "original": { + "owner": "dune-universe", + "repo": "opam-overlays", + "type": "github" + } + }, + "opam-repository": { + "flake": false, + "locked": { + "lastModified": 1667585809, + "narHash": "sha256-jWBHfjcQAU9jtvF1KRvl+CpjONYWWB5qfSyp+hA3Fow=", + "owner": "ocaml", + "repo": "opam-repository", + "rev": "245530a0fe6a6fdc474c6f58ac1b9e2128e6ace7", + "type": "github" + }, + "original": { + "owner": "ocaml", + "repo": "opam-repository", + "type": "github" + } + }, + "opam-repository_2": { + "flake": false, + "locked": { + "lastModified": 1667585809, + "narHash": "sha256-jWBHfjcQAU9jtvF1KRvl+CpjONYWWB5qfSyp+hA3Fow=", + "owner": "ocaml", + "repo": "opam-repository", + "rev": "245530a0fe6a6fdc474c6f58ac1b9e2128e6ace7", + "type": "github" + }, + "original": { + "owner": "ocaml", + "repo": "opam-repository", + "type": "github" + } + }, + "opam2json": { + "inputs": { + "nixpkgs": [ + "ocamllsp", + "opam-nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1665671715, + "narHash": "sha256-7f75C6fIkiLzfkwLpJxlQIKf+YORGsXGV8Dr2LDDi+A=", + "owner": "tweag", + "repo": "opam2json", + "rev": "32fa2dcd993a27f9e75ee46fb8b78a7cd5d05113", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "opam2json", + "type": "github" + } + }, + "opam2json_2": { + "inputs": { + "nixpkgs": [ + "opam-nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1665671715, + "narHash": "sha256-7f75C6fIkiLzfkwLpJxlQIKf+YORGsXGV8Dr2LDDi+A=", + "owner": "tweag", + "repo": "opam2json", + "rev": "32fa2dcd993a27f9e75ee46fb8b78a7cd5d05113", + "type": "github" + }, + "original": { + "owner": "tweag", + "repo": "opam2json", + "type": "github" + } + }, + "poetry2nix": { + "flake": false, + "locked": { + "lastModified": 1632969109, + "narHash": "sha256-jPDclkkiAy5m2gGLBlKgH+lQtbF7tL4XxBrbSzw+Ioc=", + "owner": "nix-community", + "repo": "poetry2nix", + "rev": "aee8f04296c39d88155e05d25cfc59dfdd41cc77", + "type": "github" + }, + "original": { + "owner": "nix-community", + "ref": "1.21.0", + "repo": "poetry2nix", + "type": "github" + } + }, + "pre-commit-hooks": { + "inputs": { + "flake-utils": [ + "melange", + "dream2nix", + "flake-utils-pre-commit" + ], + "nixpkgs": [ + "melange", + "dream2nix", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1646153636, + "narHash": "sha256-AlWHMzK+xJ1mG267FdT8dCq/HvLCA6jwmx2ZUy5O8tY=", + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "rev": "b6bc0b21e1617e2b07d8205e7fae7224036dfa4b", + "type": "github" + }, + "original": { + "owner": "cachix", + "repo": "pre-commit-hooks.nix", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "melange": "melange", + "nixpkgs": "nixpkgs_3", + "ocamllsp": "ocamllsp", + "opam-nix": "opam-nix_2", + "opam-repository": "opam-repository_2" + } + }, + "rust-analyzer-src": { + "flake": false, + "locked": { + "lastModified": 1657557289, + "narHash": "sha256-PRW+nUwuqNTRAEa83SfX+7g+g8nQ+2MMbasQ9nt6+UM=", + "owner": "rust-lang", + "repo": "rust-analyzer", + "rev": "caf23f29144b371035b864a1017dbc32573ad56d", + "type": "github" + }, + "original": { + "owner": "rust-lang", + "ref": "nightly", + "repo": "rust-analyzer", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/duniverse/dune_/flake.nix b/duniverse/dune_/flake.nix new file mode 100644 index 000000000..cfa5bfbe6 --- /dev/null +++ b/duniverse/dune_/flake.nix @@ -0,0 +1,130 @@ +{ + inputs = { + nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; + flake-utils.url = "github:numtide/flake-utils"; + ocamllsp.url = "git+https://www.github.com/ocaml/ocaml-lsp?submodules=1"; + opam-nix = { + url = "github:tweag/opam-nix"; + inputs.opam-repository.follows = "opam-repository"; + }; + opam-repository = { + url = "github:ocaml/opam-repository"; + flake = false; + }; + melange.url = "github:melange-re/melange"; + }; + outputs = { self, flake-utils, opam-nix, nixpkgs, ocamllsp, opam-repository, melange }@inputs: + let package = "dune"; + in flake-utils.lib.eachDefaultSystem (system: + let + devPackages = { + menhir = "*"; + lwt = "*"; + csexp = "*"; + core_bench = "*"; + js_of_ocaml = "*"; + js_of_ocaml-compiler = "*"; + mdx = "*"; + odoc = "*"; + ppx_expect = "*"; + ppxlib = "*"; + ctypes = "*"; + utop = "*"; + cinaps = "*"; + ocamlfind = "1.9.2"; + }; + pkgs = nixpkgs.legacyPackages.${system}; + ocamlformat = + let + ocamlformat_version = + let + lists = pkgs.lib.lists; + strings = pkgs.lib.strings; + ocamlformat_config = strings.splitString "\n" (builtins.readFile ./.ocamlformat); + prefix = "version="; + ocamlformat_version_pred = line: strings.hasPrefix prefix line; + version_line = lists.findFirst ocamlformat_version_pred "not_found" ocamlformat_config; + version = strings.removePrefix prefix version_line; + in + builtins.replaceStrings [ "." ] [ "_" ] version; + in + builtins.getAttr ("ocamlformat_" + ocamlformat_version) pkgs; + scope = + opam-nix.lib.${system}.buildOpamProject' + { + inherit pkgs; + repos = [ opam-repository ]; + } ./. + (devPackages // { + ocaml-base-compiler = "4.14.0"; + }); + in + { + packages.default = scope.dune; + + devShells.doc = + pkgs.mkShell { + buildInputs = (with pkgs; + [ + sphinx + sphinx-autobuild + python310Packages.sphinx-rtd-theme + ] + ); + }; + + devShells.fmt = + pkgs.mkShell { + inputsFrom = [ pkgs.dune_3 ]; + buildInputs = [ ocamlformat ]; + }; + + devShells.slim = with pkgs.ocamlPackages; pkgs.mkShell { + inputsFrom = [ dune_3 ]; + nativeBuildInputs = with pkgs; [ pkg-config nodejs-slim ]; + buildInputs = [ + merlin + ocamlformat + ppx_expect + ctypes + integers + mdx + cinaps + menhir + odoc + lwt + ]; + }; + + devShells.coq = + pkgs.mkShell { + inputsFrom = [ pkgs.dune_3 ]; + buildInputs = with pkgs; [ + coq_8_16 + coq_8_16.ocamlPackages.findlib + ]; + }; + + devShells.default = + pkgs.mkShell { + nativeBuildInputs = [ pkgs.opam ]; + buildInputs = (with pkgs; + [ + # dev tools + ocamlformat + coq_8_16 + nodejs-slim + pkg-config + file + ccls + mercurial + ] ++ (if stdenv.isLinux then [ strace ] else [ ])) + ++ [ + ocamllsp.outputs.packages.${system}.ocaml-lsp-server + melange.outputs.packages.${system}.default + ] + ++ nixpkgs.lib.attrsets.attrVals (builtins.attrNames devPackages) scope; + inputsFrom = [ self.packages.${system}.default ]; + }; + }); +} diff --git a/duniverse/dune_/nix/default.nix b/duniverse/dune_/nix/default.nix deleted file mode 100644 index 87c273a78..000000000 --- a/duniverse/dune_/nix/default.nix +++ /dev/null @@ -1,64 +0,0 @@ -# parameterized derivation with dependencies injected (callPackage style) - -# We generate nix derivations corresponding to the opam packages from -# opam-repository that we are interested in. We do this by passing the desired -# package names to opam2nix, which runs the opam solve and spits out a build -# plan into opam-selection.nix -# The build plan can be regenerated with $ make nix/opam-selection.nix -{ pkgs, stdenv, opam2nix, fetchFromGitHub }: -let - strings = pkgs.lib.strings; - ocaml = pkgs.ocaml-ng.ocamlPackages_4_13.ocaml; - coq = fetchFromGitHub { - owner = "coq"; - repo = "coq"; - rev = "f16b7c75bcc8651e43ec1f0c8ae6744748665213"; - sha256 = "sha256-C+rk3CMUGypbsCgbHQUgaBIzOE0jUaeQ/YHZ0GYx8aI="; - }; - args = { - inherit ocaml; - selection = ./opam-selection.nix; - src = { coq-core = coq; }; - }; - opam-selection = opam2nix.build args; - resolve = opam2nix.resolve args ([ - # test deps - "lwt" - "bisect_ppx" - "cinaps" - "core_bench" - "csexp" - "js_of_ocaml" - "js_of_ocaml-compiler" - "mdx" - "menhir" - "merlin" - "ocamlfind" - "odoc" - "ppx_expect" - "ppx_inline_test" - "ppxlib" - "result" - "utop" - "ctypes" - "${coq}/coq-core.opam" - ]); - - coq-core = opam-selection.coq-core.overrideAttrs (super: { - buildInputs = (super.buildInputs or [ ]) ++ [ pkgs.bash pkgs.gnused pkgs.which ]; - configurePhase = '' - patchShebangs dev/tools/ doc/stdlib - ''; - preInstallCheck = '' - patchShebangs tools/ - patchShebangs test-suite/ - export OCAMLPATH=$OCAMLFIND_DESTDIR:$OCAMLPATH - ''; - }); - -in { - inherit resolve; - inherit coq-core; - inherit ocaml; - opam = opam-selection; -} diff --git a/duniverse/dune_/nix/opam-selection.nix b/duniverse/dune_/nix/opam-selection.nix deleted file mode 100644 index 6fd2e6721..000000000 --- a/duniverse/dune_/nix/opam-selection.nix +++ /dev/null @@ -1,2608 +0,0 @@ -### This file is generated by opam2nix. - -self: -let - lib = self.lib; - pkgs = self.pkgs; - repoPath = self.repoPath; - repos = - { - opam-repository = - rec { - fetch = - { - owner = "ocaml"; - repo = "opam-repository"; - rev = "5c11b9b7623477179eaa907883f10cb99de83542"; - sha256 = "1j8dsffq5mibjrbgsgynp6937mckhhvcd8gjc897jci8li83yhfg"; - }; - src = (pkgs.fetchFromGitHub) fetch; - }; - }; - selection = self.selection; -in -{ - format-version = 4; - ocaml-version = "4.13.1"; - repos = repos; - selection = - { - astring = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1djnad9sq12idlakj069xvwm2nn7wqm137pqbxxai5frkgi08x74"; - package = "packages/astring/astring.0.8.5"; - }; - pname = "astring"; - src = pkgs.fetchurl - { - sha256 = "1ykhg9gd3iy7zsgyiy2p9b1wkpqg9irw5pvcqs3sphq71iir4ml6"; - url = "https://erratique.ch/software/astring/releases/astring-0.8.5.tbz"; - }; - version = "0.8.5"; - }; - base = - { - opamInputs = - { - dune = selection.dune; - dune-configurator = selection.dune-configurator; - ocaml = selection.ocaml; - sexplib0 = selection.sexplib0; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1v61rsyfwkpla41ga6hsagzjihmn1lg5whg2gwb01w9xhdy95qd2"; - package = "packages/base/base.v0.14.3"; - }; - pname = "base"; - src = pkgs.fetchurl - { - sha256 = "0nmydvlbw124c0qz80fx1rpggpr00ylp2zpnyn26qf1a0pfw0kg3"; - url = "https://github.com/janestreet/base/archive/v0.14.3.tar.gz"; - }; - version = "v0.14.3"; - }; - base-bytes = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0a68lmbf68jgm1i3b59j2sc3ha9yhv4678f9mfwwvczw88prq7l3"; - package = "packages/base-bytes/base-bytes.base"; - }; - pname = "base-bytes"; - src = null; - version = "base"; - }; - base-threads = - { - opamInputs = { - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1c4bpyh61ampjgk5yh3inrgcpf1z1xv0pshn54ycmpn4dyzv0p2x"; - package = "packages/base-threads/base-threads.base"; - }; - pname = "base-threads"; - src = null; - version = "base"; - }; - base-unix = - { - opamInputs = { - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0mpsvb7684g723ylngryh15aqxg3blb7hgmq2fsqjyppr36iyzwg"; - package = "packages/base-unix/base-unix.base"; - }; - pname = "base-unix"; - src = null; - version = "base"; - }; - base_bigstring = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_jane = selection.ppx_jane; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0yn51npq4fwi9nllfhq2r3kkb17pg3igvvjgblac1g3v0nmhj6c4"; - package = "packages/base_bigstring/base_bigstring.v0.14.0"; - }; - pname = "base_bigstring"; - src = pkgs.fetchurl - { - sha256 = "1fhldk58w56ixkin763kpic512xvkkf9b4mrnjfsbm8in75kzndq"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/base_bigstring-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - base_quickcheck = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_base = selection.ppx_base; - ppx_fields_conv = selection.ppx_fields_conv; - ppx_let = selection.ppx_let; - ppx_sexp_message = selection.ppx_sexp_message; - ppx_sexp_value = selection.ppx_sexp_value; - ppxlib = selection.ppxlib; - splittable_random = selection.splittable_random; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0lxxagkyg1jh0x7bbps1972bid51a82m1h2x3nyz342dnsy4k6h1"; - package = "packages/base_quickcheck/base_quickcheck.v0.14.1"; - }; - pname = "base_quickcheck"; - src = pkgs.fetchurl - { - sha256 = "0n5h0ysn593awvz4crkvzf5r800hd1c55bx9mm9vbqs906zii6mn"; - url = "https://github.com/janestreet/base_quickcheck/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - bigarray-compat = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1hq7lmh99p720plkbv1faqqz2xz4ff9g49kkpsryg9ws3ld8ry05"; - package = "packages/bigarray-compat/bigarray-compat.1.1.0"; - }; - pname = "bigarray-compat"; - src = pkgs.fetchurl - { - sha256 = "1m8q6ywik6h0wrdgv8ah2s617y37n1gdj4qvc86yi12winj6ji23"; - url = "https://github.com/mirage/bigarray-compat/releases/download/v1.1.0/bigarray-compat-1.1.0.tbz"; - }; - version = "1.1.0"; - }; - bin_prot = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - mirage-xen-ocaml = selection.mirage-xen-ocaml or null; - ocaml = selection.ocaml; - ppx_compare = selection.ppx_compare; - ppx_custom_printf = selection.ppx_custom_printf; - ppx_fields_conv = selection.ppx_fields_conv; - ppx_optcomp = selection.ppx_optcomp; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppx_variants_conv = selection.ppx_variants_conv; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:17ylwhh1kv9klavfag20n4g3175i7nmljbdj12z9yiqm4da3r4rk"; - package = "packages/bin_prot/bin_prot.v0.14.0"; - }; - pname = "bin_prot"; - src = pkgs.fetchurl - { - sha256 = "1f1ng6cixi3ci0nb765yfzqk9b3s752hy1i3702kh59gni1psycp"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/bin_prot-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - biniou = - { - opamInputs = - { - dune = selection.dune; - easy-format = selection.easy-format; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1m9s9v4zr7022k6d50482qq7w41fdqp58nkpfhcp8574hg65kh69"; - package = "packages/biniou/biniou.1.2.1"; - }; - pname = "biniou"; - src = pkgs.fetchurl - { - sha256 = "0da3m0g0dhl02jfynrbysjh070xk2z6rxcx34xnqx6ljn5l6qm1m"; - url = "https://github.com/mjambon/biniou/releases/download/1.2.1/biniou-1.2.1.tbz"; - }; - version = "1.2.1"; - }; - bisect_ppx = - { - opamInputs = - { - base-unix = selection.base-unix; - cmdliner = selection.cmdliner; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1bqnxqhvgk21q9kki0x40f5bnkiq5z3ldpyk3dr5zglc5afhvx3c"; - package = "packages/bisect_ppx/bisect_ppx.2.8.0"; - }; - pname = "bisect_ppx"; - src = pkgs.fetchurl - { - sha256 = "0xsk7kvc2drx5llb7mws9d5iavfk0k2qlfkpki1k5acyvdj6yvhd"; - url = "https://github.com/aantron/bisect_ppx/archive/2.8.0.tar.gz"; - }; - version = "2.8.0"; - }; - camomile = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:08z0c35bcm72ch2n7w0b1x7xnwn2hhcky5r6vyz8hi4m9jqv6azv"; - package = "packages/camomile/camomile.1.0.2"; - }; - pname = "camomile"; - src = pkgs.fetchurl - { - sha256 = "0chn7ldqb3wyf95yhmsxxq65cif56smgz1mhhc7m0dpwmyq1k97h"; - url = "https://github.com/yoriyuki/Camomile/releases/download/1.0.2/camomile-1.0.2.tbz"; - }; - version = "1.0.2"; - }; - charInfo_width = - { - opamInputs = - { - camomile = selection.camomile; - dune = selection.dune; - ocaml = selection.ocaml; - result = selection.result; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1vx3dlvd3xslkc9q93yyqnn479sj4wpmp9xwngipnibla7mcpyq7"; - package = "packages/charInfo_width/charInfo_width.1.1.0"; - }; - pname = "charInfo_width"; - src = pkgs.fetchurl - { - sha256 = "0wl1hcwbx2mmgbhwh1wwgjixvppjq0k43nqyq13xm4pvgdxfvci1"; - url = "https://github.com/kandu/charInfo_width/archive/1.1.0.tar.gz"; - }; - version = "1.1.0"; - }; - cinaps = - { - opamInputs = - { - base-unix = selection.base-unix; - dune = selection.dune; - ocaml = selection.ocaml; - re = selection.re; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:01ycwfmid8zkir81g425dvjnjfdd58z2zjxig0aqwxgdxc139931"; - package = "packages/cinaps/cinaps.v0.15.1"; - }; - pname = "cinaps"; - src = pkgs.fetchurl - { - sha256 = "0w3125jfwckvmd3dx3r0qx7hj9kahdi9nqf3cqsv19nqymq8xq8v"; - url = "https://github.com/ocaml-ppx/cinaps/archive/v0.15.1.tar.gz"; - }; - version = "v0.15.1"; - }; - cmdliner = - { - opamInputs = { - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1wz42ijdnbq49q3raz2yyddvqsg0a62wdhhl2wmmz124ymavqz97"; - package = "packages/cmdliner/cmdliner.1.1.0"; - }; - pname = "cmdliner"; - src = pkgs.fetchurl - { - sha256 = "1i5k2bdmkd97g0il9cxfd8praqbvblnq5k3irwp2c9g5fkh9vdca"; - url = "https://erratique.ch/software/cmdliner/releases/cmdliner-1.1.0.tbz"; - }; - version = "1.1.0"; - }; - conf-gmp = - { - buildInputs = [ (pkgs.gmp or null) (pkgs.gmp-dev or null) - (pkgs.gmp-devel or null) (pkgs.libgmp-dev or null) ]; - opamInputs = { - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1jqny2fh81yfhr0frxr5xfcgf0fmgn8c5nhhy7wkxaqsjcdb4144"; - package = "packages/conf-gmp/conf-gmp.4"; - }; - pname = "conf-gmp"; - src = null; - version = "4"; - }; - coq-core = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - zarith = selection.zarith; - }; - opamSrc = "coq-core.opam"; - pname = "coq-core"; - src = self.directSrc "coq-core"; - version = "dev"; - }; - core = - { - buildInputs = [ (pkgs.linux-headers or null) ]; - opamInputs = - { - base-threads = selection.base-threads; - core_kernel = selection.core_kernel; - dune = selection.dune; - jst-config = selection.jst-config; - ocaml = selection.ocaml; - ppx_jane = selection.ppx_jane; - sexplib = selection.sexplib; - spawn = selection.spawn; - timezone = selection.timezone; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:13hkxn24szh9j0xl6m65k9cg8blqh44yb0nz9m5wrfbyfn8zd1hd"; - package = "packages/core/core.v0.14.1"; - }; - pname = "core"; - src = pkgs.fetchurl - { - sha256 = "1862zsk85i00vsv2chgb156b1chp8f7p508hsz6sadjx6h98q5cc"; - url = "https://github.com/janestreet/core/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - core_bench = - { - opamInputs = - { - core = selection.core; - core_kernel = selection.core_kernel; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_jane = selection.ppx_jane; - re = selection.re; - textutils = selection.textutils; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1wpvyznr2301knfdx17nnrlsv6w3yddqazcssk102vdknhkfn7a5"; - package = "packages/core_bench/core_bench.v0.14.0"; - }; - pname = "core_bench"; - src = pkgs.fetchurl - { - sha256 = "1cnpc6831hgcrc50x27qbfcyfk7anz0y62vj42kf9m96axk5b1br"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/core_bench-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - core_kernel = - { - opamInputs = - { - base = selection.base; - base_bigstring = selection.base_bigstring; - base_quickcheck = selection.base_quickcheck; - bin_prot = selection.bin_prot; - dune = selection.dune; - fieldslib = selection.fieldslib; - jane-street-headers = selection.jane-street-headers; - jst-config = selection.jst-config; - ocaml = selection.ocaml; - ppx_assert = selection.ppx_assert; - ppx_base = selection.ppx_base; - ppx_hash = selection.ppx_hash; - ppx_inline_test = selection.ppx_inline_test; - ppx_jane = selection.ppx_jane; - ppx_optcomp = selection.ppx_optcomp; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppx_sexp_message = selection.ppx_sexp_message; - sexplib = selection.sexplib; - splittable_random = selection.splittable_random; - stdio = selection.stdio; - time_now = selection.time_now; - typerep = selection.typerep; - variantslib = selection.variantslib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:09c7k6m1vm8jhqfivn8w663v362qwjf6cb5xlzijd0sjgh1dwai5"; - package = "packages/core_kernel/core_kernel.v0.14.2"; - }; - pname = "core_kernel"; - src = pkgs.fetchurl - { - sha256 = "0jyf08i9wzg3yf32f158i6n9gm751bk8zj7xqx79jnnkchwkbxb6"; - url = "https://github.com/janestreet/core_kernel/archive/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - cppo = - { - opamInputs = - { - base-unix = selection.base-unix; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0pzd8irqkkkpfgw8nq9d21z9rj5m3qlzixyb7ybfy4b1fwh3n8bp"; - package = "packages/cppo/cppo.1.6.8"; - }; - pname = "cppo"; - src = pkgs.fetchurl - { - sha256 = "0lxy4xkkkwgs1cj6d9lyzsqi9f6fc9r6cir5imi7yjqrpd86s1by"; - url = "https://github.com/ocaml-community/cppo/archive/v1.6.8.tar.gz"; - }; - version = "1.6.8"; - }; - csexp = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:01lc95kz13gpki4xazyh6n20kv1g9inyb5myv240wl2n9v50z8fl"; - package = "packages/csexp/csexp.1.5.1"; - }; - pname = "csexp"; - src = pkgs.fetchurl - { - sha256 = "00mc19f89pxpmjl62862ya5kjcfrl8rjzvs00j05h2m9bw3f81fn"; - url = "https://github.com/ocaml-dune/csexp/releases/download/1.5.1/csexp-1.5.1.tbz"; - }; - version = "1.5.1"; - }; - ctypes = - { - opamInputs = - { - bigarray-compat = selection.bigarray-compat; - ctypes-foreign = selection.ctypes-foreign or null; - integers = selection.integers; - mirage-xen = selection.mirage-xen or null; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:10lijg96g3ywklaa3ai5nzw2ax5agbc1iv01h2wmzi98v8jdhsrg"; - package = "packages/ctypes/ctypes.0.20.0"; - }; - pname = "ctypes"; - src = pkgs.fetchurl - { - sha256 = "0ym8hhp3zhdiwdpf8i4yfgbxnzi3kk3bd9akg28ir4z348ksfzy9"; - url = "https://github.com/ocamllabs/ocaml-ctypes/archive/0.20.0.tar.gz"; - }; - version = "0.20.0"; - }; - dot-merlin-reader = - { - opamInputs = - { - csexp = selection.csexp; - dune = selection.dune; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - result = selection.result; - yojson = selection.yojson; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1cs765ls6zkv2vakmzg0b7gmqvj6dxk0c0hvk46573zkqmw8vpcr"; - package = "packages/dot-merlin-reader/dot-merlin-reader.4.1"; - }; - pname = "dot-merlin-reader"; - src = pkgs.fetchurl - { - sha256 = "1kg765h6gqq5ffa1fdvm0kpa9w922y3af804ags5ssk4p1pnv8ql"; - url = "https://github.com/ocaml/merlin/releases/download/v4.1/dot-merlin-reader-v4.1.tbz"; - }; - version = "4.1"; - }; - dune = - { - opamInputs = - { - base-threads = selection.base-threads; - base-unix = selection.base-unix; - ocaml = selection.ocaml or null; - ocamlfind-secondary = selection.ocamlfind-secondary or null; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0m4pbbfyhmjw8mb2d0cr2pkypl54g2f098bnwhd2arj21nkdi3l8"; - package = "packages/dune/dune.2.9.3"; - }; - pname = "dune"; - src = pkgs.fetchurl - { - sha256 = "1ml8bxym8sdfz25bx947al7cvsi2zg5lcv7x9w6xb01cmdryqr9y"; - url = "https://github.com/ocaml/dune/releases/download/2.9.3/dune-site-2.9.3.tbz"; - }; - version = "2.9.3"; - }; - dune-configurator = - { - opamInputs = - { - csexp = selection.csexp; - dune = selection.dune; - ocaml = selection.ocaml; - result = selection.result; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:08bfsmnl4qw5wr7gcfg18xk70x8x195cs7kr1mch13fq83f8m8np"; - package = "packages/dune-configurator/dune-configurator.2.9.3"; - }; - pname = "dune-configurator"; - src = pkgs.fetchurl - { - sha256 = "1ml8bxym8sdfz25bx947al7cvsi2zg5lcv7x9w6xb01cmdryqr9y"; - url = "https://github.com/ocaml/dune/releases/download/2.9.3/dune-site-2.9.3.tbz"; - }; - version = "2.9.3"; - }; - easy-format = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0rjgw1ygf8khwb7vgl5vnw907m8b5mpkb0bnlqiqz9zfmfb4jd47"; - package = "packages/easy-format/easy-format.1.3.2"; - }; - pname = "easy-format"; - src = pkgs.fetchurl - { - sha256 = "09hrikx310pac2sb6jzaa7k6fmiznnmhdsqij1gawdymhawc4h1l"; - url = "https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz"; - }; - version = "1.3.2"; - }; - fieldslib = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1gsrbs4x45k4bp1zih9c6db3axhaiy91knac6bk6hpgv9sjalicm"; - package = "packages/fieldslib/fieldslib.v0.14.0"; - }; - pname = "fieldslib"; - src = pkgs.fetchurl - { - sha256 = "10n5y376fb5jgqk9h8vq158rm1b36h9lzh6p11q33h6xgvb1v6n3"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/fieldslib-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - fmt = - { - opamInputs = - { - base-unix = selection.base-unix or null; - cmdliner = selection.cmdliner or null; - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1czh5i3i4mkf9xfasji3v7n821qmnnandlklh67ali0x87brldny"; - package = "packages/fmt/fmt.0.9.0"; - }; - pname = "fmt"; - src = pkgs.fetchurl - { - sha256 = "0q8j2in2473xh7k4hfgnppv9qy77f2ih89yp6yhpbp92ba021yzi"; - url = "https://erratique.ch/software/fmt/releases/fmt-0.9.0.tbz"; - }; - version = "0.9.0"; - }; - fpath = - { - opamInputs = - { - astring = selection.astring; - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1pnskgw9fqq4kg1x4sc4vcv9rh0kksilx4qngwafpyss42mqq2i2"; - package = "packages/fpath/fpath.0.7.3"; - }; - pname = "fpath"; - src = pkgs.fetchurl - { - sha256 = "03z7mj0sqdz465rc4drj1gr88l9q3nfs374yssvdjdyhjbqqzc0j"; - url = "https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz"; - }; - version = "0.7.3"; - }; - integers = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - stdlib-shims = selection.stdlib-shims; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:09kkiwbj0jz0zk9394m2ras9myh0xy4g5n580wiggayk38038wsv"; - package = "packages/integers/integers.0.6.0"; - }; - pname = "integers"; - src = pkgs.fetchurl - { - sha256 = "1y1b0sh6zdr08rc6naq107i55xs4g3dpw4qj4si1l83h6bqdajvv"; - url = "https://github.com/ocamllabs/ocaml-integers/archive/0.6.0.tar.gz"; - }; - version = "0.6.0"; - }; - jane-street-headers = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1w6zjjmyszk9pax139rkxb3vx0w23w0pfd46bddfyfkxq2rbwsvf"; - package = "packages/jane-street-headers/jane-street-headers.v0.14.0"; - }; - pname = "jane-street-headers"; - src = pkgs.fetchurl - { - sha256 = "028yxb4h3iy025iy89v8653m5brh7flrjshghs4x99pd690pmfs7"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/jane-street-headers-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - js_of_ocaml = - { - opamInputs = - { - dune = selection.dune; - js_of_ocaml-compiler = selection.js_of_ocaml-compiler; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - uchar = selection.uchar; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0krl3wlgld1ibpy5bivygw060578kxvk81wnipnnsc92drpk5nyk"; - package = "packages/js_of_ocaml/js_of_ocaml.4.0.0"; - }; - pname = "js_of_ocaml"; - src = pkgs.fetchurl - { - sha256 = "0pj9jjrmi0xxrzmygv4b5whsibw1jxy3wgibmws85x5jwlczh0nz"; - url = "https://github.com/ocsigen/js_of_ocaml/releases/download/4.0.0/js_of_ocaml-4.0.0.tbz"; - }; - version = "4.0.0"; - }; - js_of_ocaml-compiler = - { - opamInputs = - { - cmdliner = selection.cmdliner; - dune = selection.dune; - menhir = selection.menhir; - menhirLib = selection.menhirLib; - menhirSdk = selection.menhirSdk; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind or null; - ppxlib = selection.ppxlib; - yojson = selection.yojson; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:168fq44ndm268374152w39x9pa351h8ddz3xgada46s9sw0qa2n6"; - package = "packages/js_of_ocaml-compiler/js_of_ocaml-compiler.4.0.0"; - }; - pname = "js_of_ocaml-compiler"; - src = pkgs.fetchurl - { - sha256 = "0pj9jjrmi0xxrzmygv4b5whsibw1jxy3wgibmws85x5jwlczh0nz"; - url = "https://github.com/ocsigen/js_of_ocaml/releases/download/4.0.0/js_of_ocaml-4.0.0.tbz"; - }; - version = "4.0.0"; - }; - jst-config = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - dune-configurator = selection.dune-configurator; - ocaml = selection.ocaml; - ppx_assert = selection.ppx_assert; - stdio = selection.stdio; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0myym84b9yx4vqa0ml0zf3cx6rms3g5dv704vhf5bpr7jnqz0qcb"; - package = "packages/jst-config/jst-config.v0.14.1"; - }; - pname = "jst-config"; - src = pkgs.fetchurl - { - sha256 = "0wdjs0lvc5wbggh27cf490jarfibrrb5xxsrigg41m32kjkbijm4"; - url = "https://github.com/janestreet/jst-config/archive/refs/tags/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - lambda-term = - { - opamInputs = - { - camomile = selection.camomile; - dune = selection.dune; - lwt = selection.lwt; - lwt_log = selection.lwt_log; - lwt_react = selection.lwt_react; - mew_vi = selection.mew_vi; - ocaml = selection.ocaml; - react = selection.react; - zed = selection.zed; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0v2wk9gxj0p1znivgrbshj038l2rjhzrhk61s7kiayy9ka101cav"; - package = "packages/lambda-term/lambda-term.3.1.0"; - }; - pname = "lambda-term"; - src = pkgs.fetchurl - { - sha256 = "1462j2c2nnzv6ng8b6907bw0zy3mhhnnjdm8k6as0sgm9ls0r77r"; - url = "https://github.com/ocaml-community/lambda-term/archive/3.1.0.tar.gz"; - }; - version = "3.1.0"; - }; - logs = - { - opamInputs = - { - base-threads = selection.base-threads or null; - cmdliner = selection.cmdliner or null; - fmt = selection.fmt or null; - js_of_ocaml = selection.js_of_ocaml or null; - lwt = selection.lwt or null; - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0pys6d25bghrwvwd4gflib2yyp5fvdy0rkivbdyli5dmp5j35a3n"; - package = "packages/logs/logs.0.7.0"; - }; - pname = "logs"; - src = pkgs.fetchurl - { - sha256 = "1jnmd675wmsmdwyb5mx5b0ac66g4c6gpv5s4mrx2j6pb0wla1x46"; - url = "https://erratique.ch/software/logs/releases/logs-0.7.0.tbz"; - }; - version = "0.7.0"; - }; - lwt = - { - opamInputs = - { - base-threads = selection.base-threads or null; - base-unix = selection.base-unix or null; - conf-libev = selection.conf-libev or null; - cppo = selection.cppo; - dune = selection.dune; - dune-configurator = selection.dune-configurator; - mmap = selection.mmap; - ocaml = selection.ocaml; - ocaml-syntax-shims = selection.ocaml-syntax-shims or null; - ocplib-endian = selection.ocplib-endian; - result = selection.result; - seq = selection.seq; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0iadlycd4q93lsk07k9zaimlysgd38sj6v50dc3cb491vl0icipz"; - package = "packages/lwt/lwt.5.5.0"; - }; - pname = "lwt"; - src = pkgs.fetchurl - { - sha256 = "15gr6nhhfjyh91v9chvm6j7vnp1hhc60y3plgvcgl5yl5k7xbbj9"; - url = "https://github.com/ocsigen/lwt/archive/refs/tags/5.5.0.tar.gz"; - }; - version = "5.5.0"; - }; - lwt_log = - { - opamInputs = - { - dune = selection.dune; - lwt = selection.lwt; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:18iddwpvs7hwkmsbii11kiw0aaad4kf8iv9vjw01npflxh729vig"; - package = "packages/lwt_log/lwt_log.1.1.1"; - }; - pname = "lwt_log"; - src = pkgs.fetchurl - { - sha256 = "0gszc8nvk2hpfq47plb36qahlnyfq28sa9mhicnf6mg5c7n1kyql"; - url = "https://github.com/aantron/lwt_log/archive/1.1.1.tar.gz"; - }; - version = "1.1.1"; - }; - lwt_react = - { - opamInputs = - { - dune = selection.dune; - lwt = selection.lwt; - ocaml = selection.ocaml; - react = selection.react; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1k0ysm1wdx55dzma6k1ifx0s09ijxg7jvjh2ak5l540lbjx30cf2"; - package = "packages/lwt_react/lwt_react.1.1.5"; - }; - pname = "lwt_react"; - src = pkgs.fetchurl - { - sha256 = "15gr6nhhfjyh91v9chvm6j7vnp1hhc60y3plgvcgl5yl5k7xbbj9"; - url = "https://github.com/ocsigen/lwt/archive/refs/tags/5.5.0.tar.gz"; - }; - version = "1.1.5"; - }; - mdx = - { - opamInputs = - { - astring = selection.astring; - cmdliner = selection.cmdliner; - cppo = selection.cppo; - csexp = selection.csexp; - dune = selection.dune; - fmt = selection.fmt; - logs = selection.logs; - ocaml = selection.ocaml; - ocaml-version = selection.ocaml-version; - ocamlfind = selection.ocamlfind; - odoc-parser = selection.odoc-parser; - re = selection.re; - result = selection.result; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1x9lcwf91ngjm14471y1ljmv2w5az51mwzqax9lh4ykpjbxkcn1n"; - package = "packages/mdx/mdx.2.1.0"; - }; - pname = "mdx"; - src = pkgs.fetchurl - { - sha256 = "1ykpxlpggvxd5q0f6hm3kckym6fjhhf8rzvvf8fkc36fqb5p6pd2"; - url = "https://github.com/realworldocaml/mdx/releases/download/2.1.0/mdx-2.1.0.tbz"; - }; - version = "2.1.0"; - }; - menhir = - { - opamInputs = - { - dune = selection.dune; - menhirLib = selection.menhirLib; - menhirSdk = selection.menhirSdk; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0v2w4jslcpd39ra755fg3731q2l565h78cg0rly6rw61ja7d1808"; - package = "packages/menhir/menhir.20220210"; - }; - pname = "menhir"; - src = pkgs.fetchurl - { - sha256 = "0dapvzw55y9ggadh7ahya22s6r972c2n2nx6jsw5437ryldfi92p"; - url = "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz"; - }; - version = "20220210"; - }; - menhirLib = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0nl416snigjxz4w4fkvgfss6g6viqnixzcjysww7rpj7fs39rpqq"; - package = "packages/menhirLib/menhirLib.20220210"; - }; - pname = "menhirLib"; - src = pkgs.fetchurl - { - sha256 = "0dapvzw55y9ggadh7ahya22s6r972c2n2nx6jsw5437ryldfi92p"; - url = "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz"; - }; - version = "20220210"; - }; - menhirSdk = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:182rqysmqw0z0zfwagq8wcbl42xrz1rnn09r9c283m2n7iv0n3a9"; - package = "packages/menhirSdk/menhirSdk.20220210"; - }; - pname = "menhirSdk"; - src = pkgs.fetchurl - { - sha256 = "0dapvzw55y9ggadh7ahya22s6r972c2n2nx6jsw5437ryldfi92p"; - url = "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz"; - }; - version = "20220210"; - }; - merlin = - { - opamInputs = - { - csexp = selection.csexp; - dot-merlin-reader = selection.dot-merlin-reader; - dune = selection.dune; - ocaml = selection.ocaml; - result = selection.result; - yojson = selection.yojson; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0895va4yli169f5kgjv3awnf3qk4p7f10ll8h7ivzhap41vh8vxc"; - package = "packages/merlin/merlin.4.4-413"; - }; - pname = "merlin"; - src = pkgs.fetchurl - { - sha256 = "1ilmh2gqpwgr51w2ba8r0s5zkj75h00wkw4az61ssvivn9jxr7k0"; - url = "https://github.com/ocaml/merlin/releases/download/v4.4-413/merlin-4.4-413.tbz"; - }; - version = "4.4-413"; - }; - mew = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - result = selection.result; - trie = selection.trie; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0g9xms016f909fzbwgxcy0k4xmvr5zk5bhnz66v9vpsiak2qm4s3"; - package = "packages/mew/mew.0.1.0"; - }; - pname = "mew"; - src = pkgs.fetchurl - { - sha256 = "1rjri9mgfb9gn9fmjn0ax21y9jd9wkvr7mmx2jrlqmzgabmqrlv4"; - url = "https://github.com/kandu/mew/archive/0.1.0.tar.gz"; - }; - version = "0.1.0"; - }; - mew_vi = - { - opamInputs = - { - dune = selection.dune; - mew = selection.mew; - ocaml = selection.ocaml; - react = selection.react; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0zsfhxpff78cqk2c81parajb59m7hqf6v8arksxbyfha6mls65hz"; - package = "packages/mew_vi/mew_vi.0.5.0"; - }; - pname = "mew_vi"; - src = pkgs.fetchurl - { - sha256 = "1nmg3cysglgw4115n5zpz4azrfbnfxkn2kvw73chzs69viygm4m6"; - url = "https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz"; - }; - version = "0.5.0"; - }; - mmap = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1snhaf6mixmmb49gcin5wmbz4bfjz406mip4556lids8ajm22ibh"; - package = "packages/mmap/mmap.1.1.0"; - }; - pname = "mmap"; - src = pkgs.fetchurl - { - sha256 = "0l6waidal2n8mkdn74avbslvc10sf49f5d889n838z03pra5chsc"; - url = "https://github.com/mirage/mmap/releases/download/v1.1.0/mmap-v1.1.0.tbz"; - }; - version = "1.1.0"; - }; - num = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:04wb8ww165lsifn36jcrxw5zs87id5kib6rilq6zh6qhzvij88pf"; - package = "packages/num/num.1.4"; - }; - pname = "num"; - src = pkgs.fetchurl - { - sha256 = "090gl27g84r3s2b12vgkz8fp269jqlrhx4lpg7008yviisv8hl01"; - url = "https://github.com/ocaml/num/archive/v1.4.tar.gz"; - }; - version = "1.4"; - }; - ocaml = - { - opamInputs = - { - ocaml-base-compiler = selection.ocaml-base-compiler or null; - ocaml-config = selection.ocaml-config; - ocaml-system = selection.ocaml-system or null; - ocaml-variants = selection.ocaml-variants or null; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:12aajj2hc636jr6wbv4vba8pmjdndbcvnw7q35gj4agxmrjspziw"; - package = "packages/ocaml/ocaml.4.13.1"; - }; - pname = "ocaml"; - src = null; - version = "4.13.1"; - }; - ocaml-base-compiler = - { - opamInputs = { - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:069i5vsndd9lsvdm5wk898nfnc85ww7459nibjg6881ww43w8ck1"; - package = "packages/ocaml-base-compiler/ocaml-base-compiler.4.13.1"; - }; - pname = "ocaml-base-compiler"; - src = pkgs.fetchurl - { - sha256 = "1i7ad8lh5l74wb3yzmhlv529wc75a5sjybzkad7wdl8zrj47jk0r"; - url = "https://github.com/ocaml/ocaml/archive/4.13.1.tar.gz"; - }; - version = "4.13.1"; - }; - ocaml-compiler-libs = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1blynia10j8vyj559kcvc7ic69zq6qjjn092fcsjzfw6czd8ya2c"; - package = "packages/ocaml-compiler-libs/ocaml-compiler-libs.v0.12.4"; - }; - pname = "ocaml-compiler-libs"; - src = pkgs.fetchurl - { - sha256 = "0q3pl20pkx410gw9g4m26qq6dmzi9qan2dqlga6c2ifc6pnckjaf"; - url = "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz"; - }; - version = "v0.12.4"; - }; - ocaml-config = - { - opamInputs = - { - ocaml-base-compiler = selection.ocaml-base-compiler or null; - ocaml-system = selection.ocaml-system or null; - ocaml-variants = selection.ocaml-variants or null; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0h0hgqq9mbywvqygppfdc50gf9ss8a97l4dgsv3hszmzh6gglgrg"; - package = "packages/ocaml-config/ocaml-config.2"; - }; - pname = "ocaml-config"; - src = null; - version = "2"; - }; - ocaml-version = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:18ixm46gxssqcljvjyz3yj65jphbs3jf9v998bbfm06m3y49z038"; - package = "packages/ocaml-version/ocaml-version.3.4.0"; - }; - pname = "ocaml-version"; - src = pkgs.fetchurl - { - sha256 = "09cavcmla9zyqj3vmmp4n59bgj1ydbk4qhsz1dqvgsyqx2svxhfq"; - url = "https://github.com/ocurrent/ocaml-version/releases/download/v3.4.0/ocaml-version-v3.4.0.tbz"; - }; - version = "3.4.0"; - }; - ocamlbuild = - { - opamInputs = { - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:04ws6wbbsv56r4b6f29514inn77d91gb6sa8z62bxkswk1s1r1fn"; - package = "packages/ocamlbuild/ocamlbuild.0.14.1"; - }; - pname = "ocamlbuild"; - src = pkgs.fetchurl - { - sha256 = "0ml2y3dqhhbwlf94l3jgz6gfhhfp41qaf1sjm8p8c37q1vzpj4jf"; - url = "https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.1.tar.gz"; - }; - version = "0.14.1"; - }; - ocamlfind = - { - opamInputs = - { - graphics = selection.graphics or null; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1wq1lkw3rpgilprlakznsxxf60mcidn3fzi3vjrgjdrnnp9hvh19"; - package = "packages/ocamlfind/ocamlfind.1.9.3"; - }; - pname = "ocamlfind"; - src = pkgs.fetchurl - { - sha256 = "0hfcwamcvinmww59b5i4yxbf0kxyzkp5qv3d1c7ybn9q52vgq463"; - url = "http://download.camlcity.org/download/findlib-1.9.3.tar.gz"; - }; - version = "1.9.3"; - }; - ocplib-endian = - { - opamInputs = - { - base-bytes = selection.base-bytes; - cppo = selection.cppo; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1jldvb471gyhkrzwfvqg722l3a8dc37hhhyas66skjzfmqyi2pnh"; - package = "packages/ocplib-endian/ocplib-endian.1.2"; - }; - pname = "ocplib-endian"; - src = pkgs.fetchurl - { - sha256 = "085kskr0cxcnv2d62n3jq1r273p7giisy56zfl26mm7amvl79blp"; - url = "https://github.com/OCamlPro/ocplib-endian/archive/refs/tags/1.2.tar.gz"; - }; - version = "1.2"; - }; - octavius = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0bagilkanfjyi56hrk9dw43xs6zry9p8n3l55r3d58v5hz2xsbwl"; - package = "packages/octavius/octavius.1.2.2"; - }; - pname = "octavius"; - src = pkgs.fetchurl - { - sha256 = "1bg0fcm7haqxvx5wx2cci0mbbq0gf1vw9fa4kkd6jsriw1611jga"; - url = "https://github.com/ocaml-doc/octavius/archive/v1.2.2.tar.gz"; - }; - version = "1.2.2"; - }; - odoc = - { - opamInputs = - { - astring = selection.astring; - cmdliner = selection.cmdliner; - cppo = selection.cppo; - dune = selection.dune; - fmt = selection.fmt; - fpath = selection.fpath; - ocaml = selection.ocaml; - odoc-parser = selection.odoc-parser; - result = selection.result; - tyxml = selection.tyxml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0wmvf0nd16lbis6y0y5swqlnxna4p8inwjq25m1ww3hav5yf3vsv"; - package = "packages/odoc/odoc.2.1.0"; - }; - pname = "odoc"; - src = pkgs.fetchurl - { - sha256 = "0rs99qfka968dq0c6f80s2qcsdkada37akzjy5j82dpfa0x558k5"; - url = "https://github.com/ocaml/odoc/releases/download/2.1.0/odoc-2.1.0.tbz"; - }; - version = "2.1.0"; - }; - odoc-parser = - { - opamInputs = - { - astring = selection.astring; - dune = selection.dune; - ocaml = selection.ocaml; - result = selection.result; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:089fhf57wh7an4hgl88smgi4fdzy8yb95c3bhj15m7pvsy9h3sdf"; - package = "packages/odoc-parser/odoc-parser.1.0.0"; - }; - pname = "odoc-parser"; - src = pkgs.fetchurl - { - sha256 = "18bsdql39nar0k8mfvafczrkqw8dv8gdmi7b5fdsvsx9f7m0iamn"; - url = "https://github.com/ocaml-doc/odoc-parser/releases/download/1.0.0/odoc-parser-1.0.0.tbz"; - }; - version = "1.0.0"; - }; - parsexp = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - sexplib0 = selection.sexplib0; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1fqnxdr1pgxmada77hkhyyr7yybpv2f810shnhvhkpw15h58azx1"; - package = "packages/parsexp/parsexp.v0.14.2"; - }; - pname = "parsexp"; - src = pkgs.fetchurl - { - sha256 = "0c7jl6sqfawqpvbhci8vyyhgvcyd3lw5lj3jcf5f1p6w1177xqgn"; - url = "https://github.com/janestreet/parsexp/archive/refs/tags/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - ppx_assert = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_cold = selection.ppx_cold; - ppx_compare = selection.ppx_compare; - ppx_here = selection.ppx_here; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1ry1bqssjw5lc7h0x2cc7f8rmz807j5l7029lxd4i12vgq91x5km"; - package = "packages/ppx_assert/ppx_assert.v0.14.0"; - }; - pname = "ppx_assert"; - src = pkgs.fetchurl - { - sha256 = "1l2rr4jz2q5b35ryn2z146z7m9v6k8krp5gpn8ilib66mnz5zx15"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_assert-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_base = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - ppx_cold = selection.ppx_cold; - ppx_compare = selection.ppx_compare; - ppx_enumerate = selection.ppx_enumerate; - ppx_hash = selection.ppx_hash; - ppx_js_style = selection.ppx_js_style; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1n66x8xl2n0qbq1g0b1l3nsdqlb3czj5w509riwqdgz11fyrzi25"; - package = "packages/ppx_base/ppx_base.v0.14.0"; - }; - pname = "ppx_base"; - src = pkgs.fetchurl - { - sha256 = "0b7a3fmi90jk8paz0g36yzaq670fbnrbi1j8r5ibh9wbcfli7ji6"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_base-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_bench = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - ppx_inline_test = selection.ppx_inline_test; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0r17lcfhxd14ihbbhqjqjmx26ig4xf62dmc2pblg7flzcf4k64dp"; - package = "packages/ppx_bench/ppx_bench.v0.14.1"; - }; - pname = "ppx_bench"; - src = pkgs.fetchurl - { - sha256 = "1jr3cf4zsk894x64c8ir9ap9l412q35b2605pr7flrlxbm4vkf3f"; - url = "https://github.com/janestreet/ppx_bench/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_bin_prot = - { - opamInputs = - { - base = selection.base; - bin_prot = selection.bin_prot; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_here = selection.ppx_here; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0rsbhajm4927f1798baalwf3f7f5vs8jy27bxd6rhhybnvqjxyj9"; - package = "packages/ppx_bin_prot/ppx_bin_prot.v0.14.0"; - }; - pname = "ppx_bin_prot"; - src = pkgs.fetchurl - { - sha256 = "0wa2jmvm2k88b37pbcafy1mdf5iaip0yxg5dw774sbh28nm08m2s"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_bin_prot-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_cold = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0g566vskiblrxr246c3s26rlzxciln518fr4f6d8lid63qgrgnfm"; - package = "packages/ppx_cold/ppx_cold.v0.14.0"; - }; - pname = "ppx_cold"; - src = pkgs.fetchurl - { - sha256 = "1madfzhpir9amnxmg530n70vll0jrl59vyp71miji73i6b9sy6n2"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_cold-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_compare = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1ndfsgazb7yg5q3aqzcrnr914sf615bsh4z4q202bdvpf0fqj31k"; - package = "packages/ppx_compare/ppx_compare.v0.14.0"; - }; - pname = "ppx_compare"; - src = pkgs.fetchurl - { - sha256 = "0mqxa2s194nif7x4fjn1p5gd9i3bakr8nv27gf8x1g5nmi8q9pmp"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_compare-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_custom_printf = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1karjqaa17ai6v4y7wb2zwfpscyirmb4ixdr3lw6i83icklsgmdw"; - package = "packages/ppx_custom_printf/ppx_custom_printf.v0.14.1"; - }; - pname = "ppx_custom_printf"; - src = pkgs.fetchurl - { - sha256 = "0kzbckbvhfn3s9an1hq01qd5iac7wgirw182ablpqxc6r3dmijrl"; - url = "https://github.com/janestreet/ppx_custom_printf/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_derivers = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1hj1ina0n7pgz16mrvijczapw75pd0hif0i18dpw7d1fyg2qr8py"; - package = "packages/ppx_derivers/ppx_derivers.1.2.1"; - }; - pname = "ppx_derivers"; - src = pkgs.fetchurl - { - sha256 = "159vqy616ni18mn0dlv8c2y4h7mb4hahwjn53yrr59yyhzhmwndn"; - url = "https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz"; - }; - version = "1.2.1"; - }; - ppx_enumerate = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0lgnrpq1vmb44367y7mdr7jw1yqmy08fi6phgq8pch3a47fdk2rm"; - package = "packages/ppx_enumerate/ppx_enumerate.v0.14.0"; - }; - pname = "ppx_enumerate"; - src = pkgs.fetchurl - { - sha256 = "1ij6sffgqhnjwnj9brhrrw1c6xgxlh0s6r17x1qkgnyrc73gfsz8"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_enumerate-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_expect = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_here = selection.ppx_here; - ppx_inline_test = selection.ppx_inline_test; - ppxlib = selection.ppxlib; - re = selection.re; - stdio = selection.stdio; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:14hnawvs9fc87kghg00zj0p1p21f22gdy1767l2nwb4ihl3h133b"; - package = "packages/ppx_expect/ppx_expect.v0.14.2"; - }; - pname = "ppx_expect"; - src = pkgs.fetchurl - { - sha256 = "1gcjlya6knnsrl60sd3vlgp7arj39xm5fjjfk5sick4z66agm2n5"; - url = "https://github.com/janestreet/ppx_expect/archive/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - ppx_fields_conv = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - fieldslib = selection.fieldslib; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0332mrn1xk3423rm4hk5lif9igrj3339xyfd6464wcbkpakivfba"; - package = "packages/ppx_fields_conv/ppx_fields_conv.v0.14.2"; - }; - pname = "ppx_fields_conv"; - src = pkgs.fetchurl - { - sha256 = "0r7d51j54r1za6bwqsmhmhhfab8n10zyk5zznhkm91f20dx9ddip"; - url = "https://github.com/janestreet/ppx_fields_conv/archive/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - ppx_fixed_literal = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:13wng3z0x3fx6l4vym8rddc0yniplim94gn5x8bcfkjd2yhxd88s"; - package = "packages/ppx_fixed_literal/ppx_fixed_literal.v0.14.0"; - }; - pname = "ppx_fixed_literal"; - src = pkgs.fetchurl - { - sha256 = "0w0a06143mhmczbpr0lfb66r6im7075gck4p0idbcari63sximqj"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_fixed_literal-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_hash = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_compare = selection.ppx_compare; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0zcnsd0724w6kpx4w1i3nbfrvffhnqjn3rinddgqjndx5pvghrlc"; - package = "packages/ppx_hash/ppx_hash.v0.14.0"; - }; - pname = "ppx_hash"; - src = pkgs.fetchurl - { - sha256 = "0x4wgdvhgd8a49bzari52jpkykxpv6ncgp5ncda3xgg0a9r49s8n"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_hash-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_here = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0f7p619ymqm27iclcx3cbyyn1k0mccw9vsa0l88m1jk3kjgjbmzz"; - package = "packages/ppx_here/ppx_here.v0.14.0"; - }; - pname = "ppx_here"; - src = pkgs.fetchurl - { - sha256 = "0b444djy68v6ji0ypwv5l02pkl151qzrgg96lyhl8dxfrzvj1zkj"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_here-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_inline_test = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - time_now = selection.time_now; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1vwg8bgw093ia075n7vh0kl82sjd5r9yk27s45ljzz9cmfqrr4sa"; - package = "packages/ppx_inline_test/ppx_inline_test.v0.14.1"; - }; - pname = "ppx_inline_test"; - src = pkgs.fetchurl - { - sha256 = "0qzvm8rg07annl8zpqlhzx1z8ahrrf02r1brd43ykqas5sww3rfp"; - url = "https://github.com/janestreet/ppx_inline_test/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_jane = - { - opamInputs = - { - base_quickcheck = selection.base_quickcheck; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_assert = selection.ppx_assert; - ppx_base = selection.ppx_base; - ppx_bench = selection.ppx_bench; - ppx_bin_prot = selection.ppx_bin_prot; - ppx_custom_printf = selection.ppx_custom_printf; - ppx_expect = selection.ppx_expect; - ppx_fields_conv = selection.ppx_fields_conv; - ppx_fixed_literal = selection.ppx_fixed_literal; - ppx_here = selection.ppx_here; - ppx_inline_test = selection.ppx_inline_test; - ppx_let = selection.ppx_let; - ppx_module_timer = selection.ppx_module_timer; - ppx_optcomp = selection.ppx_optcomp; - ppx_optional = selection.ppx_optional; - ppx_pipebang = selection.ppx_pipebang; - ppx_sexp_message = selection.ppx_sexp_message; - ppx_sexp_value = selection.ppx_sexp_value; - ppx_stable = selection.ppx_stable; - ppx_string = selection.ppx_string; - ppx_typerep_conv = selection.ppx_typerep_conv; - ppx_variants_conv = selection.ppx_variants_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1jqzfdg3rbb96mgw0cpbsmr1y06whhqys6a4rkfdih6z4n5cm4ns"; - package = "packages/ppx_jane/ppx_jane.v0.14.0"; - }; - pname = "ppx_jane"; - src = pkgs.fetchurl - { - sha256 = "18js98xdqf8d54sjn1gccjkwbv2p56qy7bhvjgk94pr3fipfz0v7"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_jane-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_js_style = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - octavius = selection.octavius; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:05bc07ghvfd4d85inf1qvpqxphvcg7mgf8fn9ycib6fdmxdkkamq"; - package = "packages/ppx_js_style/ppx_js_style.v0.14.1"; - }; - pname = "ppx_js_style"; - src = pkgs.fetchurl - { - sha256 = "1nq4rj659f34dc28pj7ir2szqbpky4nzs9qfw0am6sf36jwispiw"; - url = "https://github.com/janestreet/ppx_js_style/archive/refs/tags/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_let = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1n3ayvvmiwmv5jnyjl8nr510dblijwx9g2r39hl5xxgr57d4c7f7"; - package = "packages/ppx_let/ppx_let.v0.14.0"; - }; - pname = "ppx_let"; - src = pkgs.fetchurl - { - sha256 = "1qcrnd86pbr1di5m6z4ps4p15qawwa02jxwz3xfd82hdbjmdwf1s"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_let-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_module_timer = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_base = selection.ppx_base; - ppxlib = selection.ppxlib; - stdio = selection.stdio; - time_now = selection.time_now; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:18q8zyppvl9wskx5flhcfmkznzihfs3kk3c38n0kdh1ngg6c1prr"; - package = "packages/ppx_module_timer/ppx_module_timer.v0.14.0"; - }; - pname = "ppx_module_timer"; - src = pkgs.fetchurl - { - sha256 = "04a7vzk4s3jn6wj94q0hn8kd9vxlzkpcq5ifpvz3bdfgmypjks5z"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_module_timer-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_optcomp = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - stdio = selection.stdio; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0xh7m3hsm7vrhzmd86n3irhydp9lyr23ax9mg1khq2jhcbyqqvy0"; - package = "packages/ppx_optcomp/ppx_optcomp.v0.14.3"; - }; - pname = "ppx_optcomp"; - src = pkgs.fetchurl - { - sha256 = "0bxzh0pm3zdiadrd37jjzp7zm2qn28mx25ahk0shgfb73vya809n"; - url = "https://github.com/janestreet/ppx_optcomp/archive/v0.14.3.tar.gz"; - }; - version = "v0.14.3"; - }; - ppx_optional = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0jg35ql4vwzh27hv2vn52hilfb2cpdl91wiaj0r6nh9s6iwy8dzf"; - package = "packages/ppx_optional/ppx_optional.v0.14.0"; - }; - pname = "ppx_optional"; - src = pkgs.fetchurl - { - sha256 = "1hh6ivlp1qpvyn8l0vhrahkkcp3scf7km254sgplprmk10wnyidz"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_optional-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_pipebang = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1rklw915zv3apij5icp19337aza8di19sp86qp0w6lwimmdvx7dn"; - package = "packages/ppx_pipebang/ppx_pipebang.v0.14.0"; - }; - pname = "ppx_pipebang"; - src = pkgs.fetchurl - { - sha256 = "19afbbvy72i1347prvkpy3ms75xnk7kl2hn83h40p6yh27100hky"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_pipebang-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_sexp_conv = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - sexplib0 = selection.sexplib0; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:03c4ar76g1sz2y35a9jbffw957i17ixwd7ky8cg5ss7m7jl7x1fs"; - package = "packages/ppx_sexp_conv/ppx_sexp_conv.v0.14.3"; - }; - pname = "ppx_sexp_conv"; - src = pkgs.fetchurl - { - sha256 = "0fbnkhsd6yphc49pa21nlmbik99n7qkaz8l9paq96v012ipg9h9g"; - url = "https://github.com/janestreet/ppx_sexp_conv/archive/v0.14.3.tar.gz"; - }; - version = "v0.14.3"; - }; - ppx_sexp_message = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_here = selection.ppx_here; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0djv8npvc7lx1d20f3ln3s3hffh729fpyyj156fpylkqnr9lcfv7"; - package = "packages/ppx_sexp_message/ppx_sexp_message.v0.14.1"; - }; - pname = "ppx_sexp_message"; - src = pkgs.fetchurl - { - sha256 = "06d1cx8nh6chgx09lqjgsagc02lfsvv18fydrviqjvydx52m2qjf"; - url = "https://github.com/janestreet/ppx_sexp_message/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_sexp_value = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_here = selection.ppx_here; - ppx_sexp_conv = selection.ppx_sexp_conv; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0wqj7nr9nvyss3qjf5jcbijjqkrah2ib8ypfp4hxw00vmyfvyrps"; - package = "packages/ppx_sexp_value/ppx_sexp_value.v0.14.0"; - }; - pname = "ppx_sexp_value"; - src = pkgs.fetchurl - { - sha256 = "0yc6i1yx9mb8pwjkswy09aqg5kz1hgrpjyniq2v6whfjvxl1qrkj"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/ppx_sexp_value-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - ppx_stable = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1b2kvif9jc2wj99ciaz6876myn05qbk3a7gn40msnpmd9prgg1lc"; - package = "packages/ppx_stable/ppx_stable.v0.14.1"; - }; - pname = "ppx_stable"; - src = pkgs.fetchurl - { - sha256 = "1dw8ilrvi5lssxnbflnzskmyi3k93ij2kbyz49y93agv0b8dsq01"; - url = "https://github.com/janestreet/ppx_stable/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_string = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_base = selection.ppx_base; - ppxlib = selection.ppxlib; - stdio = selection.stdio; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0adczy40rfpif3jwz2vrhf8kphzilvgffws2si9ypzs264ipjvg8"; - package = "packages/ppx_string/ppx_string.v0.14.1"; - }; - pname = "ppx_string"; - src = pkgs.fetchurl - { - sha256 = "1a8f7bplbxvwm4lh0m57j89jkwkxfm9r5ndcvvlj5v6py8pv69wj"; - url = "https://github.com/janestreet/ppx_string/archive/v0.14.1.tar.gz"; - }; - version = "v0.14.1"; - }; - ppx_typerep_conv = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - typerep = selection.typerep; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:13fsnz1ndp973s265alzn2l8r1s5bwyica864xgl247yp77f8yy2"; - package = "packages/ppx_typerep_conv/ppx_typerep_conv.v0.14.2"; - }; - pname = "ppx_typerep_conv"; - src = pkgs.fetchurl - { - sha256 = "1g1sb3prscpa7jwnk08f50idcgyiiv0b9amkl0kymj5cghkdqw0n"; - url = "https://github.com/janestreet/ppx_typerep_conv/archive/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - ppx_variants_conv = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppxlib = selection.ppxlib; - variantslib = selection.variantslib; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0x7xyzzdp9gpx3j32nkh8n1baw8831ppa40c5s4lb4f5gpzjg9m9"; - package = "packages/ppx_variants_conv/ppx_variants_conv.v0.14.2"; - }; - pname = "ppx_variants_conv"; - src = pkgs.fetchurl - { - sha256 = "06d63vi2ijzqa3wqnywwqywldq72karss39zi47d544y10rq4rid"; - url = "https://github.com/janestreet/ppx_variants_conv/archive/v0.14.2.tar.gz"; - }; - version = "v0.14.2"; - }; - ppxlib = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - ocaml-compiler-libs = selection.ocaml-compiler-libs; - ppx_derivers = selection.ppx_derivers; - sexplib0 = selection.sexplib0; - stdlib-shims = selection.stdlib-shims; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0yjsgdkfkbwyjj3yihrqnxlpagrbcr1gln7bxfmx96y3xa4fs8jv"; - package = "packages/ppxlib/ppxlib.0.24.0"; - }; - pname = "ppxlib"; - src = pkgs.fetchurl - { - sha256 = "1j4hg8gc8mkw64gvjghig1179ih90yki54hf8qxmn3yd5ry04rkp"; - url = "https://github.com/ocaml-ppx/ppxlib/releases/download/0.24.0/ppxlib-0.24.0.tbz"; - }; - version = "0.24.0"; - }; - re = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - seq = selection.seq; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1f2xgscc07g800ia8z43i1p377dj2fjdrpzsqgzvw1dnplwnklya"; - package = "packages/re/re.1.10.3"; - }; - pname = "re"; - src = pkgs.fetchurl - { - sha256 = "1fqfg609996bgxr14yyfxhvl6hm9c1j0mm2xjdjigqrzgyb4crc4"; - url = "https://github.com/ocaml/ocaml-re/releases/download/1.10.3/re-1.10.3.tbz"; - }; - version = "1.10.3"; - }; - react = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1airidp9cw8sk92jc3bvarph3pc43qaf3hcywi0anmpznsygcm0z"; - package = "packages/react/react.1.2.2"; - }; - pname = "react"; - src = pkgs.fetchurl - { - sha256 = "16cg4byj8lfbbw96dhh8sks5y9n1c3fshz7f2p8m7wgisqax7bf4"; - url = "https://erratique.ch/software/react/releases/react-1.2.2.tbz"; - }; - version = "1.2.2"; - }; - result = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0ybmvlisfz5swvbcq855czz1ysv9zxmb79f1m0x8284hczmfm98f"; - package = "packages/result/result.1.5"; - }; - pname = "result"; - src = pkgs.fetchurl - { - sha256 = "0cpfp35fdwnv3p30a06wd0py3805qxmq3jmcynjc3x2qhlimwfkw"; - url = "https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz"; - }; - version = "1.5"; - }; - seq = - { - opamInputs = { - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1vm8mk6zm2q3fwnkprl6jib048zr4ysldw0bl74x6wwbxj0vx6k9"; - package = "packages/seq/seq.base"; - }; - pname = "seq"; - src = null; - version = "base"; - }; - sexplib = - { - opamInputs = - { - dune = selection.dune; - num = selection.num; - ocaml = selection.ocaml; - parsexp = selection.parsexp; - sexplib0 = selection.sexplib0; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1nlzjkx60d4z09b15nq35ivzl6akk3svq7nl4vv5swhsmj8gvpl4"; - package = "packages/sexplib/sexplib.v0.14.0"; - }; - pname = "sexplib"; - src = pkgs.fetchurl - { - sha256 = "12rlnc6fcrjfdn3gs2agi418sj54ighhs6dfll37zcv7mgywblm2"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - sexplib0 = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:0k9vkjbiibja48c0yayal7xwyik3h3c3v4dwd3j7jbmras63ig2c"; - package = "packages/sexplib0/sexplib0.v0.14.0"; - }; - pname = "sexplib0"; - src = pkgs.fetchurl - { - sha256 = "0adrc0r1vvvr41dcpj8jwkzh1dfgqf0mks9xlnnskqfm3a51iavg"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib0-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - spawn = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1zfg8d644i2pdq90jwblpi0y8k7xim4xb8i11czpv1qjw2p0s1y1"; - package = "packages/spawn/spawn.v0.15.0"; - }; - pname = "spawn"; - src = pkgs.fetchurl - { - sha256 = "1isppdyahdcdv8agw1w1l3hyl6kwsbcspjw2h5rlrxn71ajv43ri"; - url = "https://github.com/janestreet/spawn/archive/v0.15.0.tar.gz"; - }; - version = "v0.15.0"; - }; - splittable_random = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_assert = selection.ppx_assert; - ppx_bench = selection.ppx_bench; - ppx_inline_test = selection.ppx_inline_test; - ppx_sexp_message = selection.ppx_sexp_message; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:14s1ka5p5af599ira53kygzny65ls49vkxw3xk9ia5xavp7gv4bp"; - package = "packages/splittable_random/splittable_random.v0.14.0"; - }; - pname = "splittable_random"; - src = pkgs.fetchurl - { - sha256 = "185rpmdnrzs80br138pnjbx9hfp1046zvj1ap0brq1sxdwzak6lf"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/splittable_random-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - stdio = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:19hlf6bgx1avq4ifwji2rj2f2j26v3nf8ywjnwh2m3dpvfqc4pvk"; - package = "packages/stdio/stdio.v0.14.0"; - }; - pname = "stdio"; - src = pkgs.fetchurl - { - sha256 = "1hj5hraprqy2i90a690l11yjszvb99j818q3d684ryx6p2lddk0l"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/stdio-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - stdlib-shims = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:19g9dnaxyh2ajz6pdczdsqzzvsmfrxwx6f613inkr31jw5hrqkiz"; - package = "packages/stdlib-shims/stdlib-shims.0.3.0"; - }; - pname = "stdlib-shims"; - src = pkgs.fetchurl - { - sha256 = "0jnqsv6pqp5b5g7lcjwgd75zqqvcwcl5a32zi03zg1kvj79p5gxs"; - url = "https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz"; - }; - version = "0.3.0"; - }; - textutils = - { - opamInputs = - { - core = selection.core; - core_kernel = selection.core_kernel; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_jane = selection.ppx_jane; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:09ikh4xmy7ghzvz8m1p790jbhi04akarlaxqaywjl1f1qbdrhpnk"; - package = "packages/textutils/textutils.v0.14.0"; - }; - pname = "textutils"; - src = pkgs.fetchurl - { - sha256 = "1ss956gfk2pch3nsqis4x7z79j2d6q002bf8z8xw9z2r64wzi8hl"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/textutils-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - time_now = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - jane-street-headers = selection.jane-street-headers; - jst-config = selection.jst-config; - ocaml = selection.ocaml; - ppx_base = selection.ppx_base; - ppx_optcomp = selection.ppx_optcomp; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1s8bqbks0cjw4x68nn5xlkykn3bcqh2rmrx6hgs53dalkiqv7ry0"; - package = "packages/time_now/time_now.v0.14.0"; - }; - pname = "time_now"; - src = pkgs.fetchurl - { - sha256 = "0hkn2jw4dz5gflnsblskl5wp6z7zbrahwjmaxmsskfviwjg82cqh"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/time_now-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - timezone = - { - opamInputs = - { - core_kernel = selection.core_kernel; - dune = selection.dune; - ocaml = selection.ocaml; - ppx_jane = selection.ppx_jane; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1508a5cygb5p4n3kknx8dsrndf9x47fsq232gz4hr9pm8ipriixz"; - package = "packages/timezone/timezone.v0.14.0"; - }; - pname = "timezone"; - src = pkgs.fetchurl - { - sha256 = "095xni0szjqqax2r9zh9820l72ixfga2pl0njnarp3795vkw0rdp"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/timezone-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - topkg = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:04vg4zic7f6zk44vkvqw2fcr562hl7d0gklv3vgphk4n3bnqbcyy"; - package = "packages/topkg/topkg.1.0.5"; - }; - pname = "topkg"; - src = pkgs.fetchurl - { - sha256 = "1iyinmcfqpprk7k4cc51nqgypayprbj4larwcfqw86k5dri84825"; - url = "https://erratique.ch/software/topkg/releases/topkg-1.0.5.tbz"; - }; - version = "1.0.5"; - }; - trie = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1ds07ikjjymacnlxfx1widfi7qz0js61lsqqq0xa90501p17nq10"; - package = "packages/trie/trie.1.0.0"; - }; - pname = "trie"; - src = pkgs.fetchurl - { - sha256 = "1slq4kiwnc723dsaw15ms7xxpqz061v8zck1m6iyc5j2li70by62"; - url = "https://github.com/kandu/trie/archive/1.0.0.tar.gz"; - }; - version = "1.0.0"; - }; - typerep = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1hhgz8nrarcmbrnknah05wlz3yf1sq4j4mjgjajmbjnls26dkyfa"; - package = "packages/typerep/typerep.v0.14.0"; - }; - pname = "typerep"; - src = pkgs.fetchurl - { - sha256 = "0rmp5jsjg6sgn5yx0pcvch0phs7nak2fg1d48g5sjcyyyj8n1279"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/typerep-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - tyxml = - { - opamInputs = - { - dune = selection.dune; - ocaml = selection.ocaml; - re = selection.re; - seq = selection.seq; - uutf = selection.uutf; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1lw91vsiijp4n6vgpfbws72c1v7a1b0v1fkxd7spasl8z27ljq2g"; - package = "packages/tyxml/tyxml.4.5.0"; - }; - pname = "tyxml"; - src = pkgs.fetchurl - { - sha256 = "0s30f72m457c3gbdmdwbx7ls9zg806nvm83aiz9qkpglbppwr6n6"; - url = "https://github.com/ocsigen/tyxml/releases/download/4.5.0/tyxml-4.5.0.tbz"; - }; - version = "4.5.0"; - }; - uchar = - { - opamInputs = - { - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:17sfpyj5a1z3knnjvnfa5vql6cj2x9pzgzk8w4jrvd2zii2bwpcl"; - package = "packages/uchar/uchar.0.0.2"; - }; - pname = "uchar"; - src = pkgs.fetchurl - { - sha256 = "1w2saw7zanf9m9ffvz2lvcxvlm118pws2x1wym526xmydhqpyfa7"; - url = "https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz"; - }; - version = "0.0.2"; - }; - utop = - { - opamInputs = - { - base-threads = selection.base-threads; - base-unix = selection.base-unix; - camomile = selection.camomile; - cppo = selection.cppo; - dune = selection.dune; - lambda-term = selection.lambda-term; - lwt = selection.lwt; - lwt_react = selection.lwt_react; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - react = selection.react; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:07ra6xlknabjvyw8yfm3a6z8j1kal22222vciblrw21y1v8qjnkk"; - package = "packages/utop/utop.2.9.0"; - }; - pname = "utop"; - src = pkgs.fetchurl - { - sha256 = "17jd61bc6pva5wqmnc9xq70ysyjplrzf1p25sq1s7wgrfq2vlyyd"; - url = "https://github.com/ocaml-community/utop/releases/download/2.9.0/utop-2.9.0.tbz"; - }; - version = "2.9.0"; - }; - uutf = - { - opamInputs = - { - cmdliner = selection.cmdliner or null; - ocaml = selection.ocaml; - ocamlbuild = selection.ocamlbuild; - ocamlfind = selection.ocamlfind; - topkg = selection.topkg; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1x57h3bc68rsm2kd18wjbkfjk67shak6jgplp7paw97faqgmgx3x"; - package = "packages/uutf/uutf.1.0.3"; - }; - pname = "uutf"; - src = pkgs.fetchurl - { - sha256 = "0s05r8ggp1g97zq4rnvbxzj22pv8ld0k5wsdw662jw0y7mhsawl7"; - url = "https://erratique.ch/software/uutf/releases/uutf-1.0.3.tbz"; - }; - version = "1.0.3"; - }; - variantslib = - { - opamInputs = - { - base = selection.base; - dune = selection.dune; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1g0z5w2wgsj59vrz7mdzjxdg0vxhck0q8yvzhvag77xzw85r5kjs"; - package = "packages/variantslib/variantslib.v0.14.0"; - }; - pname = "variantslib"; - src = pkgs.fetchurl - { - sha256 = "11zp27gh282dx9ifbhcp6i7fkc97fvk8amaj58mf1g1hwklc0lm3"; - url = "https://ocaml.janestreet.com/ocaml-core/v0.14/files/variantslib-v0.14.0.tar.gz"; - }; - version = "v0.14.0"; - }; - yojson = - { - opamInputs = - { - biniou = selection.biniou; - cppo = selection.cppo; - dune = selection.dune; - easy-format = selection.easy-format; - ocaml = selection.ocaml; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1n8iih0jmaf9b0hsv6ph729jajws9w43kgm24324p4wlj45rjs2q"; - package = "packages/yojson/yojson.1.7.0"; - }; - pname = "yojson"; - src = pkgs.fetchurl - { - sha256 = "1iich6323npvvs8r50lkr4pxxqm9mf6w67cnid7jg1j1g5gwcvv5"; - url = "https://github.com/ocaml-community/yojson/releases/download/1.7.0/yojson-1.7.0.tbz"; - }; - version = "1.7.0"; - }; - zarith = - { - opamInputs = - { - conf-gmp = selection.conf-gmp; - ocaml = selection.ocaml; - ocamlfind = selection.ocamlfind; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:03by05004bgfkfllpacf3vk1h8i6q7wzwi7cgxy0nyj5ffga0ggh"; - package = "packages/zarith/zarith.1.12"; - }; - pname = "zarith"; - src = pkgs.fetchurl - { - sha256 = "1098xpqsq3gwpz9k2gc6ahiz2zk0z0xxi1lwc07nvj2570y5ccnc"; - url = "https://github.com/ocaml/Zarith/archive/release-1.12.tar.gz"; - }; - version = "1.12"; - }; - zed = - { - opamInputs = - { - base-bytes = selection.base-bytes; - camomile = selection.camomile; - charInfo_width = selection.charInfo_width; - dune = selection.dune; - ocaml = selection.ocaml; - react = selection.react; - }; - opamSrc = repoPath (repos.opam-repository.src) - { - hash = "sha256:1k1yd4dwg6x5rija3lan3q57nr6f1xa45248613rr7k2x5zdp2nx"; - package = "packages/zed/zed.3.1.0"; - }; - pname = "zed"; - src = pkgs.fetchurl - { - sha256 = "1z95fs49hi00xy078a83m0vfdqwjb5953rwr15lfpirldi4v11y3"; - url = "https://github.com/ocaml-community/zed/archive/3.1.0.tar.gz"; - }; - version = "3.1.0"; - }; - }; -} - diff --git a/duniverse/dune_/nix/opam2nix.nix b/duniverse/dune_/nix/opam2nix.nix deleted file mode 100644 index 2520e4dfb..000000000 --- a/duniverse/dune_/nix/opam2nix.nix +++ /dev/null @@ -1,4 +0,0 @@ -import (builtins.fetchGit { - url = "https://github.com/timbertson/opam2nix.git"; - rev = "c9192288543be9ea17ba8a568e41258082016768"; -}) { } diff --git a/duniverse/dune_/ocamlc-loc.opam b/duniverse/dune_/ocamlc-loc.opam index fff0239f1..8ed1b77ba 100644 --- a/duniverse/dune_/ocamlc-loc.opam +++ b/duniverse/dune_/ocamlc-loc.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Parse ocaml compiler output into structured form" @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "dyn" {= version} "odoc" {with-doc} diff --git a/duniverse/dune_/ordering.opam b/duniverse/dune_/ordering.opam index 69979506a..f8fd8cb48 100644 --- a/duniverse/dune_/ordering.opam +++ b/duniverse/dune_/ordering.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.4.1" +version: "3.6.1" synopsis: "Element ordering" description: "Element ordering" maintainer: ["Jane Street Group, LLC "] @@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "odoc" {with-doc} ] diff --git a/duniverse/dune_/otherlibs/action-plugin/src/dune b/duniverse/dune_/otherlibs/action-plugin/src/dune index ba3716567..aa3ea1825 100644 --- a/duniverse/dune_/otherlibs/action-plugin/src/dune +++ b/duniverse/dune_/otherlibs/action-plugin/src/dune @@ -1,6 +1,6 @@ (library (name dune_action_plugin) (public_name dune-action-plugin) - (libraries stdune csexp dune-glob unix) + (libraries stdune csexp dune-glob unix dune-rpc.private) (synopsis "[Internal] Monadic interface for defining scripts with dynamic or complex sets of dependencies.")) diff --git a/duniverse/dune_/otherlibs/action-plugin/src/import.ml b/duniverse/dune_/otherlibs/action-plugin/src/import.ml index 99472c4ca..245f61b6e 100644 --- a/duniverse/dune_/otherlibs/action-plugin/src/import.ml +++ b/duniverse/dune_/otherlibs/action-plugin/src/import.ml @@ -12,3 +12,5 @@ include struct module Result = Result module Map = Map end + +module Conv = Dune_rpc_private.Conv diff --git a/duniverse/dune_/otherlibs/action-plugin/src/protocol.ml b/duniverse/dune_/otherlibs/action-plugin/src/protocol.ml index 607dcef2c..09203de80 100644 --- a/duniverse/dune_/otherlibs/action-plugin/src/protocol.ml +++ b/duniverse/dune_/otherlibs/action-plugin/src/protocol.ml @@ -2,17 +2,7 @@ open Import let run_by_dune_env_variable = "DUNE_DYNAMIC_RUN_CLIENT" -let sexp_of_list sexp_of_t list : Sexp.t = List (List.map ~f:sexp_of_t list) - -let list_of_sexp (t_of_sexp : Sexp.t -> 'a Option.t) : Sexp.t -> _ = function - | List sexps -> List.map sexps ~f:t_of_sexp |> Option.List.all - | _ -> None - -let sexp_of_string string : Sexp.t = Atom string - -let string_of_sexp : Sexp.t -> _ = function - | Atom string -> Some string - | _ -> None +module Error = Sexpable_intf.Error module Dependency = struct module T = struct @@ -24,16 +14,20 @@ module Dependency = struct ; glob : string } - let sexp_of_t : _ -> Sexp.t = function - | File path -> List [ Atom "file"; Atom path ] - | Directory path -> List [ Atom "directory"; Atom path ] - | Glob { path; glob } -> List [ Atom "glob"; Atom path; Atom glob ] - - let t_of_sexp : Sexp.t -> _ = function - | List [ Atom "file"; Atom path ] -> Some (File path) - | List [ Atom "directory"; Atom path ] -> Some (Directory path) - | List [ Atom "glob"; Atom path; Atom glob ] -> Some (Glob { path; glob }) - | _ -> None + let conv = + let open Conv in + let file = constr "File" string (fun s -> File s) in + let directory = constr "Directory" string (fun s -> Directory s) in + let glob_cstr = + constr "Glob" (pair string string) (fun (path, glob) -> + Glob { path; glob }) + in + sum + [ econstr file; econstr directory; econstr glob_cstr ] + (function + | File s -> case s file + | Directory s -> case s directory + | Glob { path; glob } -> case (path, glob) glob_cstr) let compare x y = match (x, y) with @@ -58,9 +52,7 @@ module Dependency = struct module Set = struct include O.Set - let sexp_of_t (t : t) = to_list t |> sexp_of_list T.sexp_of_t - - let t_of_sexp sexp = Option.O.(list_of_sexp T.t_of_sexp sexp >>| of_list) + let conv : t Conv.value = Conv.iso (Conv.list conv) of_list to_list end end @@ -71,19 +63,21 @@ module Greeting = struct ; response_fn : string } - let sexp_of_t { run_arguments_fn; response_fn } : Sexp.t = - List [ Atom run_arguments_fn; Atom response_fn ] - - let t_of_sexp : Sexp.t -> _ = function - | List [ Atom run_arguments_fn; Atom response_fn ] -> - Some { run_arguments_fn; response_fn } - | _ -> None + let conv = + let open Conv in + let to_ (run_arguments_fn, response_fn) = + { run_arguments_fn; response_fn } + in + let from { run_arguments_fn; response_fn } = + (run_arguments_fn, response_fn) + in + iso (pair string string) to_ from let version = 0 end include T - include Serializable_intf.Make (T) + include Sexpable_intf.Make (T) end module Run_arguments = struct @@ -93,28 +87,24 @@ module Run_arguments = struct ; targets : String.Set.t } - let sexp_of_t { prepared_dependencies; targets } : Sexp.t = - List - [ Dependency.Set.sexp_of_t prepared_dependencies - ; targets |> String.Set.to_list |> sexp_of_list sexp_of_string - ] - - let t_of_sexp : Sexp.t -> _ = function - | List [ prepared_dependencies; targets ] -> - let open Option.O in - let* prepared_dependencies = - Dependency.Set.t_of_sexp prepared_dependencies - in - let+ targets = list_of_sexp string_of_sexp targets in - let targets = String.Set.of_list targets in + let conv = + let from { prepared_dependencies; targets } = + (prepared_dependencies, targets) + in + let to_ (prepared_dependencies, targets) = { prepared_dependencies; targets } - | _ -> None + in + let string_set = + Conv.iso Conv.(list string) String.Set.of_list String.Set.to_list + in + let conv = Conv.pair Dependency.Set.conv string_set in + Conv.iso conv to_ from let version = 0 end include T - include Serializable_intf.Make (T) + include Sexpable_intf.Make (T) end module Response = struct @@ -123,22 +113,24 @@ module Response = struct | Done | Need_more_deps of Dependency.Set.t - let sexp_of_t : _ -> Sexp.t = function - | Done -> List [ Atom "done" ] - | Need_more_deps deps -> - List [ Atom "need_more_deps"; Dependency.Set.sexp_of_t deps ] - - let t_of_sexp : Sexp.t -> _ = function - | List [ Atom "done" ] -> Some Done - | List [ Atom "need_more_deps"; sexp ] -> - Option.O.(Dependency.Set.t_of_sexp sexp >>| fun xs -> Need_more_deps xs) - | _ -> None + let conv = + let open Conv in + let done_ = constr "Done" unit (fun () -> Done) in + let need_more_deps = + constr "Need_more_deps" Dependency.Set.conv (fun deps -> + Need_more_deps deps) + in + sum + [ econstr done_; econstr need_more_deps ] + (function + | Done -> case () done_ + | Need_more_deps deps -> case deps need_more_deps) let version = 0 end include T - include Serializable_intf.Make (T) + include Sexpable_intf.Make (T) end module Context = struct @@ -168,33 +160,39 @@ module Context = struct match Sys.getenv_opt run_by_dune_env_variable with | None -> Run_outside_of_dune | Some value -> ( - match Greeting.deserialize value with - | Error (Version_mismatch _) -> version_mismatch_error - | Error Parse_error -> cannot_parse_error - | Ok greeting -> ( - match - ( Result.try_with (fun () -> - Io.String_path.read_file greeting.run_arguments_fn) - , Sys.file_exists greeting.response_fn ) - with - | _, false -> file_not_found_error - | Error _, _ -> cannot_read_file - | Ok data, true -> ( - match Run_arguments.deserialize data with - | Error (Version_mismatch _) -> version_mismatch_error - | Error Parse_error -> cannot_parse_error - | Ok { prepared_dependencies; targets } -> - Ok - { response_fn = greeting.response_fn - ; prepared_dependencies - ; targets - }))) + match Csexp.parse_string value with + | Error _ -> cannot_parse_error + | Ok sexp -> ( + match Greeting.of_sexp sexp with + | Error (Version_mismatch _) -> version_mismatch_error + | Error Parse_error -> cannot_parse_error + | Ok greeting -> ( + match + ( Result.try_with (fun () -> + Io.String_path.read_file greeting.run_arguments_fn) + , Sys.file_exists greeting.response_fn ) + with + | _, false -> file_not_found_error + | Error _, _ -> cannot_read_file + | Ok data, true -> ( + match Csexp.parse_string data with + | Error _ -> cannot_parse_error + | Ok sexp -> ( + match Run_arguments.of_sexp sexp with + | Error (Version_mismatch _) -> version_mismatch_error + | Error Parse_error -> cannot_parse_error + | Ok { prepared_dependencies; targets } -> + Ok + { response_fn = greeting.response_fn + ; prepared_dependencies + ; targets + }))))) let prepared_dependencies (t : t) = t.prepared_dependencies let targets (t : t) = t.targets let respond (t : t) response = - let data = Response.serialize response in + let data = Response.to_sexp response |> Csexp.to_string in Io.String_path.write_file t.response_fn data end diff --git a/duniverse/dune_/otherlibs/action-plugin/src/protocol.mli b/duniverse/dune_/otherlibs/action-plugin/src/protocol.mli index c9e19b8e6..086aba791 100644 --- a/duniverse/dune_/otherlibs/action-plugin/src/protocol.mli +++ b/duniverse/dune_/otherlibs/action-plugin/src/protocol.mli @@ -1,6 +1,7 @@ open Import open Sexpable_intf -open Serializable_intf + +module Error : module type of Error module Dependency : sig type t = @@ -11,14 +12,10 @@ module Dependency : sig ; glob : string } - include Sexpable with type t := t - module Map : Map.S with type key = t module Set : sig include Set.S with type elt = t and type 'a map = 'a Map.t - - include Sexpable with type t := t end end @@ -28,7 +25,7 @@ module Greeting : sig ; response_fn : string } - include Serializable with type t := t + include Sexpable with type t := t end module Run_arguments : sig @@ -37,7 +34,7 @@ module Run_arguments : sig ; targets : String.Set.t } - include Serializable with type t := t + include Sexpable with type t := t end module Response : sig @@ -45,7 +42,7 @@ module Response : sig | Done | Need_more_deps of Dependency.Set.t - include Serializable with type t := t + include Sexpable with type t := t end (** Dune sets this environment variable to pass [Greeting.t] to client. *) diff --git a/duniverse/dune_/otherlibs/action-plugin/src/serializable_intf.ml b/duniverse/dune_/otherlibs/action-plugin/src/serializable_intf.ml deleted file mode 100644 index 4f4985985..000000000 --- a/duniverse/dune_/otherlibs/action-plugin/src/serializable_intf.ml +++ /dev/null @@ -1,54 +0,0 @@ -open Stdune -open Sexpable_intf - -module Deserialization_error = struct - type t = - | Version_mismatch of int - | Parse_error -end - -module type Serializable = sig - type t - - val serialize : t -> String.t - - val deserialize : String.t -> (t, Deserialization_error.t) Result.t -end - -module type S = sig - include Sexpable - - val version : int -end - -module Make (TypeToSerialize : S) : - Serializable with type t := TypeToSerialize.t = struct - open TypeToSerialize - - let parsing_error_of_option : - _ Option.t -> (_, Deserialization_error.t) Result.t = function - | Some data -> Ok data - | None -> Error Parse_error - - let serialize t = - Sexp.(List [ Atom "version"; Atom (Int.to_string version); sexp_of_t t ]) - |> Csexp.to_string - - let deserialize data = - let open Result.O in - let* sexp = - Csexp.parse_string data - |> Result.map_error ~f:(fun _message -> Deserialization_error.Parse_error) - in - let* format_version, data = - match sexp with - | List [ Atom "version"; Atom version; data ] -> Ok (version, data) - | _ -> Error Deserialization_error.Parse_error - in - let* format_version = - Int.of_string format_version |> parsing_error_of_option - in - if format_version <> version then - Error (Deserialization_error.Version_mismatch format_version) - else t_of_sexp data |> parsing_error_of_option -end diff --git a/duniverse/dune_/otherlibs/action-plugin/src/sexpable_intf.ml b/duniverse/dune_/otherlibs/action-plugin/src/sexpable_intf.ml index 1346bba4b..b4cad8c0e 100644 --- a/duniverse/dune_/otherlibs/action-plugin/src/sexpable_intf.ml +++ b/duniverse/dune_/otherlibs/action-plugin/src/sexpable_intf.ml @@ -1,9 +1,42 @@ -open Stdune +open Import + +module Error = struct + type t = + | Version_mismatch of int + | Parse_error +end module type Sexpable = sig type t - val sexp_of_t : t -> Sexp.t + val to_sexp : t -> Sexp.t + + val of_sexp : Sexp.t -> (t, Error.t) result +end + +module type S = sig + type t + + val conv : t Conv.value + + val version : int +end + +module Make (Type : S) = struct + let conv = + let open Conv in + pair int Type.conv + + let of_sexp sexp : (_, Error.t) result = + match Conv.of_sexp Conv.(pair int sexp) ~version:(0, 0) sexp with + | Error _ -> Error Parse_error + | Ok (version, sexp) -> ( + match Int.equal version Type.version with + | false -> Error (Version_mismatch version) + | true -> ( + match Conv.of_sexp Type.conv ~version:(0, 0) sexp with + | Error _ -> Error Parse_error + | Ok v -> Ok v)) - val t_of_sexp : Sexp.t -> t Option.t + let to_sexp t = Conv.to_sexp conv (Type.version, t) end diff --git a/duniverse/dune_/otherlibs/build-info/test/run.t b/duniverse/dune_/otherlibs/build-info/test/run.t index cb80f04a2..a78f1a861 100644 --- a/duniverse/dune_/otherlibs/build-info/test/run.t +++ b/duniverse/dune_/otherlibs/build-info/test/run.t @@ -100,9 +100,9 @@ Check what the generated build info module looks like: None [@@inline never] - let p1 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%" - let p2 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%" - let p0 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%" + let p1 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%") + let p2 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%") + let p0 = eval (Sys.opaque_identity "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%") let version = p0 diff --git a/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.ml b/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.ml index 9d985f583..46a51e825 100644 --- a/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.ml +++ b/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.ml @@ -18,32 +18,38 @@ module Timestamp : sig val to_json : t -> Json.t val of_float_seconds : float -> t + + val to_float_seconds : t -> float end = struct type t = float let of_float_seconds x = x + let to_float_seconds x = x + let to_json f = let n = int_of_float @@ (f *. 1_000_000.) in `Int n end -module Stack_frame = struct - module Id = struct - type t = - [ `String of string - | `Int of int - ] +module Id = struct + type t = + [ `Int of int + | `String of string + ] - let to_json (t : t) : Json.t = (t :> Json.t) + let create x = x - let to_string = function - | `String s -> s - | `Int i -> string_of_int i + let to_string = function + | `String s -> s + | `Int i -> string_of_int i - let create x : t = x - end + let to_json (t : t) = (t :> Json.t) + let field id = ("id", to_json id) +end + +module Stack_frame = struct module Raw = struct type t = string list @@ -83,8 +89,7 @@ module Event = struct ; pid : int ; tid : int ; cname : string option - ; stackframe : - [ `Id of Stack_frame.Id.t | `Raw of Stack_frame.Raw.t ] option + ; stackframe : [ `Id of Id.t | `Raw of Stack_frame.Raw.t ] option } let common_fields ?tts ?cname ?(cat = []) ?(pid = 0) ?(tid = 0) ?stackframe @@ -93,6 +98,8 @@ module Event = struct let set_ts t ts = { t with ts } + let ts t = t.ts + type scope = | Global | Process @@ -105,18 +112,6 @@ module Event = struct type args = (string * Json.t) list - module Id = struct - type t = - | Int of int - | String of string - - let to_json = function - | Int i -> `Int i - | String s -> `String s - - let field id = ("id", to_json id) - end - type object_kind = | New | Snapshot of @@ -207,7 +202,7 @@ module Event = struct add_field_opt (fun stackframe -> match stackframe with - | `Id id -> ("sf", Stack_frame.Id.to_json id) + | `Id id -> ("sf", Id.to_json id) | `Raw r -> ("stack", Stack_frame.Raw.to_json r)) stackframe fields @@ -321,7 +316,7 @@ module Output_object = struct type t = { displayTimeUnit : [ `Ms | `Ns ] option ; traceEvents : Event.t list - ; stackFrames : (Stack_frame.Id.t * Stack_frame.t) list option + ; stackFrames : (Id.t * Stack_frame.t) list option ; extra_fields : (string * Json.t) list option } @@ -346,7 +341,7 @@ module Output_object = struct | Some frames -> let frames = List.map frames ~f:(fun (id, frame) -> - let id = Stack_frame.Id.to_string id in + let id = Id.to_string id in (id, Stack_frame.to_json frame)) in ("stackFrames", `Assoc frames) :: json diff --git a/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.mli b/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.mli index 2c983b284..9d4837539 100644 --- a/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.mli +++ b/duniverse/dune_/otherlibs/chrome-trace/src/chrome_trace.mli @@ -24,13 +24,13 @@ module Json : sig ] end -module Stack_frame : sig - module Id : sig - type t +module Id : sig + type t - val create : [ `String of string | `Int of int ] -> t - end + val create : [ `String of string | `Int of int ] -> t +end +module Stack_frame : sig module Raw : sig type t @@ -49,12 +49,8 @@ module Event : sig type t val of_float_seconds : float -> t - end - module Id : sig - type t = - | Int of int - | String of string + val to_float_seconds : t -> float end type common_fields @@ -65,12 +61,14 @@ module Event : sig -> ?cat:string list -> ?pid:int -> ?tid:int - -> ?stackframe:[ `Id of Stack_frame.Id.t | `Raw of Stack_frame.Raw.t ] + -> ?stackframe:[ `Id of Id.t | `Raw of Stack_frame.Raw.t ] -> ts:Timestamp.t -> name:string -> unit -> common_fields + val ts : common_fields -> Timestamp.t + val set_ts : common_fields -> Timestamp.t -> common_fields type args = (string * Json.t) list @@ -99,7 +97,7 @@ module Output_object : sig val create : ?displayTimeUnit:[ `Ms | `Ns ] -> ?extra_fields:(string * Json.t) list - -> ?stackFrames:(Stack_frame.Id.t * Stack_frame.t) list + -> ?stackFrames:(Id.t * Stack_frame.t) list -> traceEvents:Event.t list -> unit -> t diff --git a/duniverse/dune_/otherlibs/chrome-trace/test/chrome_trace_tests.ml b/duniverse/dune_/otherlibs/chrome-trace/test/chrome_trace_tests.ml index 821f5e26d..ec6e4b5e0 100644 --- a/duniverse/dune_/otherlibs/chrome-trace/test/chrome_trace_tests.ml +++ b/duniverse/dune_/otherlibs/chrome-trace/test/chrome_trace_tests.ml @@ -12,7 +12,7 @@ let c = let () = let module Event = Chrome_trace.Event in - let module Id = Event.Id in + let module Id = Chrome_trace.Id in let module Timestamp = Event.Timestamp in let events = [ Event.complete @@ -26,7 +26,9 @@ let () = ~ts:(Timestamp.of_float_seconds 0.5) ~name:"cnt" ()) [ ("bar", `Int 250) ] - ; Event.async (Id.String "foo") Event.Start + ; Event.async + (Id.create (`String "foo")) + Event.Start (Event.common_fields ~ts:(Timestamp.of_float_seconds 0.5) ~name:"async" ()) diff --git a/duniverse/dune_/otherlibs/dune-rpc/dune_rpc.mli b/duniverse/dune_/otherlibs/dune-rpc/dune_rpc.mli index fe6d7b85d..c00c41e49 100644 --- a/duniverse/dune_/otherlibs/dune-rpc/dune_rpc.mli +++ b/duniverse/dune_/otherlibs/dune-rpc/dune_rpc.mli @@ -154,9 +154,9 @@ module V1 : sig encountered, which was required by the next element, and so on. *) val targets : t -> Target.t list - (* The directory from which the action producing the error was run, relative - to the workspace root. This is often, but not always, the directory of - the first target in [targets]. + (* The directory from which the action producing the error was run. This is + often, but not always, the directory of the first target in [targets]. + This path of this directory is absolute. If this is [None], then the error does not have an associated error (for example, if your opam installation is too old). *) @@ -470,7 +470,7 @@ module V1 : sig end module Config : sig - (** The registy directory is located using xdg *) + (** The registry directory is located using xdg *) type t diff --git a/duniverse/dune_/otherlibs/dune-rpc/private/types.ml b/duniverse/dune_/otherlibs/dune-rpc/private/types.ml index fb5930333..1278a29a9 100644 --- a/duniverse/dune_/otherlibs/dune-rpc/private/types.ml +++ b/duniverse/dune_/otherlibs/dune-rpc/private/types.ml @@ -35,7 +35,7 @@ end module Version = struct type t = int * int - let latest = (3, 4) + let latest = (3, 6) let sexp : t Conv.value = let open Conv in diff --git a/duniverse/dune_/otherlibs/dune-rpc/private/versioned.ml b/duniverse/dune_/otherlibs/dune-rpc/private/versioned.ml index 6a278df04..91be95de5 100644 --- a/duniverse/dune_/otherlibs/dune-rpc/private/versioned.ml +++ b/duniverse/dune_/otherlibs/dune-rpc/private/versioned.ml @@ -97,7 +97,7 @@ module Make (Fiber : Fiber_intf.S) = struct externally-retrievable way. This is because when invoking an RPC of type [('req, 'resp)], we are *given* a value of type ['req], so the object being stored in the map cannot have its type erased. Instead, we use a - [Univ_map] (with the key being stored in the [Decl.t]) so we can retreive + [Univ_map] (with the key being stored in the [Decl.t]) so we can retrieve a correctly-typed [Generation.t] mapping later. However, unlike a string table, the use of a [Univ_map.t] means that we diff --git a/duniverse/dune_/otherlibs/dune-rpc/private/where.mli b/duniverse/dune_/otherlibs/dune-rpc/private/where.mli index c5942f80a..071590770 100644 --- a/duniverse/dune_/otherlibs/dune-rpc/private/where.mli +++ b/duniverse/dune_/otherlibs/dune-rpc/private/where.mli @@ -5,6 +5,8 @@ type t = | `Ip of [ `Host of string ] * [ `Port of int ] ] +val rpc_socket_relative_to_build_dir : string + val to_string : t -> string val compare : t -> t -> Ordering.t diff --git a/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mli b/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mli new file mode 100644 index 000000000..4c7a545a6 --- /dev/null +++ b/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mli @@ -0,0 +1,42 @@ +exception Unknown_format + +type lines = + | Single of int + | Range of int * int + +type source = + | Code of + { code : int + ; name : string + } + | Alert of string + +type severity = + | Error of source option + | Warning of source + +type loc = + { chars : (int * int) option + ; lines : lines + ; path : string + } + +type line = + { indent : int + ; contents : string + } + +type token = + | Loc of + { indent : int + ; loc : loc + ; message : string + } + | Line of line + | Eof + +val severity : Lexing.lexbuf -> (severity * string) option + +val skip_excerpt : Lexing.lexbuf -> [ `Stop | `Continue ] + +val token : Lexing.lexbuf -> token diff --git a/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mll b/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mll index 83afa0d0e..8e18062f2 100644 --- a/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mll +++ b/duniverse/dune_/otherlibs/ocamlc_loc/src/lexer.mll @@ -23,13 +23,7 @@ type line = { indent : int ; contents : string } type token = - | Toplevel of - { indent : int - ; loc : loc - ; severity : severity - ; message : string - } - | Related of { indent : int ; loc : loc ; message: string } + | Loc of { indent : int ; loc : loc ; message : string } | Line of line | Eof @@ -49,32 +43,41 @@ let digits = ['0' - '9']+ let range = digits "-" digits +let any = _ * + rule skip_excerpt = parse - | blank digits " | " [^ '\n']* "\n" - { skip_excerpt lexbuf } - | blank '^'+ blank "\n" - { () } - | eof { () } - | "" { () } + | blank digits " | " [^ '\n']* "\n"? + { `Continue } + | blank '^'+ blank "\n"? + { `Continue } + | eof { `Stop } + | "" { `Stop } and severity = parse - | "Error:" blank { Error None } - | "Warning" blank (digits as code) blank "[" ([^ ']']+ as name) "]:" blank - { Warning (Code { code = int_of_string code ; name }) + | "Error:" + (blank any as rest) + { Some (Error None, rest) } + | "Warning" blank (digits as code) blank "[" ([^ ']']+ as name) "]:" + (blank any as rest) + { Some (Warning (Code { code = int_of_string code ; name }), rest) } | "Error" blank "(warning" blank (digits as code) blank "[" ([^ ']']+ as name) "]):" - blank - { Error (Some (Code { code = int_of_string code ; name })) + (blank any as rest) + { Some (Error (Some (Code { code = int_of_string code ; name })), rest) } | (("Error" | "Warning") as kind) " (alert " ([^ ')']+ as alert) "):" + (blank any as rest) { let alert = Alert alert in - match kind with - | "Error" -> Error (Some alert) - | "Warning" -> Warning alert - | _ -> assert false + let res = + match kind with + | "Error" -> Error (Some alert) + | "Warning" -> Warning alert + | _ -> assert false + in + Some (res, rest) } - | "" { raise_notrace Unknown_format } + | "" { None } and line = parse | (blank as prefix) ([^ '\n']* as contents) blank newline? @@ -82,10 +85,6 @@ and line = parse } | eof { Eof } -and toplevel_message = parse - | blank ([^ '\n']* as message) blank '\n' { message } - | "" { "" } - and token = parse | (blank as indent) "File \"" ([^ '"']* as path) "\", " blank (("line " (digits as line) | "lines " (range as lines))) @@ -109,19 +108,7 @@ and token = parse in let indent = String.length indent in let loc = { lines ; path ; chars } in - let severity, message = - if indent > 0 then begin - (None, message) - end else begin - skip_excerpt lexbuf; - let severity = severity lexbuf in - let message = toplevel_message lexbuf in - (Some severity, message) - end - in - match severity with - | None -> Related { loc ; indent ; message } - | Some severity -> Toplevel { loc ; severity; indent ; message } + Loc { loc ; indent ; message } } | eof { Eof } | "" { line lexbuf } diff --git a/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.ml b/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.ml index 0b8b8a64d..99904e15b 100644 --- a/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.ml +++ b/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.ml @@ -49,6 +49,8 @@ module Tokens : sig val junk : t -> unit + val push : t -> Lexer.token -> unit + val next : t -> Lexer.token end = struct type t = @@ -58,6 +60,8 @@ end = struct let create lexbuf = { lexbuf; unread = [] } + let push t token = t.unread <- token :: t.unread + let next t = match t.unread with | [] -> Lexer.token t.lexbuf @@ -79,47 +83,106 @@ end = struct | _ -> ignore (Lexer.token t.lexbuf) end -let parse lexbuf = - let tokens = Tokens.create lexbuf in - let rec acc_message min_indent acc = - match Tokens.peek tokens with - | Line line -> +let indent_of_severity = function + | Error _ -> String.length "Error: " + | Warning _ -> String.length "Warning: " + +let severity tokens = + match Tokens.peek tokens with + | Line { contents; indent } -> ( + match Lexer.severity (Lexing.from_string contents) with + | None -> raise Unknown_format + | Some (severity, new_contents) -> + Tokens.junk tokens; + let indent = indent_of_severity severity + indent in + Tokens.push tokens (Line { indent; contents = new_contents }); + severity) + | _ -> raise Unknown_format + +let rec skip_excerpt tokens = + match Tokens.peek tokens with + | Line { contents; indent = _ } -> ( + match Lexer.skip_excerpt (Lexing.from_string contents) with + | `Continue -> + Tokens.junk tokens; + skip_excerpt tokens + | `Stop -> ()) + | _ -> () + +let rec acc_message tokens min_indent acc = + match Tokens.peek tokens with + | Line line -> + Tokens.junk tokens; + let min_indent = min min_indent line.indent in + acc_message tokens min_indent (line :: acc) + | _ -> + List.rev_map acc ~f:(fun { indent; contents } -> + let prefix = String.make (indent - min_indent) ' ' in + prefix ^ contents) + |> String.concat "\n" |> String.trim + +let rec related tokens acc = + match Tokens.peek tokens with + | Loc { indent; message; loc } -> + if indent = 0 then List.rev acc + else ( Tokens.junk tokens; - let min_indent = min min_indent line.indent in - acc_message min_indent (line :: acc) - | _ -> - List.rev_map acc ~f:(fun { indent; contents } -> - let prefix = String.make (indent - min_indent) ' ' in - prefix ^ contents) - |> String.concat "\n" |> String.trim + let message = + acc_message tokens indent [ { indent; contents = message } ] + in + let acc = (loc, message) :: acc in + related tokens acc) + | _ -> List.rev acc + +let toplevel tokens = + match Tokens.next tokens with + | Loc { indent; message; loc } -> + if indent > 0 then raise Unknown_format; + skip_excerpt tokens; + let severity = severity tokens in + let indent = indent + indent_of_severity severity in + let message = + acc_message tokens indent [ { indent; contents = message } ] + in + let related = related tokens [] in + { loc; severity; message; related } + | _ -> raise Unknown_format + +let parse s = + let lexbuf = Lexing.from_string s in + let tokens = Tokens.create lexbuf in + let rec loop acc = + match toplevel tokens with + | exception Unknown_format -> List.rev acc + | t -> loop (t :: acc) in - let rec related acc = + loop [] + +let dyn_of_raw = + Dyn.list (function + | `Loc loc -> dyn_of_loc loc + | `Message m -> Dyn.string m) + +let parse_raw s = + let lexbuf = Lexing.from_string s in + let tokens = Tokens.create lexbuf in + let rec loop acc = match Tokens.peek tokens with - | Related { indent; loc; message } -> + | Loc { loc; message; indent } -> Tokens.junk tokens; - let message = acc_message indent [ { indent; contents = message } ] in - related ((loc, message) :: acc) - | _ -> List.rev acc - in - let rec toplevel acc = - match Tokens.next tokens with - | Toplevel { indent; loc; severity; message } -> + let acc = `Loc loc :: acc in let message = - let indent = - indent - + - match severity with - | Error _ -> String.length "Error: " - | Warning _ -> String.length "Warning: " - in - acc_message indent [ { indent; contents = message } ] + acc_message tokens indent [ { contents = message; indent } ] in - let related = related [] in - let acc = { severity; loc; message; related } :: acc in - toplevel acc - | Eof -> acc - | _ -> raise Unknown_format + let acc = `Message message :: acc in + loop acc + | Line line -> + Tokens.junk tokens; + let message = acc_message tokens line.indent [ line ] in + let acc = `Message message :: acc in + loop acc + | Eof -> + Tokens.junk tokens; + List.rev acc in - try List.rev @@ toplevel [] with Unknown_format -> [] - -let parse s = parse (Lexing.from_string s) + loop [] diff --git a/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.mli b/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.mli index 10630f4cd..3a4ee1637 100644 --- a/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.mli +++ b/duniverse/dune_/otherlibs/ocamlc_loc/src/ocamlc_loc.mli @@ -31,4 +31,8 @@ type report = val dyn_of_report : report -> Dyn.t +val dyn_of_raw : [ `Loc of loc | `Message of string ] list -> Dyn.t + +val parse_raw : string -> [ `Loc of loc | `Message of string ] list + val parse : string -> report list diff --git a/duniverse/dune_/otherlibs/ocamlc_loc/test/ocamlc_loc_tests.ml b/duniverse/dune_/otherlibs/ocamlc_loc/test/ocamlc_loc_tests.ml index 2c249fbbd..5398bf94a 100644 --- a/duniverse/dune_/otherlibs/ocamlc_loc/test/ocamlc_loc_tests.ml +++ b/duniverse/dune_/otherlibs/ocamlc_loc/test/ocamlc_loc_tests.ml @@ -37,81 +37,6 @@ module Test = struct Ocamlc_loc.parse output |> print_errors end -let%expect_test "" = - Test.create (fun t -> - let open Test in - let (_ : Path.t) = file t ~fname:"test.ml" ~contents:"let () = 123" in - cmd "ocamlc -c test.ml 2> out"; - Path.relative t.dir "out"); - [%expect - {| - >> error 0 - { loc = { path = "test.ml"; line = Single 1; chars = Some (9, 12) } - ; message = - "This expression has type int but an expression was expected of type\n\ - \ unit" - ; related = [] - ; severity = Error None - } |}] - -let%expect_test "" = - Test.create (fun t -> - let open Test in - let (_ : Path.t) = - file t ~fname:"test.ml" - ~contents: - {ocaml| -module X : sig - val x : int -> int -end = struct - let x y = y +. 2.0 -end -|ocaml} - in - cmd "ocamlc -c test.ml 2> out"; - Path.relative t.dir "out"); - [%expect - {| - >> error 0 - { loc = { path = "test.ml"; line = Range 4,6; chars = Some (6, 3) } - ; message = - "Signature mismatch:\n\ - Modules do not match:\n\ - \ sig val x : float -> float end\n\ - is not included in\n\ - \ sig val x : int -> int end\n\ - Values do not match:\n\ - \ val x : float -> float\n\ - is not included in\n\ - \ val x : int -> int\n\ - The type float -> float is not compatible with the type int -> int\n\ - Type float is not compatible with type int" - ; related = - [ ({ path = "test.ml"; line = Single 3; chars = Some (2, 20) }, - "Expected declaration") - ; ({ path = "test.ml"; line = Single 5; chars = Some (6, 7) }, - "Actual declaration") - ] - ; severity = Error None - } |}] - -let%expect_test "warning" = - Test.create (fun t -> - let open Test in - let (_ : Path.t) = - file t ~fname:"test.ml" ~contents:"let () = let x = 2 in ()" - in - cmd "ocamlc -c test.ml 2> out"; - Path.relative t.dir "out"); - [%expect - {| - >> error 0 - { loc = { path = "test.ml"; line = Single 1; chars = Some (13, 14) } - ; message = "unused variable x." - ; related = [] - ; severity = Warning { code = 26; name = "unused-var" } - } |}] - (* FIXME: unused value warning isn't parsed correctly - the file excerpt isn't extracted *) let%expect_test "unused value" = @@ -135,20 +60,29 @@ Error (warning 32 [unused-value-declaration]): unused value foo. ; severity = Error Some { code = 32; name = "unused-value-declaration" } } |}] +let test_error raw_error = + String.trim raw_error |> Ocamlc_loc.parse |> Test.print_errors + +let test_error_raw raw_error = + String.trim raw_error |> Ocamlc_loc.parse_raw |> Ocamlc_loc.dyn_of_raw + |> Dyn.to_string |> print_endline + let%expect_test "mli mismatch" = - Test.create (fun t -> - let open Test in - let (_ : Path.t) = file t ~fname:"test.mli" ~contents:"val x : int" in - let (_ : Path.t) = file t ~fname:"test.ml" ~contents:"let x = false" in - cmd "ocamlc -c test.mli 2> /dev/null"; - cmd "ocamlc -c test.ml 2> out"; - Path.relative t.dir "out"); + test_error + {| +File "test.ml", line 1: +Error: The implementation test.ml does not match the interface test.cmi: + Values do not match: val x : bool is not included in val x : int + The type bool is not compatible with the type int + File "test.mli", line 1, characters 0-11: Expected declaration + File "test.ml", line 1, characters 4-5: Actual declaration +|}; [%expect {| >> error 0 { loc = { path = "test.ml"; line = Single 1; chars = None } ; message = - "The implementation test.ml does not match the interface test.cmi: \n\ + "The implementation test.ml does not match the interface test.cmi:\n\ Values do not match: val x : bool is not included in val x : int\n\ The type bool is not compatible with the type int" ; related = @@ -160,10 +94,92 @@ let%expect_test "mli mismatch" = ; severity = Error None } |}] +let%expect_test "" = + test_error + {| +File "test.ml", line 1, characters 9-12: +1 | let () = 123 + ^^^ +Error: This expression has type int but an expression was expected of type + unit +|}; + [%expect + {| + >> error 0 + { loc = { path = "test.ml"; line = Single 1; chars = Some (9, 12) } + ; message = + "This expression has type int but an expression was expected of type\n\ + \ unit" + ; related = [] + ; severity = Error None + } |}] + +let%expect_test "warning" = + test_error + {| +File "test.ml", line 1, characters 13-14: +1 | let () = let x = 2 in () + ^ +Warning 26 [unused-var]: unused variable x. +|}; + [%expect + {| + >> error 0 + { loc = { path = "test.ml"; line = Single 1; chars = Some (13, 14) } + ; message = "unused variable x." + ; related = [] + ; severity = Warning { code = 26; name = "unused-var" } + } |}] + +let%expect_test "" = + test_error + {| +File "test.ml", lines 3-5, characters 6-3: +3 | ......struct +4 | let x y = y +. 2.0 +5 | end +Error: Signature mismatch: + Modules do not match: + sig val x : float -> float end + is not included in + sig val x : int -> int end + Values do not match: + val x : float -> float + is not included in + val x : int -> int + The type float -> float is not compatible with the type int -> int + Type float is not compatible with type int + File "test.ml", line 2, characters 2-20: Expected declaration + File "test.ml", line 4, characters 6-7: Actual declaration +|}; + [%expect + {| + >> error 0 + { loc = { path = "test.ml"; line = Range 3,5; chars = Some (6, 3) } + ; message = + "Signature mismatch:\n\ + Modules do not match:\n\ + \ sig val x : float -> float end\n\ + is not included in\n\ + \ sig val x : int -> int end\n\ + Values do not match:\n\ + \ val x : float -> float\n\ + is not included in\n\ + \ val x : int -> int\n\ + The type float -> float is not compatible with the type int -> int\n\ + Type float is not compatible with type int" + ; related = + [ ({ path = "test.ml"; line = Single 2; chars = Some (2, 20) }, + "Expected declaration") + ; ({ path = "test.ml"; line = Single 4; chars = Some (6, 7) }, + "Actual declaration") + ] + ; severity = Error None + } |}] + let%expect_test "ml mli mismatch 2" = - let raw_error = - String.trim - {| + test_error + {| File "src/dune_rules/artifacts.ml", line 1: Error: The implementation src/dune_rules/artifacts.ml does not match the interface src/dune_rules/.dune_rules.objs/byte/dune_rules__Artifacts.cmi: @@ -184,9 +200,7 @@ Error: The implementation src/dune_rules/artifacts.ml Expected declaration File "src/dune_rules/artifacts.ml", line 50, characters 8-13: Actual declaration - |} - in - Ocamlc_loc.parse raw_error |> Test.print_errors; + |}; [%expect {| >> error 0 @@ -224,7 +238,7 @@ Error: The implementation src/dune_rules/artifacts.ml } |}] let%expect_test "" = - let raw_error = + test_error {| File "fooexe.ml", line 3, characters 0-7: 3 | Bar.run ();; @@ -241,10 +255,7 @@ File "fooexe.ml", line 7, characters 11-22: ^^^^^^^^^^^ Error (alert deprecated): module Intf_only Will be removed past 2020-20-20. Use Mylib.Intf_only instead. -|} - |> String.trim - in - Ocamlc_loc.parse raw_error |> Test.print_errors; +|}; [%expect {| >> error 0 @@ -273,7 +284,7 @@ Will be removed past 2020-20-20. Use Mylib.Intf_only instead. } |}] let%expect_test "undefined fields" = - let raw_error = + test_error {| File "test/expect-tests/timer_tests.ml", lines 6-10, characters 2-3: 6 | ..{ Scheduler.Config.concurrency = 1 @@ -282,10 +293,7 @@ File "test/expect-tests/timer_tests.ml", lines 6-10, characters 2-3: 9 | ; insignificant_changes = `React 10 | } Error: Some record fields are undefined: signal_watcher -|} - |> String.trim - in - Ocamlc_loc.parse raw_error |> Test.print_errors; +|}; [%expect {| >> error 0 @@ -298,3 +306,87 @@ Error: Some record fields are undefined: signal_watcher ; related = [] ; severity = Error None } |}] + +let%expect_test "undefined fields" = + test_error_raw {| +Error: Some record fields are undefined: signal_watcher +|}; + [%expect + {| + [ "Error: Some record fields are undefined: signal_watcher" ] |}] + +let%expect_test "test error from merlin" = + test_error_raw + {|Signature mismatch: +Modules do not match: + sig val x : int end +is not included in + sig val x : unit end +Values do not match: val x : int is not included in val x : unit +The type int is not compatible with the type unit +File "test.ml", line 2, characters 2-14: Expected declaration +File "test.ml", line 4, characters 6-7: Actual declaration + |}; + [%expect + {| + [ "Signature mismatch:\n\ + Modules do not match:\n\ + \ sig val x : int end\n\ + is not included in\n\ + \ sig val x : unit end\n\ + Values do not match: val x : int is not included in val x : unit\n\ + The type int is not compatible with the type unit" + ; { path = "test.ml"; line = Single 2; chars = Some (2, 14) } + ; "Expected declaration" + ; { path = "test.ml"; line = Single 4; chars = Some (6, 7) } + ; "Actual declaration" + ] |}] + +let%expect_test "ml/mli error" = + test_error + {| +File "src/dune_engine/build_system.ml", line 1: +Error: The implementation src/dune_engine/build_system.ml + does not match the interface src/dune_engine/.dune_engine.objs/byte/dune_engine__Build_system.cmi: + The value `dune_stats' is required but not provided + File "src/dune_engine/build_system.mli", line 8, characters 0-40: + Expected declaration + |}; + [%expect + {| + >> error 0 + { loc = + { path = "src/dune_engine/build_system.ml" + ; line = Single 1 + ; chars = None + } + ; message = + "The implementation src/dune_engine/build_system.ml\n\ + does not match the interface src/dune_engine/.dune_engine.objs/byte/dune_engine__Build_system.cmi:\n\ + \ The value `dune_stats' is required but not provided" + ; related = + [ ({ path = "src/dune_engine/build_system.mli" + ; line = Single 8 + ; chars = Some (0, 40) + }, + "Expected declaration") + ] + ; severity = Error None + } |}] + +let%expect_test "ml/mli error" = + test_error + {| +File "bin/common.ml", line 1004, characters 8-43: +1004 | Dune_engine.Build_system.dune_stats := Some stats; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Unbound value Dune_engine.Build_system.dune_stats + |}; + [%expect + {| + >> error 0 + { loc = { path = "bin/common.ml"; line = Single 1004; chars = Some (8, 43) } + ; message = "Unbound value Dune_engine.Build_system.dune_stats" + ; related = [] + ; severity = Error None + } |}] diff --git a/duniverse/dune_/otherlibs/stdune/ansi_color.ml b/duniverse/dune_/otherlibs/stdune/ansi_color.ml index 9a4842d56..153e5b1a5 100644 --- a/duniverse/dune_/otherlibs/stdune/ansi_color.ml +++ b/duniverse/dune_/otherlibs/stdune/ansi_color.ml @@ -123,18 +123,30 @@ module Style = struct Printf.sprintf "\027[%sm" (String.concat l ~sep:";") end -let term_supports_color = - lazy - (match Stdlib.Sys.getenv "TERM" with +let supports_color fd = + let is_smart = + match Stdlib.Sys.getenv "TERM" with | exception Not_found -> false | "dumb" -> false - | _ -> true) + | _ -> true + and clicolor = + match Stdlib.Sys.getenv "CLICOLOR" with + | exception Not_found -> true + | "0" -> false + | _ -> true + and clicolor_force = + match Stdlib.Sys.getenv "CLICOLOR_FORCE" with + | exception Not_found -> false + | "0" -> false + | _ -> true + in + (is_smart && Unix.isatty fd && clicolor) || clicolor_force -let stdout_supports_color = - lazy (Lazy.force term_supports_color && Unix.isatty Unix.stdout) +let stdout_supports_color = lazy (supports_color Unix.stdout) -let stderr_supports_color = - lazy (Lazy.force term_supports_color && Unix.isatty Unix.stderr) +let stderr_supports_color = lazy (supports_color Unix.stderr) + +let output_is_a_tty = lazy (Unix.isatty Unix.stderr) let rec tag_handler current_styles ppf styles pp = Format.pp_print_as ppf 0 (Style.escape_sequence_no_reset styles); @@ -162,22 +174,35 @@ let prerr = let strip str = let len = String.length str in let buf = Buffer.create len in - let rec loop i = - if i = len then Buffer.contents buf + let rec loop start i = + if i = len then ( + if i - start > 0 then Buffer.add_substring buf str start (i - start); + Buffer.contents buf) else - match str.[i] with - | '\027' -> skip (i + 1) - | c -> - Buffer.add_char buf c; - loop (i + 1) + match String.unsafe_get str i with + | '\027' -> + if i - start > 0 then Buffer.add_substring buf str start (i - start); + skip (i + 1) + | _ -> loop start (i + 1) and skip i = if i = len then Buffer.contents buf else - match str.[i] with - | 'm' -> loop (i + 1) + match String.unsafe_get str i with + | 'm' -> loop (i + 1) (i + 1) | _ -> skip (i + 1) in - loop 0 + loop 0 0 + +let index_from_any str start chars = + let n = String.length str in + let rec go i = + if i >= n then None + else + match List.find chars ~f:(fun c -> Char.equal str.[i] c) with + | None -> go (i + 1) + | Some c -> Some (i, c) + in + go start let parse_line str styles = let len = String.length str in @@ -201,9 +226,9 @@ let parse_line str styles = let seq_start = seq_start + 2 in if seq_start >= len || str.[seq_start - 1] <> '[' then (styles, acc) else - match String.index_from str seq_start 'm' with + match index_from_any str seq_start [ 'm'; 'K' ] with | None -> (styles, acc) - | Some seq_end -> + | Some (seq_end, 'm') -> let styles = if seq_start = seq_end then (* Some commands output "\027[m", which seems to be interpreted @@ -223,7 +248,8 @@ let parse_line str styles = else s :: styles) |> List.rev in - loop styles (seq_end + 1) acc) + loop styles (seq_end + 1) acc + | Some (seq_end, _) -> loop styles (seq_end + 1) acc) in loop styles 0 Pp.nop diff --git a/duniverse/dune_/otherlibs/stdune/ansi_color.mli b/duniverse/dune_/otherlibs/stdune/ansi_color.mli index 2c13649ee..acc6522a4 100644 --- a/duniverse/dune_/otherlibs/stdune/ansi_color.mli +++ b/duniverse/dune_/otherlibs/stdune/ansi_color.mli @@ -95,6 +95,8 @@ val stdout_supports_color : bool Lazy.t val stderr_supports_color : bool Lazy.t +val output_is_a_tty : bool Lazy.t + (** Filter out escape sequences in a string *) val strip : string -> string diff --git a/duniverse/dune_/otherlibs/stdune/applicative.ml b/duniverse/dune_/otherlibs/stdune/applicative.ml index f2ecfbcd9..aec59d228 100644 --- a/duniverse/dune_/otherlibs/stdune/applicative.ml +++ b/duniverse/dune_/otherlibs/stdune/applicative.ml @@ -23,7 +23,7 @@ module Make (A : Applicative_intf.Basic) = struct and+ xs = all xs in x :: xs end -[@@inlined always] +[@@inline always] module Id = struct include Make (struct diff --git a/duniverse/dune_/otherlibs/stdune/bytes_unit.ml b/duniverse/dune_/otherlibs/stdune/bytes_unit.ml new file mode 100644 index 000000000..f4abea613 --- /dev/null +++ b/duniverse/dune_/otherlibs/stdune/bytes_unit.ml @@ -0,0 +1,27 @@ +(* CR-someday amokhov: Add KiB, MiB, GiB. *) +let conversion_table = + [ ([ "B"; "bytes" ], 1L) + ; ([ "kB"; "KB"; "kilobytes" ], 1_000L) + ; ([ "MB"; "megabytes" ], 1_000_000L) + ; ([ "GB"; "gigabytes" ], 1_000_000_000L) + ; ([ "TB"; "terabytes" ], 1_000_000_000_000L) + ] + +let pp x = + (* We go through the list to find the first unit that is greater than the + number of bytes and take the predecessor as the units for printing. For the + special base case where no conversion is necessary we don't print as a + float. *) + let suffix, value = + let rec loop = function + | [] -> assert false + | [ (units, value) ] -> (List.hd units, value) + | (units, value) :: ((_, value') :: _ as l) -> + if x = 0L then (List.hd units, value) + else if value <= x && x < value' then (List.hd units, value) + else loop l + in + loop @@ conversion_table + in + if value = 1L then Printf.sprintf "%Ld%s" x suffix + else Printf.sprintf "%.2f%s" (Int64.to_float x /. Int64.to_float value) suffix diff --git a/duniverse/dune_/otherlibs/stdune/bytes_unit.mli b/duniverse/dune_/otherlibs/stdune/bytes_unit.mli new file mode 100644 index 000000000..c317fcd7f --- /dev/null +++ b/duniverse/dune_/otherlibs/stdune/bytes_unit.mli @@ -0,0 +1,7 @@ +(** Conversion table for byte suffixes and their corresponding [Int64.t] values. + The first element of the tuple is a list of possible suffixes for the second + element of the tuple which is the value. There are some static checks done + on this table ensuring it is ordered and well-formed.*) +val conversion_table : (string list * Int64.t) list + +val pp : Int64.t -> string diff --git a/duniverse/dune_/otherlibs/stdune/caml/dune_caml.ml b/duniverse/dune_/otherlibs/stdune/caml/dune_caml.ml deleted file mode 100644 index 177622672..000000000 --- a/duniverse/dune_/otherlibs/stdune/caml/dune_caml.ml +++ /dev/null @@ -1,16 +0,0 @@ -(** This library is internal to dune and guarantees no API stability. *) - -module Bytes = Bytes -module Filename = Filename -module String = String -module Char = Char -module Hashtbl = MoreLabels.Hashtbl -module Lexing = Lexing -module Digest = Digest -module StringLabels = StringLabels -module ListLabels = ListLabels -module List = List -module MoreLabels = MoreLabels -module ArrayLabels = ArrayLabels -module Scanf = Scanf -module Sys = Sys diff --git a/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.ml b/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.ml index 4d65b3a70..5d530af3f 100644 --- a/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.ml +++ b/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.ml @@ -146,6 +146,8 @@ module Unix_error = struct module Detailed = struct type nonrec t = t * string * string + let raise (e, x, y) = raise (Unix.Unix_error (e, x, y)) + let create error ~syscall ~arg = (error, syscall, arg) let catch f x = diff --git a/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.mli b/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.mli index 85593f927..46dd167a0 100644 --- a/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.mli +++ b/duniverse/dune_/otherlibs/stdune/dune_filesystem_stubs/dune_filesystem_stubs.mli @@ -11,6 +11,8 @@ module Unix_error : sig module Detailed : sig type nonrec t = t * string * string + val raise : t -> 'a + val create : Unix.error -> syscall:string -> arg:string -> t (** Apply a function to an argument, catching a detailed Unix error. *) diff --git a/duniverse/dune_/otherlibs/stdune/map.ml b/duniverse/dune_/otherlibs/stdune/map.ml index 9d661d29d..15cdc00b6 100644 --- a/duniverse/dune_/otherlibs/stdune/map.ml +++ b/duniverse/dune_/otherlibs/stdune/map.ml @@ -220,6 +220,20 @@ module Make (Key : Key) : S with type key = Key.t = struct | (_ : _ t) -> true | exception Exit -> false + exception Found of Key.t + + let find_key t ~f = + match + iteri t ~f:(fun key _ -> if f key then raise_notrace (Found key) else ()) + with + | () -> None + | exception Found e -> Some e + + let to_dyn f t = + Dyn.Map (to_list t |> List.map ~f:(fun (k, v) -> (Key.to_dyn k, f v))) + + let to_seq = to_seq + module Multi = struct type nonrec 'a t = 'a list t @@ -250,19 +264,20 @@ module Make (Key : Key) : S with type key = Key.t = struct iteri ~f:(fun k -> List.iter ~f:(check_found k)) m; None with Found p -> Some p - end - exception Found of Key.t + let to_flat_list t = fold t ~init:[] ~f:List.rev_append - let find_key t ~f = - match - iteri t ~f:(fun key _ -> if f key then raise_notrace (Found key) else ()) - with - | () -> None - | exception Found e -> Some e + let map t ~f = map t ~f:(fun l -> List.map ~f l) - let to_dyn f t = - Dyn.Map (to_list t |> List.map ~f:(fun (k, v) -> (Key.to_dyn k, f v))) + let parent_equal = equal - let to_seq = to_seq + let equal t t' ~equal = + parent_equal + ~equal:(fun l l' -> + Result.value ~default:false @@ List.for_all2 ~f:equal l l') + t t' + + let to_dyn a_to_dyn t = + to_dyn (fun l -> Dyn.List (List.map ~f:a_to_dyn l)) t + end end diff --git a/duniverse/dune_/otherlibs/stdune/map_intf.ml b/duniverse/dune_/otherlibs/stdune/map_intf.ml index a384fc219..2035601ff 100644 --- a/duniverse/dune_/otherlibs/stdune/map_intf.ml +++ b/duniverse/dune_/otherlibs/stdune/map_intf.ml @@ -163,5 +163,13 @@ module type S = sig that [f e = true]. If such an [e] is found then the function returns [Some (k,e)], otherwise it returns [None]. *) val find_elt : 'a t -> f:('a -> bool) -> (key * 'a) option + + val to_flat_list : 'a t -> 'a list + + val equal : 'a t -> 'a t -> equal:('a -> 'a -> bool) -> bool + + val map : 'a t -> f:('a -> 'b) -> 'b t + + val to_dyn : ('a -> Dyn.t) -> 'a t -> Dyn.t end end diff --git a/duniverse/dune_/otherlibs/stdune/monad.ml b/duniverse/dune_/otherlibs/stdune/monad.ml index 1670c198c..81fc8063a 100644 --- a/duniverse/dune_/otherlibs/stdune/monad.ml +++ b/duniverse/dune_/otherlibs/stdune/monad.ml @@ -32,7 +32,7 @@ module Make (M : Basic) = struct let ( and* ) = ( and+ ) end end -[@@inlined always] +[@@inline always] module Id = Make (struct type 'a t = 'a diff --git a/duniverse/dune_/otherlibs/stdune/monoid.ml b/duniverse/dune_/otherlibs/stdune/monoid.ml index 3ea242d1e..0f44d7621 100644 --- a/duniverse/dune_/otherlibs/stdune/monoid.ml +++ b/duniverse/dune_/otherlibs/stdune/monoid.ml @@ -14,7 +14,7 @@ module Make (M : Basic) : Monoid_intf.S with type t = M.t = struct let map_reduce ~f = List.fold_left ~init:empty ~f:(fun acc a -> combine acc (f a)) end -[@@inlined always] +[@@inline always] module Exists = Make (struct type t = bool diff --git a/duniverse/dune_/otherlibs/stdune/path.ml b/duniverse/dune_/otherlibs/stdune/path.ml index dd383d3d8..048747a1f 100644 --- a/duniverse/dune_/otherlibs/stdune/path.ml +++ b/duniverse/dune_/otherlibs/stdune/path.ml @@ -514,7 +514,7 @@ let abs_root, set_root = in (abs_root, set_root) -module Kind = struct +module Outside_build_dir = struct type t = | External of External.t | In_source_dir of Local.t @@ -544,6 +544,37 @@ module Kind = struct match x with | In_source_dir x -> In_source_dir (Local.append x y) | External x -> External (External.relative x (Local.to_string y)) + + let to_string_maybe_quoted t = String.maybe_quoted (to_string t) + + let equal (x : t) (y : t) = + match (x, y) with + | External x, External y -> External.equal x y + | External _, In_source_dir _ -> false + | In_source_dir x, In_source_dir y -> Local.equal x y + | In_source_dir _, External _ -> false + + let hash = Poly.hash + + let parent = function + | In_source_dir t -> ( + match Local.parent t with + | None -> None + | Some s -> Some (In_source_dir s)) + | External t -> ( + match External.parent t with + | None -> None + | Some s -> Some (External s)) + + module Table = Hashtbl.Make (struct + type nonrec t = t + + let hash = Poly.hash + + let equal = Poly.equal + + let to_dyn = to_dyn + end) end module Permissions = struct @@ -628,11 +659,11 @@ module Build = struct Code_error.raise "Path.Build.drop_build_context_maybe_sandboxed_exn" [ ("t", to_dyn t) ] - let build_dir = Fdecl.create Kind.to_dyn + let build_dir = Fdecl.create Outside_build_dir.to_dyn let build_dir_prefix = Fdecl.create Dyn.opaque - let set_build_dir (new_build_dir : Kind.t) = + let set_build_dir (new_build_dir : Outside_build_dir.t) = let new_build_dir_prefix = (match new_build_dir with | External _ -> () @@ -659,6 +690,8 @@ module Build = struct if Local.is_root p then External.to_string b else Filename.concat (External.to_string b) (Local.to_string p) + let to_string_maybe_quoted p = String.maybe_quoted (to_string p) + let of_local t = t let chmod t ~mode = Unix.chmod (to_string t) mode @@ -666,8 +699,6 @@ module Build = struct let lstat t = Unix.lstat (to_string t) let unlink_no_err t = Fpath.unlink_no_err (to_string t) - - module Kind = Kind end module T : sig @@ -678,6 +709,9 @@ module T : sig val to_dyn : t -> Dyn.t + (** [External _] < [In_source_tree _] < [In_build_dir _] + + Path of the same kind are compared using the standard lexical order *) val compare : t -> t -> Ordering.t val equal : t -> t -> bool @@ -701,8 +735,8 @@ end = struct | External _, _ -> Lt | _, External _ -> Gt | In_source_tree x, In_source_tree y -> Local.compare x y - | In_source_tree _, _ -> Lt - | _, In_source_tree _ -> Gt + | In_source_tree _, In_build_dir _ -> Lt + | In_build_dir _, In_source_tree _ -> Gt | In_build_dir x, In_build_dir y -> Local.compare x y let equal (x : t) (y : t) = x = y @@ -733,10 +767,11 @@ let is_root = function | In_source_tree s -> Local.is_root s | In_build_dir _ | External _ -> false -let kind = function - | In_build_dir p -> Kind.append_local (Fdecl.get Build.build_dir) p - | In_source_tree s -> Kind.In_source_dir s - | External s -> Kind.External s +let local_or_external : t -> Outside_build_dir.t = function + | In_build_dir p -> + Outside_build_dir.append_local (Fdecl.get Build.build_dir) p + | In_source_tree s -> In_source_dir s + | External s -> External s let is_managed = function | In_build_dir _ | In_source_tree _ -> true @@ -772,7 +807,8 @@ let relative ?error_loc t fn = | Error `Outside_the_workspace -> external_ (External.relative - (External.of_string (Kind.to_absolute_filename (kind t))) + (External.of_string + (Outside_build_dir.to_absolute_filename (local_or_external t))) fn)) | In_build_dir p -> in_build_dir (Local.relative p fn ?error_loc) | External s -> external_ (External.relative s fn)) @@ -799,7 +835,8 @@ let of_filename_relative_to_initial_cwd fn = (if Filename.is_relative fn then External.relative External.initial_cwd fn else External.of_string fn) -let to_absolute_filename t = Kind.to_absolute_filename (kind t) +let to_absolute_filename t = + Outside_build_dir.to_absolute_filename (local_or_external t) let external_of_local x ~root = External.to_string (External.relative root (Local.to_string x)) @@ -901,6 +938,22 @@ let as_in_source_tree_exn t = "[as_in_source_tree_exn] called on something not in source tree" [ ("t", to_dyn t) ] +let as_outside_build_dir_exn : t -> Outside_build_dir.t = function + | In_source_tree s -> In_source_dir s + | External s -> External s + | In_build_dir path -> + Code_error.raise "as_outside_build_dir_exn" [ ("path", Build.to_dyn path) ] + +let destruct_build_dir : + t -> [ `Inside of Build.t | `Outside of Outside_build_dir.t ] = function + | In_source_tree p -> `Outside (In_source_dir p) + | External s -> `Outside (External s) + | In_build_dir s -> `Inside s + +let outside_build_dir : Outside_build_dir.t -> t = function + | In_source_dir d -> In_source_tree d + | External s -> External s + let as_in_build_dir = function | In_build_dir b -> Some b | In_source_tree _ | External _ -> None @@ -989,14 +1042,14 @@ let drop_optional_build_context_src_exn t = | In_source_tree p -> p let split_first_component t = - match kind t with + match local_or_external t with | In_source_dir t -> Option.map (Local.split_first_component t) ~f:(fun (before, after) -> (before, after |> in_source_tree)) | _ -> None let explode t = - match kind t with + match local_or_external t with | In_source_dir p when Local.is_root p -> Some [] | In_source_dir s -> Some (String.split (Local.to_string s) ~on:'/') | External _ -> None @@ -1046,7 +1099,7 @@ let build_dir_exists () = is_directory build_dir let ensure_build_dir_exists () = let perms = 0o777 in - match kind build_dir with + match local_or_external build_dir with | In_source_dir p -> Relative_to_source_root.mkdir_p p ~perms | External p -> ( let p = External.to_string p in @@ -1087,7 +1140,8 @@ let mkdir_p ?perms = function | External s -> External.mkdir_p s ?perms | In_source_tree s -> Relative_to_source_root.mkdir_p s ?perms | In_build_dir k -> - Kind.mkdir_p ?perms (Kind.append_local (Fdecl.get Build.build_dir) k) + Outside_build_dir.mkdir_p ?perms + (Outside_build_dir.append_local (Fdecl.get Build.build_dir) k) let touch ?(create = true) p = let p = @@ -1095,7 +1149,8 @@ let touch ?(create = true) p = | External s -> External.to_string s | In_source_tree s -> Local_gen.to_string s | In_build_dir k -> - Kind.to_string (Kind.append_local (Fdecl.get Build.build_dir) k) + Outside_build_dir.to_string + (Outside_build_dir.append_local (Fdecl.get Build.build_dir) k) in let create = if create then fun () -> Unix.close (Unix.openfile p [ Unix.O_CREAT ] 0o777) @@ -1212,7 +1267,11 @@ let follow_symlink path = module Expert = struct let drop_absolute_prefix ~prefix p = - match String.drop_prefix ~prefix:(Kind.to_absolute_filename prefix) p with + match + String.drop_prefix + ~prefix:(Outside_build_dir.to_absolute_filename prefix) + p + with | None -> None | Some "" -> Some Local.root | Some p -> @@ -1222,13 +1281,13 @@ module Expert = struct let p = External.to_string ext in match Fdecl.get Build.build_dir with | External s -> ( - match drop_absolute_prefix ~prefix:(Kind.External s) p with + match drop_absolute_prefix ~prefix:(External s) p with | Some s -> Some (in_build_dir s) | None -> - drop_absolute_prefix ~prefix:(Kind.In_source_dir Local.root) p + drop_absolute_prefix ~prefix:(In_source_dir Local.root) p |> Option.map ~f:in_source_tree) | In_source_dir _ -> - drop_absolute_prefix ~prefix:(Kind.In_source_dir Local.root) p + drop_absolute_prefix ~prefix:(In_source_dir Local.root) p |> Option.map ~f:make_local_path let try_localize_external t = diff --git a/duniverse/dune_/otherlibs/stdune/path.mli b/duniverse/dune_/otherlibs/stdune/path.mli index 43a69c05e..3822970b2 100644 --- a/duniverse/dune_/otherlibs/stdune/path.mli +++ b/duniverse/dune_/otherlibs/stdune/path.mli @@ -63,8 +63,6 @@ module Local : sig val relative : ?error_loc:Loc0.t -> t -> string list -> t end - val relative : ?error_loc:Loc0.t -> t -> string -> t - val split_first_component : t -> (string * t) option val explode : t -> string list @@ -98,10 +96,6 @@ module Source : sig val of_local : Local.t -> t - (** [relative dir s] if s can be ".." it could escape the working directory. - {!Path.relative} should be used instead. *) - val relative : ?error_loc:Loc0.t -> t -> string -> t - val split_first_component : t -> (string * Local.t) option val explode : t -> string list @@ -134,6 +128,28 @@ module Permissions : sig val remove : t -> int -> int end +module Outside_build_dir : sig + type t = + | External of External.t + | In_source_dir of Source.t + + val hash : t -> int + + val equal : t -> t -> bool + + val to_dyn : t -> Dyn.t + + val of_string : string -> t + + val to_string : t -> string + + val to_string_maybe_quoted : t -> string + + val parent : t -> t option + + module Table : Hashtbl.S with type key = t +end + module Build : sig type w @@ -154,8 +170,6 @@ module Build : sig val relative : ?error_loc:Loc0.t -> t -> string list -> t end - val relative : ?error_loc:Loc0.t -> t -> string -> t - val split_first_component : t -> (string * Local.t) option val explode : t -> string list @@ -182,17 +196,9 @@ module Build : sig "righter" type. *) val extract_first_component : t -> (string * Local.t) option - module Kind : sig - type t = private - | External of External.t - | In_source_dir of Local.t - - val of_string : string -> t - end - (** Set the build directory. Can only be called once and must be done before paths are converted to strings elsewhere. *) - val set_build_dir : Kind.t -> unit + val set_build_dir : Outside_build_dir.t -> unit val split_sandbox_root : t -> t option * t @@ -214,6 +220,13 @@ type t = private include Path_intf.S with type t := t +val as_outside_build_dir_exn : t -> Outside_build_dir.t + +val destruct_build_dir : + t -> [ `Inside of Build.t | `Outside of Outside_build_dir.t ] + +val outside_build_dir : Outside_build_dir.t -> t + val hash : t -> int (** [to_string_maybe_quoted t] is [maybe_quoted (to_string t)] *) @@ -227,8 +240,6 @@ val is_root : t -> bool val is_managed : t -> bool -val relative : ?error_loc:Loc0.t -> t -> string -> t - (** [relative_to_source_in_build ~dir s] compute the path [s] relative to the source directory corresponding to [dir] *) val relative_to_source_in_build_or_external : diff --git a/duniverse/dune_/otherlibs/stdune/stdune.ml b/duniverse/dune_/otherlibs/stdune/stdune.ml index 71294de56..0605b4563 100644 --- a/duniverse/dune_/otherlibs/stdune/stdune.ml +++ b/duniverse/dune_/otherlibs/stdune/stdune.ml @@ -10,7 +10,6 @@ module Array = Array module Bytes = Bytes module Char = Char module Comparator = Comparator -module Console = Console module Either = Either module Exn = Exn module Exn_with_backtrace = Exn_with_backtrace @@ -44,7 +43,6 @@ module Proc = Proc module Type_eq = Type_eq module Nothing = Nothing module Bin = Bin -module Digest = Digest module Fdecl = Fdecl module Unit = Unit module Monad = Monad @@ -68,9 +66,9 @@ module Seq = Seq module Temp = Temp module Queue = Queue module Caller_id = Caller_id -module Metrics = Metrics module Dune_filesystem_stubs = Dune_filesystem_stubs module Predicate = Predicate +module Bytes_unit = Bytes_unit module Unix_error = struct include Dune_filesystem_stubs.Unix_error diff --git a/duniverse/dune_/otherlibs/stdune/string.ml b/duniverse/dune_/otherlibs/stdune/string.ml index f2f5227f8..7a57bb382 100644 --- a/duniverse/dune_/otherlibs/stdune/string.ml +++ b/duniverse/dune_/otherlibs/stdune/string.ml @@ -73,7 +73,7 @@ let drop_prefix_if_exists s ~prefix = let drop_suffix s ~suffix = if is_suffix s ~suffix then - if length s = length suffix then Some s + if length s = length suffix then Some "" else Some (sub s ~pos:0 ~len:(length s - length suffix)) else None diff --git a/duniverse/dune_/otherlibs/stdune/top_closure.ml b/duniverse/dune_/otherlibs/stdune/top_closure.ml index 01912741d..626cb9e33 100644 --- a/duniverse/dune_/otherlibs/stdune/top_closure.ml +++ b/duniverse/dune_/otherlibs/stdune/top_closure.ml @@ -26,7 +26,7 @@ module Make (Keys : Top_closure_intf.Keys) (Monad : Monad_intf.S) = struct | Ok (res, _visited) -> Monad.return (Ok (List.rev res)) | Error elts -> Monad.return (Error elts) end -[@@inlined always] +[@@inline always] module Int = Make (Int.Set) (Monad.Id) module String = Make (String.Set) (Monad.Id) diff --git a/duniverse/dune_/otherlibs/xdg/xdg_stubs.c b/duniverse/dune_/otherlibs/xdg/xdg_stubs.c index ea28a248b..a14e811e8 100644 --- a/duniverse/dune_/otherlibs/xdg/xdg_stubs.c +++ b/duniverse/dune_/otherlibs/xdg/xdg_stubs.c @@ -5,6 +5,11 @@ #ifdef _WIN32 +/* Windows Vista functions enabled */ + +#undef _WIN32_WINNT +#define _WIN32_WINNT 0x0600 + #include #include #include diff --git a/duniverse/dune_/shell.nix b/duniverse/dune_/shell.nix deleted file mode 100644 index 5020b001d..000000000 --- a/duniverse/dune_/shell.nix +++ /dev/null @@ -1,50 +0,0 @@ -let - pkgs = (import { }); - opam2nix = (import ./nix/opam2nix.nix); - local = pkgs.callPackage ./nix { inherit opam2nix; }; - inherit (pkgs) stdenv lib; - -in pkgs.mkShell { - # standard dependencies fetched from nixpkgs. essentially everything outside - # of opam - buildInputs = (with pkgs; ([ - coreutils - # we prefer tools from outside our opam build plan to minimize conflicts - ocamlformat_0_20_1 - ocaml-ng.ocamlPackages_4_13.ocaml-lsp - git - mercurial # for tests - opam - nodejs-14_x - patdiff - gnugrep - gnused - gawk - # we can't use coq from nixpkgs because it doesn't include libraries - # coq - python38Packages.sphinx - python38Packages.sphinx_rtd_theme - # opam dependencies. the versions for these are solved for in - # nix/opam-selection.nix - ] ++ (if stdenv.isDarwin then [fswatch] else []))) - ++ (with local.opam; [ - lwt - bisect_ppx - cinaps - core_bench - csexp - js_of_ocaml - js_of_ocaml-compiler - mdx - menhir - merlin - ocamlfind - odoc - ppx_expect - ppx_inline_test - ppxlib - result - utop - ctypes - ]) ++ [ local.coq-core ]; -} diff --git a/duniverse/dune_/src/csexp_rpc/csexp_rpc.ml b/duniverse/dune_/src/csexp_rpc/csexp_rpc.ml index 5f8c2d38e..afe8bd527 100644 --- a/duniverse/dune_/src/csexp_rpc/csexp_rpc.ml +++ b/duniverse/dune_/src/csexp_rpc/csexp_rpc.ml @@ -226,22 +226,7 @@ module Server = struct ; buf : Bytes.t } - let create sockaddr ~backlog = - let fd = - Unix.socket ~cloexec:true - (Unix.domain_of_sockaddr sockaddr) - Unix.SOCK_STREAM 0 - in - Unix.setsockopt fd Unix.SO_REUSEADDR true; - Unix.set_nonblock fd; - (match sockaddr with - | ADDR_UNIX p -> - let p = Path.of_string p in - Path.unlink_no_err p; - Path.mkdir_p (Path.parent_exn p); - at_exit (fun () -> Path.unlink_no_err p) - | _ -> ()); - Socket.bind fd sockaddr; + let create fd sockaddr ~backlog = Unix.listen fd backlog; let r_interrupt_accept, w_interrupt_accept = Unix.pipe ~cloexec:true () in Unix.set_nonblock r_interrupt_accept; @@ -276,61 +261,86 @@ module Server = struct end type t = - { mutable transport : Transport.t option + { mutable state : + [ `Init of Unix.file_descr | `Running of Transport.t | `Closed ] ; backlog : int ; sockaddr : Unix.sockaddr + ; ready : unit Fiber.Ivar.t } - let create sockaddr ~backlog = { sockaddr; backlog; transport = None } + let create sockaddr ~backlog = + let fd = + Unix.socket ~cloexec:true + (Unix.domain_of_sockaddr sockaddr) + Unix.SOCK_STREAM 0 + in + Unix.set_nonblock fd; + Unix.setsockopt fd Unix.SO_REUSEADDR true; + match Socket.bind fd sockaddr with + | exception Unix.Unix_error (EADDRINUSE, _, _) -> Error `Already_in_use + | () -> + Ok { sockaddr; backlog; state = `Init fd; ready = Fiber.Ivar.create () } + + let ready t = Fiber.Ivar.read t.ready let serve (t : t) = let* async = Worker.create () in - let+ transport = - Worker.task_exn async ~f:(fun () -> - Transport.create t.sockaddr ~backlog:t.backlog) - in - t.transport <- Some transport; - let accept () = - Worker.task async ~f:(fun () -> - Transport.accept transport - |> Option.map ~f:(fun client -> - let in_ = Unix.in_channel_of_descr client in - let out = Unix.out_channel_of_descr client in - (in_, out))) - in - let loop () = - let* accept = accept () in - match accept with - | Error `Stopped -> - Log.info [ Pp.text "RPC stopped accepting." ]; - Fiber.return None - | Error (`Exn exn) -> - Log.info - [ Pp.text "RPC accept failed. Server will not accept new clients" - ; Exn_with_backtrace.pp exn - ]; - Fiber.return None - | Ok None -> - Log.info - [ Pp.text - "RPC accepted the last client. No more clients will be accepted." - ]; - Fiber.return None - | Ok (Some (in_, out)) -> - let+ session = Session.create ~socket:true in_ out in - Some session - in - Fiber.Stream.In.create loop + match t.state with + | `Closed -> Code_error.raise "already closed" [] + | `Running _ -> Code_error.raise "already running" [] + | `Init fd -> + let* transport = + Worker.task_exn async ~f:(fun () -> + Transport.create fd t.sockaddr ~backlog:t.backlog) + in + t.state <- `Running transport; + let+ () = Fiber.Ivar.fill t.ready () in + let accept () = + Worker.task async ~f:(fun () -> + Transport.accept transport + |> Option.map ~f:(fun client -> + let in_ = Unix.in_channel_of_descr client in + let out = Unix.out_channel_of_descr client in + (in_, out))) + in + let loop () = + let* accept = accept () in + match accept with + | Error `Stopped -> + Log.info [ Pp.text "RPC stopped accepting." ]; + Fiber.return None + | Error (`Exn exn) -> + Log.info + [ Pp.text "RPC accept failed. Server will not accept new clients" + ; Exn_with_backtrace.pp exn + ]; + Fiber.return None + | Ok None -> + Log.info + [ Pp.text + "RPC accepted the last client. No more clients will be \ + accepted." + ]; + Fiber.return None + | Ok (Some (in_, out)) -> + let+ session = Session.create ~socket:true in_ out in + Some session + in + Fiber.Stream.In.create loop let stop t = - match t.transport with - | None -> Code_error.raise "server not running" [] - | Some t -> Transport.stop t + let () = + match t.state with + | `Closed -> () + | `Running t -> Transport.stop t + | `Init fd -> Unix.close fd + in + t.state <- `Closed let listening_address t = - match t.transport with - | None -> Code_error.raise "server not running" [] - | Some t -> Unix.getsockname t.fd + match t.state with + | `Init fd | `Running { Transport.fd; _ } -> Unix.getsockname fd + | `Closed -> Code_error.raise "server is already closed" [] end module Client = struct diff --git a/duniverse/dune_/src/csexp_rpc/csexp_rpc.mli b/duniverse/dune_/src/csexp_rpc/csexp_rpc.mli index 1aa76666e..6107aabec 100644 --- a/duniverse/dune_/src/csexp_rpc/csexp_rpc.mli +++ b/duniverse/dune_/src/csexp_rpc/csexp_rpc.mli @@ -48,7 +48,11 @@ module Server : sig (** RPC Server *) type t - val create : Unix.sockaddr -> backlog:int -> t + val create : Unix.sockaddr -> backlog:int -> (t, [ `Already_in_use ]) result + + (** [ready t] returns a fiber that completes when clients can start connecting + to the server *) + val ready : t -> unit Fiber.t val stop : t -> unit diff --git a/duniverse/dune_/src/dune_cache/dune b/duniverse/dune_/src/dune_cache/dune index f2497ef8d..84749e611 100644 --- a/duniverse/dune_/src/dune_cache/dune +++ b/duniverse/dune_/src/dune_cache/dune @@ -1,4 +1,4 @@ (library (name dune_cache) (synopsis "[Internal] Dune's local and cloud build cache") - (libraries csexp dune_cache_storage fiber stdune unix)) + (libraries csexp dune_digest dune_cache_storage fiber stdune unix)) diff --git a/duniverse/dune_/src/dune_cache/dune_cache.ml b/duniverse/dune_/src/dune_cache/dune_cache.ml new file mode 100644 index 000000000..623e0ab24 --- /dev/null +++ b/duniverse/dune_/src/dune_cache/dune_cache.ml @@ -0,0 +1,3 @@ +module Config = Config +module Local = Local +module Trimmer = Trimmer diff --git a/duniverse/dune_/src/dune_cache/import.ml b/duniverse/dune_/src/dune_cache/import.ml new file mode 100644 index 000000000..25fa36d5a --- /dev/null +++ b/duniverse/dune_/src/dune_cache/import.ml @@ -0,0 +1,3 @@ +module Digest = Dune_digest +module Restore_result = Dune_cache_storage.Restore_result +module Store_result = Dune_cache_storage.Store_result diff --git a/duniverse/dune_/src/dune_cache/local.ml b/duniverse/dune_/src/dune_cache/local.ml index fdfde7bb4..6e9aeab14 100644 --- a/duniverse/dune_/src/dune_cache/local.ml +++ b/duniverse/dune_/src/dune_cache/local.ml @@ -1,8 +1,7 @@ open Stdune open Dune_cache_storage.Layout open Fiber.O -module Store_result = Dune_cache_storage.Store_result -module Restore_result = Dune_cache_storage.Restore_result +open Import module Store_artifacts_result = struct type t = @@ -199,16 +198,8 @@ module Artifacts = struct let result = store_metadata ~mode ~rule_digest ~metadata:[] artifacts in Store_artifacts_result.of_store_result ~artifacts result) - let rec fold_list_result l ~init ~f = - match l with - | [] -> Ok init - | x :: xs -> ( - match f init x with - | Ok acc -> fold_list_result xs ~init:acc ~f - | Error e -> Error e) - let create_all_or_nothing ~create ~destroy list = - fold_list_result list ~init:[] ~f:(fun acc x -> + Result.List.fold_left list ~init:[] ~f:(fun acc x -> match create x with | Error e -> List.iter acc ~f:destroy; diff --git a/duniverse/dune_/src/dune_cache/local.mli b/duniverse/dune_/src/dune_cache/local.mli index 094735326..272cf1c89 100644 --- a/duniverse/dune_/src/dune_cache/local.mli +++ b/duniverse/dune_/src/dune_cache/local.mli @@ -16,7 +16,7 @@ store the mtime in the metadata and complain if it's not what we expected. *) open Stdune -module Restore_result := Dune_cache_storage.Restore_result +open Import module Store_artifacts_result : sig (* Outcomes are ordered in the order of severity. *) diff --git a/duniverse/dune_/src/dune_cache_storage/dune b/duniverse/dune_/src/dune_cache_storage/dune index 2d47a6de2..42497b274 100644 --- a/duniverse/dune_/src/dune_cache_storage/dune +++ b/duniverse/dune_/src/dune_cache_storage/dune @@ -1,4 +1,4 @@ (library (name dune_cache_storage) (synopsis "[Internal] Dune cache storage, used for local and cloud caches") - (libraries csexp dune_util fiber fiber_util stdune xdg unix)) + (libraries csexp dune_util dune_digest fiber fiber_util stdune xdg unix)) diff --git a/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.ml b/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.ml index 445f26f70..433a3151b 100644 --- a/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.ml +++ b/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.ml @@ -1,4 +1,5 @@ open Stdune +open Import module Layout = Layout module Mode = Mode module Util = Util diff --git a/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.mli b/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.mli index c1ff9a10a..01421e7f9 100644 --- a/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.mli +++ b/duniverse/dune_/src/dune_cache_storage/dune_cache_storage.mli @@ -2,6 +2,7 @@ local and cloud caches. *) open Stdune +open Import module Layout = Layout module Mode = Mode module Util = Util diff --git a/duniverse/dune_/src/dune_cache_storage/import.ml b/duniverse/dune_/src/dune_cache_storage/import.ml new file mode 100644 index 000000000..b90844d81 --- /dev/null +++ b/duniverse/dune_/src/dune_cache_storage/import.ml @@ -0,0 +1 @@ +module Digest = Dune_digest diff --git a/duniverse/dune_/src/dune_cache_storage/layout.ml b/duniverse/dune_/src/dune_cache_storage/layout.ml index 01cc4f2d9..db0cbec93 100644 --- a/duniverse/dune_/src/dune_cache_storage/layout.ml +++ b/duniverse/dune_/src/dune_cache_storage/layout.ml @@ -1,4 +1,5 @@ open Stdune +open Import let default_root_dir () = let cache_dir = Xdg.cache_dir (Lazy.force Dune_util.xdg) in diff --git a/duniverse/dune_/src/dune_cache_storage/layout.mli b/duniverse/dune_/src/dune_cache_storage/layout.mli index 3912cabd8..de085e6d6 100644 --- a/duniverse/dune_/src/dune_cache_storage/layout.mli +++ b/duniverse/dune_/src/dune_cache_storage/layout.mli @@ -6,6 +6,7 @@ decision in 6 months. *) open Stdune +open Import (** The path to the root directory of the cache. *) val root_dir : Path.t diff --git a/duniverse/dune_/src/dune_config/dune b/duniverse/dune_/src/dune_config/dune index ca422e041..7e607ad46 100644 --- a/duniverse/dune_/src/dune_config/dune +++ b/duniverse/dune_/src/dune_config/dune @@ -3,6 +3,7 @@ (libraries stdune xdg + dune_console dune_lang dune_cache dune_cache_storage diff --git a/duniverse/dune_/src/dune_config/dune_config.ml b/duniverse/dune_/src/dune_config/dune_config.ml index 704dbe102..3f36033b1 100644 --- a/duniverse/dune_/src/dune_config/dune_config.ml +++ b/duniverse/dune_/src/dune_config/dune_config.ml @@ -2,6 +2,7 @@ open Stdune open Dune_lang.Decoder module Scheduler = Dune_engine.Scheduler module Sandbox_mode = Dune_engine.Sandbox_mode +module Console = Dune_console module Stanza = Dune_lang.Stanza module Config = Dune_util.Config module String_with_vars = Dune_lang.String_with_vars @@ -16,15 +17,21 @@ module Terminal_persistence = struct type t = | Preserve | Clear_on_rebuild + | Clear_on_rebuild_and_flush_history - let all = [ ("preserve", Preserve); ("clear-on-rebuild", Clear_on_rebuild) ] + let all = + [ ("preserve", Preserve) + ; ("clear-on-rebuild", Clear_on_rebuild) + ; ("clear-on-rebuild-and-flush-history", Clear_on_rebuild_and_flush_history) + ] let to_dyn = function | Preserve -> Dyn.Variant ("Preserve", []) | Clear_on_rebuild -> Dyn.Variant ("Clear_on_rebuild", []) + | Clear_on_rebuild_and_flush_history -> + Variant ("Clear_on_rebuild_and_flush_history", []) - let decode = - enum [ ("perserve", Preserve); ("clear-on-rebuild", Clear_on_rebuild) ] + let decode = enum all end module Concurrency = struct diff --git a/duniverse/dune_/src/dune_config/dune_config.mli b/duniverse/dune_/src/dune_config/dune_config.mli index 967ae820d..83c8dad69 100644 --- a/duniverse/dune_/src/dune_config/dune_config.mli +++ b/duniverse/dune_/src/dune_config/dune_config.mli @@ -44,6 +44,7 @@ module Terminal_persistence : sig type t = | Preserve | Clear_on_rebuild + | Clear_on_rebuild_and_flush_history val all : (string * t) list end diff --git a/duniverse/dune_/src/dune_console/dune b/duniverse/dune_/src/dune_console/dune new file mode 100644 index 000000000..befeee527 --- /dev/null +++ b/duniverse/dune_/src/dune_console/dune @@ -0,0 +1,3 @@ +(library + (name dune_console) + (libraries stdune threads.posix)) diff --git a/duniverse/dune_/otherlibs/stdune/console.ml b/duniverse/dune_/src/dune_console/dune_console.ml similarity index 58% rename from duniverse/dune_/otherlibs/stdune/console.ml rename to duniverse/dune_/src/dune_console/dune_console.ml index ddae71a3a..97a70fa96 100644 --- a/duniverse/dune_/otherlibs/stdune/console.ml +++ b/duniverse/dune_/src/dune_console/dune_console.ml @@ -1,3 +1,5 @@ +open Stdune + module Backend = struct module type S = sig val print_user_message : User_message.t -> unit @@ -7,11 +9,17 @@ module Backend = struct val print_if_no_status_line : User_message.Style.t Pp.t -> unit val reset : unit -> unit + + val reset_flush_history : unit -> unit + + val finish : unit -> unit end type t = (module S) module Dumb_no_flush : S = struct + let finish () = () + let print_user_message msg = Option.iter msg.User_message.loc ~f:(fun loc -> Loc.render Format.err_formatter (Loc.pp loc)); @@ -26,6 +34,8 @@ module Backend = struct (Pp.seq (Pp.map_tags msg ~f:User_message.Print_config.default) Pp.cut) let reset () = prerr_string "\x1b[H\x1b[2J" + + let reset_flush_history () = prerr_string "\x1b[1;1H\x1b[2J\x1b[3J" end module Dumb : S = struct @@ -42,11 +52,17 @@ module Backend = struct let reset () = reset (); flush stderr + + let reset_flush_history () = + reset_flush_history (); + flush stderr end - module Progress : S = struct + module Progress_no_flush : S = struct let status_line = ref Pp.nop + let finish () = () + let status_line_len = ref 0 let hide_status_line () = @@ -59,32 +75,29 @@ module Backend = struct | None -> hide_status_line (); status_line := Pp.nop; - status_line_len := 0; - flush stderr + status_line_len := 0 | Some line -> let line = Pp.map_tags line ~f:User_message.Print_config.default in let line_len = String.length (Format.asprintf "%a" Pp.to_fmt line) in hide_status_line (); status_line := line; status_line_len := line_len; - show_status_line (); - flush stderr + show_status_line () let print_if_no_status_line _msg = () let print_user_message msg = hide_status_line (); Dumb_no_flush.print_user_message msg; - show_status_line (); - flush stderr + show_status_line () let reset () = Dumb.reset () + + let reset_flush_history () = Dumb.reset_flush_history () end let dumb = (module Dumb : S) - let progress = (module Progress : S) - let main = ref dumb let set t = main := t @@ -99,6 +112,10 @@ module Backend = struct A.set_status_line x; B.set_status_line x + let finish () = + A.finish (); + B.finish () + let print_if_no_status_line msg = A.print_if_no_status_line msg; B.print_if_no_status_line msg @@ -106,7 +123,100 @@ module Backend = struct let reset () = A.reset (); B.reset () + + let reset_flush_history () = + A.reset_flush_history (); + B.reset_flush_history () end : S) + + let spawn_thread = Fdecl.create Dyn.opaque + + let threaded (module Base : S) : (module S) = + let module T = struct + let mutex = Mutex.create () + + let finish_cv = Condition.create () + + type state = + { messages : User_message.t Queue.t + ; mutable finish_requested : bool + ; mutable finished : bool + ; mutable status_line : User_message.Style.t Pp.t option + } + + let state = + { messages = Queue.create () + ; status_line = None + ; finished = false + ; finish_requested = false + } + + let finish () = + Mutex.lock mutex; + state.finish_requested <- true; + while not state.finished do + Condition.wait finish_cv mutex + done; + Mutex.unlock mutex + + let print_user_message m = + Mutex.lock mutex; + Queue.push state.messages m; + Mutex.unlock mutex + + let set_status_line sl = + Mutex.lock mutex; + state.status_line <- sl; + Mutex.unlock mutex + + let print_if_no_status_line _msg = () + + let reset () = + Mutex.lock mutex; + Queue.clear state.messages; + state.status_line <- None; + Base.reset (); + Mutex.unlock mutex + + let reset_flush_history () = + Mutex.lock mutex; + Queue.clear state.messages; + state.status_line <- None; + Base.reset_flush_history (); + Mutex.unlock mutex + end in + ( Fdecl.get spawn_thread @@ fun () -> + let open T in + let last = ref (Unix.gettimeofday ()) in + let frame_rate = 1. /. 60. in + try + while true do + Mutex.lock mutex; + while not (Queue.is_empty state.messages) do + Base.print_user_message (Queue.pop_exn state.messages) + done; + Base.set_status_line state.status_line; + flush stderr; + let finish_requested = state.finish_requested in + if finish_requested then raise_notrace Exit; + Mutex.unlock mutex; + let now = Unix.gettimeofday () in + let elapsed = now -. !last in + if elapsed >= frame_rate then last := now + else + let delta = frame_rate -. elapsed in + Unix.sleepf delta; + last := delta +. now + done + with Exit -> + state.finished <- true; + Condition.broadcast finish_cv; + Mutex.unlock mutex ); + (module T) + + let progress = + let t = lazy (threaded (module Progress_no_flush)) in + fun () -> Lazy.force t end let print_user_message msg = @@ -129,6 +239,14 @@ let reset () = let (module M : Backend.S) = !Backend.main in M.reset () +let reset_flush_history () = + let (module M : Backend.S) = !Backend.main in + M.reset_flush_history () + +let finish () = + let (module M : Backend.S) = !Backend.main in + M.finish () + module Status_line = struct type t = | Live of (unit -> User_message.Style.t Pp.t) diff --git a/duniverse/dune_/otherlibs/stdune/console.mli b/duniverse/dune_/src/dune_console/dune_console.mli similarity index 77% rename from duniverse/dune_/otherlibs/stdune/console.mli rename to duniverse/dune_/src/dune_console/dune_console.mli index 43d185682..30b2f0090 100644 --- a/duniverse/dune_/otherlibs/stdune/console.mli +++ b/duniverse/dune_/src/dune_console/dune_console.mli @@ -1,3 +1,5 @@ +open Stdune + (** Manages the console *) (** The console is a system than can report messages and a status to the user. @@ -6,23 +8,7 @@ application as well as composing backends. *) module Backend : sig - module type S = sig - (** Format and print a user message to the console *) - val print_user_message : User_message.t -> unit - - (** Change the status line *) - val set_status_line : User_message.Style.t Pp.t option -> unit - - (** Print a message if the backend does not display the status line. This is - needed so that the important status changes show up even when a [dumb] - terminal backend is used. *) - val print_if_no_status_line : User_message.Style.t Pp.t -> unit - - (** Reset the log output *) - val reset : unit -> unit - end - - type t = (module S) + type t val set : t -> unit @@ -35,11 +21,23 @@ module Backend : sig val dumb : t (** A backend that just displays the status line in the terminal *) - val progress : t + val progress : unit -> t + + val spawn_thread : ((unit -> unit) -> unit) Fdecl.t + + val threaded : t -> t end -(** The main backend for the application *) -include Backend.S +(** Format and print a user message to the console *) +val print_user_message : User_message.t -> unit + +(** Reset the log output and (try) to remove the history *) +val reset_flush_history : unit -> unit + +(** Reset the log output *) +val reset : unit -> unit + +val finish : unit -> unit (** [print paragraphs] is a short-hand for: diff --git a/duniverse/dune_/src/dune_digest/dune b/duniverse/dune_/src/dune_digest/dune new file mode 100644 index 000000000..5a3429edd --- /dev/null +++ b/duniverse/dune_/src/dune_digest/dune @@ -0,0 +1,3 @@ +(library + (name dune_digest) + (libraries dune_metrics stdune)) diff --git a/duniverse/dune_/otherlibs/stdune/digest.ml b/duniverse/dune_/src/dune_digest/dune_digest.ml similarity index 51% rename from duniverse/dune_/otherlibs/stdune/digest.ml rename to duniverse/dune_/src/dune_digest/dune_digest.ml index 2e5a0ed17..f46633540 100644 --- a/duniverse/dune_/otherlibs/stdune/digest.ml +++ b/duniverse/dune_/src/dune_digest/dune_digest.ml @@ -1,8 +1,11 @@ +open Stdune + type t = string module D = Stdlib.Digest module Set = String.Set module Map = String.Map +module Metrics = Dune_metrics module type Digest_impl = sig val file : string -> t @@ -63,13 +66,17 @@ let generic a = Metrics.Timer.record "generic_digest" ~f:(fun () -> string (Marshal.to_string a [ No_sharing ])) -let file_with_executable_bit ~executable path = +let path_with_executable_bit = (* We follow the digest scheme used by Jenga. *) let string_and_bool ~digest_hex ~bool = Impl.string (digest_hex ^ if bool then "\001" else "\000") in + fun ~executable ~content_digest -> + string_and_bool ~digest_hex:content_digest ~bool:executable + +let file_with_executable_bit ~executable path = let content_digest = file path in - string_and_bool ~digest_hex:content_digest ~bool:executable + path_with_executable_bit ~content_digest ~executable module Stats_for_digest = struct type t = @@ -109,43 +116,59 @@ exception let directory_digest_version = 2 -let rec path_with_stats ~allow_dirs path (stats : Stats_for_digest.t) : +let path_with_stats ~allow_dirs path (stats : Stats_for_digest.t) : Path_digest_result.t = + let rec loop path (stats : Stats_for_digest.t) = + match stats.st_kind with + | S_LNK -> + let executable = + Path.Permissions.test Path.Permissions.execute stats.st_perm + in + Dune_filesystem_stubs.Unix_error.Detailed.catch + (fun path -> + let contents = Unix.readlink (Path.to_string path) in + path_with_executable_bit ~executable ~content_digest:contents) + path + |> Path_digest_result.of_result + | S_REG -> + let executable = + Path.Permissions.test Path.Permissions.execute stats.st_perm + in + Dune_filesystem_stubs.Unix_error.Detailed.catch + (file_with_executable_bit ~executable) + path + |> Path_digest_result.of_result + | S_DIR when allow_dirs -> ( + (* CR-someday amokhov: The current digesting scheme has collisions for files + and directories. It's unclear if this is actually a problem. If it turns + out to be a problem, we should include [st_kind] into both digests. *) + match Path.readdir_unsorted path with + | Error e -> Path_digest_result.Unix_error e + | Ok listing -> ( + match + List.rev_map listing ~f:(fun name -> + let path = Path.relative path name in + let stats = + match Path.lstat path with + | Error e -> raise_notrace (E (`Unix_error e)) + | Ok stat -> Stats_for_digest.of_unix_stats stat + in + let digest = + match loop path stats with + | Ok s -> s + | Unix_error e -> raise_notrace (E (`Unix_error e)) + | Unexpected_kind -> raise_notrace (E `Unexpected_kind) + in + (name, digest)) + |> List.sort ~compare:(fun (x, _) (y, _) -> String.compare x y) + with + | exception E (`Unix_error e) -> Path_digest_result.Unix_error e + | exception E `Unexpected_kind -> Path_digest_result.Unexpected_kind + | contents -> + Ok (generic (directory_digest_version, contents, stats.st_perm)))) + | S_DIR | S_BLK | S_CHR | S_FIFO | S_SOCK -> Unexpected_kind + in match stats.st_kind with - | S_REG -> - let executable = - Path.Permissions.test Path.Permissions.execute stats.st_perm - in - Dune_filesystem_stubs.Unix_error.Detailed.catch - (file_with_executable_bit ~executable) - path - |> Path_digest_result.of_result - | S_DIR when allow_dirs -> ( - (* CR-someday amokhov: The current digesting scheme has collisions for files - and directories. It's unclear if this is actually a problem. If it turns - out to be a problem, we should include [st_kind] into both digests. *) - match Path.readdir_unsorted path with - | Error e -> Path_digest_result.Unix_error e - | Ok listing -> ( - match - List.rev_map listing ~f:(fun name -> - let path = Path.relative path name in - let stats = - match Path.lstat path with - | Error e -> raise_notrace (E (`Unix_error e)) - | Ok stat -> Stats_for_digest.of_unix_stats stat - in - let digest = - match path_with_stats ~allow_dirs path stats with - | Ok s -> s - | Unix_error e -> raise_notrace (E (`Unix_error e)) - | Unexpected_kind -> raise_notrace (E `Unexpected_kind) - in - (name, digest)) - |> List.sort ~compare:(fun (x, _) (y, _) -> String.compare x y) - with - | exception E (`Unix_error e) -> Path_digest_result.Unix_error e - | exception E `Unexpected_kind -> Path_digest_result.Unexpected_kind - | contents -> - Ok (generic (directory_digest_version, contents, stats.st_perm)))) - | S_DIR | S_BLK | S_CHR | S_LNK | S_FIFO | S_SOCK -> Unexpected_kind + | S_DIR when not allow_dirs -> Unexpected_kind + | S_BLK | S_CHR | S_LNK | S_FIFO | S_SOCK -> Unexpected_kind + | _ -> loop path stats diff --git a/duniverse/dune_/otherlibs/stdune/digest.mli b/duniverse/dune_/src/dune_digest/dune_digest.mli similarity index 99% rename from duniverse/dune_/otherlibs/stdune/digest.mli rename to duniverse/dune_/src/dune_digest/dune_digest.mli index 05ffd2df5..1bcf2af5a 100644 --- a/duniverse/dune_/otherlibs/stdune/digest.mli +++ b/duniverse/dune_/src/dune_digest/dune_digest.mli @@ -1,3 +1,5 @@ +open Stdune + (** Digests (MD5) *) type t diff --git a/duniverse/dune_/src/dune_engine/action.ml b/duniverse/dune_/src/dune_engine/action.ml index a24aa14a9..c8e4f0c3f 100644 --- a/duniverse/dune_/src/dune_engine/action.ml +++ b/duniverse/dune_/src/dune_engine/action.ml @@ -72,7 +72,7 @@ struct List [ atom ("write-file" ^ File_perm.suffix perm); target x; string y ] | Rename (x, y) -> List [ atom "rename"; target x; target y ] | Remove_tree x -> List [ atom "remove-tree"; target x ] - | Mkdir x -> List [ atom "mkdir"; path x ] + | Mkdir x -> List [ atom "mkdir"; target x ] | Diff { optional; file1; file2; mode = Binary } -> assert (not optional); List [ atom "cmp"; path file1; target file2 ] @@ -87,7 +87,6 @@ struct ; List (List.map ~f:string extras) ; target into ] - | No_infer r -> List [ atom "no-infer"; encode r ] | Pipe (outputs, l) -> List (atom (sprintf "pipe-%s" (Outputs.to_string outputs)) @@ -287,8 +286,7 @@ let fold_one_step t ~init:acc ~f = | Redirect_out (_, _, _, t) | Redirect_in (_, _, t) | Ignore (_, t) - | With_accepted_exit_codes (_, t) - | No_infer t -> f acc t + | With_accepted_exit_codes (_, t) -> f acc t | Progn l | Pipe (_, l) -> List.fold_left l ~init:acc ~f | Run _ | Dynamic_run _ @@ -318,7 +316,7 @@ let chdirs = | Chdir (dir, _) -> ( match Path.as_in_build_dir dir with | None -> - Code_error.raise "chdir ouside the build directory" + Code_error.raise "chdir outside the build directory" [ ("dir", Path.to_dyn dir) ] | Some dir -> Path.Build.Set.add acc dir) | _ -> acc @@ -336,8 +334,7 @@ let rec is_dynamic = function | Redirect_out (_, _, _, t) | Redirect_in (_, _, t) | Ignore (_, t) - | With_accepted_exit_codes (_, t) - | No_infer t -> is_dynamic t + | With_accepted_exit_codes (_, t) -> is_dynamic t | Progn l | Pipe (_, l) -> List.exists l ~f:is_dynamic | Run _ | System _ @@ -386,7 +383,7 @@ let is_useful_to distribute memoize = | Setenv (_, _, t) -> loop t | Redirect_out (_, _, _, t) -> memoize || loop t | Redirect_in (_, _, t) -> loop t - | Ignore (_, t) | With_accepted_exit_codes (_, t) | No_infer t -> loop t + | Ignore (_, t) | With_accepted_exit_codes (_, t) -> loop t | Progn l | Pipe (_, l) -> List.exists l ~f:loop | Echo _ -> false | Cat _ -> memoize diff --git a/duniverse/dune_/src/dune_engine/action_builder.ml b/duniverse/dune_/src/dune_engine/action_builder.ml index 83db5c97e..2020c853e 100644 --- a/duniverse/dune_/src/dune_engine/action_builder.ml +++ b/duniverse/dune_/src/dune_engine/action_builder.ml @@ -240,6 +240,13 @@ let symlink ~src ~dst = with_file_targets ~file_targets:[ dst ] (path src >>> return (Action.Full.make (Action.Symlink (src, dst)))) +let symlink_dir ~src ~dst = + with_targets + ~targets: + (Targets.create ~files:Path.Build.Set.empty + ~dirs:(Path.Build.Set.singleton dst)) + (path src >>> return (Action.Full.make (Action.Symlink (src, dst)))) + let create_file ?(perm = Action.File_perm.Normal) fn = with_file_targets ~file_targets:[ fn ] (return diff --git a/duniverse/dune_/src/dune_engine/action_builder.mli b/duniverse/dune_/src/dune_engine/action_builder.mli index 84cf88bd8..cd41361f0 100644 --- a/duniverse/dune_/src/dune_engine/action_builder.mli +++ b/duniverse/dune_/src/dune_engine/action_builder.mli @@ -168,6 +168,8 @@ val copy : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t val symlink : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t +val symlink_dir : src:Path.t -> dst:Path.Build.t -> Action.Full.t With_targets.t + val create_file : ?perm:Action.File_perm.t -> Path.Build.t -> Action.Full.t With_targets.t diff --git a/duniverse/dune_/src/dune_engine/action_exec.ml b/duniverse/dune_/src/dune_engine/action_exec.ml index b3779c5a8..528184b43 100644 --- a/duniverse/dune_/src/dune_engine/action_exec.ml +++ b/duniverse/dune_/src/dune_engine/action_exec.ml @@ -137,14 +137,17 @@ let exec_run_dynamic_client ~ectx ~eenv prog args = ; targets } in - Io.write_file run_arguments_fn (DAP.Run_arguments.serialize run_arguments); + DAP.Run_arguments.to_sexp run_arguments + |> Csexp.to_string + |> Io.write_file run_arguments_fn; let env = let value = DAP.Greeting.( - serialize + to_sexp { run_arguments_fn = Path.to_absolute_filename run_arguments_fn ; response_fn = Path.to_absolute_filename response_fn }) + |> Csexp.to_string in Env.add eenv.env ~var:DAP.run_by_dune_env_variable ~value in @@ -153,12 +156,17 @@ let exec_run_dynamic_client ~ectx ~eenv prog args = ~stderr_to:eenv.stderr_to ~stdin_from:eenv.stdin_from ~metadata:ectx.metadata prog args in - let response = Io.read_file response_fn in + let response_raw = Io.read_file response_fn in Temp.destroy File run_arguments_fn; Temp.destroy File response_fn; + let response = + match Csexp.parse_string response_raw with + | Ok s -> DAP.Response.of_sexp s + | Error _ -> Error DAP.Error.Parse_error + in let prog_name = Path.reach ~from:eenv.working_dir prog in - match DAP.Response.deserialize response with - | Error _ when String.is_empty response -> + match response with + | Error _ when String.is_empty response_raw -> User_error.raise ~loc:ectx.rule_loc [ Pp.textf "Executable '%s' declared as using dune-action-plugin (declared with \ @@ -305,10 +313,7 @@ let rec exec t ~ectx ~eenv = Path.rm_rf (Path.build path); Fiber.return Done | Mkdir path -> - if Path.is_in_build_dir path then Path.mkdir_p path - else - Code_error.raise "Action_exec.exec: mkdir on non build dir" - [ ("path", Path.to_dyn path) ]; + Path.mkdir_p (Path.build path); Fiber.return Done | Diff ({ optional; file1; file2; mode } as diff) -> let remove_intermediate_file () = @@ -383,7 +388,6 @@ let rec exec t ~ectx ~eenv = let target = Path.build target in Io.write_lines target (String.Set.to_list lines); Fiber.return Done - | No_infer t -> exec t ~ectx ~eenv | Pipe (outputs, l) -> exec_pipe ~ectx ~eenv outputs l | Extension (module A) -> let* () = diff --git a/duniverse/dune_/src/dune_engine/action_intf.ml b/duniverse/dune_/src/dune_engine/action_intf.ml index 96e7bb917..f569d9237 100644 --- a/duniverse/dune_/src/dune_engine/action_intf.ml +++ b/duniverse/dune_/src/dune_engine/action_intf.ml @@ -51,10 +51,9 @@ module type Ast = sig | Write_file of target * File_perm.t * string | Rename of target * target | Remove_tree of target - | Mkdir of path + | Mkdir of target | Diff of (path, target) Diff.t | Merge_files_into of path list * string list * target - | No_infer of t | Pipe of Outputs.t * t list | Extension of ext end @@ -110,7 +109,7 @@ module type Helpers = sig val remove_tree : target -> t - val mkdir : path -> t + val mkdir : target -> t val diff : ?optional:bool -> ?mode:Diff.Mode.t -> path -> target -> t end diff --git a/duniverse/dune_/src/dune_engine/action_mapper.ml b/duniverse/dune_/src/dune_engine/action_mapper.ml index f54374821..9c9bf18a5 100644 --- a/duniverse/dune_/src/dune_engine/action_mapper.ml +++ b/duniverse/dune_/src/dune_engine/action_mapper.ml @@ -41,7 +41,7 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct Write_file (f_target ~dir x, perm, f_string ~dir y) | Rename (x, y) -> Rename (f_target ~dir x, f_target ~dir y) | Remove_tree x -> Remove_tree (f_target ~dir x) - | Mkdir x -> Mkdir (f_path ~dir x) + | Mkdir x -> Mkdir (f_target ~dir x) | Diff ({ file1; file2; _ } as diff) -> Diff { diff with file1 = f_path ~dir file1; file2 = f_target ~dir file2 } | Merge_files_into (sources, extras, target) -> @@ -49,7 +49,6 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct ( List.map sources ~f:(f_path ~dir) , List.map extras ~f:(f_string ~dir) , f_target ~dir target ) - | No_infer t -> No_infer (f t ~dir) | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(fun t -> f t ~dir)) | Extension ext -> Extension (f_ext ~dir ext) diff --git a/duniverse/dune_/src/dune_engine/action_to_sh.ml b/duniverse/dune_/src/dune_engine/action_to_sh.ml index 7b9dd51e0..a5383a392 100644 --- a/duniverse/dune_/src/dune_engine/action_to_sh.ml +++ b/duniverse/dune_/src/dune_engine/action_to_sh.ml @@ -86,7 +86,6 @@ let simplify act = (List.map srcs ~f:String.quote_for_shell |> String.concat ~sep:" ") (String.quote_for_shell target)) :: acc - | No_infer act -> loop act acc | Pipe (outputs, l) -> Pipe (List.map ~f:block l, outputs) :: acc | Extension _ -> Sh "# extensions are not supported" :: acc and block act = diff --git a/duniverse/dune_/src/dune_engine/build_system.ml b/duniverse/dune_/src/dune_engine/build_system.ml index da1fe6ecd..81a2d5ed2 100644 --- a/duniverse/dune_/src/dune_engine/build_system.ml +++ b/duniverse/dune_/src/dune_engine/build_system.ml @@ -6,15 +6,23 @@ module Progress = struct type t = { number_of_rules_discovered : int ; number_of_rules_executed : int + ; number_of_rules_failed : int } - let equal { number_of_rules_discovered; number_of_rules_executed } t = + let equal + { number_of_rules_discovered + ; number_of_rules_executed + ; number_of_rules_failed + } t = Int.equal number_of_rules_discovered t.number_of_rules_discovered && Int.equal number_of_rules_executed t.number_of_rules_executed + && Int.equal number_of_rules_failed t.number_of_rules_failed - let complete t = t.number_of_rules_executed - - let remaining t = t.number_of_rules_discovered - t.number_of_rules_executed + let init = + { number_of_rules_discovered = 0 + ; number_of_rules_executed = 0 + ; number_of_rules_failed = 0 + } end module Error = struct @@ -150,45 +158,35 @@ module State = struct (* This mutex ensures that at most one [run] is running in parallel. *) let build_mutex = Fiber.Mutex.create () - let progress_init = - { Progress.number_of_rules_discovered = 0; number_of_rules_executed = 0 } - - let reset_progress () = Svar.write t (Building progress_init) + let reset_progress () = Svar.write t (Building Progress.init) let set what = Svar.write t what - let incr_rule_done_exn () = + let update_build_progress_exn ~f = let current = Svar.read t in match current with - | Building current -> - Svar.write t - (Building - { current with - number_of_rules_executed = current.number_of_rules_executed + 1 - }) + | Building current -> Svar.write t @@ Building (f current) | _ -> assert false + let incr_rule_done_exn () = + update_build_progress_exn ~f:(fun p -> + { p with number_of_rules_executed = p.number_of_rules_executed + 1 }) + let start_rule_exn () = - let current = Svar.read t in - match current with - | Building current -> - Svar.write t - (Building - { current with - number_of_rules_discovered = current.number_of_rules_discovered + 1 - }) - | _ -> assert false + update_build_progress_exn ~f:(fun p -> + { p with number_of_rules_discovered = p.number_of_rules_discovered + 1 }) let errors = Svar.create Error.Set.empty let reset_errors () = Svar.write errors Error.Set.empty let add_error error = - let set = - let set = Svar.read errors in - Error.Set.add set error + let open Fiber.O in + let* () = + update_build_progress_exn ~f:(fun p -> + { p with number_of_rules_failed = p.number_of_rules_failed + 1 }) in - Svar.write errors set + Svar.write errors @@ Error.Set.add (Svar.read errors) error end let rec with_locks ~f = function @@ -410,11 +408,13 @@ end = struct } = action in + let* dune_stats = Scheduler.stats () in let sandbox = match sandbox_mode with | Some mode -> Some (Sandbox.create ~mode ~deps ~rule_dir:dir ~rule_loc:loc ~rule_digest + ~dune_stats ~expand_aliases: (Execution_parameters.expand_aliases_in_sandbox execution_parameters)) @@ -427,18 +427,7 @@ end = struct in let action = match sandbox with - | None -> - (* CR-someday amokhov: It may be possible to support directory targets - without sandboxing. We just need to make sure we clean up all stale - directory targets before running the rule and then we can discover - all created files right in the build directory. *) - if not (Path.Build.Set.is_empty targets.dirs) then - User_error.raise ~loc - [ Pp.text "Rules with directory targets must be sandboxed." ] - ~hints: - [ Pp.text "Add (sandbox always) to the (deps ) field of the rule." - ]; - action + | None -> action | Some sandbox -> Action.sandbox action sandbox in let action = @@ -475,9 +464,7 @@ end = struct let produced_targets = match sandbox with | None -> - (* Directory targets are not allowed for non-sandboxed actions, so - the call below should not raise. *) - Targets.Produced.of_validated_files_exn targets + Targets.Produced.produced_after_rule_executed_exn ~loc targets | Some sandbox -> (* The stamp file for anonymous actions is always created outside the sandbox, so we can't move it. *) @@ -507,6 +494,19 @@ end = struct | Promote promote, (Some Automatically | None) -> Target_promotion.promote ~dir ~targets ~promote ~promote_source + let execution_parameters_of_dir = + let f path = + let+ dir = Source_tree.nearest_dir path + and+ ep = Execution_parameters.default in + Dune_project.update_execution_parameters (Source_tree.Dir.project dir) ep + in + let memo = + Memo.create "execution-parameters-of-dir" + ~input:(module Path.Source) + ~cutoff:Execution_parameters.equal f + in + Memo.exec memo + let execute_rule_impl ~rule_kind rule = let { Rule.id = _; targets; dir; context; mode; action; info = _; loc } = rule @@ -521,7 +521,7 @@ end = struct match Dpath.Target_dir.of_target dir with | Regular (With_context (_, dir)) | Anonymous_action (With_context (_, dir)) -> - Source_tree.execution_parameters_of_dir dir + execution_parameters_of_dir dir | _ -> Execution_parameters.default in (* Note: we do not run the below in parallel with the above: if we fail to @@ -1174,8 +1174,12 @@ let run_exn f = | Ok res -> res | Error `Already_reported -> raise Dune_util.Report_error.Already_reported +let build_file p = + let+ (_ : Digest.t) = build_file p in + () + let read_file p ~f = - let+ _digest = build_file p in + let+ () = build_file p in f p let state = State.t diff --git a/duniverse/dune_/src/dune_engine/build_system.mli b/duniverse/dune_/src/dune_engine/build_system.mli index 465ecb09f..b724fc023 100644 --- a/duniverse/dune_/src/dune_engine/build_system.mli +++ b/duniverse/dune_/src/dune_engine/build_system.mli @@ -3,10 +3,8 @@ open Import module Action_builder := Action_builder0 -(** {1 Requests} *) - -(** Build a file and return the digest of its contents. *) -val build_file : Path.t -> Digest.t Memo.t +(** Build a file. *) +val build_file : Path.t -> unit Memo.t (** Build a file and access its contents with [f]. *) val read_file : Path.t -> f:(Path.t -> 'a) -> 'a Memo.t @@ -59,16 +57,16 @@ val run_exn : (unit -> 'a Memo.t) -> 'a Fiber.t (** {2 Misc} *) module Progress : sig + (** Measures for the progress of the build. *) + type t = { number_of_rules_discovered : int ; number_of_rules_executed : int + ; number_of_rules_failed : int } - val equal : t -> t -> bool - - val complete : t -> int - - val remaining : t -> int + (** Initialize with zeros on all measures. *) + val init : t end module State : sig diff --git a/duniverse/dune_/src/dune_engine/cached_digest.ml b/duniverse/dune_/src/dune_engine/cached_digest.ml index d089b69b5..e7786581d 100644 --- a/duniverse/dune_/src/dune_engine/cached_digest.ml +++ b/duniverse/dune_/src/dune_engine/cached_digest.ml @@ -256,7 +256,8 @@ let refresh_and_remove_write_permissions ~allow_dirs path = Path.Permissions.remove Path.Permissions.write stats.st_perm in Path.chmod ~mode:perm path; - refresh ~allow_dirs { stats with st_perm = perm } path + (* we know it's a file, so we don't allow directories for safety *) + refresh ~allow_dirs:false { stats with st_perm = perm } path | _ -> (* CR-someday amokhov: Shall we proceed if [stats.st_kind = S_DIR]? What about stranger kinds like [S_SOCK]? *) diff --git a/duniverse/dune_/src/dune_engine/clflags.ml b/duniverse/dune_/src/dune_engine/clflags.ml index 01d27f818..e1f91be99 100644 --- a/duniverse/dune_/src/dune_engine/clflags.ml +++ b/duniverse/dune_/src/dune_engine/clflags.ml @@ -22,6 +22,8 @@ let debug_backtraces b = Dune_util.Report_error.report_backtraces b; Memo.Debug.track_locations_of_lazy_values := b +let debug_load_dir = ref false + let diff_command = ref None let promote = ref None diff --git a/duniverse/dune_/src/dune_engine/clflags.mli b/duniverse/dune_/src/dune_engine/clflags.mli index 446aeb586..970350fef 100644 --- a/duniverse/dune_/src/dune_engine/clflags.mli +++ b/duniverse/dune_/src/dune_engine/clflags.mli @@ -20,6 +20,9 @@ val debug_digests : bool ref (** Print debug info for cached file-system operations *) val debug_fs_cache : bool ref +(** Print debug info when loading rules in directories *) +val debug_load_dir : bool ref + (** Wait for the filesystem clock to advance rather than dropping cached digest entries *) val wait_for_filesystem_clock : bool ref diff --git a/duniverse/dune_/src/dune_engine/diff_promotion.ml b/duniverse/dune_/src/dune_engine/diff_promotion.ml index aa5d7ef29..b8a305799 100644 --- a/duniverse/dune_/src/dune_engine/diff_promotion.ml +++ b/duniverse/dune_/src/dune_engine/diff_promotion.ml @@ -25,6 +25,13 @@ module File = struct ; dst : Path.Source.t } + let compare { src; staging; dst } t = + let open Ordering.O in + let= () = Path.Build.compare src t.src in + let= () = Option.compare Path.Build.compare staging t.staging in + let= () = Path.Source.compare dst t.dst in + Eq + let in_staging_area source = Path.Build.append_source staging_area source let to_dyn { src; staging; dst } = @@ -57,15 +64,14 @@ module File = struct let do_promote ~correction_file ~dst = Path.Source.unlink_no_err dst; let chmod = Path.Permissions.add Path.Permissions.write in - Io.copy_file ~chmod - ~src:(Path.build correction_file) - ~dst:(Path.source dst) () - - let promote { src; staging; dst } = - let correction_file = Option.value staging ~default:src in - let correction_exists = - Path.Untracked.exists (Path.build correction_file) - in + Io.copy_file ~chmod ~src:correction_file ~dst:(Path.source dst) () + + let correction_file { src; staging; _ } = + Path.build (Option.value staging ~default:src) + + let promote ({ src; staging; dst } as file) = + let correction_file = correction_file file in + let correction_exists = Path.Untracked.exists correction_file in Console.print [ Pp.box ~indent:2 (if correction_exists then @@ -179,3 +185,34 @@ let promote_files_registered_in_last_run files_to_promote = let db = load_db () in let db = do_promote db files_to_promote in dump_db db + +let diff_for_file (file : File.t) = + let msg = User_message.Annots.empty in + let original = Path.source file.dst in + let correction = File.correction_file file in + Print_diff.get msg original correction + +let filter_db files_to_promote db = + match files_to_promote with + | All -> db + | These (files, on_missing) -> + List.filter_map files ~f:(fun file -> + let r = + List.find db ~f:(fun (f : File.t) -> Path.Source.equal f.dst file) + in + if Option.is_none r then on_missing file; + r) + +let display files_to_promote = + let open Fiber.O in + let files = load_db () |> filter_db files_to_promote in + let module FileMap = Map.Make (File) in + let+ diff_opts = + Fiber.parallel_map files ~f:(fun file -> + let+ diff_opt = diff_for_file file in + match diff_opt with + | Ok diff -> Some (file, diff) + | Error _ -> None) + in + diff_opts |> List.filter_opt |> FileMap.of_list_exn + |> FileMap.iter ~f:Print_diff.Diff.print diff --git a/duniverse/dune_/src/dune_engine/diff_promotion.mli b/duniverse/dune_/src/dune_engine/diff_promotion.mli index cc3063971..941b92709 100644 --- a/duniverse/dune_/src/dune_engine/diff_promotion.mli +++ b/duniverse/dune_/src/dune_engine/diff_promotion.mli @@ -44,3 +44,5 @@ type files_to_promote = | These of Path.Source.t list * (Path.Source.t -> unit) val promote_files_registered_in_last_run : files_to_promote -> unit + +val display : files_to_promote -> unit Fiber.t diff --git a/duniverse/dune_/src/dune_engine/dune b/duniverse/dune_/src/dune_engine/dune index 109a2105a..d0a95fe91 100644 --- a/duniverse/dune_/src/dune_engine/dune +++ b/duniverse/dune_/src/dune_engine/dune @@ -4,7 +4,9 @@ (name dune_engine) (libraries unix + csexp stdune + dune_console dyn fiber incremental_cycles @@ -34,5 +36,7 @@ dune_file_watcher dune_filesystem_stubs ocaml_inotify + dune_digest + dune_metrics async_inotify_for_dune) (synopsis "Internal Dune library, do not use!")) diff --git a/duniverse/dune_/src/dune_engine/dune_engine.ml b/duniverse/dune_/src/dune_engine/dune_engine.ml index 1337ffb6b..af396ea30 100644 --- a/duniverse/dune_/src/dune_engine/dune_engine.ml +++ b/duniverse/dune_/src/dune_engine/dune_engine.ml @@ -47,3 +47,4 @@ module Report_errors_config = Report_errors_config module Compound_user_error = Compound_user_error module Reflection = Reflection module No_io = No_io +module Rpc = Rpc diff --git a/duniverse/dune_/src/dune_engine/dune_project.ml b/duniverse/dune_/src/dune_engine/dune_project.ml index ed39fa43c..e6a508284 100644 --- a/duniverse/dune_/src/dune_engine/dune_project.ml +++ b/duniverse/dune_/src/dune_engine/dune_project.ml @@ -841,7 +841,7 @@ let parse ~dir ~lang ~file ~dir_status = User_error.raise ~loc [ Pp.text "This opam file doesn't have a corresponding \ - (package ...) stanza in the dune-project_file. \ + (package ...) stanza in the dune-project file. \ Since you have at least one other (package ...) \ stanza in your dune-project file, you must a \ (package ...) stanza for each opam package in \ @@ -961,7 +961,7 @@ let load_dune_project ~dir opam_packages ~dir_status : t Memo.t = let file = Path.Source.relative dir filename in let open Memo.O in let* f = - Fs_memo.with_lexbuf_from_file (Path.source file) ~f:(fun lexbuf -> + Fs_memo.with_lexbuf_from_file (In_source_dir file) ~f:(fun lexbuf -> parse_contents lexbuf ~f:(fun lang -> parse ~dir ~lang ~file ~dir_status)) in diff --git a/duniverse/dune_/src/dune_engine/fs_cache.ml b/duniverse/dune_/src/dune_engine/fs_cache.ml index bbfdeb8bd..6470b8627 100644 --- a/duniverse/dune_/src/dune_engine/fs_cache.ml +++ b/duniverse/dune_/src/dune_engine/fs_cache.ml @@ -6,24 +6,31 @@ open Import type 'a t = { name : string (* For debugging *) - ; sample : Path.t -> 'a - ; cache : 'a Path.Table.t + ; sample : Path.Outside_build_dir.t -> 'a + ; cache : 'a Path.Outside_build_dir.Table.t ; equal : 'a -> 'a -> bool (* Used to implement cutoff *) - ; update_hook : Path.t -> unit (* Run this hook before updating an entry. *) + ; update_hook : + Path.Outside_build_dir.t + -> unit (* Run this hook before updating an entry. *) } -let create ?(update_hook = fun _path -> ()) name ~sample ~equal = - { name; sample; equal; cache = Path.Table.create 128; update_hook } +let create ?(update_hook = fun _path -> ()) name ~sample ~equal : 'a t = + { name + ; sample + ; equal + ; cache = Path.Outside_build_dir.Table.create 128 + ; update_hook + } let read { sample; cache; _ } path = - match Path.Table.find cache path with + match Path.Outside_build_dir.Table.find cache path with | Some cached_result -> cached_result | None -> let result = sample path in - Path.Table.add_exn cache path result; + Path.Outside_build_dir.Table.add_exn cache path result; result -let evict { cache; _ } path = Path.Table.remove cache path +let evict { cache; _ } path = Path.Outside_build_dir.Table.remove cache path module Update_result = struct type t = @@ -45,7 +52,7 @@ module Update_result = struct end let update { sample; cache; equal; update_hook; _ } path = - match Path.Table.find cache path with + match Path.Outside_build_dir.Table.find cache path with | None -> Update_result.Skipped | Some old_result -> ( update_hook path; @@ -53,7 +60,7 @@ let update { sample; cache; equal; update_hook; _ } path = match equal old_result new_result with | true -> Updated { changed = false } | false -> - Path.Table.set cache path new_result; + Path.Outside_build_dir.Table.set cache path new_result; Updated { changed = true }) module Reduced_stats = struct @@ -102,7 +109,9 @@ end module Untracked = struct let path_stat = let sample path = - Path.Untracked.stat path |> Result.map ~f:Reduced_stats.of_unix_stats + Path.outside_build_dir path + |> Path.Untracked.stat + |> Result.map ~f:Reduced_stats.of_unix_stats in create "path_stat" ~sample ~equal:(Result.equal Reduced_stats.equal Unix_error.Detailed.equal) @@ -111,15 +120,20 @@ module Untracked = struct module and [cached_digest.ml]. In particular, digests are stored twice, in two separate tables. We should find a way to merge the tables into one. *) let file_digest = - let sample = Cached_digest.Untracked.source_or_external_file in - let update_hook = Cached_digest.Untracked.invalidate_cached_timestamp in + let sample p = + Cached_digest.Untracked.source_or_external_file (Path.outside_build_dir p) + in + let update_hook p = + Cached_digest.Untracked.invalidate_cached_timestamp + (Path.outside_build_dir p) + in create "file_digest" ~sample ~update_hook ~equal:Cached_digest.Digest_result.equal let dir_contents = create "dir_contents" ~sample:(fun path -> - Path.Untracked.readdir_unsorted_with_kinds path + Path.Untracked.readdir_unsorted_with_kinds (Path.outside_build_dir path) |> Result.map ~f:Dir_contents.of_list) ~equal:(Result.equal Dir_contents.equal Unix_error.Detailed.equal) end diff --git a/duniverse/dune_/src/dune_engine/fs_cache.mli b/duniverse/dune_/src/dune_engine/fs_cache.mli index eda5c238c..37ac53d73 100644 --- a/duniverse/dune_/src/dune_engine/fs_cache.mli +++ b/duniverse/dune_/src/dune_engine/fs_cache.mli @@ -1,7 +1,8 @@ open Import -(** A cached file-system operation on a [Path.t] whose result type is ['a]. For - example, an operation to check if a path exists returns ['a = bool]. +(** A cached file-system operation on a [Path.Outside_build_dir.t] whose result + type is ['a]. For example, an operation to check if a path exists returns + ['a = bool]. Currently we do not expose a way to construct such cached operations; see the [Untracked] module for a few predefined ones. *) @@ -10,10 +11,10 @@ type 'a t (** If the cache contains the result of applying an operation to a path, return it. Otherwise, perform the operation, store the result in the cache, and then return it. *) -val read : 'a t -> Path.t -> 'a +val read : 'a t -> Path.Outside_build_dir.t -> 'a (** Evict an entry from the cache. *) -val evict : 'a t -> Path.t -> unit +val evict : 'a t -> Path.Outside_build_dir.t -> unit (** Result of updating a cache entry. *) module Update_result : sig @@ -30,7 +31,7 @@ module Update_result : sig end (** Perform an operation and update the result stored in the cache. *) -val update : 'a t -> Path.t -> Update_result.t +val update : 'a t -> Path.Outside_build_dir.t -> Update_result.t (** This module caches only a subset of fields of [Unix.stats] because other fields are currently unused. diff --git a/duniverse/dune_/src/dune_engine/fs_memo.ml b/duniverse/dune_/src/dune_engine/fs_memo.ml index 5f199ac52..52acaf409 100644 --- a/duniverse/dune_/src/dune_engine/fs_memo.ml +++ b/duniverse/dune_/src/dune_engine/fs_memo.ml @@ -13,15 +13,16 @@ module Watcher : sig directly if there is no parent. This is an optimisation that allows us to reduce the number of watched paths: typically, the number of directories is a lot smaller than the number of files. *) - val watch : try_to_watch_via_parent:bool -> Path.t -> unit Memo.t + val watch : + try_to_watch_via_parent:bool -> Path.Outside_build_dir.t -> unit Memo.t (* Invalidate a path after receiving an event from the file watcher. *) - val invalidate : Path.t -> Memo.Invalidation.t + val invalidate : Path.Outside_build_dir.t -> Memo.Invalidation.t end = struct (* A record of a call to [watch] made while the file watcher was missing. *) type watch_record = - { accessed_path : Path.t - ; path_to_watch : Path.t + { accessed_path : Path.Outside_build_dir.t + ; path_to_watch : Path.Outside_build_dir.t } (* CR-someday amokhov: We should try to simplify the initialisation of the @@ -97,6 +98,7 @@ end = struct ({ accessed_path; path_to_watch } :: watch_records) | No_file_watcher -> () | File_watcher dune_file_watcher -> + let path_to_watch = Path.outside_build_dir path_to_watch in watch_path dune_file_watcher path_to_watch (* This comment applies to both memoization tables below. @@ -108,32 +110,32 @@ end = struct on every computation is sometimes necessary. *) let memo_for_watching_directly = Memo.create "fs_memo_for_watching_directly" - ~input:(module Path) + ~input:(module Path.Outside_build_dir) (fun accessed_path -> watch_or_record_path ~accessed_path ~path_to_watch:accessed_path; Memo.return ()) let memo_for_watching_via_parent = Memo.create "fs_memo_for_watching_via_parent" - ~input:(module Path) + ~input:(module Path.Outside_build_dir) (fun accessed_path -> let path_to_watch = - Option.value (Path.parent accessed_path) ~default:accessed_path + Option.value + (Path.Outside_build_dir.parent accessed_path) + ~default:accessed_path in watch_or_record_path ~accessed_path ~path_to_watch; Memo.return ()) let watch ~try_to_watch_via_parent path = - if Path.is_in_build_dir path then - Code_error.raise "Fs_memo.Watcher.watch called on a build path" - [ ("path", Path.to_dyn path) ]; match try_to_watch_via_parent with | false -> Memo.exec memo_for_watching_directly path | true -> Memo.exec memo_for_watching_via_parent path - module Update_all = Monoid.Function (Path) (Fs_cache.Update_result) + module Update_all = + Monoid.Function (Path.Outside_build_dir) (Fs_cache.Update_result) - let update_all : Path.t -> Fs_cache.Update_result.t = + let update_all : Path.Outside_build_dir.t -> Fs_cache.Update_result.t = let update t path = let result = Fs_cache.update t path in if !Clflags.debug_fs_cache then @@ -141,16 +143,20 @@ end = struct (User_message.make [ Pp.hbox (Pp.textf "Updating %s cache for %S: %s" - (Fs_cache.Debug.name t) (Path.to_string path) + (Fs_cache.Debug.name t) + (Path.Outside_build_dir.to_string path) (Dyn.to_string (Fs_cache.Update_result.to_dyn result))) ]); result in - Update_all.reduce - [ update Fs_cache.Untracked.path_stat - ; update Fs_cache.Untracked.file_digest - ; update Fs_cache.Untracked.dir_contents - ] + fun p -> + let all = + [ update Fs_cache.Untracked.path_stat + ; update Fs_cache.Untracked.file_digest + ; update Fs_cache.Untracked.dir_contents + ] + in + Update_all.reduce all p (* CR-someday amokhov: We share Memo tables for tracking different file-system operations. This saves some memory, but leads to recomputing more memoized @@ -161,13 +167,16 @@ end = struct match update_all path with | Skipped | Updated { changed = false } -> Memo.Invalidation.empty | Updated { changed = true } -> + let reason : Memo.Invalidation.Reason.t = + Path_changed (Path.outside_build_dir path) + in Memo.Invalidation.combine (Memo.Cell.invalidate (Memo.cell memo_for_watching_directly path) - ~reason:(Path_changed path)) + ~reason) (Memo.Cell.invalidate (Memo.cell memo_for_watching_via_parent path) - ~reason:(Path_changed path)) + ~reason) let init ~dune_file_watcher = match !state with @@ -196,6 +205,7 @@ end = struct state := File_watcher watcher; Memo.Invalidation.map_reduce watch_records ~f:(fun { accessed_path; path_to_watch } -> + let path_to_watch = Path.outside_build_dir path_to_watch in watch_path watcher path_to_watch; invalidate accessed_path)) end @@ -270,7 +280,8 @@ let dir_exists path = of [file_digest] seems error-prone. We may need to rethink this decision. *) let file_digest ?(force_update = false) path = if force_update then ( - Cached_digest.Untracked.invalidate_cached_timestamp path; + Cached_digest.Untracked.invalidate_cached_timestamp + (Path.outside_build_dir path); Fs_cache.evict Fs_cache.Untracked.file_digest path); let+ () = Watcher.watch ~try_to_watch_via_parent:true path in Fs_cache.read Fs_cache.Untracked.file_digest path @@ -296,17 +307,17 @@ let tracking_file_digest path = let with_lexbuf_from_file path ~f = let+ () = tracking_file_digest path in - Io.Untracked.with_lexbuf_from_file path ~f + Io.Untracked.with_lexbuf_from_file (Path.outside_build_dir path) ~f let file_contents path = let+ () = tracking_file_digest path in - Io.read_file path + Io.read_file (Path.outside_build_dir path) (* When a file or directory is created or deleted, we need to also invalidate the parent directory, so that the [dir_contents] queries are re-executed. *) let invalidate_path_and_its_parent path = Memo.Invalidation.combine (Watcher.invalidate path) - (match Path.parent path with + (match Path.Outside_build_dir.parent path with | None -> Memo.Invalidation.empty | Some path -> Watcher.invalidate path) @@ -326,6 +337,7 @@ let invalidate_path_and_its_parent path = directory should be added to or removed from the result. *) let handle_fs_event ({ kind; path } : Dune_file_watcher.Fs_memo_event.t) : Memo.Invalidation.t = + let path = Path.as_outside_build_dir_exn path in match kind with | File_changed -> Watcher.invalidate path | Created | Deleted | Unknown -> invalidate_path_and_its_parent path diff --git a/duniverse/dune_/src/dune_engine/fs_memo.mli b/duniverse/dune_/src/dune_engine/fs_memo.mli index f357e0bdf..9598af29c 100644 --- a/duniverse/dune_/src/dune_engine/fs_memo.mli +++ b/duniverse/dune_/src/dune_engine/fs_memo.mli @@ -4,24 +4,24 @@ open Import to be invalidated because they were accessed before [init] was called. *) val init : dune_file_watcher:Dune_file_watcher.t option -> Memo.Invalidation.t -(** All functions in this module raise a code error when given a path in the - build directory. *) - (** Check if a source or external file exists and declare a dependency on it. *) -val file_exists : Path.t -> bool Memo.t +val file_exists : Path.Outside_build_dir.t -> bool Memo.t (** Check if a source or external directory exists and declare a dependency on it. *) -val dir_exists : Path.t -> bool Memo.t +val dir_exists : Path.Outside_build_dir.t -> bool Memo.t -val is_directory : Path.t -> (bool, Unix_error.Detailed.t) result Memo.t +val is_directory : + Path.Outside_build_dir.t -> (bool, Unix_error.Detailed.t) result Memo.t (** Call [Path.stat] on a path and declare a dependency on it. *) val path_stat : - Path.t -> (Fs_cache.Reduced_stats.t, Unix_error.Detailed.t) result Memo.t + Path.Outside_build_dir.t + -> (Fs_cache.Reduced_stats.t, Unix_error.Detailed.t) result Memo.t (** Like [path_stat] but extracts the [st_kind] field from the result. *) -val path_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t +val path_kind : + Path.Outside_build_dir.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t (** Digest the contents of a source or external file and declare a dependency on it. When [force_update = true], evict the file from all digest caches and @@ -30,13 +30,16 @@ val path_kind : Path.t -> (File_kind.t, Unix_error.Detailed.t) result Memo.t is about to be invalidated by an incoming file-system event. By not using the cache in this situation, it's possible to avoid unnecessary restarts. *) val file_digest : - ?force_update:bool -> Path.t -> Cached_digest.Digest_result.t Memo.t + ?force_update:bool + -> Path.Outside_build_dir.t + -> Cached_digest.Digest_result.t Memo.t (** Like [Io.Untracked.with_lexbuf_from_file] but declares a dependency on the path. *) -val with_lexbuf_from_file : Path.t -> f:(Lexing.lexbuf -> 'a) -> 'a Memo.t +val with_lexbuf_from_file : + Path.Outside_build_dir.t -> f:(Lexing.lexbuf -> 'a) -> 'a Memo.t -val file_contents : Path.t -> string Memo.t +val file_contents : Path.Outside_build_dir.t -> string Memo.t (** Read the contents of a source or external directory and declare a dependency on it. When [force_update = true], evict the directory from the file-system @@ -47,7 +50,7 @@ val file_contents : Path.t -> string Memo.t restarts. *) val dir_contents : ?force_update:bool - -> Path.t + -> Path.Outside_build_dir.t -> (Fs_cache.Dir_contents.t, Unix_error.Detailed.t) result Memo.t (** Handle file system event. *) diff --git a/duniverse/dune_/src/dune_engine/import.ml b/duniverse/dune_/src/dune_engine/import.ml index c8cffeaf4..95d73e5da 100644 --- a/duniverse/dune_/src/dune_engine/import.ml +++ b/duniverse/dune_/src/dune_engine/import.ml @@ -1,4 +1,7 @@ include Stdune +module Digest = Dune_digest +module Console = Dune_console +module Metrics = Dune_metrics module Log = Dune_util.Log module Re = Dune_re module Stringlike = Dune_util.Stringlike diff --git a/duniverse/dune_/src/dune_engine/include_stanza.ml b/duniverse/dune_/src/dune_engine/include_stanza.ml index 9db828e65..99bcef91a 100644 --- a/duniverse/dune_/src/dune_engine/include_stanza.ml +++ b/duniverse/dune_/src/dune_engine/include_stanza.ml @@ -36,7 +36,7 @@ let load_sexps ~context:{ current_file; include_stack } (loc, fn) = let dir = Path.Source.parent_exn current_file in let current_file = Path.Source.relative dir fn in let open Memo.O in - let* exists = Fs_memo.file_exists (Path.source current_file) in + let* exists = Fs_memo.file_exists (In_source_dir current_file) in if not exists then User_error.raise ~loc [ Pp.textf "File %s doesn't exist." @@ -47,7 +47,7 @@ let load_sexps ~context:{ current_file; include_stack } (loc, fn) = Path.Source.equal f current_file) then error { current_file; include_stack }; let+ sexps = - Path.source current_file - |> Fs_memo.with_lexbuf_from_file ~f:(Dune_lang.Parser.parse ~mode:Many) + Fs_memo.with_lexbuf_from_file (In_source_dir current_file) + ~f:(Dune_lang.Parser.parse ~mode:Many) in (sexps, { current_file; include_stack }) diff --git a/duniverse/dune_/src/dune_engine/load_rules.ml b/duniverse/dune_/src/dune_engine/load_rules.ml index 14ef5e0c2..685eebe79 100644 --- a/duniverse/dune_/src/dune_engine/load_rules.ml +++ b/duniverse/dune_/src/dune_engine/load_rules.ml @@ -82,7 +82,7 @@ let get_dir_triage ~dir = Dir_triage.Known (Source { files }) | External dir_ext -> let+ files = - Fs_memo.dir_contents dir >>| function + Fs_memo.dir_contents (External dir_ext) >>| function | Error (Unix.ENOENT, _, _) -> Path.External.Set.empty | Error unix_error -> User_warning.emit @@ -279,11 +279,12 @@ let no_rule_found ~loc fn = [ ("fn", Path.Build.to_dyn fn) ] let source_or_external_file_digest path = - assert (not (Path.is_in_build_dir path)); let report_user_error details = let+ loc = Current_rule_loc.get () in User_error.raise ?loc - ([ Pp.textf "File unavailable: %s" (Path.to_string_maybe_quoted path) ] + ([ Pp.textf "File unavailable: %s" + (Path.Outside_build_dir.to_string_maybe_quoted path) + ] @ details) in Fs_memo.file_digest path >>= function @@ -302,10 +303,11 @@ let source_or_external_file_digest path = let eval_source_file : type a. a Action_builder.eval_mode -> Path.t -> a Memo.t = fun mode path -> + let path_outside_build_dir = Path.as_outside_build_dir_exn path in match mode with | Lazy -> Memo.return () | Eager -> - let+ d = source_or_external_file_digest path in + let+ d = source_or_external_file_digest path_outside_build_dir in Dep.Fact.file path d module rec Load_rules : sig @@ -576,7 +578,7 @@ end = struct match Dir_triage.Build_directory.parent d with | None -> Code_error.raise - "[gen_rules] returned Redirect_to_parent on a root direcoty" + "[gen_rules] returned Redirect_to_parent on a root directory" [ ( "context_or_install" , Context_or_install.to_dyn context_or_install ) ] @@ -630,37 +632,6 @@ end = struct && Subdir_set.mem build_dir_only_sub_dirs name then report_rule_internal_dir_conflict name loc); let* rules_produced = Memo.Lazy.force rules in - let () = - let real_directory_targets = Rules.directory_targets rules_produced in - if - not - (Path.Build.Map.equal real_directory_targets directory_targets - ~equal:(fun _ _ -> - (* The locations should match if the declration knows which - rule will generate the directory, but it it's not necessary - as the rule's actual location has higher priority. *) - true)) - then - let mismatched_directories = - let error message loc = - Dyn.record - [ ("message", Dyn.string message); ("loc", Loc.to_dyn_hum loc) ] - in - Path.Build.Map.merge real_directory_targets directory_targets - ~f:(fun _ generated declared -> - match (generated, declared) with - | None, None | Some _, Some _ -> None - | Some loc, None -> Some (error "not declared" loc) - | None, Some loc -> Some (error "not generated" loc)) - in - Code_error.raise - "gen_rules returned a set of directory targets that doesn't match \ - the set of directory targets from returned rules" - [ ("dir", Path.Build.to_dyn dir) - ; ( "mismatched_directories" - , Path.Build.Map.to_dyn Fun.id mismatched_directories ) - ] - in let rules = let dir = Path.build dir in Rules.find rules_produced dir @@ -813,6 +784,37 @@ end = struct in let subdirs_to_keep = Subdir_set.of_dir_set descendants_to_keep in let rules_here = compile_rules ~dir ~source_dirs rules in + let () = + let real_directory_targets = Rules.directory_targets rules_produced in + if + not + (Path.Build.Map.equal real_directory_targets directory_targets + ~equal:(fun _ _ -> + (* The locations should match if the declaration knows which + rule will generate the directory, but it's not necessary + as the rule's actual location has higher priority. *) + true)) + then + let mismatched_directories = + let error message loc = + Dyn.record + [ ("message", Dyn.string message); ("loc", Loc.to_dyn_hum loc) ] + in + Path.Build.Map.merge real_directory_targets directory_targets + ~f:(fun _ generated declared -> + match (generated, declared) with + | None, None | Some _, Some _ -> None + | Some loc, None -> Some (error "not declared" loc) + | None, Some loc -> Some (error "not generated" loc)) + in + Code_error.raise + "gen_rules returned a set of directory targets that doesn't match \ + the set of directory targets from returned rules" + [ ("dir", Path.Build.to_dyn dir) + ; ( "mismatched_directories" + , Path.Build.Map.to_dyn Fun.id mismatched_directories ) + ] + in remove_old_artifacts ~dir ~rules_here ~subdirs_to_keep; remove_old_sub_dirs_in_anonymous_actions_dir ~dir: @@ -830,6 +832,10 @@ end = struct { Loaded.allowed_subdirs = descendants_to_keep; rules_here; aliases } let load_dir_impl ~dir : Loaded.t Memo.t = + if !Clflags.debug_load_dir then + Console.print_user_message + (User_message.make + [ Pp.textf "Loading build directory %s" (Path.to_string dir) ]); get_dir_triage ~dir >>= function | Known l -> Memo.return l | Build_directory x -> load_build_directory_exn x @@ -882,17 +888,16 @@ type rule_or_source = | Rule of Path.Build.t * Rule.t let get_rule_or_source path = - let dir = Path.parent_exn path in - if Path.is_strict_descendant_of_build_dir dir then - let path = Path.as_in_build_dir_exn path in + match Path.destruct_build_dir path with + | `Outside path -> + let+ d = source_or_external_file_digest path in + Source d + | `Inside path -> ( get_rule_internal path >>= function | Some rule -> Memo.return (Rule (path, rule)) | None -> let* loc = Current_rule_loc.get () in - no_rule_found ~loc path - else - let+ d = source_or_external_file_digest path in - Source d + no_rule_found ~loc path) type target_type = | File diff --git a/duniverse/dune_/src/dune_engine/package.ml b/duniverse/dune_/src/dune_engine/package.ml index 68846d8cf..0720e58cb 100644 --- a/duniverse/dune_/src/dune_engine/package.ml +++ b/duniverse/dune_/src/dune_engine/package.ml @@ -498,10 +498,14 @@ module Info = struct (Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> repeat string) and+ license = field_o "license" - (Dune_lang.Syntax.since Stanza.syntax (v (3, 2)) - >>> repeat1 string - <|> ( Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) >>> string - >>| fun s -> [ s ] )) + (Dune_lang.Syntax.since Stanza.syntax (v (1, 9)) + >>> let* l = repeat1 string in + (if List.length l > 1 then + Dune_lang.Syntax.since ~what:"Parsing several licenses" + Stanza.syntax + (v (3, 2)) + else return ()) + >>> return l) and+ homepage = field_o "homepage" (Dune_lang.Syntax.since Stanza.syntax (v (1, 10)) >>> string) @@ -733,10 +737,9 @@ let load_opam_file file name = let open Memo.O in let+ opam = let+ opam = - Path.source file - |> Fs_memo.with_lexbuf_from_file ~f:(fun lexbuf -> - try Ok (Opam_file.parse lexbuf) - with User_error.E _ as exn -> Error exn) + Fs_memo.with_lexbuf_from_file (In_source_dir file) ~f:(fun lexbuf -> + try Ok (Opam_file.parse lexbuf) + with User_error.E _ as exn -> Error exn) in match opam with | Ok s -> Some s diff --git a/duniverse/dune_/src/dune_engine/print_diff.ml b/duniverse/dune_/src/dune_engine/print_diff.ml index 82d069297..49d9bd71d 100644 --- a/duniverse/dune_/src/dune_engine/print_diff.ml +++ b/duniverse/dune_/src/dune_engine/print_diff.ml @@ -15,7 +15,64 @@ let resolve_link_for_git path = User_error.raise [ Pp.textf "Unable to resolve symlink %s" (Path.to_string path) ] -let print ?(skip_trailing_cr = Sys.win32) annots path1 path2 = +module Diff = struct + type t = + { loc : Loc.t option + ; output : string + } + + let print { loc; output } = + Option.iter loc ~f:(fun loc -> + Loc.pp loc |> Pp.map_tags ~f:(fun Loc.Loc -> []) |> Ansi_color.print); + print_string output +end + +type command = + { dir : Path.t + ; metadata : Process.metadata + ; prog : Path.t + ; args : string list + } + +module With_fallback : sig + type t + + val fail : User_message.t -> t + + val run : command -> fallback:t -> t + + val exec : t -> _ Fiber.t + + val capture : t -> (Diff.t, User_message.t) result Fiber.t +end = struct + type t = + { commands : command list + ; error : User_message.t + } + + let run command ~fallback:{ commands; error } = + { commands = command :: commands; error } + + let fail error = { commands = []; error } + + let rec exec = function + | { commands = []; error } -> raise (User_error.E error) + | { commands = { dir; metadata; prog; args } :: commands; error } -> + let* () = Process.run ~dir ~env:Env.initial Strict prog args ~metadata in + exec { commands; error } + + let rec capture = function + | { commands = []; error } -> Fiber.return (Error error) + | { commands = { dir; metadata; prog; args } :: commands; error } -> ( + let* output, code = + Process.run_capture ~dir ~env:Env.initial Return prog args ~metadata + in + match code with + | 1 -> Fiber.return (Ok { Diff.output; loc = metadata.loc }) + | _ -> capture { commands; error }) +end + +let prepare ~skip_trailing_cr annots path1 path2 = let dir, file1, file2 = match ( Path.extract_build_context_dir_maybe_sandboxed path1 @@ -26,22 +83,25 @@ let print ?(skip_trailing_cr = Sys.win32) annots path1 path2 = | _ -> (Path.root, path1, path2) in let loc = Loc.in_file file1 in - let run_process ?(dir = dir) + let run ?(dir = dir) ?(metadata = Process.create_metadata ~purpose:Internal_job ~loc ~annots ()) prog args - = - Process.run ~dir ~env:Env.initial Strict prog args ~metadata + ~fallback = + With_fallback.run { dir; prog; args; metadata } ~fallback in let file1, file2 = Path.(to_string file1, to_string file2) in - let fallback () = - User_error.raise ~loc ~annots - [ Pp.textf "Files %s and %s differ." - (Path.to_string_maybe_quoted (Path.drop_optional_sandbox_root path1)) - (Path.to_string_maybe_quoted (Path.drop_optional_sandbox_root path2)) - ] + let fallback = + With_fallback.fail + (User_error.make ~loc ~annots + [ Pp.textf "Files %s and %s differ." + (Path.to_string_maybe_quoted + (Path.drop_optional_sandbox_root path1)) + (Path.to_string_maybe_quoted + (Path.drop_optional_sandbox_root path2)) + ]) in let normal_diff () = - let dir, path, args, skip_trailing_cr_arg, files = + let diff = let which prog = Bin.which ~path:(Env.path Env.initial) prog in match which "git" with | Some path -> @@ -52,28 +112,31 @@ let print ?(skip_trailing_cr = Sys.win32) annots path1 path2 = can run this fake [.git] file. *) Path.root in - ( dir - , path - , [ "--no-pager"; "diff"; "--no-index"; "--color=always"; "-u" ] - , "--ignore-cr-at-eol" - , List.map - ~f:(fun path -> resolve_link_for_git path |> Path.reach ~from:dir) - [ path1; path2 ] ) + Some + ( dir + , path + , [ "--no-pager"; "diff"; "--no-index"; "--color=always"; "-u" ] + , "--ignore-cr-at-eol" + , List.map + ~f:(fun path -> resolve_link_for_git path |> Path.reach ~from:dir) + [ path1; path2 ] ) | None -> ( match which "diff" with | Some path -> - (dir, path, [ "-u" ], "--strip-trailing-cr", [ file1; file2 ]) - | None -> fallback ()) + Some (dir, path, [ "-u" ], "--strip-trailing-cr", [ file1; file2 ]) + | None -> None) in - let args = - if skip_trailing_cr then args @ [ skip_trailing_cr_arg ] else args - in - let args = args @ files in - let* () = run_process ~dir path args in - fallback () + match diff with + | None -> fallback + | Some (dir, path, args, skip_trailing_cr_arg, files) -> + let args = + if skip_trailing_cr then args @ [ skip_trailing_cr_arg ] else args + in + let args = args @ files in + run ~dir path args ~fallback in match !Clflags.diff_command with - | Some "-" -> fallback () + | Some "-" -> fallback | Some cmd -> let sh, arg = Utils.system_shell_exn ~needed_to:"print diffs" in let cmd = @@ -81,40 +144,49 @@ let print ?(skip_trailing_cr = Sys.win32) annots path1 path2 = (String.quote_for_shell file1) (String.quote_for_shell file2) in - let* () = run_process sh [ arg; cmd ] in - User_error.raise ~loc ~annots - [ Pp.textf "command reported no differences: %s" - (if Path.is_root dir then cmd - else - sprintf "cd %s && %s" - (String.quote_for_shell (Path.to_string dir)) - cmd) - ] + run sh [ arg; cmd ] + ~fallback: + (With_fallback.fail + (User_error.make ~loc ~annots + [ Pp.textf "command reported no differences: %s" + (if Path.is_root dir then cmd + else + sprintf "cd %s && %s" + (String.quote_for_shell (Path.to_string dir)) + cmd) + ])) | None -> ( - if Config.inside_dune then fallback () + if Config.inside_dune then fallback else match Bin.which ~path:(Env.path Env.initial) "patdiff" with | None -> normal_diff () | Some prog -> - let* () = - run_process prog - ([ "-keep-whitespace"; "-location-style"; "omake" ] - @ (if Lazy.force Ansi_color.stderr_supports_color then [] - else [ "-ascii" ]) - @ [ file1; file2 ]) - ~metadata: - ((* Because of the [-location-style omake], patdiff will print the - location of each hunk in a format that the editor should - understand. However, the location won't be the first line of - the output, so the [process] module won't recognise that the - output has a location. - - For this reason, we manually pass the below annotation. *) - Process.create_metadata ~purpose:Internal_job ~loc - ~annots: - (User_message.Annots.set annots - User_message.Annots.has_embedded_location ()) - ()) - in - (* Use "diff" if "patdiff" reported no differences *) - normal_diff ()) + run prog + ([ "-keep-whitespace"; "-location-style"; "omake" ] + @ (if Lazy.force Ansi_color.stderr_supports_color then [] + else [ "-ascii" ]) + @ [ file1; file2 ]) + ~metadata: + ((* Because of the [-location-style omake], patdiff will print the + location of each hunk in a format that the editor should + understand. However, the location won't be the first line of + the output, so the [process] module won't recognise that the + output has a location. + + For this reason, we manually pass the below annotation. *) + Process.create_metadata ~purpose:Internal_job ~loc + ~annots: + (User_message.Annots.set annots + User_message.Annots.has_embedded_location ()) + ()) + ~fallback: + ((* Use "diff" if "patdiff" reported no differences *) + normal_diff ())) + +let print ?(skip_trailing_cr = Sys.win32) annots path1 path2 = + let p = prepare ~skip_trailing_cr annots path1 path2 in + With_fallback.exec p + +let get ?(skip_trailing_cr = Sys.win32) annots path1 path2 = + let p = prepare ~skip_trailing_cr annots path1 path2 in + With_fallback.capture p diff --git a/duniverse/dune_/src/dune_engine/print_diff.mli b/duniverse/dune_/src/dune_engine/print_diff.mli index 72dd45262..31da9fa76 100644 --- a/duniverse/dune_/src/dune_engine/print_diff.mli +++ b/duniverse/dune_/src/dune_engine/print_diff.mli @@ -7,3 +7,16 @@ val print : -> Path.t -> Path.t -> _ Fiber.t + +module Diff : sig + type t + + val print : t -> unit +end + +val get : + ?skip_trailing_cr:bool + -> User_message.Annots.t + -> Path.t + -> Path.t + -> (Diff.t, User_message.t) result Fiber.t diff --git a/duniverse/dune_/src/dune_engine/process.ml b/duniverse/dune_/src/dune_engine/process.ml index 73e1fec55..ecec4cac3 100644 --- a/duniverse/dune_/src/dune_engine/process.ml +++ b/duniverse/dune_/src/dune_engine/process.ml @@ -11,10 +11,12 @@ let with_directory_annot = type ('a, 'b) failure_mode = | Strict : ('a, 'a) failure_mode | Accept : int Predicate.t -> ('a, ('a, int) result) failure_mode + | Return : ('a, 'a * int) failure_mode let accepted_codes : type a b. (a, b) failure_mode -> int -> bool = function | Strict -> Int.equal 0 | Accept exit_codes -> fun i -> Predicate.test exit_codes i + | Return -> fun _ -> true let map_result : type a b. (a, b) failure_mode -> int -> f:(unit -> a) -> b = fun mode t ~f -> @@ -24,6 +26,7 @@ let map_result : type a b. (a, b) failure_mode -> int -> f:(unit -> a) -> b = match t with | 0 -> Ok (f ()) | n -> Error n) + | Return -> (f (), t) module Io = struct type input = Input @@ -591,7 +594,9 @@ let report_process_start stats ~metadata ~id ~pid ~prog ~args ~now = ; ("pid", `Int (Pid.to_int pid)) ] in - let event = Event.async (Int id) ~args Start common in + let event = + Event.async (Chrome_trace.Id.create (`Int id)) ~args Start common + in Dune_stats.emit stats event; (common, args) diff --git a/duniverse/dune_/src/dune_engine/process.mli b/duniverse/dune_/src/dune_engine/process.mli index 8d9ada83c..a0f067efe 100644 --- a/duniverse/dune_/src/dune_engine/process.mli +++ b/duniverse/dune_/src/dune_engine/process.mli @@ -11,6 +11,8 @@ type ('a, 'b) failure_mode = | Accept : int Predicate.t -> ('a, ('a, int) result) failure_mode (** Accept the following non-zero exit codes, and return [Error code] if the process exists with one of these codes. *) + | Return : ('a, 'a * int) failure_mode + (** Accept any error code and return it. *) module Io : sig (** Where to redirect stdout/stderr/stdin *) diff --git a/duniverse/dune_/src/dune_engine/rpc.ml b/duniverse/dune_/src/dune_engine/rpc.ml new file mode 100644 index 000000000..4472fd623 --- /dev/null +++ b/duniverse/dune_/src/dune_engine/rpc.ml @@ -0,0 +1,49 @@ +open Import +open Fiber.O + +type server = + { run : unit Fiber.t + ; stop : unit Fiber.t + ; ready : unit Fiber.t + } + +type t = + { server : server + ; pool : Fiber.Pool.t + ; mutable state : [ `Awaiting_start | `Running | `Stopped ] + } + +let t = Fiber.Var.create () + +let stop ({ state; server; pool } as t) = + let* () = Fiber.return () in + match state with + | `Stopped -> Fiber.return () + | `Awaiting_start -> Fiber.Pool.stop pool + | `Running -> + t.state <- `Stopped; + Fiber.fork_and_join_unit + (fun () -> Fiber.Pool.stop pool) + (fun () -> server.stop) + +let with_background_rpc server f = + let pool = Fiber.Pool.create () in + let v = { state = `Awaiting_start; server; pool } in + Fiber.Var.set t v (fun () -> + Fiber.fork_and_join_unit + (fun () -> Fiber.Pool.run pool) + (fun () -> Fiber.finalize f ~finally:(fun () -> stop v))) + +let ensure_ready () = + let* ({ state; server; pool } as t) = Fiber.Var.get_exn t in + match state with + | `Stopped -> Code_error.raise "server already stopped" [] + | `Running -> Fiber.return () + | `Awaiting_start -> + t.state <- `Running; + let* () = Fiber.Pool.task pool ~f:(fun () -> server.run) in + server.ready + +let stop () = + let* t = Fiber.Var.get_exn t in + stop t diff --git a/duniverse/dune_/src/dune_engine/rpc.mli b/duniverse/dune_/src/dune_engine/rpc.mli new file mode 100644 index 000000000..b39ef44a3 --- /dev/null +++ b/duniverse/dune_/src/dune_engine/rpc.mli @@ -0,0 +1,11 @@ +type server = + { run : unit Fiber.t + ; stop : unit Fiber.t + ; ready : unit Fiber.t + } + +val with_background_rpc : server -> (unit -> 'a Fiber.t) -> 'a Fiber.t + +val ensure_ready : unit -> unit Fiber.t + +val stop : unit -> unit Fiber.t diff --git a/duniverse/dune_/src/dune_engine/rule.ml b/duniverse/dune_/src/dune_engine/rule.ml index e8eb2b256..87eea8dde 100644 --- a/duniverse/dune_/src/dune_engine/rule.ml +++ b/duniverse/dune_/src/dune_engine/rule.ml @@ -95,8 +95,10 @@ let make ?(mode = Mode.Standard) ~context ?(info = Info.Internal) ~targets | Valid { parent_dir; targets } -> (parent_dir, targets) | No_targets -> report_error "Rule has no targets specified" | Inconsistent_parent_dir -> - report_error "Rule has targets in different directories." - ~extra_pp:[ Pp.text "Targets:"; Targets.pp targets ] + (* user written actions have their own validation step that also works + with the target inference mechanism *) + Code_error.raise "Rule has targets in different directories." + [ ("targets", Targets.to_dyn targets) ] | File_and_directory_target_with_the_same_name path -> report_error (sprintf "%S is declared as both a file and a directory target." diff --git a/duniverse/dune_/src/dune_engine/rule.mli b/duniverse/dune_/src/dune_engine/rule.mli index 269a02039..1adda243b 100644 --- a/duniverse/dune_/src/dune_engine/rule.mli +++ b/duniverse/dune_/src/dune_engine/rule.mli @@ -16,8 +16,8 @@ end module Promote : sig module Lifetime : sig type t = - | Unlimited (** The promoted file will be deleted by [dune clean] *) - | Until_clean + | Unlimited + | Until_clean (** The promoted file will be deleted by [dune clean] *) end module Into : sig @@ -62,7 +62,7 @@ type t = private ; mode : Mode.t ; info : Info.t ; loc : Loc.t - ; (* Directory where all the targets are produced. *) dir : Path.Build.t + ; dir : Path.Build.t (** Directory where all the targets are produced. *) } include Comparable_intf.S with type key := t diff --git a/duniverse/dune_/src/dune_engine/rule_cache.ml b/duniverse/dune_/src/dune_engine/rule_cache.ml index f2005f5bd..b2881deae 100644 --- a/duniverse/dune_/src/dune_engine/rule_cache.ml +++ b/duniverse/dune_/src/dune_engine/rule_cache.ml @@ -122,7 +122,7 @@ module Workspace_local = struct let compute_target_digests (targets : Targets.Validated.t) : (Digest.t Targets.Produced.t, Miss_reason.t) Result.t = match Targets.Produced.of_validated targets with - | Error unix_error -> + | Error (_, unix_error) -> Miss (Error_while_collecting_directory_targets unix_error) | Ok targets -> ( match @@ -331,7 +331,7 @@ module Shared = struct Log.info [ Pp.textf "cache store skipped [%s]: already present" hex ]; update_cached_digests ~targets_and_digests | Error (Unix.Unix_error (Unix.EXDEV, "link", file)) -> - (* We cannot hardlink accross partitions so we kindly let the user know + (* We cannot hardlink across partitions so we kindly let the user know that they should use copy cache instead. *) Log.info [ Pp.concat @@ -378,7 +378,6 @@ module Shared = struct | None -> ( let missing, errors = let process_target target (missing, errors) = - let expected_syscall_path = Path.to_string (Path.build target) in match compute_digest target with | Ok (_ : Digest.t) -> (missing, errors) | No_such_file -> (target :: missing, errors) @@ -401,13 +400,17 @@ module Shared = struct (missing, (target, Unix_error.Detailed.pp unix_error) :: errors) | Error exn -> let error = - match exn with - | Sys_error msg -> - Pp.verbatim - (String.drop_prefix_if_exists - ~prefix:(expected_syscall_path ^ ": ") - msg) - | exn -> Pp.verbatim (Printexc.to_string exn) + Pp.verbatim + (match exn with + | Sys_error msg -> + let prefix = + let expected_syscall_path = + Path.to_string (Path.build target) + in + expected_syscall_path ^ ": " + in + String.drop_prefix_if_exists ~prefix msg + | exn -> Printexc.to_string exn) in (missing, (target, error) :: errors) in diff --git a/duniverse/dune_/src/dune_engine/rules.mli b/duniverse/dune_/src/dune_engine/rules.mli index 41681fb9e..623d881ed 100644 --- a/duniverse/dune_/src/dune_engine/rules.mli +++ b/duniverse/dune_/src/dune_engine/rules.mli @@ -116,6 +116,6 @@ val find : t -> Path.t -> Dir_rules.t (** [prefix_rules prefix ~f] adds [prefix] to all the rules generated by [f] *) val prefix_rules : unit Action_builder.t -> f:(unit -> 'a Memo.t) -> 'a Memo.t -(** [directory_targets t] returns all the directory tagets generated by [t]. The - locations are of the rules that introduce these targets *) +(** [directory_targets t] returns all the directory targets generated by [t]. + The locations are of the rules that introduce these targets *) val directory_targets : t -> Loc.t Path.Build.Map.t diff --git a/duniverse/dune_/src/dune_engine/sandbox.ml b/duniverse/dune_/src/dune_engine/sandbox.ml index 1c513c9dd..9d65d2015 100644 --- a/duniverse/dune_/src/dune_engine/sandbox.ml +++ b/duniverse/dune_/src/dune_engine/sandbox.ml @@ -13,7 +13,7 @@ let init = Io.write_file (Path.relative dir ".git") ""; (* We create a [.hg/requires] file to prevent hg from escaping the sandbox. It will complain that "Escaping the Dune sandbox" is an - unkown feature. *) + unknown feature. *) Io.write_file (Path.relative dir ".hg/requires") "Escaping the Dune sandbox") @@ -102,7 +102,15 @@ let snapshot t = in walk (Path.build t.dir) Path.Map.empty -let create ~mode ~rule_loc ~deps ~rule_dir ~rule_digest ~expand_aliases = +let create ~mode ~dune_stats ~rule_loc ~deps ~rule_dir ~rule_digest + ~expand_aliases = + let event = + Dune_stats.start dune_stats (fun () -> + let cat = Some [ "create-sandbox" ] in + let name = Loc.to_file_colon_line rule_loc in + let args = None in + { cat; name; args }) + in init (); let sandbox_suffix = rule_digest |> Digest.to_string in let sandbox_dir = Path.Build.relative sandbox_dir sandbox_suffix in @@ -116,6 +124,7 @@ let create ~mode ~rule_loc ~deps ~rule_dir ~rule_digest ~expand_aliases = (* CR-someday amokhov: Note that this doesn't link dynamic dependencies, so targets produced dynamically will be unavailable. *) link_deps t ~mode ~deps; + Dune_stats.finish event; match mode with | Patch_back_source_tree -> (* Only supported on Linux because we rely on the mtime changing to detect @@ -149,18 +158,10 @@ let rename_optional_file ~src ~dst = | exception Unix.Unix_error (ENOENT, _, _) -> () | () -> ()) -(* Recursively move regular files from [src] to [dst] and return the set of - moved files. *) -let rename_dir_recursively ~loc ~src_dir ~dst_dir = +(* Recursively collect regular files from [src] to [dst] and return the set of + of files collected. *) +let collect_dir_recursively ~loc ~src_dir ~dst_dir = let rec loop ~src_dir ~dst_dir = - (match Fpath.mkdir (Path.Build.to_string dst_dir) with - | Created -> () - | Already_exists -> - (* We clean up all targets (including directory targets) before running an - action, so this branch should be unreachable. *) - Code_error.raise "Stale directory target in the build directory" - [ ("dst_dir", Path.Build.to_dyn dst_dir) ] - | Missing_parent_directory -> assert false); match Dune_filesystem_stubs.read_directory_with_kinds (Path.Build.to_string src_dir) @@ -168,11 +169,10 @@ let rename_dir_recursively ~loc ~src_dir ~dst_dir = | Ok files -> List.map files ~f:(fun (file, kind) -> match (kind : File_kind.t) with - | S_REG -> - let src = Path.Build.relative src_dir file in - let dst = Path.Build.relative dst_dir file in - Unix.rename (Path.Build.to_string src) (Path.Build.to_string dst); - Appendable_list.singleton (dst_dir, file) + | S_LNK + (* TODO symlinks outside of the sandbox are going to be broken, + but users shouldn't be doing this anyway. *) + | S_REG -> Appendable_list.singleton (dst_dir, file) | S_DIR -> loop ~src_dir:(Path.Build.relative src_dir file) @@ -236,7 +236,15 @@ let move_targets_to_build_dir t ~loc ~should_be_skipped rename_optional_file ~src:(map_path t target) ~dst:target); let discovered_targets = Path.Build.Set.to_list_map targets.dirs ~f:(fun target -> - rename_dir_recursively ~loc ~src_dir:(map_path t target) ~dst_dir:target) + let src_dir = map_path t target in + let files = collect_dir_recursively ~loc ~src_dir ~dst_dir:target in + if Path.Untracked.exists (Path.build target) then + (* We clean up all targets (including directory targets) before running an + action, so this branch should be unreachable. *) + Code_error.raise "Stale directory target in the build directory" + [ ("dst_dir", Path.Build.to_dyn target) ]; + Path.rename (Path.build src_dir) (Path.build target); + files) |> Appendable_list.concat |> Appendable_list.to_list in Targets.Produced.expand_validated_exn targets discovered_targets diff --git a/duniverse/dune_/src/dune_engine/sandbox.mli b/duniverse/dune_/src/dune_engine/sandbox.mli index e22976333..637859c77 100644 --- a/duniverse/dune_/src/dune_engine/sandbox.mli +++ b/duniverse/dune_/src/dune_engine/sandbox.mli @@ -12,6 +12,7 @@ val map_path : t -> Path.Build.t -> Path.Build.t (** Create a new sandbox and copy or link dependencies inside it. *) val create : mode:Sandbox_mode.some + -> dune_stats:Dune_stats.t option -> rule_loc:Loc.t -> deps:Dep.Facts.t -> rule_dir:Path.Build.t diff --git a/duniverse/dune_/src/dune_engine/scheduler.ml b/duniverse/dune_/src/dune_engine/scheduler.ml index f805e00c0..38bd2aaf0 100644 --- a/duniverse/dune_/src/dune_engine/scheduler.ml +++ b/duniverse/dune_/src/dune_engine/scheduler.ml @@ -39,7 +39,7 @@ module Config = struct let console_backend t = match t.status_line with | false -> Console.Backend.dumb - | true -> Console.Backend.progress + | true -> Console.Backend.progress () end type t = @@ -140,6 +140,11 @@ end = struct in Thread.create f x + let () = + Fdecl.set Console.Backend.spawn_thread (fun f -> + let (_ : Thread.t) = create ~signal_watcher:`Yes f () in + ()) + let spawn ~signal_watcher f = let (_ : Thread.t) = create ~signal_watcher f () in () @@ -843,10 +848,10 @@ end = struct Mutex.unlock t.mutex end -(** All fields of [t] must be immutable. This is because we re-create [t] - everytime we start a new build to locally set the [cancel] field. However, - all instances of [t] must share all other fields, in particular the - references such as [status]. +(** All fields of [t] must be immutable. This is because we re-create [t] every + time we start a new build to locally set the [cancel] field. However, all + instances of [t] must share all other fields, in particular the references + such as [status]. Another option would be to split [t] in two records such as: @@ -888,6 +893,10 @@ let t_opt () = Fiber.Var.get t let t () = Fiber.Var.get_exn t +let stats () = + let+ t = t () in + t.config.stats + let running_jobs_count t = Event.Queue.pending_jobs t.events let yield_if_there_are_pending_events () = @@ -1399,10 +1408,6 @@ let sleep duration = (* cancellation mechanism isn't exposed to the user *) assert false -let flush_file_watcher () = - let* t = t () in - flush_file_watcher t - let wait_for_build_input_change () = let* t = t () in wait_for_build_input_change t diff --git a/duniverse/dune_/src/dune_engine/scheduler.mli b/duniverse/dune_/src/dune_engine/scheduler.mli index d2f7e8cd6..f00f72ac3 100644 --- a/duniverse/dune_/src/dune_engine/scheduler.mli +++ b/duniverse/dune_/src/dune_engine/scheduler.mli @@ -177,9 +177,7 @@ val inject_memo_invalidation : Memo.Invalidation.t -> unit Fiber.t this long. *) val sleep : float -> unit Fiber.t -(** Wait until all file system changes that happened so far have been - acknowledged by the scheduler. *) -val flush_file_watcher : unit -> unit Fiber.t +val stats : unit -> Dune_stats.t option Fiber.t (** Wait for a build input to change. If a build input change was seen but hasn't been handled yet, return immediately. diff --git a/duniverse/dune_/src/dune_engine/source_tree.ml b/duniverse/dune_/src/dune_engine/source_tree.ml index 4e3a0adcf..c8a678c06 100644 --- a/duniverse/dune_/src/dune_engine/source_tree.ml +++ b/duniverse/dune_/src/dune_engine/source_tree.ml @@ -27,8 +27,7 @@ module File = struct module Map = Map.Make (T) - let of_source_path p = - Fs_memo.path_stat (Path.source p) >>| Result.map ~f:of_stats + let of_source_path p = Fs_memo.path_stat p >>| Result.map ~f:of_stats end module Dune_file = struct @@ -94,9 +93,10 @@ module Dune_file = struct (Plain, plain) | true -> let* kind, ast = - Fs_memo.with_lexbuf_from_file (Path.source file) ~f:(fun lb -> + Fs_memo.with_lexbuf_from_file (In_source_dir file) ~f:(fun lb -> let kind, ast = - if Dune_lang.Dune_lexer.is_script lb then (Ocaml_script, []) + if Dune_lang.Dune_file_script.is_script lb then + (Ocaml_script, []) else (Plain, Dune_lang.Parser.parse lb ~mode:Many) in (kind, ast)) @@ -166,7 +166,7 @@ end = struct { t with files = String.Set.filter t.files ~f:(fun fn -> f t.path fn) } let of_source_path_impl path = - Fs_memo.dir_contents (Path.source path) >>= function + Fs_memo.dir_contents (In_source_dir path) >>= function | Error unix_error -> User_warning.emit [ Pp.textf "Unable to read directory %s. Ignoring." @@ -191,11 +191,11 @@ end = struct let+ is_directory, file = match kind with | S_DIR -> ( - File.of_source_path path >>| function + File.of_source_path (In_source_dir path) >>| function | Ok file -> (true, file) | Error _ -> (true, File.dummy)) | S_LNK -> ( - Fs_memo.path_stat (Path.source path) >>| function + Fs_memo.path_stat (In_source_dir path) >>| function | Ok ({ st_kind = S_DIR; _ } as st) -> (true, File.of_stats st) | Ok _ | Error _ -> (false, File.dummy)) | _ -> Memo.return (false, File.dummy) @@ -489,7 +489,8 @@ end = struct (fun (`Is_error is_error, project) -> let open Memo.O in let+ exists = - Dune_project.file project |> Path.source |> Fs_memo.file_exists + Path.Outside_build_dir.In_source_dir (Dune_project.file project) + |> Fs_memo.file_exists in if not exists then User_warning.emit ~is_error @@ -590,7 +591,7 @@ end = struct let* readdir = Readdir.filter_files readdir project in let vcs = get_vcs ~default:Ancestor_vcs ~readdir in let* dirs_visited = - File.of_source_path path >>| function + File.of_source_path (In_source_dir path) >>| function | Ok file -> Dirs_visited.singleton path file | Error unix_error -> error_unable_to_load ~path unix_error in @@ -693,19 +694,6 @@ let nearest_dir path = let* root = root () in nearest_dir root components -let execution_parameters_of_dir = - let f path = - let+ dir = nearest_dir path - and+ ep = Execution_parameters.default in - Dune_project.update_execution_parameters (Dir0.project dir) ep - in - let memo = - Memo.create "execution-parameters-of-dir" - ~input:(module Path.Source) - ~cutoff:Execution_parameters.equal f - in - Memo.exec memo - let nearest_vcs path = let* dir = nearest_dir path in match Dir0.vcs dir with diff --git a/duniverse/dune_/src/dune_engine/source_tree.mli b/duniverse/dune_/src/dune_engine/source_tree.mli index 5f5d3e89b..3433eb116 100644 --- a/duniverse/dune_/src/dune_engine/source_tree.mli +++ b/duniverse/dune_/src/dune_engine/source_tree.mli @@ -95,9 +95,6 @@ val is_vendored : Path.Source.t -> bool Memo.t (** [true] iff the path is a file *) val file_exists : Path.Source.t -> bool Memo.t -(** Return the execution parameters for the following directory *) -val execution_parameters_of_dir : Path.Source.t -> Execution_parameters.t Memo.t - (**/**) (* Hook to describe how to filter source files. This can be used by forks of diff --git a/duniverse/dune_/src/dune_engine/sub_dirs.mli b/duniverse/dune_/src/dune_engine/sub_dirs.mli index 8255bdbd4..7fd47a83f 100644 --- a/duniverse/dune_/src/dune_engine/sub_dirs.mli +++ b/duniverse/dune_/src/dune_engine/sub_dirs.mli @@ -40,7 +40,7 @@ module Status : sig end end -type subdir_stanzas = (Loc.t * Predicate_lang.Glob.t) option Status.Map.t +type subdir_stanzas val or_default : subdir_stanzas -> Predicate_lang.Glob.t Status.Map.t diff --git a/duniverse/dune_/src/dune_engine/target_promotion.ml b/duniverse/dune_/src/dune_engine/target_promotion.ml index a8b875416..c347e9311 100644 --- a/duniverse/dune_/src/dune_engine/target_promotion.ml +++ b/duniverse/dune_/src/dune_engine/target_promotion.ml @@ -9,21 +9,19 @@ open! Import in the source tree, or creates a new file with the same name. *) module To_delete = struct module P = Dune_util.Persistent.Make (struct - (* CR-someday amokhov: This should really be a [Path.Source.Set.t] but - changing it now would require bumping the [version]. Should we do it? *) - type t = Path.Set.t + type t = Path.Source.Set.t let name = "PROMOTED-TO-DELETE" - let version = 1 + let version = 2 - let to_dyn = Path.Set.to_dyn + let to_dyn = Path.Source.Set.to_dyn end) let fn = Path.relative Path.build_dir ".to-delete-in-source-tree" (* [db] is used to accumulate promoted files from rules. *) - let db = lazy (ref (Option.value ~default:Path.Set.empty (P.load fn))) + let db = lazy (ref (Option.value ~default:Path.Source.Set.empty (P.load fn))) let get_db () = !(Lazy.force db) @@ -39,23 +37,21 @@ module To_delete = struct needs_dumping := true let add p = - let p = Path.source p in modify_db (fun db -> - if Path.Set.mem db p then None else Some (Path.Set.add db p)) + if Path.Source.Set.mem db p then None + else Some (Path.Source.Set.add db p)) let remove p = - let p = Path.source p in modify_db (fun db -> - if Path.Set.mem db p then Some (Path.Set.remove db p) else None) + if Path.Source.Set.mem db p then Some (Path.Source.Set.remove db p) + else None) let dump () = if !needs_dumping && Path.build_dir_exists () then ( needs_dumping := false; get_db () |> P.dump fn) - let mem p = - let p = Path.source p in - Path.Set.mem !(Lazy.force db) p + let mem p = Path.Source.Set.mem !(Lazy.force db) p let () = Hooks.End_of_build.always dump end @@ -101,7 +97,7 @@ let promote_target_if_not_up_to_date ~src ~src_digest ~dst ~promote_source the tracked [Fs_memo.file_digest] to subscribe to the promotion result. *) let* promoted = match - Fs_cache.read Fs_cache.Untracked.file_digest (Path.source dst) + Fs_cache.read Fs_cache.Untracked.file_digest (In_source_dir dst) |> Cached_digest.Digest_result.to_option with | Some dst_digest when Digest.equal src_digest dst_digest -> @@ -128,7 +124,7 @@ let promote_target_if_not_up_to_date ~src ~src_digest ~dst ~promote_source true in let+ dst_digest_result = - Memo.run (Fs_memo.file_digest ~force_update:promoted (Path.source dst)) + Memo.run (Fs_memo.file_digest ~force_update:promoted (In_source_dir dst)) in match Cached_digest.Digest_result.to_option dst_digest_result with | Some dst_digest -> @@ -183,7 +179,7 @@ let promote ~dir ~(targets : _ Targets.Produced.t) ~promote ~promote_source = (User_message.Annots.singleton User_message.Annots.needs_stack_trace ()) in - Memo.run (Fs_memo.path_kind (Path.source into_dir)) >>| function + Memo.run (Fs_memo.path_kind (In_source_dir into_dir)) >>| function | Ok S_DIR -> fun src -> Path.Source.relative into_dir (Path.Build.basename src) | Ok _other_kind -> promote_into_error (Pp.textf "%S is not a directory.") @@ -206,17 +202,18 @@ let promote ~dir ~(targets : _ Targets.Produced.t) ~promote ~promote_source = (User_message.Annots.singleton User_message.Annots.needs_stack_trace ()) in let create_directory_if_needed ~dir = - let dst_dir = Path.source (relocate dir) in + let dst_dir = relocate dir in (* It is OK to use [Untracked.path_stat] on [dst_dir] here because below we will use [Fs_memo.dir_contents] to subscribe to [dst_dir]'s contents, so Dune will notice its deletion. Furthermore, if we used a tracked version, [Path.mkdir_p] below would generate an unnecessary file-system event. *) - match Fs_cache.(read Untracked.path_stat) dst_dir with + match Fs_cache.(read Untracked.path_stat) (In_source_dir dst_dir) with | Ok { st_kind; _ } when st_kind = S_DIR -> () - | Error (ENOENT, _, _) -> Path.mkdir_p dst_dir + | Error (ENOENT, _, _) -> Path.mkdir_p (Path.source dst_dir) | Ok _ | Error _ -> ( (* Try to delete any unexpected stuff out of the way. In future, we might want to make this aggressive cleaning behaviour conditional. *) + let dst_dir = Path.source dst_dir in match Unix_error.Detailed.catch (fun () -> @@ -249,11 +246,14 @@ let promote ~dir ~(targets : _ Targets.Produced.t) ~promote ~promote_source = (* There can be some files or directories left over from earlier builds, so we need to remove them from [targets.dirs]. *) let remove_stale_files_and_subdirectories ~dir ~expected_filenames = - let dst_dir = Path.source (relocate dir) in + let dst_dir = relocate dir in (* We use a tracked version to subscribe to the correct directory listing. In this way, if a user manually creates a file inside a directory target, this function will rerun and remove it. *) - Memo.run (Fs_memo.dir_contents ~force_update:true dst_dir) >>| function + Memo.run (Fs_memo.dir_contents ~force_update:true (In_source_dir dst_dir)) + >>| + let dst_dir = Path.source dst_dir in + function | Error unix_error -> directory_target_error ~unix_error ~dst_dir [] | Ok dir_contents -> Fs_cache.Dir_contents.iter dir_contents ~f:(function diff --git a/duniverse/dune_/src/dune_engine/target_promotion.mli b/duniverse/dune_/src/dune_engine/target_promotion.mli index f1439d62c..bed60035c 100644 --- a/duniverse/dune_/src/dune_engine/target_promotion.mli +++ b/duniverse/dune_/src/dune_engine/target_promotion.mli @@ -17,7 +17,7 @@ val promote : -> unit Fiber.t (** The set of files created in the source tree that need to be deleted. *) -val files_in_source_tree_to_delete : unit -> Path.Set.t +val files_in_source_tree_to_delete : unit -> Path.Source.Set.t val delete_stale_dot_merlin_file : dir:Path.Build.t diff --git a/duniverse/dune_/src/dune_engine/targets.ml b/duniverse/dune_/src/dune_engine/targets.ml index 829a1b67e..2a1962fb6 100644 --- a/duniverse/dune_/src/dune_engine/targets.ml +++ b/duniverse/dune_/src/dune_engine/targets.ml @@ -103,7 +103,7 @@ module Produced = struct let of_validated = let rec collect dir : (unit String.Map.t Path.Build.Map.t, _) result = match Path.Untracked.readdir_unsorted_with_kinds (Path.build dir) with - | Error _ as error -> error + | Error e -> Error (`Directory dir, e) | Ok dir_contents -> let open Result.O in let+ filenames, dirs = @@ -138,19 +138,22 @@ module Produced = struct in Ok { files; dirs } - let of_validated_files_exn (validated : Validated.t) = - let dirs = - match Path.Build.Set.is_empty validated.dirs with - | true -> Path.Build.Map.empty - | false -> - Code_error.raise - "Targets.Produced.of_validated_files_exn: Unexpected directory." - [ ("validated", Validated.to_dyn validated) ] - in - let files = - Path.Build.Set.to_map validated.files ~f:(fun (_ : Path.Build.t) -> ()) - in - { files; dirs } + let produced_after_rule_executed_exn ~loc targets = + match of_validated targets with + | Ok t -> t + | Error (`Directory dir, (Unix.ENOENT, _, _)) -> + User_error.raise ~loc + [ Pp.textf "Rule failed to produce directory %S" + (Path.Build.drop_build_context_maybe_sandboxed_exn dir + |> Path.Source.to_string_maybe_quoted) + ] + | Error (`Directory dir, (unix_error, _, _)) -> + User_error.raise ~loc + [ Pp.textf "Rule produced unreadable directory %S" + (Path.Build.drop_build_context_maybe_sandboxed_exn dir + |> Path.Source.to_string_maybe_quoted) + ; Pp.verbatim (Unix.error_message unix_error) + ] let of_file_list_exn list = { files = Path.Build.Map.of_list_exn list; dirs = Path.Build.Map.empty } @@ -169,7 +172,7 @@ module Produced = struct (Path.Build.Set.exists validated.dirs ~f:(fun validated_dir -> Path.Build.is_descendant dir ~of_:validated_dir)) in - List.iter (Path.Build.Map.keys dirs) ~f:(fun dir -> + Path.Build.Map.iteri dirs ~f:(fun dir _ -> if is_unexpected dir then Code_error.raise "Targets.Produced.expand_validated_exn: Unexpected directory." diff --git a/duniverse/dune_/src/dune_engine/targets.mli b/duniverse/dune_/src/dune_engine/targets.mli index a3f74f342..7b2578f10 100644 --- a/duniverse/dune_/src/dune_engine/targets.mli +++ b/duniverse/dune_/src/dune_engine/targets.mli @@ -73,11 +73,13 @@ module Produced : sig (** Expand [targets : Validated.t] by recursively traversing directory targets and collecting all contained files. *) - val of_validated : Validated.t -> (unit t, Unix_error.Detailed.t) result + val of_validated : + Validated.t + -> (unit t, [ `Directory of Path.Build.t ] * Unix_error.Detailed.t) result - (** Return [targets : Validated.t] with the empty map of [dirs]. Raises a code - error if [targets.dir] is not empty. *) - val of_validated_files_exn : Validated.t -> unit t + (** Like [of_validated] but assumes the targets have been just produced by a + rule. If some directory targets aren't readable, an error is raised *) + val produced_after_rule_executed_exn : loc:Loc.t -> Validated.t -> unit t (** Populates only the [files] field, leaving [dirs] empty. Raises a code error if the list contains duplicates. *) diff --git a/duniverse/dune_/src/dune_file_watcher/dune b/duniverse/dune_/src/dune_file_watcher/dune index 51c9eacfe..c35764e11 100644 --- a/duniverse/dune_/src/dune_file_watcher/dune +++ b/duniverse/dune_/src/dune_file_watcher/dune @@ -3,6 +3,7 @@ (libraries spawn fsevents + dune_console unix stdune threads.posix diff --git a/duniverse/dune_/src/dune_file_watcher/dune_file_watcher.ml b/duniverse/dune_/src/dune_file_watcher/dune_file_watcher.ml index d6cf33517..0cfcac5eb 100644 --- a/duniverse/dune_/src/dune_file_watcher/dune_file_watcher.ml +++ b/duniverse/dune_/src/dune_file_watcher/dune_file_watcher.ml @@ -1,5 +1,6 @@ open! Stdune module Inotify_lib = Async_inotify_for_dune.Async_inotify +module Console = Dune_console module Fs_memo_event = struct type kind = @@ -254,7 +255,7 @@ module Fs_sync : sig val is_special_file : path_as_reported_by_file_watcher:string -> bool (** fsevents always reports absolute paths. therefore, we need callers to make - an effort to determine if an abosulte path is in fact in the build dir *) + an effort to determine if an absolute path is in fact in the build dir *) val is_special_file_fsevents : Path.t -> bool val consume_event : (string, 'a) Table.t -> string -> 'a option @@ -485,29 +486,37 @@ let create_inotifylib ~scheduler = Inotify_lib.add inotify (Lazy.force Fs_sync.special_dir); { kind = Inotify inotify; sync_table } -let fsevents_callback (scheduler : Scheduler.t) ~f events = +let fsevents_callback ?exclusion_paths (scheduler : Scheduler.t) ~f events = + let skip_path = + (* excluding a [path] will exclude children under [path] but not [path] + itself. Hence we need to skip [path] manually *) + match exclusion_paths with + | None -> fun _ -> false + | Some paths -> fun p -> List.mem paths p ~equal:Path.equal + in scheduler.thread_safe_send_emit_events_job (fun () -> List.filter_map events ~f:(fun event -> let path = Fsevents.Event.path event |> Path.of_string |> Path.Expert.try_localize_external in - f event path)) + if skip_path path then None else f event path)) let fsevents ?exclusion_paths ~latency ~paths scheduler f = let paths = List.map paths ~f:Path.to_absolute_filename in let fsevents = - Fsevents.create ~latency ~paths ~f:(fsevents_callback scheduler ~f) + Fsevents.create ~latency ~paths + ~f:(fsevents_callback ?exclusion_paths scheduler ~f) in Option.iter exclusion_paths ~f:(fun paths -> + let paths = List.rev_map paths ~f:Path.to_absolute_filename in Fsevents.set_exclusion_paths fsevents ~paths); fsevents let fsevents_standard_event event path = - let action = Fsevents.Event.action event in let kind = - match action with - | Unknown -> Fs_memo_event.Unknown + match Fsevents.Event.action event with + | Rename | Unknown -> Fs_memo_event.Unknown | Create -> Created | Remove -> Deleted | Modify -> @@ -530,7 +539,7 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) () = else match Fsevents.Event.action event with | Remove -> None - | Unknown | Create | Modify -> + | Rename | Unknown | Create | Modify -> Option.map (Fs_sync.consume_event sync_table path) ~f:(fun id -> Event.Sync id)) in @@ -542,7 +551,6 @@ let create_fsevents ?(latency = 0.2) ~(scheduler : Scheduler.t) () = |> List.rev_map ~f:(fun base -> let path = Path.relative (Path.source Path.Source.root) base in path)) - |> List.rev_map ~f:Path.to_absolute_filename in fsevents ~latency scheduler ~exclusion_paths ~paths fsevents_standard_event in diff --git a/duniverse/dune_/src/dune_lang/action.ml b/duniverse/dune_/src/dune_lang/action.ml index b821564d4..1b8c13388 100644 --- a/duniverse/dune_/src/dune_lang/action.ml +++ b/duniverse/dune_/src/dune_lang/action.ml @@ -215,15 +215,12 @@ let decode = and+ xs = repeat sw in Echo (x :: xs) ) ; ( "cat" - , let+ x = sw - and+ xs = repeat sw - and+ version = Syntax.get_exn Stanza.syntax - and+ loc = loc in - let minimum_version = (3, 4) in - if List.is_non_empty xs && version < minimum_version then - Syntax.Error.since loc Stanza.syntax minimum_version - ~what:"Passing several arguments to 'cat'"; - Cat (x :: xs) ) + , let* xs = repeat1 sw in + (if List.length xs > 1 then + Syntax.since ~what:"Passing several arguments to 'cat'" + Stanza.syntax (3, 4) + else return ()) + >>> return (Cat xs) ) ; ( "copy" , let+ src = sw and+ dst = sw in diff --git a/duniverse/dune_/src/dune_lang/dune b/duniverse/dune_/src/dune_lang/dune index 1d7fe2938..583b8f05f 100644 --- a/duniverse/dune_/src/dune_lang/dune +++ b/duniverse/dune_/src/dune_lang/dune @@ -11,4 +11,4 @@ ordering (re_export dune_sexp))) -(ocamllex dune_lexer) +(ocamllex dune_file_script) diff --git a/duniverse/dune_/src/dune_lang/dune_lexer.mli b/duniverse/dune_/src/dune_lang/dune_file_script.mli similarity index 100% rename from duniverse/dune_/src/dune_lang/dune_lexer.mli rename to duniverse/dune_/src/dune_lang/dune_file_script.mli diff --git a/duniverse/dune_/src/dune_lang/dune_lexer.mll b/duniverse/dune_/src/dune_lang/dune_file_script.mll similarity index 100% rename from duniverse/dune_/src/dune_lang/dune_lexer.mll rename to duniverse/dune_/src/dune_lang/dune_file_script.mll diff --git a/duniverse/dune_/src/dune_lang/dune_lang.ml b/duniverse/dune_/src/dune_lang/dune_lang.ml index ffd146cf5..881daf68f 100644 --- a/duniverse/dune_/src/dune_lang/dune_lang.ml +++ b/duniverse/dune_/src/dune_lang/dune_lang.ml @@ -6,6 +6,4 @@ module Glob = Glob module String_with_vars = String_with_vars module Pform = Pform module Action = Action - -(* TODO remove the [Dune] prefix *) -module Dune_lexer = Dune_lexer +module Dune_file_script = Dune_file_script diff --git a/duniverse/dune_/src/dune_lang/format.ml b/duniverse/dune_/src/dune_lang/format.ml index c6d15b378..5b8191871 100644 --- a/duniverse/dune_/src/dune_lang/format.ml +++ b/duniverse/dune_/src/dune_lang/format.ml @@ -8,7 +8,7 @@ type dune_file = | Sexps of Cst.t list let parse lb = - if Dune_lexer.is_script lb then OCaml_syntax (Loc.of_lexbuf lb) + if Dune_file_script.is_script lb then OCaml_syntax (Loc.of_lexbuf lb) else Sexps (Parser.parse lb ~mode:Cst) let can_be_displayed_wrapped = diff --git a/duniverse/dune_/src/dune_lang/pform.ml b/duniverse/dune_/src/dune_lang/pform.ml index dc23a155d..94373c944 100644 --- a/duniverse/dune_/src/dune_lang/pform.ml +++ b/duniverse/dune_/src/dune_lang/pform.ml @@ -147,6 +147,7 @@ module Macro = struct | Read_lines | Path_no_dep | Ocaml_config + | Coq_config | Env | Artifact of Artifact.t @@ -191,6 +192,9 @@ module Macro = struct | Ocaml_config, Ocaml_config -> Eq | Ocaml_config, _ -> Lt | _, Ocaml_config -> Gt + | Coq_config, Coq_config -> Eq + | Coq_config, _ -> Lt + | _, Coq_config -> Gt | Env, Env -> Eq | Env, _ -> Lt | _, Env -> Gt @@ -215,6 +219,7 @@ module Macro = struct | Read_lines -> string "Read_lines" | Path_no_dep -> string "Path_no_dep" | Ocaml_config -> string "Ocaml_config" + | Coq_config -> string "Coq_config" | Env -> string "Env" | Artifact ext -> variant "Artifact" [ Artifact.to_dyn ext ] end @@ -320,6 +325,7 @@ let encode_to_latest_dune_lang_version t = | Read_lines -> Some "read-lines" | Path_no_dep -> None | Ocaml_config -> Some "ocaml-config" + | Coq_config -> Some "coq" | Env -> Some "env" | Artifact a -> Some (String.drop (Artifact.ext a) 1) with @@ -409,6 +415,7 @@ module Env = struct ; ("path-no-dep", deleted_in ~version:(1, 0) Macro.Path_no_dep) ; ("ocaml-config", macro Ocaml_config) ; ("env", since ~version:(1, 4) Macro.Env) + ; ("coq", macro Coq_config) ] @ List.map ~f:artifact Artifact.all) in diff --git a/duniverse/dune_/src/dune_lang/pform.mli b/duniverse/dune_/src/dune_lang/pform.mli index 3d7ea1910..5c04b225f 100644 --- a/duniverse/dune_/src/dune_lang/pform.mli +++ b/duniverse/dune_/src/dune_lang/pform.mli @@ -85,6 +85,7 @@ module Macro : sig | Read_lines | Path_no_dep | Ocaml_config + | Coq_config | Env | Artifact of Artifact.t diff --git a/duniverse/dune_/src/dune_metrics/dune b/duniverse/dune_/src/dune_metrics/dune new file mode 100644 index 000000000..b8d985839 --- /dev/null +++ b/duniverse/dune_/src/dune_metrics/dune @@ -0,0 +1,3 @@ +(library + (name dune_metrics) + (libraries stdune)) diff --git a/duniverse/dune_/otherlibs/stdune/metrics.ml b/duniverse/dune_/src/dune_metrics/dune_metrics.ml similarity index 99% rename from duniverse/dune_/otherlibs/stdune/metrics.ml rename to duniverse/dune_/src/dune_metrics/dune_metrics.ml index dac1be515..e17ac851d 100644 --- a/duniverse/dune_/otherlibs/stdune/metrics.ml +++ b/duniverse/dune_/src/dune_metrics/dune_metrics.ml @@ -1,3 +1,5 @@ +open Stdune + let enabled = ref false let enable () = enabled := true diff --git a/duniverse/dune_/otherlibs/stdune/metrics.mli b/duniverse/dune_/src/dune_metrics/dune_metrics.mli similarity index 97% rename from duniverse/dune_/otherlibs/stdune/metrics.mli rename to duniverse/dune_/src/dune_metrics/dune_metrics.mli index db7c1cca5..38f54cac0 100644 --- a/duniverse/dune_/otherlibs/stdune/metrics.mli +++ b/duniverse/dune_/src/dune_metrics/dune_metrics.mli @@ -1,3 +1,5 @@ +open Stdune + (** Utilities for collecting performance metrics *) (** This function must be called to enable all performance metrics. *) diff --git a/duniverse/dune_/src/dune_rpc_impl/client.ml b/duniverse/dune_/src/dune_rpc_impl/client.ml index 53f422ad1..6cfef8860 100644 --- a/duniverse/dune_/src/dune_rpc_impl/client.ml +++ b/duniverse/dune_/src/dune_rpc_impl/client.ml @@ -16,7 +16,8 @@ module Connection = struct | Error exn -> Error (User_error.make - [ Pp.text "failed to connect to RPC server %s" + [ Pp.textf "failed to connect to RPC server %s" + (Where.to_string where) ; Exn_with_backtrace.pp exn ]) diff --git a/duniverse/dune_/src/dune_rpc_impl/server.ml b/duniverse/dune_/src/dune_rpc_impl/server.ml index e2ccfb6e1..eae653839 100644 --- a/duniverse/dune_/src/dune_rpc_impl/server.ml +++ b/duniverse/dune_/src/dune_rpc_impl/server.ml @@ -1,124 +1,115 @@ open Import open Fiber.O open Dune_rpc_server -module Initialize = Dune_rpc.Initialize -module Public = Dune_rpc.Public -module Versioned = Dune_rpc.Versioned -module Server_notifications = Dune_rpc.Server_notifications -module Sub = Dune_rpc.Sub -module Progress = Dune_rpc.Progress -module Procedures = Dune_rpc.Procedures -module Id = Dune_rpc.Id -module Diagnostic = Dune_rpc.Diagnostic -module Conv = Dune_rpc.Conv +module Global_lock = Dune_util.Global_lock + +include struct + open Dune_rpc + module Initialize = Initialize + module Public = Public + module Versioned = Versioned + module Server_notifications = Server_notifications + module Sub = Sub + module Progress = Progress + module Procedures = Procedures + module Id = Id + module Diagnostic = Diagnostic + module Conv = Conv +end + +include struct + open Dune_engine + module Source_tree = Source_tree + module Build_config = Build_config + module Dune_project = Dune_project + module Diff_promotion = Diff_promotion +end + module Dep_conf = Dune_rules.Dep_conf -module Stanza = Dune_lang.Stanza -module Source_tree = Dune_engine.Source_tree -module Build_config = Dune_engine.Build_config -module Dune_project = Dune_engine.Dune_project -module Diff_promotion = Dune_engine.Diff_promotion module Build_outcome = Decl.Build_outcome +module Status = Decl.Status +module Stanza = Dune_lang.Stanza module String_with_vars = Dune_lang.String_with_vars module Pform = Dune_lang.Pform -module Status = Decl.Status - -module Config = struct - type t = - { handler : Dune_rpc_server.t - ; pool : Fiber.Pool.t - ; backlog : int - ; root : string - ; where : Dune_rpc.Where.t - } -end module Run = struct module Registry = Dune_rpc_private.Registry module Server = Dune_rpc_server.Make (Csexp_rpc.Session) type t = - { server : Csexp_rpc.Server.t - ; handler : Dune_rpc_server.t + { handler : Dune_rpc_server.t ; pool : Fiber.Pool.t + ; root : string ; where : Dune_rpc.Where.t + ; server : Csexp_rpc.Server.t Lazy.t ; stats : Dune_stats.t option - ; root : string + ; server_ivar : Csexp_rpc.Server.t Fiber.Ivar.t + ; registry : [ `Add | `Skip ] } - let t_var : t Fiber.Var.t = Fiber.Var.create () - - let of_config { Config.handler; backlog; pool; root; where } stats = - let server = Csexp_rpc.Server.create (Where.to_socket where) ~backlog in - { server; handler; stats; pool; root; where } - let run t = - Fiber.Var.set t_var t (fun () -> - let cleanup_registry = ref None in - let run_cleanup_registry () = - match !cleanup_registry with - | None -> () - | Some path -> - Fpath.unlink_no_err path; - cleanup_registry := None - in - let with_print_errors f () = - Fiber.with_error_handler f ~on_error:(fun exn -> - Format.eprintf "%a@." Exn_with_backtrace.pp_uncaught exn; - Exn_with_backtrace.reraise exn) - in - Fiber.finalize - (with_print_errors (fun () -> - let open Fiber.O in - Fiber.fork_and_join_unit - (fun () -> - let* sessions = Csexp_rpc.Server.serve t.server in - let () = - let (`Caller_should_write { Registry.File.path; contents }) - = - let registry_config = - Registry.Config.create (Lazy.force Dune_util.xdg) - in - let dune = - let pid = Unix.getpid () in - let where = - match t.where with - | `Ip (host, port) -> `Ip (host, port) - | `Unix a -> - `Unix - (if Filename.is_relative a then - Filename.concat (Sys.getcwd ()) a - else a) - in - Registry.Dune.create ~where ~root:t.root ~pid - in - Registry.Config.register registry_config dune - in - let (_ : Fpath.mkdir_p_result) = - Fpath.mkdir_p (Filename.dirname path) - in - Io.String_path.write_file path contents; - cleanup_registry := Some path; - at_exit run_cleanup_registry - in - let* () = Server.serve sessions t.stats t.handler in - Fiber.Pool.stop t.pool) - (fun () -> Fiber.Pool.run t.pool))) - ~finally:(fun () -> - run_cleanup_registry (); - Fiber.return ())) - - let stop () = - let open Fiber.O in - let* t = Fiber.Var.get t_var in - match t with - | None -> Code_error.raise "rpc not running" [] - | Some s -> - Csexp_rpc.Server.stop s.server; - Fiber.return () + let cleanup_registry = ref None in + let with_registry f = + match t.registry with + | `Skip -> () + | `Add -> f () + in + let run_cleanup_registry () = + match !cleanup_registry with + | None -> () + | Some path -> + Fpath.unlink_no_err path; + cleanup_registry := None + in + let with_print_errors f () = + Fiber.with_error_handler f ~on_error:(fun exn -> + Format.eprintf "%a@." Exn_with_backtrace.pp_uncaught exn; + Exn_with_backtrace.reraise exn) + in + let run () = + let open Fiber.O in + let server = Lazy.force t.server in + let* () = Fiber.Ivar.fill t.server_ivar server in + Fiber.fork_and_join_unit + (fun () -> + let* sessions = Csexp_rpc.Server.serve server in + let () = + with_registry @@ fun () -> + let (`Caller_should_write { Registry.File.path; contents }) = + let registry_config = + Registry.Config.create (Lazy.force Dune_util.xdg) + in + let dune = + let pid = Unix.getpid () in + let where = + match t.where with + | `Ip (host, port) -> `Ip (host, port) + | `Unix a -> + `Unix + (if Filename.is_relative a then + Filename.concat (Sys.getcwd ()) a + else a) + in + Registry.Dune.create ~where ~root:t.root ~pid + in + Registry.Config.register registry_config dune + in + let (_ : Fpath.mkdir_p_result) = + Fpath.mkdir_p (Filename.dirname path) + in + Io.String_path.write_file path contents; + cleanup_registry := Some path; + at_exit run_cleanup_registry + in + let* () = Server.serve sessions t.stats t.handler in + Fiber.Pool.stop t.pool) + (fun () -> Fiber.Pool.run t.pool) + in + Fiber.finalize (with_print_errors run) ~finally:(fun () -> + with_registry run_cleanup_registry; + Fiber.return ()) end -let stop = Run.stop - type pending_build_action = | Build of Dep_conf.t list * Build_outcome.t Fiber.Ivar.t @@ -215,13 +206,22 @@ end = struct end type t = - { config : Config.t + { config : Run.t ; pending_build_jobs : (Dep_conf.t list * Build_outcome.t Fiber.Ivar.t) Job_queue.t ; mutable clients : Clients.t - ; stats : Dune_stats.t option } +let ready (t : t) = + let* server = Fiber.Ivar.read t.config.server_ivar in + Csexp_rpc.Server.ready server + +let stop (t : t) = + let+ server = Fiber.Ivar.peek t.config.server_ivar in + match server with + | None -> () + | Some server -> Csexp_rpc.Server.stop server + let handler (t : t Fdecl.t) : 'a Dune_rpc_server.Handler.t = let on_init session (_ : Initialize.Request.t) = let t = Fdecl.get t in @@ -277,8 +277,7 @@ let handler (t : t Fdecl.t) : 'a Dune_rpc_server.Handler.t = let remaining = now.number_of_rules_discovered - now.number_of_rules_executed in - let complete = now.number_of_rules_executed in - In_progress { complete; remaining } + In_progress { complete = now.number_of_rules_executed; remaining } in Handler.implement_long_poll rpc Procedures.Poll.progress Build_system.state ~equal:Build_system.State.equal ~diff @@ -327,7 +326,9 @@ let handler (t : t Fdecl.t) : 'a Dune_rpc_server.Handler.t = ~f:(fun (_, entry) -> Session.Stage1.request_close entry.session)) in let shutdown () = - Fiber.fork_and_join_unit Dune_engine.Scheduler.shutdown Run.stop + Fiber.fork_and_join_unit Dune_engine.Scheduler.shutdown (fun () -> + Csexp_rpc.Server.stop (Lazy.force t.config.server); + Fiber.return ()) in Fiber.fork_and_join_unit terminate_sessions shutdown in @@ -399,14 +400,42 @@ let handler (t : t Fdecl.t) : 'a Dune_rpc_server.Handler.t = in rpc -let create ~root stats = +let create ~lock_timeout ~registry ~root stats = let t = Fdecl.create Dyn.opaque in let pending_build_jobs = Job_queue.create () in let handler = Dune_rpc_server.make (handler t) in let pool = Fiber.Pool.create () in let where = Where.default () in - let config = { Config.handler; backlog = 10; pool; root; where } in - let res = { config; pending_build_jobs; clients = Clients.empty; stats } in + Global_lock.lock_exn ~timeout:lock_timeout; + let server = + lazy + (let socket_file = Where.rpc_socket_file () in + Path.unlink_no_err (Path.build socket_file); + Path.mkdir_p (Path.build (Path.Build.parent_exn socket_file)); + match Csexp_rpc.Server.create (Where.to_socket where) ~backlog:10 with + | Ok s -> + at_exit (fun () -> Path.Build.unlink_no_err socket_file); + s + | Error `Already_in_use -> + User_error.raise + [ Pp.textf + "Dune rpc is already running in this workspace. If this is not \ + the case, please delete %s" + (Path.Build.to_string_maybe_quoted (Where.rpc_socket_file ())) + ]) + in + let config = + { Run.handler + ; pool + ; root + ; where + ; stats + ; server + ; registry + ; server_ivar = Fiber.Ivar.create () + } + in + let res = { config; pending_build_jobs; clients = Clients.empty } in Fdecl.set t res; res @@ -414,9 +443,9 @@ let listening_address t = t.config.where let run t = let* () = Fiber.return () in - Run.run (Run.of_config t.config t.stats) + Run.run t.config -let stats (t : t) = t.stats +let stats (t : t) = t.config.stats let pending_build_action t = Job_queue.read t.pending_build_jobs diff --git a/duniverse/dune_/src/dune_rpc_impl/server.mli b/duniverse/dune_/src/dune_rpc_impl/server.mli index 50e75180f..3931dc722 100644 --- a/duniverse/dune_/src/dune_rpc_impl/server.mli +++ b/duniverse/dune_/src/dune_rpc_impl/server.mli @@ -2,7 +2,12 @@ open Import type t -val create : root:string -> Dune_stats.t option -> t +val create : + lock_timeout:float option + -> registry:[ `Add | `Skip ] + -> root:string + -> Dune_stats.t option + -> t val listening_address : t -> Dune_rpc.Where.t @@ -15,6 +20,8 @@ val pending_build_action : t -> pending_build_action Fiber.t (** Stop accepting new rpc connections. Fiber returns when all existing connections terminate *) -val stop : unit -> unit Fiber.t +val stop : t -> unit Fiber.t + +val ready : t -> unit Fiber.t val run : t -> unit Fiber.t diff --git a/duniverse/dune_/src/dune_rpc_impl/where.ml b/duniverse/dune_/src/dune_rpc_impl/where.ml index be0619596..482be1970 100644 --- a/duniverse/dune_/src/dune_rpc_impl/where.ml +++ b/duniverse/dune_/src/dune_rpc_impl/where.ml @@ -48,3 +48,11 @@ let to_socket = function let to_string = function | `Unix p -> sprintf "unix://%s" p | `Ip (`Host host, `Port port) -> sprintf "%s:%d" host port + +let rpc_socket_file = + let f = + lazy + (Path.Build.(relative root) + Dune_rpc_private.Where.rpc_socket_relative_to_build_dir) + in + fun () -> Lazy.force f diff --git a/duniverse/dune_/src/dune_rpc_impl/where.mli b/duniverse/dune_/src/dune_rpc_impl/where.mli index 4e6d88fbd..43c73921e 100644 --- a/duniverse/dune_/src/dune_rpc_impl/where.mli +++ b/duniverse/dune_/src/dune_rpc_impl/where.mli @@ -8,4 +8,6 @@ val get : unit -> Dune_rpc.Where.t option val to_socket : Dune_rpc.Where.t -> Unix.sockaddr +val rpc_socket_file : unit -> Path.Build.t + val to_string : Dune_rpc.Where.t -> string diff --git a/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.ml b/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.ml index 3c947e866..7ab386caa 100644 --- a/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.ml +++ b/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.ml @@ -234,7 +234,7 @@ module Event = struct let ts = Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in Event.common_fields ~ts ~name () in - let id = Event.Id.Int (Session.Id.to_int id) in + let id = Chrome_trace.Id.create (`Int (Session.Id.to_int id)) in Event.async ?args id kind common in Dune_stats.emit stats event) diff --git a/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.mli b/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.mli index 9f385d6dd..1a0853344 100644 --- a/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.mli +++ b/duniverse/dune_/src/dune_rpc_server/dune_rpc_server.mli @@ -27,7 +27,7 @@ module Session : sig the state after [on_terminate] finishes. *) val get : 'a t -> 'a - (** [get session a] sets the curent state to [a].*) + (** [get session a] sets the current state to [a].*) val set : 'a t -> 'a -> unit val active : _ t -> bool diff --git a/duniverse/dune_/src/dune_rules/action_unexpanded.ml b/duniverse/dune_/src/dune_rules/action_unexpanded.ml index 7a43e1bee..af9172f45 100644 --- a/duniverse/dune_/src/dune_rules/action_unexpanded.ml +++ b/duniverse/dune_/src/dune_rules/action_unexpanded.ml @@ -16,6 +16,15 @@ let as_in_build_dir ~what ~loc p = (Path.to_string_maybe_quoted p) ] +let validate_target_dir ~targets_dir ~loc targets path = + if Path.Build.(parent_exn path <> targets_dir) then + User_error.raise ~loc + [ Pp.text + "This action has targets in a different directory than the current \ + one, this is not allowed by dune at the moment:" + ; Targets.pp targets + ] + module Action_expander : sig (* An applicative to help write action expansion. It is similar to [Action_builder.With_targets.t] but with some differences. The differences @@ -40,7 +49,10 @@ module Action_expander : sig val set_env : var:string -> value:string t -> (value:string -> 'a) t -> 'a t val run : - 'a t -> expander:Expander.t -> 'a Action_builder.With_targets.t Memo.t + 'a t + -> targets_dir:Path.Build.t option + -> expander:Expander.t + -> 'a Action_builder.With_targets.t Memo.t (* String with vars expansion *) module E : sig @@ -85,7 +97,7 @@ end = struct type deps = Path.Set.t Action_builder.t type collector = - { file_targets : Path.Build.Set.t (** We only infer file targets *) + { file_targets : Loc.t Path.Build.Map.t (** We only infer file targets *) ; deps : deps ; deps_if_exist : deps } @@ -121,10 +133,10 @@ end = struct in fun l env acc -> loop [] l env acc - let run t ~expander = + let run t ~targets_dir ~expander = let deps = Action_builder.return Path.Set.empty in let acc = - { file_targets = Path.Build.Set.empty; deps; deps_if_exist = deps } + { file_targets = Path.Build.Map.empty; deps; deps_if_exist = deps } in let env = { expander; infer = true; dir = Expander.dir expander } in Memo.map (t env acc) ~f:(fun (b, acc) -> @@ -135,7 +147,7 @@ end = struct {[ (progn (copy a b) (copy b c)) ]} *) let remove_targets = let file_targets = - Path.Build.Set.to_list file_targets + Path.Build.Map.keys file_targets |> Path.Set.of_list_map ~f:Path.build in fun deps -> Path.Set.diff deps file_targets @@ -149,7 +161,13 @@ end = struct >>> Action_builder.if_file_exists f ~then_:(Action_builder.path f) ~else_:(Action_builder.return ())) in - let targets = Targets.Files.create file_targets in + let targets = + let file_targets = Path.Build.Set.of_keys file_targets in + Targets.Files.create file_targets + in + Option.iter targets_dir ~f:(fun targets_dir -> + Path.Build.Map.iteri file_targets ~f:(fun path loc -> + validate_target_dir ~targets_dir ~loc targets path)); Action_builder.with_targets ~targets (let+ () = deps >>= Action_builder.path_set and+ () = deps_if_exist >>= action_builder_path_set_if_exist @@ -308,14 +326,16 @@ end = struct , acc ) else let+! p = Expander.No_deps.expand_path env sw in - let p = as_in_build_dir p ~what ~loc:(loc sw) in + let loc = loc sw in + let p = as_in_build_dir p ~what ~loc in ( Action_builder.return p - , { acc with file_targets = f acc.file_targets p } ) + , { acc with file_targets = f acc.file_targets p loc } ) let consume_file = - add_or_remove_target ~what:"File" ~f:Path.Build.Set.remove + add_or_remove_target ~what:"File" ~f:(fun map p _loc -> + Path.Build.Map.remove map p) - let target = add_or_remove_target ~what:"Target" ~f:Path.Build.Set.add + let target = add_or_remove_target ~what:"Target" ~f:Path.Build.Map.set let prog_and_args sw env acc = let b = @@ -425,19 +445,20 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = let+ fn = E.target fn and+ s = E.string s in O.Write_file (fn, perm, s) - | Mkdir x -> + | Mkdir x -> ( (* This code path should in theory be unreachable too, but we don't delete it to remember about the check in in case we expose [mkdir] in the syntax one day. *) let+ path = E.path x in - if not (Path.is_managed path) then + match Path.as_in_build_dir path with + | Some path -> O.Mkdir path + | None -> User_error.raise ~loc:(String_with_vars.loc x) [ Pp.text "(mkdir ...) is not supported for paths outside of the workspace:" ; Pp.seq (Pp.verbatim " ") (Dune_lang.pp (List [ Dune_lang.atom "mkdir"; Dpath.encode path ])) - ]; - O.Mkdir path + ]) | Diff { optional; file1; file2; mode } -> let+ file1 = E.dep_if_exists file1 and+ file2 = @@ -464,7 +485,8 @@ let expand_no_targets t ~loc ~deps:deps_written_by_user ~expander ~what = Expander.set_expanding_what expander (User_action_without_targets { what }) in let* { Action_builder.With_targets.build; targets } = - Action_builder.of_memo (Action_expander.run (expand t) ~expander) + Action_builder.of_memo + (Action_expander.run (expand t) ~targets_dir:None ~expander) in if not (Targets.is_empty targets) then User_error.raise ~loc @@ -507,7 +529,7 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir Expander.set_expanding_what expander (User_action targets_written_by_user) in let+! { Action_builder.With_targets.build; targets } = - Action_expander.run (expand t) ~expander + Action_expander.run (expand t) ~targets_dir:(Some targets_dir) ~expander in let targets = match (targets_written_by_user : _ Targets_spec.t) with @@ -515,13 +537,7 @@ let expand t ~loc ~deps:deps_written_by_user ~targets_dir | Static { targets = targets_written_by_user; multiplicity = _ } -> let files, dirs = List.partition_map targets_written_by_user ~f:(fun (path, kind) -> - if Path.Build.(parent_exn path <> targets_dir) then - User_error.raise ~loc - [ Pp.text - "This action has targets in a different directory than the \ - current one, this is not allowed by dune at the moment:" - ; Targets.pp targets - ]; + validate_target_dir ~targets_dir ~loc targets path; match kind with | File -> Left path | Directory -> Right path) diff --git a/duniverse/dune_/src/dune_rules/artifact_substitution.ml b/duniverse/dune_/src/dune_rules/artifact_substitution.ml index e8864c04c..5dc5c345a 100644 --- a/duniverse/dune_/src/dune_rules/artifact_substitution.ml +++ b/duniverse/dune_/src/dune_rules/artifact_substitution.ml @@ -48,8 +48,24 @@ type conf = ; get_location : Section.t -> Package.Name.t -> Path.t ; get_config_path : configpath -> Path.t option ; hardcoded_ocaml_path : hardcoded_ocaml_path + ; sign_hook : (Path.t -> unit Fiber.t) option Lazy.t } +let mac_codesign_hook ~codesign path = + Process.run Strict codesign [ "-s"; "-"; Path.to_string path ] + +let sign_hook_of_context (context : Context.t) = + let config = context.ocaml_config in + match (Ocaml_config.system config, Ocaml_config.architecture config) with + | "macosx", "arm64" -> ( + let codesign_name = "codesign" in + match Bin.which ~path:context.path codesign_name with + | None -> + Utils.program_not_found ~loc:None + ~hint:"codesign should be part of the macOS installation" codesign_name + | Some codesign -> Some (mac_codesign_hook ~codesign)) + | _ -> None + let conf_of_context (context : Context.t option) = let get_vcs = Source_tree.nearest_vcs in match context with @@ -58,6 +74,7 @@ let conf_of_context (context : Context.t option) = ; get_location = (fun _ _ -> Code_error.raise "no context available" []) ; get_config_path = (fun _ -> Code_error.raise "no context available" []) ; hardcoded_ocaml_path = Hardcoded [] + ; sign_hook = lazy None } | Some context -> let get_location = Install.Section.Paths.get_local_location context.name in @@ -70,13 +87,16 @@ let conf_of_context (context : Context.t option) = let install_dir = Path.build (Path.Build.relative install_dir "lib") in Hardcoded (install_dir :: context.default_ocamlpath) in + let sign_hook = lazy (sign_hook_of_context context) in { get_vcs = Source_tree.nearest_vcs ; get_location ; get_config_path ; hardcoded_ocaml_path + ; sign_hook } -let conf_for_install ~relocatable ~default_ocamlpath ~stdlib_dir ~roots = +let conf_for_install ~relocatable ~default_ocamlpath ~stdlib_dir ~roots ~context + = let get_vcs = Source_tree.nearest_vcs in let hardcoded_ocaml_path = match relocatable with @@ -91,13 +111,15 @@ let conf_for_install ~relocatable ~default_ocamlpath ~stdlib_dir ~roots = | Sourceroot -> None | Stdlib -> Some stdlib_dir in - { get_location; get_vcs; get_config_path; hardcoded_ocaml_path } + let sign_hook = lazy (sign_hook_of_context context) in + { get_location; get_vcs; get_config_path; hardcoded_ocaml_path; sign_hook } let conf_dummy = { get_vcs = (fun _ -> Memo.return None) ; get_location = (fun _ _ -> Path.root) ; get_config_path = (fun _ -> None) ; hardcoded_ocaml_path = Hardcoded [] + ; sign_hook = lazy None } let to_dyn = function @@ -395,14 +417,17 @@ let buf_len = max_len let buf = Bytes.create buf_len -type _ mode = - | Test : bool mode - | Copy : +type mode = + | Test + | Copy of { input_file : Path.t ; output : bytes -> int -> int -> unit ; conf : conf } - -> unit mode + +type status = + | Some_substitution + | No_substitution (** The copy algorithm works as follow: @@ -442,10 +467,9 @@ output the replacement | | | | \--------------------------------------------------------------------------/ v} *) -let parse : type a. input:_ -> mode:a mode -> a Fiber.t = - fun ~input ~mode -> +let parse ~input ~mode = let open Fiber.O in - let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data : a Fiber.t = + let rec loop scanner_state ~beginning_of_data ~pos ~end_of_data ~status = let scanner_state = Scanner.run scanner_state ~buf ~pos ~end_of_data in let placeholder_start = match scanner_state with @@ -471,7 +495,7 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = match decode placeholder with | Some t -> ( match mode with - | Test -> Fiber.return true + | Test -> Fiber.return Some_substitution | Copy { output; input_file; conf } -> let* s = eval t ~conf in (if !Clflags.debug_artifact_substitution then @@ -487,13 +511,14 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = let s = encode_replacement ~len ~repl:s in output (Bytes.unsafe_of_string s) 0 len; let pos = placeholder_start + len in - loop Scan0 ~beginning_of_data:pos ~pos ~end_of_data) + loop Scan0 ~beginning_of_data:pos ~pos ~end_of_data + ~status:Some_substitution) | None -> (* Restart just after [prefix] since we know for sure that a placeholder cannot start before that. *) loop Scan0 ~beginning_of_data:placeholder_start ~pos:(placeholder_start + prefix_len) - ~end_of_data) + ~end_of_data ~status) | scanner_state -> ( (* We reached the end of the buffer: move the leftover data back to the beginning of [buf] and refill the buffer *) @@ -516,24 +541,24 @@ let parse : type a. input:_ -> mode:a mode -> a Fiber.t = (* There might still be another placeholder after this invalid one with a length that is too long *) loop Scan0 ~beginning_of_data:0 ~pos:prefix_len ~end_of_data:leftover + ~status | _ -> ( match mode with - | Test -> Fiber.return false + | Test -> Fiber.return No_substitution | Copy { output; _ } -> (* Nothing more to read; [leftover] is definitely not the beginning of a placeholder, send it and end the copy *) output buf 0 leftover; - Fiber.return ())) + Fiber.return status)) | n -> loop scanner_state ~beginning_of_data:0 ~pos:leftover - ~end_of_data:(leftover + n)) + ~end_of_data:(leftover + n) ~status) in match input buf 0 buf_len with - | 0 -> ( - match mode with - | Test -> Fiber.return false - | Copy _ -> Fiber.return ()) - | n -> loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n + | 0 -> Fiber.return No_substitution + | n -> + loop Scan0 ~beginning_of_data:0 ~pos:0 ~end_of_data:n + ~status:No_substitution let copy ~conf ~input_file ~input ~output = parse ~input ~mode:(Copy { conf; input_file; output }) @@ -547,6 +572,38 @@ let copy_file_non_atomic ~conf ?chmod ~src ~dst () = Fiber.return ()) (fun () -> copy ~conf ~input_file:src ~input:(input ic) ~output:(output oc)) +let run_sign_hook conf ~has_subst file = + match has_subst with + | No_substitution -> Fiber.return () + | Some_substitution -> ( + match Lazy.force conf.sign_hook with + | Some hook -> hook file + | None -> Fiber.return ()) + +(** This is just an optimisation: skip the renaming if the destination exists + and has the right digest. The optimisation is useful to avoid unnecessary + retriggering of Dune and other file-watching systems. *) +let replace_if_different ~delete_dst_if_it_is_a_directory ~src ~dst = + let up_to_date = + match Path.Untracked.stat dst with + | Ok { st_kind; _ } when st_kind = S_DIR -> ( + match delete_dst_if_it_is_a_directory with + | true -> + Path.rm_rf dst; + false + | false -> + User_error.raise + [ Pp.textf "Cannot copy artifact to %S because it is a directory" + (Path.to_string dst) + ]) + | Error (_ : Unix_error.Detailed.t) -> false + | Ok (_ : Unix.stats) -> + let temp_file_digest = Digest.file src in + let dst_digest = Digest.file dst in + Digest.equal temp_file_digest dst_digest + in + if not up_to_date then Path.rename src dst + let copy_file ~conf ?chmod ?(delete_dst_if_it_is_a_directory = false) ~src ~dst () = (* We create a temporary file in the same directory to ensure it's on the same @@ -561,29 +618,12 @@ let copy_file ~conf ?chmod ?(delete_dst_if_it_is_a_directory = false) ~src ~dst Fiber.finalize (fun () -> let open Fiber.O in - let+ () = copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () in - let up_to_date = - match Path.Untracked.stat dst with - | Ok { st_kind; _ } when st_kind = S_DIR -> ( - match delete_dst_if_it_is_a_directory with - | true -> - Path.rm_rf dst; - false - | false -> - User_error.raise - [ Pp.textf "Cannot copy artifact to %S because it is a directory" - (Path.to_string dst) - ]) - | Error (_ : Unix_error.Detailed.t) -> false - | Ok (_ : Unix.stats) -> - let temp_file_digest = Digest.file temp_file in - let dst_digest = Digest.file dst in - Digest.equal temp_file_digest dst_digest + Path.parent dst |> Option.iter ~f:Path.mkdir_p; + let* has_subst = + copy_file_non_atomic ~conf ?chmod ~src ~dst:temp_file () in - (* This is just an optimisation: skip the renaming if the destination - exists and has the right digest. The optimisation is useful to avoid - unnecessary retriggering of Dune and other file-watching systems. *) - if not up_to_date then Path.rename temp_file dst) + let+ () = run_sign_hook conf ~has_subst temp_file in + replace_if_different ~delete_dst_if_it_is_a_directory ~src:temp_file ~dst) ~finally:(fun () -> Path.unlink_no_err temp_file; Fiber.return ()) diff --git a/duniverse/dune_/src/dune_rules/artifact_substitution.mli b/duniverse/dune_/src/dune_rules/artifact_substitution.mli index 786befda7..1e762d33f 100644 --- a/duniverse/dune_/src/dune_rules/artifact_substitution.mli +++ b/duniverse/dune_/src/dune_rules/artifact_substitution.mli @@ -26,6 +26,8 @@ type conf = private ; get_config_path : configpath -> Path.t option ; hardcoded_ocaml_path : hardcoded_ocaml_path (** Initial prefix of installation when relocatable chosen *) + ; sign_hook : (Path.t -> unit Fiber.t) option Lazy.t + (** Called on binary after if has been edited *) } val conf_of_context : Context.t option -> conf @@ -35,6 +37,7 @@ val conf_for_install : -> default_ocamlpath:Path.t list -> stdlib_dir:Path.t -> roots:Path.t Install.Section.Paths.Roots.t + -> context:Context.t -> conf val conf_dummy : conf @@ -64,21 +67,27 @@ val copy_file : -> unit -> unit Fiber.t +type status = + | Some_substitution + | No_substitution + (** Generic version of [copy_file]. Rather than filenames, it takes an input and output functions. Their semantic must match the ones of the [input] and [output] functions from the OCaml standard library. [input_file] is used only for debugging purposes. It must be the name of the - source file. *) + source file. + + Return whether a substitution happened. *) val copy : conf:conf -> input_file:Path.t -> input:(Bytes.t -> int -> int -> int) -> output:(Bytes.t -> int -> int -> unit) - -> unit Fiber.t + -> status Fiber.t (** Produce the string that would replace the placeholder with the given value .*) val encode_replacement : len:int -> repl:string -> string (** Test if a file contains a substitution placeholder. *) -val test_file : src:Path.t -> unit -> bool Fiber.t +val test_file : src:Path.t -> unit -> status Fiber.t diff --git a/duniverse/dune_/src/dune_rules/artifacts.ml b/duniverse/dune_/src/dune_rules/artifacts.ml index fb2714c3f..1bd42d249 100644 --- a/duniverse/dune_/src/dune_rules/artifacts.ml +++ b/duniverse/dune_/src/dune_rules/artifacts.ml @@ -27,7 +27,8 @@ module Bin = struct let binary_available t name = if not (Filename.is_relative name) then - Fs_memo.file_exists (Path.of_filename_relative_to_initial_cwd name) + Path.of_filename_relative_to_initial_cwd name + |> Path.as_outside_build_dir_exn |> Fs_memo.file_exists else match String.Map.find t.local_bins name with | Some _ -> Memo.return true diff --git a/duniverse/dune_/src/dune_rules/artifacts_db.ml b/duniverse/dune_/src/dune_rules/artifacts_db.ml index cc7fdd96b..36237be0a 100644 --- a/duniverse/dune_/src/dune_rules/artifacts_db.ml +++ b/duniverse/dune_/src/dune_rules/artifacts_db.ml @@ -13,7 +13,11 @@ let get_installed_binaries ~(context : Context.t) stanzas = Memo.List.map stanzas ~f:(fun (d : Dune_file.t) -> let dir = Path.Build.append_source context.build_dir d.dir in let binaries_from_install files = - Memo.List.map files ~f:(fun fb -> + let* unexpanded_file_bindings = + Dune_file.Install_conf.File_entry.to_file_bindings_unexpanded files + ~expand_str:(expand_str ~dir) ~dir + in + Memo.List.map unexpanded_file_bindings ~f:(fun fb -> let+ p = File_binding.Unexpanded.destination_relative_to_install_path fb ~section:Bin ~expand:(expand_str ~dir) diff --git a/duniverse/dune_/src/dune_rules/buildable_rules.ml b/duniverse/dune_/src/dune_rules/buildable_rules.ml index 85a553680..6a5764012 100644 --- a/duniverse/dune_/src/dune_rules/buildable_rules.ml +++ b/duniverse/dune_/src/dune_rules/buildable_rules.ml @@ -26,31 +26,42 @@ let with_lib_deps (t : Context.t) compile_info ~dir ~f = in Rules.prefix_rules prefix ~f -let modules_rules sctx (buildable : Dune_file.Buildable.t) expander ~dir scope - modules ~lib_name ~empty_intf_modules = +type kind = + | Executables of Dune_file.Buildable.t * (Loc.t * string) list + | Library of Dune_file.Buildable.t * Lib_name.Local.t + | Melange of + { preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t + ; preprocessor_deps : Dep_conf.t list + ; lint : Preprocess.Without_instrumentation.t Preprocess.Per_module.t + ; empty_module_interface_if_absent : bool + } + +let modules_rules ~preprocess ~preprocessor_deps ~lint + ~empty_module_interface_if_absent sctx expander ~dir scope modules ~lib_name + ~empty_intf_modules = let* pp = let instrumentation_backend = Lib.DB.instrumentation_backend (Scope.libs scope) in - let* preprocess = + let* preprocess_with_instrumentation = Resolve.Memo.read_memo - (Preprocess.Per_module.with_instrumentation buildable.preprocess + (Preprocess.Per_module.with_instrumentation preprocess ~instrumentation_backend) in let* instrumentation_deps = Resolve.Memo.read_memo - (Preprocess.Per_module.instrumentation_deps buildable.preprocess + (Preprocess.Per_module.instrumentation_deps preprocess ~instrumentation_backend) in - Preprocessing.make sctx ~dir ~scope ~preprocess ~expander - ~preprocessor_deps:buildable.preprocessor_deps ~instrumentation_deps - ~lint:buildable.lint ~lib_name + Preprocessing.make sctx ~dir ~scope + ~preprocess:preprocess_with_instrumentation ~expander ~preprocessor_deps + ~instrumentation_deps ~lint ~lib_name in let add_empty_intf = - let default = buildable.empty_module_interface_if_absent in + let default = empty_module_interface_if_absent in match empty_intf_modules with - | `Lib -> fun _ -> default - | `Exe_mains mains -> + | None -> fun _ -> default + | Some mains -> if Dune_project.executables_implicit_empty_intf (Scope.project scope) then let executable_names = List.map mains ~f:Module_name.of_string_allow_invalid @@ -67,3 +78,33 @@ let modules_rules sctx (buildable : Dune_file.Buildable.t) expander ~dir scope else Memo.return m) in (modules, pp) + +let modules_rules sctx kind expander ~dir scope modules = + let preprocess, preprocessor_deps, lint, empty_module_interface_if_absent = + match kind with + | Executables (buildable, _) | Library (buildable, _) -> + ( buildable.preprocess + , buildable.preprocessor_deps + , buildable.lint + , buildable.empty_module_interface_if_absent ) + | Melange + { preprocess + ; preprocessor_deps + ; lint + ; empty_module_interface_if_absent + } -> + (preprocess, preprocessor_deps, lint, empty_module_interface_if_absent) + in + let lib_name = + match kind with + | Executables _ | Melange _ -> None + | Library (_, name) -> Some name + in + let empty_intf_modules = + match kind with + | Executables (_, modules) -> Some modules + | Library _ | Melange _ -> None + in + modules_rules ~preprocess ~preprocessor_deps ~lint + ~empty_module_interface_if_absent sctx expander ~dir scope modules ~lib_name + ~empty_intf_modules diff --git a/duniverse/dune_/src/dune_rules/buildable_rules.mli b/duniverse/dune_/src/dune_rules/buildable_rules.mli index 9cc3d9d87..599eca58b 100644 --- a/duniverse/dune_/src/dune_rules/buildable_rules.mli +++ b/duniverse/dune_/src/dune_rules/buildable_rules.mli @@ -21,13 +21,21 @@ val with_lib_deps : -> f:(unit -> 'a Memo.t) -> 'a Memo.t +type kind = + | Executables of Dune_file.Buildable.t * (Loc.t * string) list + | Library of Dune_file.Buildable.t * Lib_name.Local.t + | Melange of + { preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t + ; preprocessor_deps : Dep_conf.t list + ; lint : Preprocess.Without_instrumentation.t Preprocess.Per_module.t + ; empty_module_interface_if_absent : bool + } + val modules_rules : Super_context.t - -> Dune_file.Buildable.t + -> kind -> Expander.t -> dir:Path.Build.t -> Scope.t -> Modules.t - -> lib_name:Lib_name.Local.t option - -> empty_intf_modules:[ `Exe_mains of (Loc.t * string) list | `Lib ] -> (Modules.t * Pp_spec.t) Memo.t diff --git a/duniverse/dune_/src/dune_rules/cinaps.ml b/duniverse/dune_/src/dune_rules/cinaps.ml index d1bd0497e..608f8237a 100644 --- a/duniverse/dune_/src/dune_rules/cinaps.ml +++ b/duniverse/dune_/src/dune_rules/cinaps.ml @@ -6,6 +6,8 @@ type t = ; libraries : Lib_dep.t list ; preprocess : Preprocess.Without_instrumentation.t Preprocess.Per_module.t ; preprocessor_deps : Dep_conf.t list + ; runtime_deps : Dep_conf.t list + ; cinaps_version : Syntax.Version.t } let name = "cinaps" @@ -14,7 +16,7 @@ type Stanza.t += T of t let syntax = Dune_lang.Syntax.create ~name ~desc:"the cinaps extension" - [ ((1, 0), `Since (1, 11)) ] + [ ((1, 0), `Since (1, 11)); ((1, 1), `Since (3, 5)) ] let alias = Alias.make (Alias.Name.of_string name) @@ -24,12 +26,23 @@ let decode = (let+ loc = loc and+ files = field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.any - and+ preprocess, preprocessor_deps = Dune_file.preprocess_fields + and+ preprocess, preprocessor_deps = Stanza_common.preprocess_fields and+ libraries = field "libraries" (Dune_file.Lib_deps.decode Executable) ~default:[] + and+ runtime_deps = + field ~default:[] "runtime_deps" + (Dune_lang.Syntax.since syntax (1, 1) >>> repeat Dep_conf.decode) + and+ cinaps_version = Dune_lang.Syntax.get_exn syntax (* TODO use this field? *) and+ _flags = Ocaml_flags.Spec.decode in - { loc; files; libraries; preprocess; preprocessor_deps }) + { loc + ; files + ; libraries + ; preprocess + ; preprocessor_deps + ; runtime_deps + ; cinaps_version + }) let () = let open Dune_lang.Decoder in @@ -80,8 +93,12 @@ let gen_rules sctx t ~dir ~scope = let cinaps_exe = Path.Build.relative cinaps_dir (name ^ ".exe") in let* () = (* Ask cinaps to produce a .ml file to build *) + let sandbox = + if t.cinaps_version >= (1, 1) then Sandbox_config.needs_sandboxing + else Sandbox_config.default + in Super_context.add_rule sctx ~loc:t.loc ~dir - (Command.run ~dir:(Path.build dir) prog + (Command.run ~dir:(Path.build dir) prog ~sandbox [ A "-staged" ; Target cinaps_ml ; Deps (List.map cinapsed_files ~f:Path.build) @@ -124,8 +141,16 @@ let gen_rules sctx t ~dir ~scope = let open Action_builder.O in let module A = Action in let cinaps_exe = Path.build cinaps_exe in + let runtime_deps, sandbox = + let sandbox = + if t.cinaps_version >= (1, 1) then Sandbox_config.needs_sandboxing + else Sandbox_config.no_special_requirements + in + Dep_conf_eval.unnamed ~sandbox ~expander t.runtime_deps + in + let* () = runtime_deps in let+ () = Action_builder.path cinaps_exe in - Action.Full.make + Action.Full.make ~sandbox @@ A.chdir (Path.build dir) (A.progn (A.run (Ok cinaps_exe) [ "-diff-cmd"; "-" ] diff --git a/duniverse/dune_/src/dune_rules/cm_files.ml b/duniverse/dune_/src/dune_rules/cm_files.ml index f95c5d52b..7522f755b 100644 --- a/duniverse/dune_/src/dune_rules/cm_files.ml +++ b/duniverse/dune_/src/dune_rules/cm_files.ml @@ -22,7 +22,9 @@ let make ?(excluded_modules = []) ~obj_dir ~modules ~top_sorted_modules ~ext_obj let objects_and_cms t ~mode modules = let kind = Mode.cm_kind mode in let modules = filter_excluded_modules t modules in - let cm_files = Obj_dir.Module.L.cm_files t.obj_dir modules ~kind in + let cm_files = + Obj_dir.Module.L.cm_files t.obj_dir modules ~kind:(Ocaml kind) + in match mode with | Byte -> cm_files | Native -> @@ -35,7 +37,7 @@ let top_sorted_cms t ~mode = let kind = Mode.cm_kind mode in Action_builder.map t.top_sorted_modules ~f:(fun modules -> let modules = filter_excluded_modules t modules in - Obj_dir.Module.L.cm_files t.obj_dir ~kind modules) + Obj_dir.Module.L.cm_files t.obj_dir ~kind:(Ocaml kind) modules) let top_sorted_objects_and_cms t ~mode = Action_builder.map t.top_sorted_modules ~f:(fun modules -> diff --git a/duniverse/dune_/src/dune_rules/compilation_context.ml b/duniverse/dune_/src/dune_rules/compilation_context.ml index 7c6048cee..cba3358bd 100644 --- a/duniverse/dune_/src/dune_rules/compilation_context.ml +++ b/duniverse/dune_/src/dune_rules/compilation_context.ml @@ -1,41 +1,51 @@ open Import module Includes = struct - type t = Command.Args.without_targets Command.Args.t Cm_kind.Dict.t + type t = Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t - let make ~project ~opaque ~requires : _ Cm_kind.Dict.t = + let make ~project ~opaque ~requires : _ Lib_mode.Cm_kind.Map.t = let open Resolve.Memo.O in let iflags libs mode = Lib_flags.L.include_flags ~project libs mode in - let cmi_includes = + let make_includes_args ~mode groups = Command.Args.memo (Resolve.Memo.args (let+ libs = requires in Command.Args.S - [ iflags libs Byte - ; Hidden_deps (Lib_file_deps.deps libs ~groups:[ Cmi ]) + [ iflags libs mode + ; Hidden_deps (Lib_file_deps.deps libs ~groups) ])) in + let cmi_includes = make_includes_args ~mode:(Ocaml Byte) [ Ocaml Cmi ] in let cmx_includes = Command.Args.memo (Resolve.Memo.args (let+ libs = requires in Command.Args.S - [ iflags libs Native + [ iflags libs (Ocaml Native) ; Hidden_deps (if opaque then List.map libs ~f:(fun lib -> ( lib - , if Lib.is_local lib then [ Lib_file_deps.Group.Cmi ] - else [ Cmi; Cmx ] )) + , if Lib.is_local lib then + [ Lib_file_deps.Group.Ocaml Cmi ] + else [ Ocaml Cmi; Ocaml Cmx ] )) |> Lib_file_deps.deps_with_exts else Lib_file_deps.deps libs - ~groups:[ Lib_file_deps.Group.Cmi; Cmx ]) + ~groups:[ Lib_file_deps.Group.Ocaml Cmi; Ocaml Cmx ]) ])) in - { cmi = cmi_includes; cmo = cmi_includes; cmx = cmx_includes } + let melange_cmi_includes = + make_includes_args ~mode:Melange [ Melange Cmi ] + in + let melange_cmj_includes = + make_includes_args ~mode:Melange [ Melange Cmi; Melange Cmj ] + in + { ocaml = { cmi = cmi_includes; cmo = cmi_includes; cmx = cmx_includes } + ; melange = { cmi = melange_cmi_includes; cmj = melange_cmj_includes } + } - let empty = Cm_kind.Dict.make_all Command.Args.empty + let empty = Lib_mode.Cm_kind.Map.make_all Command.Args.empty end type opaque = @@ -73,7 +83,7 @@ type t = ; sandbox : Sandbox_config.t ; package : Package.t option ; vimpl : Vimpl.t option - ; modes : Mode.Dict.Set.t + ; modes : Lib_mode.Map.Set.t ; bin_annot : bool ; ocamldep_modules_data : Ocamldep.Modules_data.t ; loc : Loc.t option @@ -147,9 +157,12 @@ let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags in let modes = let default = - Mode.Dict.make_both (Some Dune_file.Mode_conf.Kind.Inherited) + { Lib_mode.Map.ocaml = + Mode.Dict.make_both (Some Dune_file.Mode_conf.Kind.Inherited) + ; melange = None + } in - Option.value ~default modes |> Mode.Dict.map ~f:Option.is_some + Option.value ~default modes |> Lib_mode.Map.map ~f:Option.is_some in let opaque = eval_opaque (Super_context.context super_context) opaque in let ocamldep_modules_data : Ocamldep.Modules_data.t = @@ -282,3 +295,7 @@ let root_module_entries t = >>= Resolve.read) in Action_builder.return (List.concat l) + +let set_obj_dir t obj_dir = { t with obj_dir } + +let set_modes t ~modes = { t with modes } diff --git a/duniverse/dune_/src/dune_rules/compilation_context.mli b/duniverse/dune_/src/dune_rules/compilation_context.mli index e07a2b0dc..5527eee17 100644 --- a/duniverse/dune_/src/dune_rules/compilation_context.mli +++ b/duniverse/dune_/src/dune_rules/compilation_context.mli @@ -35,7 +35,7 @@ val create : -> js_of_ocaml:Js_of_ocaml.In_context.t option -> package:Package.t option -> ?vimpl:Vimpl.t - -> ?modes:Dune_file.Mode_conf.Set.Details.t Mode.Dict.t + -> ?modes:Dune_file.Mode_conf.Set.Details.t Lib_mode.Map.t -> ?bin_annot:bool -> ?loc:Loc.t -> unit @@ -66,7 +66,8 @@ val requires_link : t -> Lib.t list Resolve.Memo.t val requires_compile : t -> Lib.t list Resolve.Memo.t -val includes : t -> Command.Args.without_targets Command.Args.t Cm_kind.Dict.t +val includes : + t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t val preprocessing : t -> Pp_spec.t @@ -84,7 +85,7 @@ val package : t -> Package.t option val vimpl : t -> Vimpl.t option -val modes : t -> Mode.Dict.Set.t +val modes : t -> Lib_mode.Map.Set.t val for_wrapped_compat : t -> t @@ -108,3 +109,7 @@ val dep_graphs : t -> Dep_graph.t Ml_kind.Dict.t val ocamldep_modules_data : t -> Ocamldep.Modules_data.t val loc : t -> Loc.t option + +val set_obj_dir : t -> Path.Build.t Obj_dir.t -> t + +val set_modes : t -> modes:Lib_mode.Map.Set.t -> t diff --git a/duniverse/dune_/src/dune_rules/context.ml b/duniverse/dune_/src/dune_rules/context.ml index d01129efc..ebcf04402 100644 --- a/duniverse/dune_/src/dune_rules/context.ml +++ b/duniverse/dune_/src/dune_rules/context.ml @@ -38,7 +38,7 @@ module Bin = struct let prog = add_exe prog in Memo.List.find_map path ~f:(fun dir -> let fn = Path.relative dir prog in - let+ exists = Fs_memo.file_exists fn in + let+ exists = Fs_memo.file_exists (Path.as_outside_build_dir_exn fn) in if exists then Some fn else None) end @@ -51,7 +51,7 @@ module Program = struct let best_path dir program = let exe_path program = let fn = Path.relative dir (program ^ Bin.exe) in - let+ exists = Fs_memo.file_exists fn in + let+ exists = Fs_memo.file_exists (Path.as_outside_build_dir_exn fn) in if exists then Some fn else None in if List.mem programs_for_which_we_prefer_opt_ext program ~equal:String.equal @@ -514,9 +514,8 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets else env in let env = - let cwd = Sys.getcwd () in let extend_var var ?(path_sep = Bin.path_sep) v = - let v = Filename.concat cwd (Path.Build.to_string v) in + let v = Path.to_absolute_filename (Path.build v) in match Env.get env var with | None -> (var, v) | Some prev -> (var, sprintf "%s%c%s" v path_sep prev) @@ -865,7 +864,7 @@ module DB = struct get context end -let compiler t (mode : Mode.t) = +let compiler t (mode : Ocaml.Mode.t) = match mode with | Byte -> Ok t.ocamlc | Native -> t.ocamlopt @@ -979,7 +978,6 @@ let force_configurator_files = List.concat_map ctxs ~f:(fun t -> [ Path.build (configurator_v1 t); Path.build (configurator_v2 t) ]) in - Memo.parallel_iter files ~f:(fun file -> - Build_system.build_file file >>| ignore)) + Memo.parallel_iter files ~f:Build_system.build_file) let make t = Memo.Lazy.force t.make diff --git a/duniverse/dune_/src/dune_rules/context.mli b/duniverse/dune_/src/dune_rules/context.mli index 281c54144..57ae0ec73 100644 --- a/duniverse/dune_/src/dune_rules/context.mli +++ b/duniverse/dune_/src/dune_rules/context.mli @@ -106,7 +106,7 @@ val to_dyn_concise : t -> Dyn.t val compare : t -> t -> Ordering.t (** Return the compiler needed for this compilation mode *) -val compiler : t -> Mode.t -> Action.Prog.t +val compiler : t -> Ocaml.Mode.t -> Action.Prog.t (** Return what [%{make}] should expand into *) val make : t -> Path.t option Memo.t diff --git a/duniverse/dune_/src/dune_rules/coq_config.ml b/duniverse/dune_/src/dune_rules/coq_config.ml new file mode 100644 index 000000000..0a9e230e9 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/coq_config.ml @@ -0,0 +1,195 @@ +open Import +open Memo.O + +module Value = struct + type t = + | Bool of bool + | Int of int + | String of string + | Strings of string list + | Path of Path.t +end + +module Vars : sig + type t + + val get : t -> string -> string + + val get_path : t -> string -> Path.t + + val of_lines : string list -> (t, User_message.Style.t Pp.t) result + + exception E of User_message.Style.t Pp.t +end = struct + open Result.O + + type t = string String.Map.t + + let of_lines lines = + let rec loop acc = function + | [] -> Ok acc + | line :: lines -> ( + match String.index line '=' with + | Some i -> + let x = (String.take line i, String.drop line (i + 1)) in + loop (x :: acc) lines + | None -> Error Pp.(textf "Unrecognized line: %S" line)) + in + let* vars = loop [] lines in + Result.map_error (String.Map.of_list vars) ~f:(fun (var, _, _) -> + Pp.(textf "Variable %S present twice." var)) + + exception E of User_message.Style.t Pp.t + + let fail fmt msg = raise (E (Pp.textf fmt msg)) + + let get_opt = String.Map.find + + let get t var = + match get_opt t var with + | Some s -> s + | None -> fail "Variable %S not found." var + + let get_path t var = get t var |> Path.of_string +end + +module Version = struct + module Num = struct + type t = + { major : int + ; minor : int + ; suffix : string + } + + let make version_string = + let open Dune_re in + let regex = + let open Re in + seq + [ rep digit |> group; char '.'; rep digit |> group; rep any |> group ] + |> compile + in + let open Result.O in + let* groups = + Re.exec_opt regex version_string |> function + | Some groups -> Result.Ok groups + | None -> Result.Error Pp.(textf "Could not parse version string.") + in + let* major = + let major = Group.get groups 1 in + major |> Int.of_string |> function + | Some major -> Result.Ok major + | None -> Result.Error Pp.(textf "Could not parse int: %S." major) + in + let* minor = + let minor = Group.get groups 2 in + minor |> Int.of_string |> function + | Some minor -> Result.Ok minor + | None -> Result.Error Pp.(textf "Could not parse int: %S." minor) + in + let suffix = Group.get groups 3 in + Result.Ok { major; minor; suffix } + + let by_name { major; minor; suffix } name : Value.t option = + match name with + | "major" -> Some (Int major) + | "minor" -> Some (Int minor) + | "suffix" -> Some (String suffix) + | _ -> None + end + + type t = + { version_num : Num.t + ; version_string : string + ; ocaml_version_string : string + } + + let impl_version bin = + let* _ = Build_system.build_file bin in + Memo.of_reproducible_fiber + @@ Process.run_capture_line Process.Strict bin [ "--print-version" ] + + let version_memo = + Memo.create "coq-and-ocaml-version" ~input:(module Path) impl_version + + let make ~bin = + let open Memo.O in + let+ coq_and_ocaml_version = Memo.exec version_memo bin in + let sbin = Path.to_string bin in + let open Result.O in + let* version_string, ocaml_version_string = + String.lsplit2 ~on:' ' coq_and_ocaml_version |> function + | Some (version_string, ocaml_version_string) -> + Result.ok (version_string, ocaml_version_string) + | None -> + Result.Error + Pp.(textf "Unable to parse output of %s --print-version." sbin) + in + let* version_num = Num.make version_string in + Result.ok { version_num; version_string; ocaml_version_string } + + let by_name t name : Value.t option = + match t with + | Error msg -> + User_error.raise Pp.[ textf "Could not parse coqc version: "; msg ] + | Ok { version_num; version_string; ocaml_version_string } -> ( + match name with + | "version.major" -> Num.by_name version_num "major" + | "version.minor" -> Num.by_name version_num "minor" + | "version.revision" -> Num.by_name version_num "revision" + | "version.suffix" -> Num.by_name version_num "suffix" + | "version" -> Some (String version_string) + | "ocaml-version" -> Some (String ocaml_version_string) + | _ -> None) +end + +type t = + { version_info : (Version.t, User_message.Style.t Pp.t) Result.t + ; coqlib : Path.t + ; coq_native_compiler_default : string + } + +let impl_config bin = + let* _ = Build_system.build_file bin in + Memo.of_reproducible_fiber + @@ Process.run_capture_lines Process.Strict bin [ "--config" ] + +let config_memo = Memo.create "coq-config" ~input:(module Path) impl_config + +let version ~bin = + let open Memo.O in + let+ t = Version.make ~bin in + let open Result.O in + let+ t = t in + t.version_string + +let make ~bin = + let open Memo.O in + let+ config_lines = Memo.exec config_memo bin + and+ version_info = Version.make ~bin in + match Vars.of_lines config_lines with + | Error msg -> + User_error.raise + Pp. + [ textf "cannot parse output of %S --config:" (Path.to_string bin) + ; msg + ] + | Ok vars -> + let coqlib = Vars.get_path vars "COQLIB" in + let coq_native_compiler_default = + Vars.get vars "COQ_NATIVE_COMPILER_DEFAULT" + in + { version_info; coqlib; coq_native_compiler_default } + +let by_name { version_info; coqlib; coq_native_compiler_default } name : + Value.t option = + match name with + | "version.major" + | "version.minor" + | "version.revision" + | "version.suffix" + | "version" + | "ocaml-version" -> Version.by_name version_info name + | "coqlib" -> Some (Path coqlib) + | "coq_native_compiler_default" -> Some (String coq_native_compiler_default) + | _ -> None diff --git a/duniverse/dune_/src/dune_rules/coq_config.mli b/duniverse/dune_/src/dune_rules/coq_config.mli new file mode 100644 index 000000000..5c02484de --- /dev/null +++ b/duniverse/dune_/src/dune_rules/coq_config.mli @@ -0,0 +1,18 @@ +open Import + +type t + +val version : bin:Path.t -> (string, User_message.Style.t Pp.t) Result.t Memo.t + +val make : bin:Path.t -> t Memo.t + +module Value : sig + type t = + | Bool of bool + | Int of int + | String of string + | Strings of string list + | Path of Path.t +end + +val by_name : t -> string -> Value.t option diff --git a/duniverse/dune_/src/dune_rules/coq_lib.ml b/duniverse/dune_/src/dune_rules/coq_lib.ml index 9dcf26f6e..5b1470593 100644 --- a/duniverse/dune_/src/dune_rules/coq_lib.ml +++ b/duniverse/dune_/src/dune_rules/coq_lib.ml @@ -50,6 +50,8 @@ include struct ; boot : t option Resolve.t ; id : Id.t ; implicit : bool (* Only useful for the stdlib *) + ; use_stdlib : bool + (* whether this theory uses the stdlib, eventually set to false for all libs *) ; src_root : Path.Build.t ; obj_root : Path.Build.t ; theories : (Loc.t * t) list Resolve.t @@ -183,6 +185,7 @@ module DB = struct let open Memo.O in let* boot = if s.boot then Resolve.Memo.return None else boot coq_db in let allow_private_deps = Option.is_none s.package in + let use_stdlib = s.buildable.use_stdlib in let+ libraries = Resolve.Memo.List.map s.buildable.plugins ~f:(fun (loc, lib) -> let open Resolve.Memo.O in @@ -237,19 +240,27 @@ module DB = struct | Some _ -> Resolve.Memo.return () | None -> Error.private_deps_not_allowed ~loc theory_name in - (loc, theory)) in + let theories = + let open Resolve.O in + let* boot = boot in + match boot with + | Some boot when use_stdlib && not s.boot -> + let+ theories = theories in + (boot.loc, boot) :: theories + | Some _ | None -> theories + in let map_error x = let human_readable_description () = Id.pp id in Resolve.push_stack_frame ~human_readable_description x in let theories = map_error theories in let libraries = map_error libraries in - { loc = s.buildable.loc ; boot ; id + ; use_stdlib ; implicit = s.boot ; obj_root = dir ; src_root = dir diff --git a/duniverse/dune_/src/dune_rules/coq_module.ml b/duniverse/dune_/src/dune_rules/coq_module.ml index 3843c9fc6..7fe823d81 100644 --- a/duniverse/dune_/src/dune_rules/coq_module.ml +++ b/duniverse/dune_/src/dune_rules/coq_module.ml @@ -92,7 +92,7 @@ let obj_files x ~wrapper_name ~mode ~obj_dir ~obj_files_mode = in let obj_files = match obj_files_mode with - | Build -> [ x.name ^ ".vo"; "." ^ x.name ^ ".aux"; x.name ^ ".glob" ] + | Build -> [ x.name ^ ".vo"; x.name ^ ".glob" ] | Install -> [ x.name ^ ".vo" ] in List.map obj_files ~f:(fun fname -> diff --git a/duniverse/dune_/src/dune_rules/coq_rules.ml b/duniverse/dune_/src/dune_rules/coq_rules.ml index c6fb7d742..4b40e7f82 100644 --- a/duniverse/dune_/src/dune_rules/coq_rules.ml +++ b/duniverse/dune_/src/dune_rules/coq_rules.ml @@ -21,7 +21,7 @@ module Util = struct List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> let info = Lib.info t in (* We want the cmi files *) - let obj_dir = Obj_dir.public_cmi_dir (Lib_info.obj_dir info) in + let obj_dir = Obj_dir.public_cmi_ocaml_dir (Lib_info.obj_dir info) in Path.Set.add acc obj_dir) let include_flags ts = include_paths ts |> Lib_flags.L.to_iflags @@ -32,7 +32,7 @@ module Util = struct let plugins = let info = Lib.info lib in let plugins = Lib_info.plugins info in - Mode.Dict.get plugins Mode.Native + Mode.Dict.get plugins Native in let to_mlpack file = [ Path.set_extension file ~ext:".mlpack" @@ -51,9 +51,83 @@ module Util = struct ] end -let resolve_program sctx ~loc ~dir prog = - Super_context.resolve_program ~dir sctx prog ~loc:(Some loc) - ~hint:"opam install coq" +let resolve_program sctx ~loc ~dir ?(hint = "opam install coq") prog = + Super_context.resolve_program ~dir sctx prog ~loc:(Some loc) ~hint + +module Coq_plugin = struct + let meta_info ~coq_lang_version ~plugin_loc ~context (lib : Lib.t) = + let debug = false in + let name = Lib.name lib |> Lib_name.to_string in + if debug then Format.eprintf "Meta info for %s@\n" name; + match Lib_info.status (Lib.info lib) with + | Public (_, pkg) -> + let package = Package.name pkg in + let meta_i = + Path.Build.relative + (Local_install_path.lib_dir ~context ~package) + "META" + in + if debug then + Format.eprintf "Meta for %s: %s@\n" name (Path.Build.to_string meta_i); + Some (Path.build meta_i) + | Installed -> None + | Installed_private | Private _ -> + let is_error = coq_lang_version >= (0, 6) in + let text = if is_error then "not supported" else "deprecated" in + User_warning.emit ?loc:plugin_loc ~is_error + [ Pp.textf "Using private library %s as a Coq plugin is %s" name text ]; + None + + (* compute include flags and mlpack rules *) + let setup_ml_deps ~coq_lang_version ~context ~plugin_loc libs theories = + (* Pair of include flags and paths to mlpack *) + let libs = + let open Resolve.Memo.O in + let* theories = theories in + let* theories = + Resolve.Memo.lift + @@ Resolve.List.concat_map ~f:Coq_lib.libraries theories + in + let libs = libs @ theories in + Lib.closure ~linking:false (List.map ~f:snd libs) + in + let flags = + Resolve.Memo.args (Resolve.Memo.map libs ~f:Util.include_flags) + in + let open Action_builder.O in + ( flags + , let* libs = Resolve.Memo.read libs in + (* If the mlpack files don't exist, don't fail *) + Action_builder.all_unit + [ Action_builder.paths + (List.filter_map + ~f:(meta_info ~plugin_loc ~coq_lang_version ~context) + libs) + ; Action_builder.paths_existing + (List.concat_map ~f:Util.ml_pack_files libs) + ] ) + + let of_buildable ~context ~lib_db ~theories_deps + (buildable : Coq_stanza.Buildable.t) = + let res = + let open Resolve.Memo.O in + let+ libs = + Resolve.Memo.List.map buildable.plugins ~f:(fun (loc, name) -> + let+ lib = Lib.DB.resolve lib_db (loc, name) in + (loc, lib)) + in + let coq_lang_version = buildable.coq_lang_version in + let plugin_loc = List.hd_opt buildable.plugins |> Option.map ~f:fst in + setup_ml_deps ~plugin_loc ~coq_lang_version ~context libs theories_deps + in + let ml_flags = Resolve.Memo.map res ~f:fst in + let mlpack_rule = + let open Action_builder.O in + let* _, mlpack_rule = Resolve.Memo.read res in + mlpack_rule + in + (ml_flags, mlpack_rule) +end module Bootstrap = struct (* the internal boot flag determines if the Coq "standard library" is being @@ -69,7 +143,7 @@ module Bootstrap = struct (** We are compiling the prelude itself [should be replaced with (per_file ...) flags] *) - let get ~boot_lib ~wrapper_name coq_module = + let get_for_module ~boot_lib ~wrapper_name coq_module = match boot_lib with | None -> No_boot | Some (_loc, lib) -> ( @@ -84,11 +158,15 @@ module Bootstrap = struct | false -> Bootstrap lib | true -> Bootstrap_prelude) + let get ~use_stdlib ~boot_lib ~wrapper_name coq_module = + if not use_stdlib then Bootstrap_prelude + else get_for_module ~boot_lib ~wrapper_name coq_module + let boot_lib_flags ~coqdoc lib : _ Command.Args.t = let dir = Coq_lib.src_root lib in S (if coqdoc then [ A "--coqlib"; Path (Path.build dir) ] - else [ A "-boot"; Util.theory_coqc_flag lib ]) + else [ A "-boot" ]) let flags ~coqdoc t : _ Command.Args.t = match t with @@ -117,8 +195,9 @@ let rec resolve_first lib_db = function module Context = struct type 'a t = { coqdep : Action.Prog.t - ; coqc : Action.Prog.t * Path.Build.t + ; coqc : Action.Prog.t ; coqdoc : Action.Prog.t + ; coqc_dir : Path.Build.t ; wrapper_name : string ; dir : Path.Build.t ; expander : Expander.t @@ -128,6 +207,7 @@ module Context = struct ; ml_flags : 'a Command.Args.t Resolve.Memo.t ; scope : Scope.t ; boot_type : Bootstrap.t Resolve.Memo.t + ; use_stdlib : bool ; profile_flags : string list Action_builder.t ; mode : Coq_mode.t ; native_includes : Path.Set.t Resolve.t @@ -135,8 +215,8 @@ module Context = struct } let coqc ?stdout_to t args = - let dir = Path.build (snd t.coqc) in - Command.run ~dir ?stdout_to (fst t.coqc) args + let dir = Path.build t.coqc_dir in + Command.run ~dir ?stdout_to t.coqc args let coq_flags t = let standard = t.profile_flags in @@ -218,26 +298,6 @@ module Context = struct ; S file_flags ] - (* compute include flags and mlpack rules *) - let setup_ml_deps libs theories = - (* Pair of include flags and paths to mlpack *) - let libs = - let open Resolve.Memo.O in - let* theories = theories in - let* theories = - Resolve.Memo.lift - @@ Resolve.List.concat_map ~f:Coq_lib.libraries theories - in - let libs = libs @ theories in - Lib.closure ~linking:false (List.map ~f:snd libs) - in - ( Resolve.Memo.args (Resolve.Memo.map libs ~f:Util.include_flags) - , let open Action_builder.O in - let* libs = Resolve.Memo.read libs in - (* If the mlpack files don't exist, don't fail *) - Action_builder.paths_existing (List.concat_map ~f:Util.ml_pack_files libs) - ) - let directories_of_lib ~sctx lib = let name = Coq_lib.name lib in let dir = Coq_lib.src_root lib in @@ -260,28 +320,15 @@ module Context = struct let create ~coqc_dir sctx ~dir ~wrapper_name ~theories_deps ~theory_dirs (buildable : Buildable.t) = let loc = buildable.loc in + let use_stdlib = buildable.use_stdlib in let rr = resolve_program sctx ~dir ~loc in + let context = Super_context.context sctx |> Context.name in let* expander = Super_context.expander sctx ~dir in let* scope = Scope.DB.find_by_dir dir in let lib_db = Scope.libs scope in (* ML-level flags for depending libraries *) let ml_flags, mlpack_rule = - let res = - let open Resolve.Memo.O in - let+ libs = - Resolve.Memo.List.map buildable.plugins ~f:(fun (loc, name) -> - let+ lib = Lib.DB.resolve lib_db (loc, name) in - (loc, lib)) - in - setup_ml_deps libs theories_deps - in - let ml_flags = Resolve.Memo.map res ~f:fst in - let mlpack_rule = - let open Action_builder.O in - let* _, mlpack_rule = Resolve.Memo.read res in - mlpack_rule - in - (ml_flags, mlpack_rule) + Coq_plugin.of_buildable ~context ~theories_deps ~lib_db buildable in let mode = select_native_mode ~sctx ~buildable in let* native_includes = @@ -296,8 +343,9 @@ module Context = struct and+ coqdoc = rr "coqdoc" and+ profile_flags = Super_context.coq sctx ~dir in { coqdep - ; coqc = (coqc, coqc_dir) + ; coqc ; coqdoc + ; coqc_dir ; wrapper_name ; dir ; expander @@ -307,6 +355,7 @@ module Context = struct ; ml_flags ; scope ; boot_type = Resolve.Memo.return Bootstrap.No_boot + ; use_stdlib ; profile_flags ; mode ; native_includes @@ -317,7 +366,8 @@ module Context = struct let boot_type = let open Resolve.Memo.O in let+ boot_lib = t.scope |> Scope.coq_libs |> Coq_lib.DB.boot_library in - Bootstrap.get ~boot_lib ~wrapper_name:t.wrapper_name coq_module + Bootstrap.get ~use_stdlib:t.use_stdlib ~boot_lib + ~wrapper_name:t.wrapper_name coq_module in { t with boot_type } end @@ -483,7 +533,7 @@ let coqdoc_rule (cctx : _ Context.t) ~sctx ~name ~file_flags ~mode |> Action_builder.With_targets.map ~f: (Action.Full.map ~f:(fun coqdoc -> - Action.Progn [ Action.mkdir (Path.build doc_dir); coqdoc ])) + Action.Progn [ Action.mkdir doc_dir; coqdoc ])) |> Action_builder.With_targets.add_directories ~directory_targets:[ doc_dir ] let setup_coqc_rule ~loc ~sctx (cctx : _ Context.t) ~file_targets coq_module = @@ -498,8 +548,8 @@ let setup_coqc_rule ~loc ~sctx (cctx : _ Context.t) ~file_targets coq_module = let setup_rule ~loc ~sctx ~dir ~source_rule ~file_targets cctx m = let cctx = Context.for_module cctx m in - let* () = setup_coqc_rule ~file_targets ~sctx ~loc cctx m ~dir in - setup_coqdep_rule ~sctx ~loc cctx ~source_rule m ~dir + setup_coqc_rule ~file_targets ~sctx ~loc cctx m ~dir + >>> setup_coqdep_rule ~sctx ~loc cctx ~source_rule m ~dir let coq_modules_of_theory ~sctx lib = Action_builder.of_memo @@ -568,8 +618,7 @@ let setup_coqdoc_rules ~sctx ~dir ~cctx (s : Theory.t) coq_modules = |> Path.build |> Action_builder.path |> Rules.Produce.Alias.add_deps (Coqdoc_mode.alias mode ~dir) ~loc in - let* () = rule Html in - rule Latex + rule Html >>> rule Latex let setup_rules ~sctx ~dir ~dir_contents (s : Theory.t) = let theory = @@ -581,9 +630,8 @@ let setup_rules ~sctx ~dir ~dir_contents (s : Theory.t) = let* cctx, coq_modules = setup_cctx_and_modules ~sctx ~dir ~dir_contents s theory in - let* () = setup_vo_rules ~sctx ~dir ~cctx s theory coq_modules in - let+ () = setup_coqdoc_rules ~sctx ~dir ~cctx s coq_modules in - () + setup_vo_rules ~sctx ~dir ~cctx s theory coq_modules + >>> setup_coqdoc_rules ~sctx ~dir ~cctx s coq_modules let coqtop_args_theory ~sctx ~dir ~dir_contents (s : Theory.t) coq_module = let name = s.name in @@ -593,23 +641,15 @@ let coqtop_args_theory ~sctx ~dir ~dir_contents (s : Theory.t) coq_module = Coq_lib.DB.resolve coq_lib_db name ~coq_lang_version:s.buildable.coq_lang_version in - let name = snd s.name in - let* coq_dir_contents = Dir_contents.coq dir_contents in - let* cctx = - let wrapper_name = Coq_lib_name.wrapper name in - let theories_deps = - Resolve.Memo.bind theory ~f:(fun theory -> - Resolve.Memo.lift @@ Coq_lib.theories_closure theory) - in - let theory_dirs = Coq_sources.directories coq_dir_contents ~name in - let theory_dirs = Path.Build.Set.of_list theory_dirs in - let coqc_dir = (Super_context.context sctx).build_dir in - Context.create sctx ~coqc_dir ~dir ~wrapper_name ~theories_deps ~theory_dirs - s.buildable - in + let* cctx, _ = setup_cctx_and_modules ~sctx ~dir ~dir_contents s theory in let cctx = Context.for_module cctx coq_module in let+ boot_type = Resolve.Memo.read_memo cctx.boot_type in - (Context.coqc_file_flags cctx, boot_type) + ( (let open Action_builder.O in + let+ coq_flags = Context.coq_flags cctx in + Command.Args.As coq_flags + :: Command.Args.S [ Context.coqc_native_flags cctx ] + :: Context.coqc_file_flags cctx) + , boot_type ) (******************************************************************************) (* Install rules *) @@ -631,7 +671,7 @@ let coq_plugins_install_rules ~scope ~package ~dst_dir (s : Theory.t) = then let loc = Lib_info.loc info in let plugins = Lib_info.plugins info in - Mode.Dict.get plugins Mode.Native + Mode.Dict.get plugins Native |> List.map ~f:(fun plugin_file -> (* Safe because all coq libraries are local for now *) let plugin_file = Path.as_in_build_dir_exn plugin_file in @@ -639,8 +679,10 @@ let coq_plugins_install_rules ~scope ~package ~dst_dir (s : Theory.t) = let dst = Path.Local.(to_string (relative dst_dir plugin_file_basename)) in - let entry = Install.Entry.make Section.Lib_root ~dst plugin_file in - (* TODO this [loc] should come from [s.buildable.libraries] *) + let entry = + (* TODO this [loc] should come from [s.buildable.libraries] *) + Install.Entry.make Section.Lib_root ~dst ~kind:`File plugin_file + in Install.Entry.Sourced.create ~loc entry) else [] in @@ -678,6 +720,7 @@ let install_rules ~sctx ~dir s = let make_entry (orig_file : Path.Build.t) (dst_file : string) = let entry = Install.Entry.make Section.Lib_root ~dst:(to_dst dst_file) orig_file + ~kind:`File in Install.Entry.Sourced.create ~loc entry in @@ -696,20 +739,21 @@ let install_rules ~sctx ~dir s = make_entry vfile vfile_dst :: obj_files) |> List.rev_append coq_plugins_install_rules -let setup_coqpp_rules ~sctx ~dir (s : Coqpp.t) = - let* coqpp = resolve_program sctx ~dir ~loc:s.loc "coqpp" in +let setup_coqpp_rules ~sctx ~dir ({ loc; modules } : Coqpp.t) = + let* coqpp = resolve_program sctx ~dir ~loc "coqpp" + and* mlg_files = Coq_sources.mlg_files ~sctx ~dir ~modules in let mlg_rule m = - let source = Path.build (Path.Build.relative dir (m ^ ".mlg")) in - let target = Path.Build.relative dir (m ^ ".ml") in + let source = Path.build m in + let target = Path.Build.set_extension m ~ext:".ml" in let args = [ Command.Args.Dep source; Hidden_targets [ target ] ] in let build_dir = (Super_context.context sctx).build_dir in Command.run ~dir:(Path.build build_dir) coqpp args in - List.rev_map ~f:mlg_rule s.modules - |> Super_context.add_rules ~loc:s.loc ~dir sctx + List.rev_map ~f:mlg_rule mlg_files |> Super_context.add_rules ~loc ~dir sctx -let setup_extraction_rules ~sctx ~dir ~dir_contents (s : Extraction.t) = - let* cctx = +let setup_extraction_cctx_and_modules ~sctx ~dir ~dir_contents + (s : Extraction.t) = + let+ cctx = let wrapper_name = "DuneExtraction" in let* theories_deps = let* scope = Scope.DB.find_by_dir dir in @@ -721,10 +765,12 @@ let setup_extraction_rules ~sctx ~dir ~dir_contents (s : Extraction.t) = let theories_deps = Resolve.Memo.lift theories_deps in Context.create sctx ~coqc_dir:dir ~dir ~wrapper_name ~theories_deps ~theory_dirs s.buildable - in - let* coq_module = - let+ coq = Dir_contents.coq dir_contents in - Coq_sources.extract coq s + and+ coq = Dir_contents.coq dir_contents in + (cctx, Coq_sources.extract coq s) + +let setup_extraction_rules ~sctx ~dir ~dir_contents (s : Extraction.t) = + let* cctx, coq_module = + setup_extraction_cctx_and_modules ~sctx ~dir ~dir_contents s in let ml_targets = Extraction.ml_target_fnames s |> List.map ~f:(Path.Build.relative dir) @@ -738,23 +784,14 @@ let setup_extraction_rules ~sctx ~dir ~dir_contents (s : Extraction.t) = ~source_rule coq_module let coqtop_args_extraction ~sctx ~dir ~dir_contents (s : Extraction.t) = - let* cctx = - let wrapper_name = "DuneExtraction" in - let* theories_deps = - let* scope = Scope.DB.find_by_dir dir in - let coq_lib_db = Scope.coq_libs scope in - Coq_lib.DB.requires_for_user_written coq_lib_db s.buildable.theories - ~coq_lang_version:s.buildable.coq_lang_version - in - let theory_dirs = Path.Build.Set.empty in - let theories_deps = Resolve.Memo.lift theories_deps in - Context.create sctx ~coqc_dir:dir ~dir ~wrapper_name ~theories_deps - ~theory_dirs s.buildable - in - let* coq_module = - let+ coq = Dir_contents.coq dir_contents in - Coq_sources.extract coq s + let* cctx, coq_module = + setup_extraction_cctx_and_modules ~sctx ~dir ~dir_contents s in let cctx = Context.for_module cctx coq_module in let+ boot_type = Resolve.Memo.read_memo cctx.boot_type in - (Context.coqc_file_flags cctx, boot_type) + ( (let open Action_builder.O in + let+ coq_flags = Context.coq_flags cctx in + Command.Args.As coq_flags + :: Command.Args.S [ Context.coqc_native_flags cctx ] + :: Context.coqc_file_flags cctx) + , boot_type ) diff --git a/duniverse/dune_/src/dune_rules/coq_rules.mli b/duniverse/dune_/src/dune_rules/coq_rules.mli index 157371123..ab891ce2d 100644 --- a/duniverse/dune_/src/dune_rules/coq_rules.mli +++ b/duniverse/dune_/src/dune_rules/coq_rules.mli @@ -57,11 +57,11 @@ val coqtop_args_theory : -> dir_contents:Dir_contents.t -> Theory.t -> Coq_module.t - -> ('a Command.Args.t list * Bootstrap.t) Memo.t + -> ('a Command.Args.t list Action_builder.t * Bootstrap.t) Memo.t val coqtop_args_extraction : sctx:Super_context.t -> dir:Path.Build.t -> dir_contents:Dir_contents.t -> Extraction.t - -> ('a Command.Args.t list * Bootstrap.t) Memo.t + -> ('a Command.Args.t list Action_builder.t * Bootstrap.t) Memo.t diff --git a/duniverse/dune_/src/dune_rules/coq_sources.ml b/duniverse/dune_/src/dune_rules/coq_sources.ml index a11a0d641..1dbb66bcd 100644 --- a/duniverse/dune_/src/dune_rules/coq_sources.ml +++ b/duniverse/dune_/src/dune_rules/coq_sources.ml @@ -92,3 +92,20 @@ let of_dir stanzas ~dir ~include_subdirs ~dirs = | _ -> acc) let lookup_module t m = Coq_module.Map.find t.rev_map m + +let mlg_files ~sctx ~dir ~modules = + let open Memo.O in + let+ standard = + (* All .mlg files in the current directory *) + let filter_mlg file = + if Path.Source.extension file = ".mlg" then + Some + (Path.Build.append_source (Super_context.context sctx).build_dir file) + else None + in + Source_tree.files_of (Path.Build.drop_build_context_exn dir) + >>| Path.Source.Set.to_list + >>| List.filter_map ~f:filter_mlg + in + let parse ~loc:_ file = Path.Build.relative dir (file ^ ".mlg") in + Ordered_set_lang.eval modules ~standard ~parse ~eq:Path.Build.equal diff --git a/duniverse/dune_/src/dune_rules/coq_sources.mli b/duniverse/dune_/src/dune_rules/coq_sources.mli index 968d2b45a..1b8302908 100644 --- a/duniverse/dune_/src/dune_rules/coq_sources.mli +++ b/duniverse/dune_/src/dune_rules/coq_sources.mli @@ -30,3 +30,9 @@ val lookup_module : t -> Coq_module.t -> [ `Theory of Theory.t | `Extraction of Extraction.t ] option + +val mlg_files : + sctx:Super_context.t + -> dir:Path.Build.t + -> modules:Ordered_set_lang.t + -> Path.Build.t list Memo.t diff --git a/duniverse/dune_/src/dune_rules/coq_stanza.ml b/duniverse/dune_/src/dune_rules/coq_stanza.ml index 3d31c5c5e..a2b903592 100644 --- a/duniverse/dune_/src/dune_rules/coq_stanza.ml +++ b/duniverse/dune_/src/dune_rules/coq_stanza.ml @@ -1,15 +1,25 @@ open Import open Dune_lang.Decoder +let coq_syntax = + Dune_lang.Syntax.create ~name:"coq" ~desc:"the Coq language" + [ ((0, 1), `Since (1, 9)) + ; ((0, 2), `Since (2, 5)) + ; ((0, 3), `Since (2, 8)) + ; ((0, 4), `Since (3, 3)) + ; ((0, 5), `Since (3, 4)) + ; ((0, 6), `Since (3, 5)) + ] + module Coqpp = struct type t = - { modules : string list + { modules : Ordered_set_lang.t ; loc : Loc.t } let decode = fields - (let+ modules = field "modules" (repeat string) + (let+ modules = Ordered_set_lang.field "modules" and+ loc = loc in { modules; loc }) @@ -18,20 +28,12 @@ module Coqpp = struct let p = ("coq.pp", decode >>| fun x -> [ T x ]) end -let coq_syntax = - Dune_lang.Syntax.create ~name:"coq" ~desc:"the Coq language" - [ ((0, 1), `Since (1, 9)) - ; ((0, 2), `Since (2, 5)) - ; ((0, 3), `Since (2, 8)) - ; ((0, 4), `Since (3, 3)) - ; ((0, 5), `Since (3, 4)) - ] - module Buildable = struct type t = { flags : Ordered_set_lang.Unexpanded.t ; coq_lang_version : Dune_sexp.Syntax.Version.t ; mode : Loc.t * Coq_mode.t + ; use_stdlib : bool ; plugins : (Loc.t * Lib_name.t) list (** ocaml libraries *) ; theories : (Loc.t * Coq_lib_name.t) list (** coq libraries *) ; loc : Loc.t @@ -60,6 +62,10 @@ module Buildable = struct located (field "mode" ~default (Dune_lang.Syntax.since coq_syntax (0, 3) >>> Coq_mode.decode)) + and+ use_stdlib = + field ~default:true "stdlib" + (Dune_lang.Syntax.since coq_syntax (0, 6) + >>> enum [ ("yes", true); ("no", false) ]) and+ libraries = field "libraries" ~default:[] (Dune_sexp.Syntax.deprecated_in coq_syntax (0, 5) @@ -73,7 +79,7 @@ module Buildable = struct ~default:[] in let plugins = merge_plugins_libraries ~plugins ~libraries in - { flags; mode; coq_lang_version; plugins; theories; loc } + { flags; mode; use_stdlib; coq_lang_version; plugins; theories; loc } end module Extraction = struct @@ -144,7 +150,7 @@ module Theory = struct [ Pp.text "Cannot both use 'package' and 'public_name', please remove \ 'public_name' as it has been deprecated since version 0.5 of the \ - Coq langugage. It will be removed before version 1.0." + Coq language. It will be removed before version 1.0." ] let boot_has_deps loc = diff --git a/duniverse/dune_/src/dune_rules/coq_stanza.mli b/duniverse/dune_/src/dune_rules/coq_stanza.mli index 09a16244d..48084c7a7 100644 --- a/duniverse/dune_/src/dune_rules/coq_stanza.mli +++ b/duniverse/dune_/src/dune_rules/coq_stanza.mli @@ -5,6 +5,7 @@ module Buildable : sig { flags : Ordered_set_lang.Unexpanded.t ; coq_lang_version : Dune_sexp.Syntax.Version.t ; mode : Loc.t * Coq_mode.t + ; use_stdlib : bool ; plugins : (Loc.t * Lib_name.t) list (** ocaml plugins *) ; theories : (Loc.t * Coq_lib_name.t) list (** coq libraries *) ; loc : Loc.t @@ -40,7 +41,7 @@ end module Coqpp : sig type t = - { modules : string list + { modules : Ordered_set_lang.t ; loc : Loc.t } diff --git a/duniverse/dune_/src/dune_rules/ctypes_rules.ml b/duniverse/dune_/src/dune_rules/ctypes_rules.ml index 51d351f79..f88fef474 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_rules.ml +++ b/duniverse/dune_/src/dune_rules/ctypes_rules.ml @@ -58,43 +58,20 @@ module Buildable = Dune_file.Buildable module Library = Dune_file.Library module Ctypes = Ctypes_stanza -let modules_of_list ~dir ~modules = - let name_map = - let build_dir = Path.build dir in - let modules = - List.map modules ~f:(fun name -> - let module_name = Module_name.of_string name in - let path = - Path.relative build_dir (Ctypes.ml_of_module_name module_name) - in - let impl = Module.File.make Dialect.ocaml path in - let source = Module.Source.make ~impl module_name in - Module.of_source ~visibility:Public ~kind:Impl source) - in - Module.Name_map.of_list_exn modules - in - Modules.exe_unwrapped name_map -(* Modules.exe_wrapped ~src_dir:dir ~modules:name_map *) - -let pp_write_file path pp = - Action_builder.write_file path @@ Format.asprintf "%a" Pp.to_fmt pp - let verbatimf fmt = Printf.ksprintf (fun s -> Pp.concat [ Pp.verbatim s; Pp.newline ]) fmt -let write_c_types_includer_module ~sctx ~dir ~filename ~type_description_functor +let write_c_types_includer_module ~type_description_functor ~c_generated_types_module = - let path = Path.Build.relative dir filename in let contents = verbatimf "include %s.Types (%s)" (Module_name.to_string type_description_functor) (Module_name.to_string c_generated_types_module) in - Super_context.add_rule ~loc:Loc.none sctx ~dir (pp_write_file path contents) + Format.asprintf "%a@." Pp.to_fmt contents -let write_entry_point_module ~ctypes ~sctx ~dir ~filename - ~type_description_instance ~function_description ~c_types_includer_module = - let path = Path.Build.relative dir filename in +let write_entry_point_module ~ctypes ~type_description_instance + ~function_description ~c_types_includer_module = let contents = Pp.concat [ verbatimf "module %s = %s" @@ -110,39 +87,7 @@ let write_entry_point_module ~ctypes ~sctx ~dir ~filename (Module_name.to_string c_generated_functions_module)) ] in - Super_context.add_rule ~loc:Loc.none sctx ~dir (pp_write_file path contents) - -let discover_gen ~external_library_name:lib ~cflags_sexp ~c_library_flags_sexp = - Pp.concat - [ verbatimf "module C = Configurator.V1" - ; verbatimf "let () =" - ; verbatimf " C.main ~name:\"%s\" (fun c ->" - (External_lib_name.to_string lib) - ; verbatimf " let default : C.Pkg_config.package_conf =" - ; verbatimf " { libs = [\"-l%s\"];" (External_lib_name.to_string lib) - ; verbatimf " cflags = [\"-I/usr/include\"] }" - ; verbatimf " in" - ; verbatimf " let conf =" - ; verbatimf " match C.Pkg_config.get c with" - ; verbatimf " | None -> default" - ; verbatimf " | Some pc ->" - ; verbatimf " match C.Pkg_config.query pc ~package:\"%s\" with" - (External_lib_name.to_string lib) - ; verbatimf " | None -> default" - ; verbatimf " | Some deps -> deps" - ; verbatimf " in" - ; verbatimf " C.Flags.write_sexp \"%s\" conf.cflags;" cflags_sexp - ; verbatimf " C.Flags.write_sexp \"%s\" conf.libs;" c_library_flags_sexp - ; verbatimf " )" - ] - -let write_discover_script ~filename ~sctx ~dir ~external_library_name - ~cflags_sexp ~c_library_flags_sexp = - let path = Path.Build.relative dir filename in - let script = - discover_gen ~external_library_name ~cflags_sexp ~c_library_flags_sexp - in - Super_context.add_rule ~loc:Loc.none sctx ~dir (pp_write_file path script) + Format.asprintf "%a@." Pp.to_fmt contents let gen_headers ~expander (headers : Ctypes.Headers.t) = let open Action_builder.O in @@ -161,16 +106,18 @@ let gen_headers ~expander (headers : Ctypes.Headers.t) = let type_gen_gen ~expander ~headers ~type_description_functor = let open Action_builder.O in let+ headers = gen_headers ~expander headers in - Pp.concat - [ verbatimf "let () =" - ; headers - ; verbatimf " Cstubs_structs.write_c Format.std_formatter" - ; verbatimf " (module %s.Types)" - (Module_name.to_string type_description_functor) - ] + Format.asprintf "%a@." Pp.to_fmt + (Pp.concat + [ verbatimf "let () =" + ; headers + ; verbatimf " Cstubs_structs.write_c Format.std_formatter" + ; verbatimf " (module %s.Types)" + (Module_name.to_string type_description_functor) + ]) let function_gen_gen ~expander ~(concurrency : Ctypes.Concurrency_policy.t) - ~errno_policy ~headers ~function_description_functor = + ~(errno_policy : Ctypes.Errno_policy.t) ~headers + ~function_description_functor = let open Action_builder.O in let module_name = Module_name.to_string function_description_functor in let concurrency = @@ -182,80 +129,62 @@ let function_gen_gen ~expander ~(concurrency : Ctypes.Concurrency_policy.t) in let errno_policy = match errno_policy with - | Ctypes.Errno_policy.Ignore_errno -> "Cstubs.ignore_errno" - | Ctypes.Errno_policy.Return_errno -> "Cstubs.return_errno" + | Ignore_errno -> "Cstubs.ignore_errno" + | Return_errno -> "Cstubs.return_errno" in let+ headers = gen_headers ~expander headers in - Pp.concat - [ verbatimf "let () =" - ; verbatimf " let concurrency = %s in" concurrency - ; verbatimf " let errno = %s in" errno_policy - ; verbatimf " let prefix = Sys.argv.(2) in" - ; verbatimf " match Sys.argv.(1) with" - ; verbatimf " | \"ml\" ->" - ; verbatimf " Cstubs.write_ml ~concurrency Format.std_formatter ~prefix" - ; verbatimf " ~errno" - ; verbatimf " (module %s.Functions)" module_name - ; verbatimf " | \"c\" ->" - ; headers - ; verbatimf " Cstubs.write_c ~concurrency Format.std_formatter ~prefix" - ; verbatimf " ~errno" - ; verbatimf " (module %s.Functions)" module_name - ; verbatimf " | s -> failwith (\"unknown functions \"^s)" - ] - -let add_rule_gen ~sctx ~dir ~filename f = - let path = Path.Build.relative dir filename in - let script = - let open Action_builder.O in - let* expander = - Action_builder.of_memo @@ Super_context.expander sctx ~dir - in - let+ pp = f ~expander in - Format.asprintf "%a" Pp.to_fmt pp - in - let action = - Action_builder.With_targets.write_file_dyn path - (Action_builder.with_no_targets script) - in - Super_context.add_rule ~loc:Loc.none sctx ~dir action - -let write_type_gen_script ~headers ~dir ~filename ~sctx - ~type_description_functor = - add_rule_gen ~dir ~filename ~sctx - (type_gen_gen ~headers ~type_description_functor) - -let write_function_gen_script ~headers ~sctx ~dir ~name - ~function_description_functor ~concurrency ~errno_policy = - add_rule_gen ~dir ~filename:(name ^ ".ml") ~sctx - (function_gen_gen ~concurrency ~errno_policy ~headers - ~function_description_functor) - -let rule ?(deps = []) ?stdout_to ?(args = []) ?(targets = []) ~exe ~sctx ~dir () - = - let build = - let exe = Ok (Path.build (Path.Build.relative dir exe)) in - let args = - let targets = List.map targets ~f:(Path.Build.relative dir) in - let deps = - List.map deps ~f:(Path.relative (Path.build dir)) |> Dep.Set.of_files - in - let open Command.Args in - [ Hidden_targets targets; Hidden_deps deps; As args ] - in - let stdout_to = Option.map stdout_to ~f:(Path.Build.relative dir) in - Command.run exe ~dir:(Path.build dir) ?stdout_to args - in - Super_context.add_rule sctx ~dir build + Format.asprintf "%a@." Pp.to_fmt + (Pp.concat + [ verbatimf "let () =" + ; verbatimf " let concurrency = %s in" concurrency + ; verbatimf " let errno = %s in" errno_policy + ; verbatimf " let prefix = Sys.argv.(2) in" + ; verbatimf " match Sys.argv.(1) with" + ; verbatimf " | \"ml\" ->" + ; verbatimf + " Cstubs.write_ml ~concurrency Format.std_formatter ~prefix" + ; verbatimf " ~errno" + ; verbatimf " (module %s.Functions)" module_name + ; verbatimf " | \"c\" ->" + ; headers + ; verbatimf + " Cstubs.write_c ~concurrency Format.std_formatter ~prefix" + ; verbatimf " ~errno" + ; verbatimf " (module %s.Functions)" module_name + ; verbatimf " | s -> failwith (\"unknown functions \"^s)" + ]) let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope - ~cflags_sexp ~output ~deps () = + ~cflags ~output ~deps = let ctx = Super_context.context sctx in let open Memo.O in let* exe = Ocaml_config.c_compiler ctx.ocaml_config |> Super_context.resolve_program ~loc:None ~dir sctx in + let project = Scope.project scope in + let with_user_and_std_flags = + let base_flags = + let use_standard_flags = + Dune_project.use_standard_c_and_cxx_flags project + in + let cfg = ctx.ocaml_config in + match use_standard_flags with + | Some true -> Fdo.c_flags ctx + | None | Some false -> + (* In dune < 2.8 flags from ocamlc_config are always added *) + List.concat + [ Ocaml_config.ocamlc_cflags cfg + ; Ocaml_config.ocamlc_cppflags cfg + ; Fdo.c_flags ctx + ] + in + let open Action_builder.O in + let* expander = Action_builder.of_memo (Super_context.expander sctx ~dir) in + Super_context.foreign_flags sctx ~dir ~expander + ~flags:Ordered_set_lang.Unexpanded.standard ~language:C + |> Action_builder.map ~f:(List.append base_flags) + in let include_args = let ocaml_where = Path.to_string ctx.stdlib_dir in (* XXX: need glob dependency *) @@ -264,11 +193,9 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope let+ lib = let ctypes = Lib_name.of_string "ctypes" in Lib.DB.resolve (Scope.libs scope) (Loc.none, ctypes) - (* | Ok lib -> lib | Error _res -> User_error.raise [ Pp.textf "the - 'ctypes' library needs to be installed to use the ctypes stanza"] *) in - Lib_flags.L.include_paths [ lib ] Mode.Native - |> Path.Set.to_list |> List.map ~f:Path.to_string + Lib_flags.L.include_paths [ lib ] (Ocaml Native) + |> Path.Set.to_list_map ~f:Path.to_string in let include_dirs = ocaml_where :: ctypes_include_dirs in List.concat_map include_dirs ~f:(fun dir -> [ "-I"; dir ]) @@ -290,27 +217,6 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope deps in let build = - let cflags_args = - let contents = - Action_builder.contents (Path.relative (Path.build dir) cflags_sexp) - in - Action_builder.map contents ~f:(fun sexp -> - let fail s = User_error.raise [ Pp.textf s ] in - let ast = - Dune_lang.Parser.parse_string ~mode:Dune_lang.Parser.Mode.Single - ~fname:cflags_sexp sexp - in - match ast with - | Atom (_loc, atom) -> [ Dune_lang.Atom.to_string atom ] - | Template _ -> fail "'template' not supported in ctypes c_flags" - | Quoted_string (_loc, s) -> [ s ] - | List (_loc, lst) -> - List.map lst ~f:(function - | Dune_lang.Ast.Atom (_loc, atom) -> Dune_lang.Atom.to_string atom - | Quoted_string (_loc, s) -> s - | Template _ -> fail "'template' not supported in ctypes c_flags" - | List _ -> fail "nested lists not supported in ctypes c_flags")) - in let absolute_path_hack p = (* These normal path builder things construct relative paths like _build/default/your/project/file.c but before dune runs gcc it actually @@ -321,12 +227,14 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope let action = let open Action_builder.O in let* include_args = Resolve.Memo.read include_args in + let* base_args = with_user_and_std_flags in deps - >>> Action_builder.map cflags_args ~f:(fun cflags_args -> + >>> Action_builder.map cflags ~f:(fun cflags_args -> let source_files = List.map source_files ~f:absolute_path_hack in let output = absolute_path_hack output in let args = - cflags_args @ include_args @ source_files @ [ "-o"; output ] + base_args @ cflags_args @ include_args @ source_files + @ [ "-o"; output ] in Action.run exe args) in @@ -336,26 +244,6 @@ let build_c_program ~foreign_archives_deps ~sctx ~dir ~source_files ~scope Super_context.add_rule sctx ~dir (Action_builder.With_targets.map ~f:Action.Full.make build) -let cctx_with_substitutions ?(libraries = []) ~modules ~dir ~loc ~scope ~cctx () - = - let compile_info = - let dune_version = Scope.project scope |> Dune_project.dune_version in - Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) - [ (loc, "ctypes") ] - (Ctypes.lib_deps_of_strings ~loc libraries) - ~dune_version ~pps:[] - in - let modules = modules_of_list ~dir ~modules in - let module Cctx = Compilation_context in - Cctx.create ~super_context:(Cctx.super_context cctx) ~scope:(Cctx.scope cctx) - ~expander:(Cctx.expander cctx) ~js_of_ocaml:(Cctx.js_of_ocaml cctx) - ~package:(Cctx.package cctx) ~flags:(Cctx.flags cctx) - ~requires_compile:(Lib.Compile.direct_requires compile_info) - ~requires_link:(Lib.Compile.requires_link compile_info) - ~obj_dir:(Cctx.obj_dir cctx) - ~opaque:(Cctx.Explicit (Cctx.opaque cctx)) - ~modules () - let program_of_module_and_dir ~dir program = let build_dir = Path.build dir in { Exe.Program.name = program @@ -363,17 +251,6 @@ let program_of_module_and_dir ~dir program = ; loc = Loc.in_file (Path.relative build_dir program) } -let exe_build_and_link ?libraries ?(modules = []) ~scope ~loc ~dir ~cctx - ~sandbox program = - let open Memo.O in - let* cctx = - cctx_with_substitutions ?libraries ~loc ~scope ~dir ~cctx - ~modules:(program :: modules) () - in - let program = program_of_module_and_dir ~dir program in - Exe.build_and_link ~program ~linkages:[ Exe.Linkage.native ] ~promote:None - ~sandbox cctx - let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps = let link_args = let open Action_builder.O in @@ -384,45 +261,34 @@ let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps = Exe.link_many ~link_args ~programs:[ program ] ~linkages:[ Exe.Linkage.native ] ~promote:None shared_cctx ~sandbox -let write_osl_to_sexp_file ~sctx ~dir ~filename ~expand_flag flags = - let build = - let sexp = - let open Action_builder.O in - let* expander = - Action_builder.of_memo @@ Super_context.expander sctx ~dir - in - let+ flags = expand_flag ~expander flags in - let sexp = Sexp.List (List.map ~f:(fun x -> Sexp.Atom x) flags) in - Sexp.to_string sexp - in - let path = Path.Build.relative dir filename in - Action_builder.write_file_dyn path sexp - in - Super_context.add_rule ~loc:Loc.none sctx ~dir build - let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx = let ctypes = Option.value_exn buildable.ctypes in let external_library_name = ctypes.external_library_name in let type_description_functor = ctypes.type_description.functor_ in let c_types_includer_module = ctypes.generated_types in let c_generated_types_module = Ctypes.c_generated_types_module ctypes in - let rule = rule ~sctx ~dir in let open Memo.O in let foreign_archives_deps = let ctx = Super_context.context sctx in let ext_lib = ctx.lib_config.ext_lib in let ext_dll = ctx.lib_config.ext_dll in List.concat_map buildable.foreign_archives ~f:(fun (_loc, archive) -> - [ Foreign.Archive.lib_file ~archive ~dir ~ext_lib - ; Foreign.Archive.dll_file ~archive ~dir ~ext_dll + let mode = Mode.Select.All in + [ Foreign.Archive.lib_file ~mode ~archive ~dir ~ext_lib + ; Foreign.Archive.dll_file ~mode ~archive ~dir ~ext_dll ]) in let* expander = Super_context.expander sctx ~dir in let deps, sandbox = Dep_conf_eval.unnamed ~expander ctypes.deps in let* () = - write_c_types_includer_module ~sctx ~dir - ~filename:(Ctypes.ml_of_module_name c_types_includer_module) - ~c_generated_types_module ~type_description_functor + Super_context.add_rule sctx ~loc:Loc.none ~dir + @@ + let target = + Path.Build.relative dir (Ctypes.ml_of_module_name c_types_includer_module) + in + Action_builder.write_file target + (write_c_types_includer_module ~c_generated_types_module + ~type_description_functor) in (* The output of this process is to generate a cflags sexp and a c library flags sexp file. We can probe these flags by using the system pkg-config, @@ -430,38 +296,27 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx = are, if the library is vendored. https://dune.readthedocs.io/en/stable/quick-start.html#defining-a-library-with-c-stubs-using-pkg-config *) - let c_library_flags_sexp = Ctypes.c_library_flags_sexp ctypes in - let cflags_sexp = Ctypes.cflags_sexp ctypes in - let* () = + let* cflags = match ctypes.build_flags_resolver with - | Vendored { c_flags; c_library_flags } -> - let* () = - write_osl_to_sexp_file ~sctx ~dir ~filename:cflags_sexp c_flags - ~expand_flag:(fun ~expander flags -> - Super_context.foreign_flags sctx ~dir ~expander ~flags ~language:C) - in - write_osl_to_sexp_file ~sctx ~dir ~filename:c_library_flags_sexp - c_library_flags ~expand_flag:(fun ~expander flags -> - Expander.expand_and_eval_set expander flags - ~standard:(Action_builder.return [])) + | Vendored { c_flags; c_library_flags = _ } -> + Super_context.foreign_flags sctx ~dir ~expander ~flags:c_flags ~language:C + |> Memo.return | Pkg_config -> - let cflags_sexp = Ctypes.cflags_sexp ctypes in - let discover_script = - sprintf "%s__ctypes_discover" - (ctypes.external_library_name |> External_lib_name.clean - |> External_lib_name.to_string) - in - let* () = - write_discover_script ~sctx ~dir ~filename:(discover_script ^ ".ml") - ~cflags_sexp ~c_library_flags_sexp ~external_library_name - in - let* (_ : Exe.dep_graphs) = - exe_build_and_link ~scope ~loc ~dir ~cctx ~sandbox - ~libraries:[ "dune.configurator" ] discover_script + let+ () = + let open Memo.O in + let setup query = + let* res = Pkg_config.gen_rule sctx ~dir ~loc query in + match res with + | Ok () -> Memo.return () + | Error `Not_found -> Memo.return () + in + let lib = External_lib_name.to_string external_library_name in + let* () = setup (Libs lib) in + setup (Cflags lib) in - rule - ~targets:[ cflags_sexp; c_library_flags_sexp ] - ~exe:(discover_script ^ ".exe") () + Pkg_config.Query.read ~dir + (Cflags (External_lib_name.to_string external_library_name)) + sctx in let generated_entry_module = ctypes.generated_entry_point in let headers = ctypes.headers in @@ -484,22 +339,36 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx = in let type_gen_script = Ctypes.type_gen_script ctypes in let* () = - write_type_gen_script ~headers ~sctx ~dir - ~filename:(type_gen_script ^ ".ml") ~type_description_functor + Super_context.add_rule ~loc:Loc.none sctx ~dir + @@ + let script = type_gen_gen ~headers ~type_description_functor ~expander in + let target = Path.Build.relative dir (type_gen_script ^ ".ml") in + Action_builder.With_targets.write_file_dyn target + (Action_builder.with_no_targets script) in let* (_ : Exe.dep_graphs) = exe_link_only type_gen_script in let* () = - rule ~stdout_to:c_generated_types_cout_c ~exe:(type_gen_script ^ ".exe") - () + Super_context.add_rule sctx ~dir ~loc:Loc.none + (let exe = + Ok (Path.build (Path.Build.relative dir (type_gen_script ^ ".exe"))) + in + let stdout_to = Path.Build.relative dir c_generated_types_cout_c in + Command.run ~stdout_to ~dir:(Path.build dir) exe []) in let* () = - build_c_program ~foreign_archives_deps ~sctx ~dir ~scope ~cflags_sexp + build_c_program ~foreign_archives_deps ~sctx ~dir ~scope ~source_files:[ c_generated_types_cout_c ] - ~output:c_generated_types_cout_exe ~deps () + ~output:c_generated_types_cout_exe ~deps ~cflags in - rule - ~stdout_to:(c_generated_types_module |> Ctypes.ml_of_module_name) - ~exe:c_generated_types_cout_exe () + Super_context.add_rule sctx ~loc:Loc.none ~dir + (let stdout_to = + Path.Build.relative dir + (c_generated_types_module |> Ctypes.ml_of_module_name) + in + let exe = + Ok (Path.build (Path.Build.relative dir c_generated_types_cout_exe)) + in + Command.run ~stdout_to ~dir:(Path.build dir) exe []) in (* Function_gen is similar to type_gen above, though it produces both an .ml file and a .c file. These files correspond to the files you would have to @@ -520,45 +389,65 @@ let gen_rules ~cctx ~(buildable : Buildable.t) ~loc ~scope ~dir ~sctx = in let function_gen_script = Ctypes.function_gen_script ctypes fd in let* () = - write_function_gen_script ~headers ~sctx ~dir - ~name:function_gen_script ~concurrency:fd.concurrency - ~errno_policy:fd.errno_policy - ~function_description_functor:fd.functor_ + Super_context.add_rule ~loc:Loc.none sctx ~dir + @@ + let target = Path.Build.relative dir (function_gen_script ^ ".ml") in + let script = + function_gen_gen ~concurrency:fd.concurrency + ~errno_policy:fd.errno_policy ~headers + ~function_description_functor:fd.functor_ ~expander + in + Action_builder.With_targets.write_file_dyn target + (Action_builder.with_no_targets script) in let* (_ : Exe.dep_graphs) = exe_link_only function_gen_script in + let exe = + Ok + (Path.build + (Path.Build.relative dir (function_gen_script ^ ".exe"))) + in + let command ~stdout_to = + Command.run ~stdout_to ~dir:(Path.build dir) exe + in let* () = - rule ~stdout_to:c_generated_functions_cout_c - ~exe:(function_gen_script ^ ".exe") - ~args:[ "c"; stubs_prefix ] () + Super_context.add_rule sctx ~dir ~loc:Loc.none + (let stdout_to = + Path.Build.relative dir c_generated_functions_cout_c + in + command ~stdout_to [ A "c"; A stubs_prefix ]) in - rule - ~stdout_to: - (Ctypes.c_generated_functions_module ctypes fd - |> Ctypes.ml_of_module_name) - ~exe:(function_gen_script ^ ".exe") - ~args:[ "ml"; stubs_prefix ] ()) + Super_context.add_rule sctx ~dir ~loc:Loc.none + (let stdout_to = + Path.Build.relative dir + (Ctypes.c_generated_functions_module ctypes fd + |> Ctypes.ml_of_module_name) + in + command ~stdout_to [ A "ml"; A stubs_prefix ])) in (* The entry point module binds the instantiated Types and Functions functors to the entry point module name and instances the user specified. *) - write_entry_point_module ~ctypes ~sctx ~dir - ~filename:(generated_entry_module |> Ctypes.ml_of_module_name) - ~type_description_instance:ctypes.type_description.instance - ~function_description:ctypes.function_description ~c_types_includer_module - -let ctypes_cclib_flags ~standard ~scope ~expander ~(buildable : Buildable.t) = + Super_context.add_rule sctx ~loc:Loc.none ~dir + (let target = + Path.Build.relative dir + (generated_entry_module |> Ctypes.ml_of_module_name) + in + Action_builder.write_file target + (write_entry_point_module ~ctypes + ~type_description_instance:ctypes.type_description.instance + ~function_description:ctypes.function_description + ~c_types_includer_module)) + +let ctypes_cclib_flags sctx ~expander ~(buildable : Buildable.t) = + let standard = Action_builder.return [] in match buildable.ctypes with | None -> standard - | Some ctypes -> - let ctypes_c_library_flags = - let path_to_sexp_file = - Ctypes_stubs.c_library_flags - ~external_library_name:ctypes.external_library_name - in - let parsing_context = - let project = Scope.project scope in - Dune_project.parsing_context project - in - Ordered_set_lang.Unexpanded.include_single ~context:parsing_context - ~pos:("", 0, 0, 0) path_to_sexp_file + | Some ctypes -> ( + let external_library_name = + External_lib_name.to_string ctypes.external_library_name in - Expander.expand_and_eval_set expander ctypes_c_library_flags ~standard + match ctypes.build_flags_resolver with + | Pkg_config -> + let dir = Expander.dir expander in + Pkg_config.Query.read (Libs external_library_name) sctx ~dir + | Vendored { c_library_flags; c_flags = _ } -> + Expander.expand_and_eval_set expander c_library_flags ~standard) diff --git a/duniverse/dune_/src/dune_rules/ctypes_rules.mli b/duniverse/dune_/src/dune_rules/ctypes_rules.mli index 27fda4c40..875c4f98a 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_rules.mli +++ b/duniverse/dune_/src/dune_rules/ctypes_rules.mli @@ -10,8 +10,7 @@ val gen_rules : -> unit Memo.t val ctypes_cclib_flags : - standard:string list Action_builder.t - -> scope:Scope.t + Super_context.t -> expander:Expander.t -> buildable:Dune_file.Buildable.t -> string list Action_builder.t diff --git a/duniverse/dune_/src/dune_rules/ctypes_stanza.ml b/duniverse/dune_/src/dune_rules/ctypes_stanza.ml index 7ba5f98f8..27cb33e1a 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_stanza.ml +++ b/duniverse/dune_/src/dune_rules/ctypes_stanza.ml @@ -170,26 +170,15 @@ let () = (return [ (name, decode >>| fun x -> [ T x ]) ]) let type_gen_script ctypes = - sprintf "%s__type_gen" - (ctypes.external_library_name |> External_lib_name.clean - |> External_lib_name.to_string) - -let module_name_lower_string module_name = - String.lowercase (Module_name.to_string module_name) + ctypes.external_library_name |> External_lib_name.clean + |> External_lib_name.to_string |> sprintf "%s__type_gen" let function_gen_script ctypes (fd : Function_description.t) = sprintf "%s__function_gen__%s__%s" (ctypes.external_library_name |> External_lib_name.clean |> External_lib_name.to_string) - (module_name_lower_string fd.functor_) - (module_name_lower_string fd.instance) - -let cflags_sexp ctypes = - Ctypes_stubs.cflags_sexp ~external_library_name:ctypes.external_library_name - -let c_library_flags_sexp ctypes = - sprintf "%s__c_library_flags.sexp" - (External_lib_name.to_string ctypes.external_library_name) + (Module_name.to_string fd.functor_) + (Module_name.to_string fd.instance) let c_generated_types_module ctypes = sprintf "%s__c_generated_types" @@ -201,18 +190,15 @@ let c_generated_functions_module ctypes (fd : Function_description.t) = sprintf "%s__c_generated_functions__%s__%s" (ctypes.external_library_name |> External_lib_name.clean |> External_lib_name.to_string) - (module_name_lower_string fd.functor_) - (module_name_lower_string fd.instance) + (Module_name.to_string fd.functor_) + (Module_name.to_string fd.instance) |> Module_name.of_string let c_generated_functions_cout_c ctypes (fd : Function_description.t) = sprintf "%s__c_cout_generated_functions__%s__%s.c" (External_lib_name.to_string ctypes.external_library_name) - (module_name_lower_string fd.functor_) - (module_name_lower_string fd.instance) - -let lib_deps_of_strings ~loc lst = - List.map lst ~f:(fun lib -> Lib_dep.Direct (loc, Lib_name.of_string lib)) + (Module_name.to_string fd.functor_) + (Module_name.to_string fd.instance) let type_gen_script_module ctypes = type_gen_script ctypes |> Module_name.of_string @@ -236,7 +222,8 @@ let non_installable_modules ctypes = :: List.map ctypes.function_description ~f:(fun function_description -> function_gen_script_module ctypes function_description) -let ml_of_module_name mn = Module_name.to_string mn ^ ".ml" |> String.lowercase +let ml_of_module_name mn = + Module_name.to_string mn ^ ".ml" |> String.uncapitalize_ascii let generated_ml_and_c_files ctypes = let ml_files = generated_modules ctypes |> List.map ~f:ml_of_module_name in diff --git a/duniverse/dune_/src/dune_rules/ctypes_stanza.mli b/duniverse/dune_/src/dune_rules/ctypes_stanza.mli index 22fa5ecdf..d520e9d9d 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_stanza.mli +++ b/duniverse/dune_/src/dune_rules/ctypes_stanza.mli @@ -74,16 +74,8 @@ val generated_ml_and_c_files : t -> string list val c_generated_functions_module : t -> Function_description.t -> Module_name.t -val lib_deps_of_strings : loc:Loc.t -> string list -> Lib_dep.t list - val c_generated_types_module : t -> Module_name.t -val c_library_flags_sexp : t -> string - -val cflags_sexp : t -> string - -val type_gen_script_module : t -> Module_name.t - val type_gen_script : t -> string val c_generated_functions_cout_c : t -> Function_description.t -> string diff --git a/duniverse/dune_/src/dune_rules/ctypes_stubs.ml b/duniverse/dune_/src/dune_rules/ctypes_stubs.ml index befc2c0ef..b2d69c9c9 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_stubs.ml +++ b/duniverse/dune_/src/dune_rules/ctypes_stubs.ml @@ -1,42 +1,8 @@ open Import -let cflags_sexp ~external_library_name = - sprintf "%s__c_flags.sexp" (External_lib_name.to_string external_library_name) - -let c_generated_functions_cout_no_ext ~external_library_name ~functor_ ~instance - = - sprintf "%s__c_cout_generated_functions__%s__%s" - (External_lib_name.to_string external_library_name) - (Module_name.to_string functor_ |> String.lowercase) - (Module_name.to_string instance |> String.lowercase) - -let c_library_flags ~external_library_name = - sprintf "%s__c_library_flags.sexp" - (External_lib_name.to_string external_library_name) - let lib_deps_of_strings ~loc lst = List.map lst ~f:(fun lib -> Lib_dep.Direct (loc, Lib_name.of_string lib)) let libraries_needed_for_ctypes ~loc = let libraries = [ "ctypes"; "ctypes.stubs" ] in lib_deps_of_strings ~loc libraries - -let add ~loc ~parsing_context ~external_library_name ~add_stubs ~functor_ - ~instance ~foreign_stubs = - let pos = ("", 0, 0, 0) in - let flags = - let cflags_sexp_include = - Ordered_set_lang.Unexpanded.include_single ~context:parsing_context ~pos - (cflags_sexp ~external_library_name) - in - Ordered_set_lang.Unexpanded.concat ~context:parsing_context ~pos - Ordered_set_lang.Unexpanded.standard cflags_sexp_include - in - add_stubs Foreign_language.C ~loc - ~names: - (Some - (Ordered_set_lang.of_atoms ~loc - [ c_generated_functions_cout_no_ext ~external_library_name ~functor_ - ~instance - ])) - ~flags:(Some flags) foreign_stubs diff --git a/duniverse/dune_/src/dune_rules/ctypes_stubs.mli b/duniverse/dune_/src/dune_rules/ctypes_stubs.mli index 0311f3466..5cde874b5 100644 --- a/duniverse/dune_/src/dune_rules/ctypes_stubs.mli +++ b/duniverse/dune_/src/dune_rules/ctypes_stubs.mli @@ -3,30 +3,4 @@ open Import (* This module would be part of Ctypes_rules, except it creates a circular dependency if Dune_file tries to access it. *) -val cflags_sexp : external_library_name:External_lib_name.t -> string - -val c_library_flags : external_library_name:External_lib_name.t -> string - -val c_generated_functions_cout_no_ext : - external_library_name:External_lib_name.t - -> functor_:Module_name.t - -> instance:Module_name.t - -> string - val libraries_needed_for_ctypes : loc:Loc.t -> Lib_dep.t list - -val add : - loc:Loc.t - -> parsing_context:Univ_map.t - -> external_library_name:External_lib_name.t - -> add_stubs: - ( Foreign_language.t - -> loc:Loc.t - -> names:Ordered_set_lang.t option - -> flags:Ordered_set_lang.Unexpanded.t option - -> Foreign.Stubs.t list - -> Foreign.Stubs.t list) - -> functor_:Module_name.t - -> instance:Module_name.t - -> foreign_stubs:Foreign.Stubs.t list - -> Foreign.Stubs.t list diff --git a/duniverse/dune_/src/dune_rules/dep_conf.ml b/duniverse/dune_/src/dune_rules/dep_conf.ml index 4db0fdcc9..719ed81c5 100644 --- a/duniverse/dune_/src/dune_rules/dep_conf.ml +++ b/duniverse/dune_/src/dune_rules/dep_conf.ml @@ -5,10 +5,7 @@ type t = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t - | Glob_files of - { glob : String_with_vars.t - ; recursive : bool - } + | Glob_files of Glob_files.t | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe @@ -51,11 +48,12 @@ let decode = ; ("alias", sw >>| fun x -> Alias x) ; ("alias_rec", sw >>| fun x -> Alias_rec x) ; ( "glob_files" - , sw >>| fun x -> Glob_files { glob = x; recursive = false } ) + , sw >>| fun glob -> Glob_files { Glob_files.glob; recursive = false } + ) ; ( "glob_files_rec" , let+ () = Dune_lang.Syntax.since Stanza.syntax (3, 0) - and+ x = sw in - Glob_files { glob = x; recursive = true } ) + and+ glob = sw in + Glob_files { Glob_files.glob; recursive = true } ) ; ("package", sw >>| fun x -> Package x) ; ("universe", return Universe) ; ( "files_recursively_in" diff --git a/duniverse/dune_/src/dune_rules/dep_conf.mli b/duniverse/dune_/src/dune_rules/dep_conf.mli index 56161c721..11873b4a7 100644 --- a/duniverse/dune_/src/dune_rules/dep_conf.mli +++ b/duniverse/dune_/src/dune_rules/dep_conf.mli @@ -4,10 +4,7 @@ type t = | File of String_with_vars.t | Alias of String_with_vars.t | Alias_rec of String_with_vars.t - | Glob_files of - { glob : String_with_vars.t - ; recursive : bool - } + | Glob_files of Glob_files.t | Source_tree of String_with_vars.t | Package of String_with_vars.t | Universe diff --git a/duniverse/dune_/src/dune_rules/dep_conf_eval.ml b/duniverse/dune_/src/dune_rules/dep_conf_eval.ml index 5e9237387..7af1bacca 100644 --- a/duniverse/dune_/src/dune_rules/dep_conf_eval.ml +++ b/duniverse/dune_/src/dune_rules/dep_conf_eval.ml @@ -15,18 +15,6 @@ let package_install ~(context : Build_context.t) ~(pkg : Package.t) = sprintf ".%s-files" (Package.Name.to_string name) |> Alias.Name.of_string |> Alias.make ~dir -module Source_tree_map_reduce = - Source_tree.Dir.Make_map_reduce (Action_builder) (Monoid.Union (Path.Set)) - -let collect_source_files_recursively dir ~f = - let prefix_with, dir = Path.extract_build_context_dir_exn dir in - Action_builder.of_memo (Source_tree.find_dir dir) >>= function - | None -> Action_builder.return Path.Set.empty - | Some dir -> - Source_tree_map_reduce.map_reduce dir ~traverse:Sub_dirs.Status.Set.all - ~f:(fun dir -> - f (Path.append_source prefix_with (Source_tree.Dir.path dir))) - type dep_evaluation_result = | Simple of Path.t list Memo.t | Other of Path.t list Action_builder.t @@ -136,21 +124,15 @@ let rec dep expander = function (let* a = make_alias expander s in let+ () = dep_on_alias_rec ~loc:(String_with_vars.loc s) a in []) - | Glob_files { glob = s; recursive } -> + | Glob_files glob_files -> Other - (let loc = String_with_vars.loc s in - let* path = Expander.expand_path expander s in - let files_in = - let glob = Path.basename path |> Glob.of_string_exn loc in - fun dir -> - Action_builder.paths_matching ~loc (File_selector.of_glob ~dir glob) - in - let+ files = - let dir = Path.parent_exn path in - if recursive then collect_source_files_recursively dir ~f:files_in - else files_in dir - in - Path.Set.to_list files) + (Glob_files.Expand.action_builder glob_files + ~f:(Expander.expand_str expander) + ~base_dir:(Expander.dir expander) + >>| List.map ~f:(fun path -> + if Filename.is_relative path then + Path.Build.relative (Expander.dir expander) path |> Path.build + else Path.of_string path)) | Source_tree s -> Other (let* path = Expander.expand_path expander s in @@ -290,11 +272,10 @@ let named ~expander l = | Unnamed dep -> add_sandbox_config acc dep | Named (_, l) -> List.fold_left l ~init:acc ~f:add_sandbox_config) ) -let unnamed ~expander l = +let unnamed ?(sandbox = Sandbox_config.no_special_requirements) ~expander l = let expander = prepare_expander expander in ( List.fold_left l ~init:(Action_builder.return ()) ~f:(fun acc x -> let+ () = acc and+ _x = to_action_builder (dep expander x) in ()) - , List.fold_left l ~init:Sandbox_config.no_special_requirements - ~f:add_sandbox_config ) + , List.fold_left l ~init:sandbox ~f:add_sandbox_config ) diff --git a/duniverse/dune_/src/dune_rules/dep_conf_eval.mli b/duniverse/dune_/src/dune_rules/dep_conf_eval.mli index e0028dcee..0e88037dc 100644 --- a/duniverse/dune_/src/dune_rules/dep_conf_eval.mli +++ b/duniverse/dune_/src/dune_rules/dep_conf_eval.mli @@ -7,7 +7,8 @@ val package_install : context:Build_context.t -> pkg:Package.t -> Alias.t (** Evaluates unnamed dependency specifications. *) val unnamed : - expander:Expander.t + ?sandbox:Sandbox_config.t + -> expander:Expander.t -> Dep_conf.t list -> unit Action_builder.t * Sandbox_config.t diff --git a/duniverse/dune_/src/dune_rules/dep_rules.ml b/duniverse/dune_/src/dune_rules/dep_rules.ml index 0e5b7dd12..1f65cb05e 100644 --- a/duniverse/dune_/src/dune_rules/dep_rules.ml +++ b/duniverse/dune_/src/dune_rules/dep_rules.ml @@ -16,7 +16,7 @@ let ooi_deps { vimpl; sctx; dir; obj_dir; modules = _; stdlib = _; sandbox = _ } let write, read = let ctx = Super_context.context sctx in let unit = - Obj_dir.Module.cm_file_exn obj_dir m ~kind:cm_kind |> Path.build + Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Ocaml cm_kind) |> Path.build in let sandbox = if dune_version >= (3, 3) then Some Sandbox_config.needs_sandboxing diff --git a/duniverse/dune_/src/dune_rules/dir_contents.ml b/duniverse/dune_/src/dune_rules/dir_contents.ml index dd19022d7..77da121fe 100644 --- a/duniverse/dune_/src/dune_rules/dir_contents.ml +++ b/duniverse/dune_/src/dune_rules/dir_contents.ml @@ -136,12 +136,14 @@ end = struct let+ generated_files = Memo.parallel_map stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with - (* XXX What about mli files? *) | Coq_stanza.Coqpp.T { modules; _ } -> - Memo.return (List.map modules ~f:(fun m -> m ^ ".ml")) + let+ mlg_files = Coq_sources.mlg_files ~sctx ~dir ~modules in + List.rev_map mlg_files ~f:(fun mlg_file -> + Path.Build.set_extension mlg_file ~ext:".ml" + |> Path.Build.basename) | Coq_stanza.Extraction.T s -> Memo.return (Coq_stanza.Extraction.ml_target_fnames s) - | Menhir.T menhir -> Memo.return (Menhir.targets menhir) + | Menhir_stanza.T menhir -> Memo.return (Menhir_stanza.targets menhir) | Rule rule -> ( Simple_rules.user_rule sctx rule ~dir ~expander >>| function | None -> [] @@ -205,9 +207,7 @@ end = struct let hash = Tuple.T2.hash Super_context.hash Path.Build.hash end - let lookup_vlib sctx ~dir = - let* t = Load.get sctx ~dir in - Memo.Lazy.force t.ml + let lookup_vlib sctx ~dir = Load.get sctx ~dir >>= ocaml let collect_group ~st_dir ~dir = let rec walk st_dir ~dir ~local = diff --git a/duniverse/dune_/src/dune_rules/dir_status.ml b/duniverse/dune_/src/dune_rules/dir_status.ml index 944fe905c..4c3406829 100644 --- a/duniverse/dune_/src/dune_rules/dir_status.ml +++ b/duniverse/dune_/src/dune_rules/dir_status.ml @@ -86,7 +86,7 @@ end = struct | Some st_dir -> ( let project_root = Source_tree.Dir.project st_dir |> Dune_project.root in let build_dir_is_project_root = - Path.Build.drop_build_context_exn dir |> Path.Source.equal project_root + Source_tree.Dir.path st_dir |> Path.Source.equal project_root in Only_packages.stanzas_in_dir dir >>= function | None -> ( diff --git a/duniverse/dune_/src/dune_rules/dune b/duniverse/dune_/src/dune_rules/dune index 897d7f164..8f3dd92e8 100644 --- a/duniverse/dune_/src/dune_rules/dune +++ b/duniverse/dune_/src/dune_rules/dune @@ -9,6 +9,8 @@ memo ocaml dune_re + dune_console + dune_digest opam_file_format dune_lang dune_glob @@ -53,11 +55,12 @@ (mode promote) (alias runtest) (targets setup.defaults.ml) - (deps %{project_root}/configure.ml) + (deps + (:configure %{project_root}/boot/configure.ml)) (action (chdir %{project_root} (setenv DUNE_CONFIGURE_OUTPUT "src/dune_rules/setup.defaults.ml" - (run %{ocaml} configure.ml))))) + (run %{ocaml} %{configure}))))) diff --git a/duniverse/dune_/src/dune_rules/dune_file.ml b/duniverse/dune_/src/dune_rules/dune_file.ml index 60801ced2..997caeede 100644 --- a/duniverse/dune_/src/dune_rules/dune_file.ml +++ b/duniverse/dune_/src/dune_rules/dune_file.ml @@ -89,37 +89,6 @@ module Lib_deps = struct let of_pps pps = List.map pps ~f:(fun pp -> Lib_dep.direct (Loc.none, pp)) end -let preprocess_fields = - let+ preprocess = - field "preprocess" Preprocess.Per_module.decode - ~default:(Preprocess.Per_module.default ()) - and+ preprocessor_deps = - field_o "preprocessor_deps" - (let+ loc = loc - and+ l = repeat Dep_conf.decode in - (loc, l)) - and+ syntax = Dune_lang.Syntax.get_exn Stanza.syntax in - let preprocessor_deps = - match preprocessor_deps with - | None -> [] - | Some (loc, deps) -> - let deps_might_be_used = - Module_name.Per_item.exists preprocess ~f:(fun p -> - match (p : _ Preprocess.t) with - | Action _ | Pps _ -> true - | No_preprocessing | Future_syntax _ -> false) - in - if not deps_might_be_used then - User_warning.emit ~loc - ~is_error:(syntax >= (2, 0)) - [ Pp.text - "This preprocessor_deps field will be ignored because no \ - preprocessor that might use them is configured." - ]; - deps - in - (preprocess, preprocessor_deps) - module Buildable = struct type t = { loc : Loc.t @@ -128,6 +97,7 @@ module Buildable = struct ; empty_module_interface_if_absent : bool ; libraries : Lib_dep.t list ; foreign_archives : (Loc.t * Foreign.Archive.t) list + ; extra_objects : Foreign.Objects.t ; foreign_stubs : Foreign.Stubs.t list ; preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t ; preprocessor_deps : Dep_conf.t list @@ -157,11 +127,11 @@ module Buildable = struct let flags = Option.value ~default:Ordered_set_lang.Unexpanded.standard flags in - Foreign.Stubs.make ~loc ~language ~names ~flags :: foreign_stubs + Foreign.Stubs.make ~loc ~language ~names ~mode:Mode.Select.All ~flags + :: foreign_stubs in let+ loc = loc - and+ project = Dune_project.get_exn () - and+ preprocess, preprocessor_deps = preprocess_fields + and+ preprocess, preprocessor_deps = Stanza_common.preprocess_fields and+ lint = field "lint" Lint.decode ~default:Lint.default and+ foreign_stubs = multi_field "foreign_stubs" @@ -170,6 +140,9 @@ module Buildable = struct field_o "foreign_archives" (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> repeat (located Foreign.Archive.decode)) + and+ extra_objects = + field_o "extra_objects" + (Dune_lang.Syntax.since Stanza.syntax (3, 5) >>> Foreign.Objects.decode) and+ c_flags = only_in_library (field_o "c_flags" (use_foreign >>> Ordered_set_lang.Unexpanded.decode)) @@ -207,39 +180,7 @@ module Buildable = struct field_o "ctypes" (Dune_lang.Syntax.since Ctypes_stanza.syntax (0, 1) >>> Ctypes_stanza.decode) - and+ loc_instrumentation, instrumentation = - located - (multi_field "instrumentation" - (Dune_lang.Syntax.since Stanza.syntax (2, 7) - >>> fields - (let+ backend = - field "backend" - (let+ libname = located Lib_name.decode - and+ flags = - let* current_ver = - Dune_lang.Syntax.get_exn Stanza.syntax - in - let version_check flag = - let ver = (2, 8) in - if current_ver >= ver then flag - else - let what = - "The possibility to pass arguments to \ - instrumentation backends" - in - Dune_lang.Syntax.Error.since - (String_with_vars.loc flag) - Stanza.syntax ver ~what - in - repeat (String_with_vars.decode >>| version_check) - in - (libname, flags)) - and+ deps = - field "deps" ~default:[] - (Dune_lang.Syntax.since Stanza.syntax (2, 9) - >>> repeat Dep_conf.decode) - in - (backend, deps)))) + and+ loc_instrumentation, instrumentation = Stanza_common.instrumentation and+ root_module = field_o "root_module" (Dune_lang.Syntax.since Stanza.syntax (2, 8) >>> Module_name.decode_loc) @@ -270,22 +211,8 @@ module Buildable = struct in libraries @ ctypes_libraries in - let foreign_stubs = - match ctypes with - | None -> foreign_stubs - | Some (ctypes : Ctypes_stanza.t) -> - let init = foreign_stubs in - List.fold_left ctypes.function_description ~init - ~f:(fun foreign_stubs fd -> - Ctypes_stubs.add ~loc - ~parsing_context:(Dune_project.parsing_context project) - ~external_library_name:ctypes.external_library_name - ~functor_:fd.Ctypes_stanza.Function_description.functor_ - ~instance:fd.Ctypes_stanza.Function_description.instance - ~add_stubs ~foreign_stubs) - in - let foreign_archives = Option.value ~default:[] foreign_archives in let foreign_archives = + let foreign_archives = Option.value ~default:[] foreign_archives in if version < (2, 0) && List.is_non_empty foreign_stubs @@ -310,6 +237,9 @@ module Buildable = struct the "lib" prefix, however, since standard linkers require it). *) | Some name -> (loc, Foreign.Archive.stubs name) :: foreign_archives in + let extra_objects = + Option.value ~default:Foreign.Objects.empty extra_objects + in { loc ; preprocess ; preprocessor_deps @@ -319,6 +249,7 @@ module Buildable = struct ; empty_module_interface_if_absent ; foreign_stubs ; foreign_archives + ; extra_objects ; libraries ; flags ; js_of_ocaml @@ -328,12 +259,18 @@ module Buildable = struct } let has_foreign t = - List.is_non_empty t.foreign_stubs || List.is_non_empty t.foreign_archives + List.is_non_empty t.foreign_stubs + || List.is_non_empty t.foreign_archives + || (not (Foreign.Objects.is_empty t.extra_objects)) + || Option.is_some t.ctypes let has_foreign_cxx t = List.exists ~f:(fun stub -> Foreign_language.(equal Cxx stub.Foreign.Stubs.language)) t.foreign_stubs + + let has_mode_dependent_foreign_stubs t = + List.exists ~f:Foreign.Stubs.is_mode_dependent t.foreign_stubs end module Public_lib = struct @@ -445,9 +382,9 @@ module Mode_conf = struct let make_one x = { byte = x; native = x; best = x } end - module Set = struct - type mode_conf = t + type mode_conf = t + module Set = struct type nonrec t = Kind.t option Map.t let empty : t = Map.make_one None @@ -507,6 +444,86 @@ module Mode_conf = struct let eval t ~has_native = eval_detailed t ~has_native |> Mode.Dict.map ~f:Option.is_some end + + module Lib = struct + type t = + | Ocaml of mode_conf + | Melange + + let decode = + enum' + [ ("byte", return @@ Ocaml Byte) + ; ("native", return @@ Ocaml Native) + ; ("best", return @@ Ocaml Best) + ; ( "melange" + , Dune_lang.Syntax.since Melange.syntax (0, 1) >>> return Melange ) + ] + + let to_string = function + | Ocaml Byte -> "byte" + | Ocaml Native -> "native" + | Ocaml Best -> "best" + | Melange -> "melange" + + let to_dyn t = Dyn.variant (to_string t) [] + + module Map = struct + type nonrec 'a t = + { ocaml : 'a Map.t + ; melange : 'a + } + + let find t = function + | Ocaml a -> Map.find t.ocaml a + | Melange -> t.melange + + let update t key ~f = + match key with + | Ocaml key -> { t with ocaml = Map.update t.ocaml key ~f } + | Melange -> { t with melange = f t.melange } + + let make_one x = { ocaml = Map.make_one x; melange = x } + end + + module Set = struct + type mode_conf = t + + type nonrec t = Kind.t option Map.t + + let empty : t = Map.make_one None + + let of_list (input : (mode_conf * Kind.t) list) : t = + List.fold_left ~init:empty input ~f:(fun acc (key, kind) -> + Map.update acc key ~f:(function + | None -> Some kind + | Some (Kind.Requested loc) -> + User_error.raise ~loc [ Pp.textf "already configured" ] + | Some Inherited -> + (* this doesn't happen as inherited can't be manually specified *) + assert false)) + + let decode = + let decode = + let+ loc, t = located decode in + (t, Kind.Requested loc) + in + repeat decode >>| of_list + + let default loc : t = { empty with ocaml = Set.default loc } + + module Details = struct + type t = Kind.t option + end + + let eval_detailed t ~has_native = + let get key : Details.t = Map.find t key in + let melange = get Melange in + { Lib_mode.Map.ocaml = Set.eval_detailed t.ocaml ~has_native; melange } + + let eval t ~has_native = + eval_detailed t ~has_native |> Lib_mode.Map.map ~f:Option.is_some + end + end end module Library = struct @@ -549,7 +566,7 @@ module Library = struct ; synopsis : string option ; install_c_headers : string list ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list - ; modes : Mode_conf.Set.t + ; modes : Mode_conf.Lib.Set.t ; kind : Lib_kind.t ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t @@ -593,8 +610,8 @@ module Library = struct and+ virtual_deps = field "virtual_deps" (repeat (located Lib_name.decode)) ~default:[] and+ modes = - field "modes" Mode_conf.Set.decode - ~default:(Mode_conf.Set.default stanza_loc) + field "modes" Mode_conf.Lib.Set.decode + ~default:(Mode_conf.Lib.Set.default stanza_loc) and+ kind = field "kind" Lib_kind.decode ~default:Lib_kind.Normal and+ optional = field_b "optional" and+ no_dynlink = field_b "no_dynlink" @@ -753,18 +770,67 @@ module Library = struct let has_foreign_cxx t = Buildable.has_foreign_cxx t.buildable - let foreign_archives t = - (if List.is_empty t.buildable.foreign_stubs then [] - else [ Foreign.Archive.stubs (Lib_name.Local.to_string (snd t.name)) ]) - @ List.map ~f:snd t.buildable.foreign_archives - - let foreign_lib_files t ~dir ~ext_lib = - List.map (foreign_archives t) ~f:(fun archive -> - Foreign.Archive.lib_file ~archive ~dir ~ext_lib) + let stubs_archive t = + if + List.is_empty t.buildable.foreign_stubs + && Option.is_none t.buildable.ctypes + then None + else Some (Foreign.Archive.stubs (Lib_name.Local.to_string (snd t.name))) + + let foreign_archives t = List.map ~f:snd t.buildable.foreign_archives + + (* This function returns archives files for a given library and mode: + - For "all" modes it returns: + - the foreign archives (which are always not mode-dependent) + - the lib's stubs archive if they are not mode-dependent + - For a specific mode "m" it returns: + - the lib's stubs archive for that mode if they are mode-dependent + *) + let foreign_lib_files t ~dir ~ext_lib ~for_mode = + let stubs_archive = stubs_archive t in + let foreign_archives = foreign_archives t in + let stubs_are_mode_dependent = + Buildable.has_mode_dependent_foreign_stubs t.buildable + in + let lib_file ~for_mode archive = + Foreign.Archive.lib_file ~archive ~dir ~ext_lib ~mode:for_mode + in + let stubs_archive = + Option.bind stubs_archive ~f:(fun archive -> + match (stubs_are_mode_dependent, for_mode) with + | false, Mode.Select.All | true, Only _ -> + Some (lib_file ~for_mode archive) + | _ -> None) + in + if for_mode = Mode.Select.All then + let foreign_archives = + (* Stubs, and thus the lib archives can have mode-dependent versions, but + right now foreign archives cannot *) + List.map foreign_archives ~f:(lib_file ~for_mode) + in + Option.to_list stubs_archive @ foreign_archives + else Option.to_list stubs_archive let foreign_dll_files t ~dir ~ext_dll = - List.map (foreign_archives t) ~f:(fun archive -> - Foreign.Archive.dll_file ~archive ~dir ~ext_dll) + let stubs_archive = stubs_archive t in + let foreign_archives = foreign_archives t in + let mode = + if Buildable.has_mode_dependent_foreign_stubs t.buildable then + (* Shared object are never created in Native mode where everything is + linked statically. *) + Mode.Select.Only Mode.Byte + else Mode.Select.All + in + let dll_file ~mode archive = + Foreign.Archive.dll_file ~archive ~dir ~ext_dll ~mode + in + let foreign_archives = + List.map foreign_archives ~f:(dll_file ~mode:Mode.Select.All) + in + (* Stubs can have mode-dependent versions, not foreign archives *) + match stubs_archive with + | Some stubs_archive -> dll_file ~mode stubs_archive :: foreign_archives + | None -> foreign_archives let archive_basename t ~ext = Lib_name.Local.to_string (snd t.name) ^ ext @@ -810,9 +876,10 @@ module Library = struct let open Memo.O in let obj_dir = obj_dir ~dir conf in let archive ?(dir = dir) ext = archive conf ~dir ~ext in - let modes = Mode_conf.Set.eval ~has_native conf.modes in + let modes = Mode_conf.Lib.Set.eval ~has_native conf.modes in let archive_for_mode ~f_ext ~mode = - if Mode.Dict.get modes mode then Some (archive (f_ext mode)) else None + if Mode.Dict.get modes.ocaml mode then Some (archive (f_ext mode)) + else None in let archives_for_mode ~f_ext = Mode.Dict.of_func (fun ~mode -> @@ -828,10 +895,21 @@ module Library = struct | Public p -> Public (conf.project, p.package) in let virtual_library = is_virtual conf in - let foreign_archives = foreign_lib_files conf ~dir ~ext_lib in + let foreign_archives = + let init = + Mode.Map.Multi.create_for_all_modes + @@ foreign_lib_files conf ~dir ~ext_lib ~for_mode:All + in + Mode.Dict.foldi modes.ocaml ~init ~f:(fun mode enabled acc -> + if enabled then + let for_mode = Mode.Select.Only mode in + let libs = foreign_lib_files conf ~dir ~ext_lib ~for_mode in + Mode.Map.Multi.add_all acc for_mode libs + else acc) + in let native_archives = let archive = archive ext_lib in - if virtual_library || not modes.native then Lib_info.Files [] + if virtual_library || not modes.ocaml.native then Lib_info.Files [] else if Option.is_some conf.implements || Lib_config.linker_can_create_empty_archives lib_config @@ -845,7 +923,8 @@ module Library = struct let jsoo_archive = (* XXX we shouldn't access the directory of the obj_dir directly. We should use something like [Obj_dir.Archive.obj] instead *) - if modes.byte then Some (archive ~dir:(Obj_dir.obj_dir obj_dir) ".cma.js") + if modes.ocaml.byte then + Some (archive ~dir:(Obj_dir.obj_dir obj_dir) ".cma.js") else None in let virtual_ = @@ -934,53 +1013,157 @@ module Plugin = struct end module Install_conf = struct + (* Expands a [String_with_vars.t] with a given function, returning the result + unless the result is an absolute path in which case a user error is raised. *) + let expand_str_with_check_for_local_path ~expand_str sw = + Memo.map (expand_str sw) ~f:(fun str -> + (if not (Filename.is_relative str) then + let loc = String_with_vars.loc sw in + User_error.raise ~loc + [ Pp.textf "Absolute paths are not allowed in the install stanza." ]); + str) + + module File_entry = struct + module Without_include = struct + type t = + | File_binding of File_binding.Unexpanded.t + | Glob_files of Glob_files.t + + let decode = + let open Dune_lang.Decoder in + let file_binding_decode = + let+ file_binding = File_binding.Unexpanded.decode in + File_binding file_binding + in + let glob_files_decode = + let version_check = Dune_lang.Syntax.since Stanza.syntax (3, 6) in + let+ glob_files = + sum + [ ( "glob_files" + , let+ glob = version_check >>> String_with_vars.decode in + { Glob_files.glob; recursive = false } ) + ; ( "glob_files_rec" + , let+ glob = version_check >>> String_with_vars.decode in + { Glob_files.glob; recursive = true } ) + ] + in + Glob_files glob_files + in + file_binding_decode <|> glob_files_decode + + let to_file_bindings_unexpanded t ~expand_str ~dir = + match t with + | File_binding file_binding -> Memo.return [ file_binding ] + | Glob_files glob_files -> + let open Memo.O in + let+ paths = + Glob_files.Expand.memo glob_files ~f:expand_str ~base_dir:dir + in + let glob_loc = String_with_vars.loc glob_files.glob in + List.map paths ~f:(fun path -> + let src = (glob_loc, path) in + File_binding.Unexpanded.make ~src ~dst:src) + + let to_file_bindings_expanded t ~expand_str ~dir = + to_file_bindings_unexpanded t ~expand_str ~dir + |> Memo.bind + ~f: + (Memo.List.map + ~f: + (File_binding.Unexpanded.expand ~dir + ~f:(expand_str_with_check_for_local_path ~expand_str))) + end + + include + Recursive_include.Make + (Without_include) + (struct + let include_keyword = "include" + + let include_allowed_in_versions = `Since (3, 5) + + let non_sexp_behaviour = `User_error + end) + + let expand_include_multi ts ~expand_str ~dir = + Memo.List.concat_map ts ~f:(expand_include ~expand_str ~dir) + + let of_file_binding file_binding = + of_base (Without_include.File_binding file_binding) + + let to_file_bindings_unexpanded ts ~expand_str ~dir = + expand_include_multi ts ~expand_str ~dir + |> Memo.bind + ~f: + (Memo.List.concat_map + ~f: + (Without_include.to_file_bindings_unexpanded ~expand_str ~dir)) + + let to_file_bindings_expanded ts ~expand_str ~dir = + expand_include_multi ts ~expand_str ~dir + |> Memo.bind + ~f: + (Memo.List.concat_map + ~f:(Without_include.to_file_bindings_expanded ~expand_str ~dir)) + end + + module Dir_entry = struct + include + Recursive_include.Make + (File_binding.Unexpanded) + (struct + let include_keyword = "include" + + let include_allowed_in_versions = `Since (3, 5) + + let non_sexp_behaviour = `User_error + end) + + let to_file_bindings_expanded ts ~expand_str ~dir = + Memo.List.concat_map ts ~f:(expand_include ~expand_str ~dir) + |> Memo.bind + ~f: + (Memo.List.map + ~f: + (File_binding.Unexpanded.expand ~dir + ~f:(expand_str_with_check_for_local_path ~expand_str))) + end + type t = { section : Install.Section_with_site.t - ; files : File_binding.Unexpanded.t list + ; files : File_entry.t list + ; dirs : Dir_entry.t list ; package : Package.t ; enabled_if : Blang.t } let decode = fields - (let+ section = field "section" Install.Section_with_site.decode - and+ files = field "files" File_binding.Unexpanded.L.decode + (let+ loc = loc + and+ section = field "section" Install.Section_with_site.decode + and+ files = field_o "files" (repeat File_entry.decode) + and+ dirs = + field_o "dirs" + (Dune_lang.Syntax.since Stanza.syntax (3, 5) + >>> repeat Dir_entry.decode) and+ package = Stanza_common.Pkg.field ~stanza:"install" and+ enabled_if = let allowed_vars = Enabled_if.common_vars ~since:(2, 6) in Enabled_if.decode ~allowed_vars ~since:(Some (2, 6)) () in - { section; files; package; enabled_if }) -end + let files, dirs = + match (files, dirs) with + | None, None -> + User_error.raise ~loc [ Pp.textf "dirs or files must be set" ] + | _, _ -> + (Option.value files ~default:[], Option.value dirs ~default:[]) + in -module Promote = struct - let into_decode = - let+ loc, dir = located relative_file in - { Rule.Promote.Into.loc; dir } + { section; dirs; files; package; enabled_if }) - let decode : Rule.Promote.t Dune_lang.Decoder.t = - fields - (let+ until_clean = - field_b "until-clean" - ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 10)) - and+ into = - field_o "into" - (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> into_decode) - and+ only = - field_o "only" - (Dune_lang.Syntax.since Stanza.syntax (1, 10) - >>> Predicate_lang.decode Glob.decode) - in - let only = - Option.map only ~f:(fun only -> - let only = Predicate_lang.map only ~f:Glob.to_predicate in - Predicate_lang.to_predicate only ~standard:Predicate_lang.any) - in - { Rule.Promote.lifetime = - (if until_clean then Until_clean else Unlimited) - ; into - ; only - }) + let expand_files t = File_entry.to_file_bindings_expanded t.files + + let expand_dirs t = Dir_entry.to_file_bindings_expanded t.dirs end module Executables = struct @@ -1140,12 +1323,18 @@ module Executables = struct let files = List.map2 t.names public_names ~f:(fun (locn, name) (locp, pub) -> Option.map pub ~f:(fun pub -> - File_binding.Unexpanded.make - ~src:(locn, name ^ ext) - ~dst:(locp, pub))) + Install_conf.File_entry.of_file_binding + (File_binding.Unexpanded.make + ~src:(locn, name ^ ext) + ~dst:(locp, pub)))) |> List.filter_opt in - { Install_conf.section = Section Bin; files; package; enabled_if }) + { Install_conf.section = Section Bin + ; files + ; dirs = [] + ; package + ; enabled_if + }) end module Link_mode = struct @@ -1188,8 +1377,6 @@ module Executables = struct let plugin = make Best Plugin - let installable_modes = [ exe; native; byte ] - let simple_representations = [ ("exe", exe) ; ("object", object_) @@ -1269,6 +1456,13 @@ module Executables = struct module O = Comparable.Make (T) + let installable_modes = + [ ((0, 0), exe) + ; ((0, 0), native) + ; ((0, 0), byte) + ; ((3, 6), Byte_complete) + ] + module Map = struct include O.Map @@ -1304,7 +1498,28 @@ module Executables = struct let default_for_tests ~version = if version < (3, 0) then byte_and_exe else singleton exe Loc.none - let best_install_mode t = List.find ~f:(mem t) installable_modes + let best_install_mode t ~(dune_version : Syntax.Version.t) = + let rec loop acc = function + | [] -> acc + | (since, mode) :: rest -> ( + match mem t mode with + | false -> loop acc rest + | true -> + if dune_version < since then + loop (Some (`Unavailable_until (since, mode))) rest + else Some (`Found mode)) + in + match loop None installable_modes with + | None -> None + | Some (`Found f) -> Some f + | Some (`Unavailable_until (since, mode)) -> + let what = + List.find_map simple_representations ~f:(fun (rep, mode') -> + Option.some_if (Ordering.is_eq (T.compare mode mode')) rep) + |> Option.value_exn + in + let loc = find_exn t mode in + Syntax.Error.since loc Stanza.syntax since ~what end end @@ -1348,7 +1563,8 @@ module Executables = struct field_b "optional" ~check:(Dune_lang.Syntax.since Stanza.syntax (2, 0)) and+ promote = field_o "promote" - (Dune_lang.Syntax.since Stanza.syntax (1, 11) >>> Promote.decode) + (Dune_lang.Syntax.since Stanza.syntax (1, 11) + >>> Rule_mode_decoder.Promote.decode) and+ () = map_validate (field "inline_tests" (repeat junk >>| fun _ -> true) ~default:false) @@ -1385,17 +1601,14 @@ module Executables = struct fname) and+ enabled_if = let allowed_vars = Enabled_if.common_vars ~since:(2, 3) in - let* syntax_version = Dune_lang.Syntax.get_exn Stanza.syntax in - let is_error = - Dune_lang.Syntax.Version.Infix.(syntax_version >= (2, 6)) - in + let is_error = Dune_lang.Syntax.Version.Infix.(dune_version >= (2, 6)) in Enabled_if.decode ~allowed_vars ~is_error ~since:(Some (2, 3)) () in fun names ~multi -> let has_public_name = Names.has_public_name names in let private_names = Names.names names in let install_conf = - match Link_mode.Map.best_install_mode modes with + match Link_mode.Map.best_install_mode ~dune_version modes with | None when has_public_name -> User_error.raise ~loc:buildable.loc [ Pp.textf "No installable mode found for %s." @@ -1403,14 +1616,19 @@ module Executables = struct ; Pp.text "When public_name is set, one of the following modes is \ required:" - ; Pp.enumerate Link_mode.installable_modes ~f:(fun mode -> + ; Pp.enumerate + (List.filter_map Link_mode.installable_modes + ~f:(fun (since, mode) -> + Option.some_if (dune_version >= since) mode)) + ~f:(fun mode -> Pp.verbatim (Dune_lang.to_string (Link_mode.encode mode))) ] | None -> None | Some mode -> let ext = match mode with - | Byte_complete | Other { mode = Byte; _ } -> ".bc" + | Byte_complete -> ".bc.exe" + | Other { mode = Byte; _ } -> ".bc" | Other { mode = Native | Best; _ } -> ".exe" in Names.install_conf names ~ext ~enabled_if @@ -1464,73 +1682,7 @@ end module Rule = struct module Mode = struct include Rule.Mode - - let mode_decoders = - [ ("standard", return Rule.Mode.Standard) - ; ("fallback", return Rule.Mode.Fallback) - ; ( "promote" - , let+ p = Promote.decode in - Rule.Mode.Promote p ) - ; ( "promote-until-clean" - , let+ () = - Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) - ~extra_info:"Use the (promote (until-clean)) syntax instead." - in - Rule.Mode.Promote { lifetime = Until_clean; into = None; only = None } - ) - ; ( "promote-into" - , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 8) - and+ () = - Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) - ~extra_info:"Use the (promote (into )) syntax instead." - and+ into = Promote.into_decode in - Rule.Mode.Promote - { lifetime = Unlimited; into = Some into; only = None } ) - ; ( "promote-until-clean-into" - , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 8) - and+ () = - Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) - ~extra_info: - "Use the (promote (until-clean) (into )) syntax instead." - and+ into = Promote.into_decode in - Rule.Mode.Promote - { lifetime = Until_clean; into = Some into; only = None } ) - ] - - module Extended = struct - type t = - | Normal of Rule.Mode.t - | Patch_back_source_tree - - let patch_back_from_source_tree_syntax = - Dune_lang.Syntax.create ~experimental:true - ~name:"patch-back-source-tree" - ~desc:"experimental support for (mode patch-back-source-tree)" - [ ((0, 1), `Since (3, 0)) ] - - let () = - Dune_project.Extension.register_simple - patch_back_from_source_tree_syntax - (Dune_lang.Decoder.return []) - - let decode = - sum - (( "patch-back-source-tree" - , let+ () = - Dune_lang.Syntax.since patch_back_from_source_tree_syntax (0, 1) - in - Patch_back_source_tree ) - :: List.map mode_decoders ~f:(fun (name, dec) -> - ( name - , let+ x = dec in - Normal x ))) - - let field = field "mode" decode ~default:(Normal Standard) - end - - let decode = sum mode_decoders - - let field = field "mode" decode ~default:Rule.Mode.Standard + include Rule_mode_decoder end type t = @@ -1542,7 +1694,7 @@ module Rule = struct ; locks : Locks.t ; loc : Loc.t ; enabled_if : Blang.t - ; alias : Alias.Name.t option + ; aliases : Alias.Name.t list ; package : Package.t option } @@ -1580,6 +1732,7 @@ module Rule = struct ; ("locks", Field) ; ("fallback", Field) ; ("mode", Field) + ; ("aliases", Field) ; ("alias", Field) ; ("enabled_if", Field) ] @@ -1594,7 +1747,7 @@ module Rule = struct ; locks = [] ; loc ; enabled_if = Blang.true_ - ; alias = None + ; aliases = [] ; package = None } @@ -1643,6 +1796,23 @@ module Rule = struct and+ alias = field_o "alias" (Dune_lang.Syntax.since Stanza.syntax (2, 0) >>> Alias.Name.decode) + and+ aliases = + field_o "aliases" + (Dune_lang.Syntax.since Stanza.syntax (3, 5) + >>> repeat Alias.Name.decode) + in + let aliases = + match alias with + | None -> Option.value ~default:[] aliases + | Some alias -> ( + match aliases with + | None -> [ alias ] + | Some _ -> + User_error.raise ~loc + [ Pp.text + "The 'alias' and 'aliases' fields are mutually exclusive. \ + Please use only the 'aliases' field." + ]) in let mode, patch_back_source_tree = match mode with @@ -1668,7 +1838,7 @@ module Rule = struct ; locks ; loc ; enabled_if - ; alias + ; aliases ; package ; patch_back_source_tree }) @@ -1738,7 +1908,7 @@ module Rule = struct ; locks = [] ; loc ; enabled_if - ; alias = None + ; aliases = [] ; package = None }) @@ -1768,58 +1938,11 @@ module Rule = struct ; locks = [] ; loc ; enabled_if - ; alias = None + ; aliases = [] ; package = None }) end -module Menhir = struct - type t = - { merge_into : string option - ; flags : Ordered_set_lang.Unexpanded.t - ; modules : string list - ; mode : Rule.Mode.t - ; loc : Loc.t - ; infer : bool - ; enabled_if : Blang.t - } - - let decode = - fields - (let+ merge_into = field_o "merge_into" string - and+ flags = Ordered_set_lang.Unexpanded.field "flags" - and+ modules = field "modules" (repeat string) - and+ mode = Rule.Mode.field - and+ infer = - field_o_b "infer" - ~check:(Dune_lang.Syntax.since Menhir_stanza.syntax (2, 0)) - and+ menhir_syntax = Dune_lang.Syntax.get_exn Menhir_stanza.syntax - and+ enabled_if = - Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () - and+ loc = loc in - let infer = - match infer with - | Some infer -> infer - | None -> menhir_syntax >= (2, 0) - in - { merge_into; flags; modules; mode; loc; infer; enabled_if }) - - type Stanza.t += T of t - - let () = - Dune_project.Extension.register_simple Menhir_stanza.syntax - (return [ ("menhir", decode >>| fun x -> [ T x ]) ]) - - let modules (stanza : t) : string list = - match stanza.merge_into with - | Some m -> [ m ] - | None -> stanza.modules - - let targets (stanza : t) : string list = - let f m = [ m ^ ".ml"; m ^ ".mli" ] in - List.concat_map (modules stanza) ~f -end - module Alias_conf = struct type t = { name : Alias.Name.t @@ -2153,6 +2276,7 @@ type Stanza.t += | Cram of Cram_stanza.t | Generate_sites_module of Generate_sites_module.t | Plugin of Plugin.t + | Melange_emit of Melange_stanzas.Emit.t module Stanzas = struct type t = Stanza.t list @@ -2269,6 +2393,10 @@ module Stanzas = struct , let+ () = Dune_lang.Syntax.since Section.dune_site_syntax (0, 1) and+ t = Plugin.decode in [ Plugin t ] ) + ; ( "melange.emit" + , let+ () = Dune_lang.Syntax.since Melange.syntax (0, 1) + and+ t = Melange_stanzas.Emit.decode in + [ Melange_emit t ] ) ] let () = Dune_project.Lang.register Stanza.syntax stanzas @@ -2332,15 +2460,27 @@ type t = ; stanzas : Stanzas.t } +let is_promoted_rule version rule = + let is_promoted_mode = function + | Rule.Mode.Promote { only = None; lifetime; _ } -> + if version >= (3, 5) then + match lifetime with + | Unlimited -> true + | Until_clean -> false + else true + | _ -> false + in + match rule with + | Rule { mode; _ } | Menhir_stanza.T { mode; _ } -> is_promoted_mode mode + | _ -> false + let parse sexps ~dir ~file ~project = let open Memo.O in let+ stanzas = Stanzas.parse ~file project sexps in let stanzas = if !Clflags.ignore_promoted_rules then - List.filter stanzas ~f:(function - | Rule { mode = Rule.Mode.Promote { only = None; _ }; _ } - | Menhir.T { mode = Rule.Mode.Promote { only = None; _ }; _ } -> false - | _ -> true) + let version = Dune_project.dune_version project in + List.filter stanzas ~f:(fun s -> not (is_promoted_rule version s)) else stanzas in { dir; project; stanzas } diff --git a/duniverse/dune_/src/dune_rules/dune_file.mli b/duniverse/dune_/src/dune_rules/dune_file.mli index d1853b8d3..0833bb8b2 100644 --- a/duniverse/dune_/src/dune_rules/dune_file.mli +++ b/duniverse/dune_/src/dune_rules/dune_file.mli @@ -20,12 +20,6 @@ module Lib_deps : sig val decode : for_ -> t Dune_lang.Decoder.t end -(** [preprocess] and [preprocessor_deps] fields *) -val preprocess_fields : - (Preprocess.Without_instrumentation.t Preprocess.Per_module.t - * Dep_conf.t list) - Dune_lang.Decoder.fields_parser - module Buildable : sig type t = { loc : Loc.t @@ -34,6 +28,7 @@ module Buildable : sig ; empty_module_interface_if_absent : bool ; libraries : Lib_dep.t list ; foreign_archives : (Loc.t * Foreign.Archive.t) list + ; extra_objects : Foreign.Objects.t ; foreign_stubs : Foreign.Stubs.t list ; preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t ; preprocessor_deps : Dep_conf.t list @@ -50,6 +45,8 @@ module Buildable : sig (** Check if the buildable has any c++ foreign stubs. *) val has_foreign_cxx : t -> bool + + val has_mode_dependent_foreign_stubs : t -> bool end module Public_lib : sig @@ -99,9 +96,9 @@ module Mode_conf : sig } end - module Set : sig - type mode_conf = t + type mode_conf := t + module Set : sig type nonrec t = Kind.t option Map.t val of_list : (mode_conf * Kind.t) list -> t @@ -116,6 +113,39 @@ module Mode_conf : sig val eval : t -> has_native:bool -> Mode.Dict.Set.t end + + module Lib : sig + type t = + | Ocaml of mode_conf + | Melange + + val to_dyn : t -> Dyn.t + + module Map : sig + type nonrec 'a t = + { ocaml : 'a Map.t + ; melange : 'a + } + end + + module Set : sig + type mode_conf := t + + type nonrec t = Kind.t option Map.t + + val of_list : (mode_conf * Kind.t) list -> t + + val decode : t Dune_lang.Decoder.t + + module Details : sig + type t = Kind.t option + end + + val eval_detailed : t -> has_native:bool -> Details.t Lib_mode.Map.t + + val eval : t -> has_native:bool -> Lib_mode.Map.Set.t + end + end end module Library : sig @@ -129,7 +159,7 @@ module Library : sig ; synopsis : string option ; install_c_headers : string list ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list - ; modes : Mode_conf.Set.t + ; modes : Mode_conf.Lib.Set.t ; kind : Lib_kind.t (* TODO: It may be worth remaming [c_library_flags] to [link_time_flags_for_c_compiler] and [library_flags] to @@ -166,13 +196,21 @@ module Library : sig (** Check if the library has any c++ foreign stubs. *) val has_foreign_cxx : t -> bool - (** The list of all foreign archives, including the foreign stubs archive. *) + (** The foreign stubs archive. *) + val stubs_archive : t -> Foreign.Archive.t option + + (** The list of foreign archives. *) val foreign_archives : t -> Foreign.Archive.t list (** The [lib*.a] files of all foreign archives, including foreign stubs. [dir] - is the directory the library is declared in. *) + is the directory the library is declared in. Only files relevant to the + [for_mode] selection will be returned. *) val foreign_lib_files : - t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t list + t + -> dir:Path.Build.t + -> ext_lib:string + -> for_mode:Mode.Select.t + -> Path.Build.t list (** The path to a library archive. [dir] is the directory the library is declared in. *) @@ -203,12 +241,39 @@ module Plugin : sig end module Install_conf : sig + module File_entry : sig + type t + + val to_file_bindings_unexpanded : + t list + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Unexpanded.t list Memo.t + end + + module Dir_entry : sig + type t + end + type t = { section : Install.Section_with_site.t - ; files : File_binding.Unexpanded.t list + ; files : File_entry.t list + ; dirs : Dir_entry.t list ; package : Package.t ; enabled_if : Blang.t } + + val expand_files : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Expanded.t list Memo.t + + val expand_dirs : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> File_binding.Expanded.t list Memo.t end module Executables : sig @@ -269,27 +334,6 @@ module Executables : sig val obj_dir : t -> dir:Path.Build.t -> Path.Build.t Obj_dir.t end -module Menhir : sig - type t = - { merge_into : string option - ; flags : Ordered_set_lang.Unexpanded.t - ; modules : string list - ; mode : Rule.Mode.t - ; loc : Loc.t - ; infer : bool - ; enabled_if : Blang.t - } - - val modules : t -> string list - - (** Return the list of targets that are generated by this stanza. This list of - targets is used by the code that computes the list of modules in the - directory. *) - val targets : t -> string list - - type Stanza.t += T of t -end - module Copy_files : sig type t = { add_line_directive : bool @@ -311,7 +355,7 @@ module Rule : sig ; locks : Locks.t ; loc : Loc.t ; enabled_if : Blang.t - ; alias : Alias.Name.t option + ; aliases : Alias.Name.t list ; package : Package.t option } end @@ -438,6 +482,7 @@ type Stanza.t += | Cram of Cram_stanza.t | Generate_sites_module of Generate_sites_module.t | Plugin of Plugin.t + | Melange_emit of Melange_stanzas.Emit.t val stanza_package : Stanza.t -> Package.t option diff --git a/duniverse/dune_/src/dune_rules/dune_load.ml b/duniverse/dune_/src/dune_rules/dune_load.ml index df8ecc9f0..8202050d7 100644 --- a/duniverse/dune_/src/dune_rules/dune_load.ml +++ b/duniverse/dune_/src/dune_rules/dune_load.ml @@ -5,7 +5,7 @@ module Jbuild_plugin : sig val create_plugin_wrapper : Context.t -> exec_dir:Path.t - -> plugin:Path.t + -> plugin:Path.Outside_build_dir.t -> wrapper:Path.Build.t -> target:Path.Build.t -> unit Memo.t @@ -74,7 +74,8 @@ end = struct Printf.fprintf oc "module Jbuild_plugin : sig\n%s\nend = struct\n%s\nend\n# 1 %S\n%s" Assets.jbuild_plugin_mli (replace_in_template vars) - (Path.to_string plugin) plugin_contents + (Path.Outside_build_dir.to_string plugin) + plugin_contents let check_no_requires path str = List.iteri (String.split str ~on:'\n') ~f:(fun n line -> @@ -106,7 +107,7 @@ end = struct let+ plugin_contents = Fs_memo.file_contents plugin in Io.with_file_out (Path.build wrapper) ~f:(fun oc -> write oc ~context ~target ~exec_dir ~plugin ~plugin_contents); - check_no_requires plugin plugin_contents + check_no_requires (Path.outside_build_dir plugin) plugin_contents end module Script = struct @@ -141,7 +142,7 @@ module Script = struct ensure_parent_dir_exists generated_dune_file; let* () = Jbuild_plugin.create_plugin_wrapper context ~exec_dir:(Path.source dir) - ~plugin:(Path.source file) ~wrapper ~target:generated_dune_file + ~plugin:(In_source_dir file) ~wrapper ~target:generated_dune_file in let context = Option.value context.for_host ~default:context in let args = diff --git a/duniverse/dune_/src/dune_rules/dune_package.ml b/duniverse/dune_/src/dune_rules/dune_package.ml index 44e43fe0d..a2e601e70 100644 --- a/duniverse/dune_/src/dune_rules/dune_package.ml +++ b/duniverse/dune_/src/dune_rules/dune_package.ml @@ -77,7 +77,8 @@ module Lib = struct ; mode_paths "archives" archives ; mode_paths "plugins" plugins ; paths "foreign_objects" foreign_objects - ; paths "foreign_archives" (Lib_info.foreign_archives info) + ; field_i "foreign_archives" (Mode.Map.encode path) + (Lib_info.foreign_archives info) ; paths "native_archives" native_archives ; paths "jsoo_runtime" jsoo_runtime ; Lib_dep.L.field_encode requires ~name:"requires" @@ -86,7 +87,7 @@ module Lib = struct ; field_o "default_implementation" (no_loc Lib_name.encode) default_implementation ; field_o "main_module_name" Module_name.encode main_module_name - ; field_l "modes" sexp (Mode.Dict.Set.encode modes) + ; field_l "modes" sexp (Mode.Dict.Set.encode modes.ocaml) ; field_l "obj_dir" sexp (Obj_dir.encode obj_dir) ; field_o "modules" Modules.encode modules ; field_o "special_builtin_support" @@ -133,10 +134,17 @@ module Lib = struct and+ plugins = mode_paths "plugins" and+ foreign_objects = paths "foreign_objects" and+ foreign_archives = - if lang.version >= (2, 0) then paths "foreign_archives" + if lang.version >= (3, 5) then + let+ field_o = field_o "foreign_archives" (Mode.Map.decode path) in + match field_o with + | Some archives -> archives + | None -> Mode.Map.empty + else if lang.version >= (2, 0) then + let+ paths = paths "foreign_archives" in + Mode.Map.Multi.create_for_all_modes paths else let+ m = mode_paths "foreign_archives" in - m.byte + Mode.Map.Multi.create_for_all_modes m.byte and+ native_archives = paths "native_archives" and+ jsoo_runtime = paths "jsoo_runtime" and+ requires = field_l "requires" (Lib_dep.decode ~allow_re_export:true) @@ -146,10 +154,7 @@ module Lib = struct and+ orig_src_dir = field_o "orig_src_dir" path and+ modules = let src_dir = Obj_dir.dir obj_dir in - field "modules" - (Modules.decode - ~implements:(Option.is_some implements) - ~src_dir ~version:lang.version) + field "modules" (Modules.decode ~src_dir) and+ special_builtin_support = field_o "special_builtin_support" (Dune_lang.Syntax.since Stanza.syntax (1, 10) @@ -183,6 +188,7 @@ module Lib = struct Some (Lib_info.Inherited.This (Modules.wrapped modules)) in let entry_modules = Lib_info.Source.External (Ok entry_modules) in + let modes = { Lib_mode.Map.ocaml = modes; melange = false } in Lib_info.create ~path_kind:External ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives @@ -415,13 +421,14 @@ module Or_meta = struct let load file = let dir = Path.parent_exn file in - Fs_memo.with_lexbuf_from_file file ~f:(fun lexbuf -> - (* XXX stop catching code errors, invalid args, etc. *) - Result.try_with (fun () -> - Vfile.parse_contents lexbuf ~f:(fun lang -> - String_with_vars.set_decoding_env - (Pform.Env.initial lang.version) - (decode ~lang ~dir)))) + Path.as_outside_build_dir_exn file + |> Fs_memo.with_lexbuf_from_file ~f:(fun lexbuf -> + (* XXX stop catching code errors, invalid args, etc. *) + Result.try_with (fun () -> + Vfile.parse_contents lexbuf ~f:(fun lang -> + String_with_vars.set_decoding_env + (Pform.Env.initial lang.version) + (decode ~lang ~dir)))) let pp ~dune_version ppf t = let t = encode ~dune_version t in diff --git a/duniverse/dune_/src/dune_rules/dune_rules.ml b/duniverse/dune_/src/dune_rules/dune_rules.ml index 10642b98f..a19a008ba 100644 --- a/duniverse/dune_/src/dune_rules/dune_rules.ml +++ b/duniverse/dune_/src/dune_rules/dune_rules.ml @@ -1,6 +1,7 @@ module Main = Main module Context = Context module Super_context = Super_context +module Compilation_context = Compilation_context module Findlib = Findlib module Colors = Colors module Profile = Profile @@ -13,7 +14,9 @@ module Lib = Lib module Lib_flags = Lib_flags module Lib_info = Lib_info module Modules = Modules +module Module_compilation = Module_compilation module Exe_rules = Exe_rules +module Lib_rules = Lib_rules module Obj_dir = Obj_dir module Merlin_ident = Merlin_ident module Merlin = Merlin @@ -30,10 +33,13 @@ module Utop = Utop module Setup = Setup module Meta = Meta module Toplevel = Toplevel +module Top_module = Top_module module Global = Global module Only_packages = Only_packages module Resolve = Resolve module Ocamldep = Ocamldep +module Dep_rules = Dep_rules +module Dep_graph = Dep_graph module Preprocess = Preprocess module Coq_rules = Coq_rules module Coq_module = Coq_module diff --git a/duniverse/dune_/src/dune_rules/enabled_if.ml b/duniverse/dune_/src/dune_rules/enabled_if.ml index b7aa594d2..075b077a3 100644 --- a/duniverse/dune_/src/dune_rules/enabled_if.ml +++ b/duniverse/dune_/src/dune_rules/enabled_if.ml @@ -7,7 +7,7 @@ type allowed_vars = (* The following variables are the ones allowed in the enabled_if fields of libraries, executables and install stanzas. While allowed variables for - theses stanzas are the same, the version at which they were allowed + these stanzas are the same, the version at which they were allowed differs. *) let common_vars_list = [ "architecture" diff --git a/duniverse/dune_/src/dune_rules/exe.ml b/duniverse/dune_/src/dune_rules/exe.ml index 95e4ce6b2..79d2bd524 100644 --- a/duniverse/dune_/src/dune_rules/exe.ml +++ b/duniverse/dune_/src/dune_rules/exe.ml @@ -1,6 +1,5 @@ open Import module CC = Compilation_context -module SC = Super_context module Program = struct type t = @@ -33,13 +32,15 @@ module Linkage = struct let is_byte x = x.mode = Byte && not (is_js x) - let custom context = + let custom_with_ext ~ext context = { mode = Byte_with_stubs_statically_linked_in - ; ext = ".exe" + ; ext ; flags = [ Ocaml.Version.custom_or_output_complete_exe context.Context.version ] } + let custom = custom_with_ext ~ext:".exe" + let native_or_custom (context : Context.t) = match context.ocamlopt with | Error _ -> custom context @@ -131,10 +132,9 @@ let exe_path_from_name cctx ~name ~(linkage : Linkage.t) = Path.Build.relative (CC.dir cctx) (name ^ linkage.ext) let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen - ~promote ?(link_args = Action_builder.return Command.Args.empty) - ?(o_files = []) ?(sandbox = Sandbox_config.default) cctx = + ~promote ~link_args ~o_files ?(sandbox = Sandbox_config.default) cctx = let sctx = CC.super_context cctx in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let dir = CC.dir cctx in let mode = Link_mode.mode linkage.mode in let exe = exe_path_from_name cctx ~name ~linkage in @@ -195,7 +195,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen ] >>| Action.Full.add_sandbox sandbox in - SC.add_rule sctx ~loc ~dir + Super_context.add_rule sctx ~loc ~dir ~mode: (match promote with | None -> Standard @@ -215,7 +215,7 @@ let link_js ~name ~loc ~cm_files ~promote ~link_time_code_gen cctx = | Lib_flags.Lib_and_module.Lib lib -> `Lib lib | Module (obj_dir, m) -> let path = - Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Mode.cm_kind Byte) + Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Ocaml (Mode.cm_kind Byte)) in `Mod path) in @@ -226,22 +226,36 @@ let link_js ~name ~loc ~cm_files ~promote ~link_time_code_gen cctx = type dep_graphs = { for_exes : Module.t list Action_builder.t list } -let link_many ?link_args ?o_files ?(embed_in_plugin_libraries = []) ?sandbox - ~programs ~linkages ~promote cctx = +let link_many ?(link_args = Action_builder.return Command.Args.empty) ?o_files + ?(embed_in_plugin_libraries = []) ?sandbox ~programs ~linkages ~promote cctx + = let open Memo.O in + let o_files = + match o_files with + | None -> Mode.Map.empty + | Some o_files -> o_files + in let modules = Compilation_context.modules cctx in let* link_time_code_gen = Link_time_code_gen.handle_special_libs cctx in let+ for_exes = Memo.parallel_map programs ~f:(fun { Program.name; main_module_name; loc } -> let top_sorted_modules = - let main = Option.value_exn (Modules.find modules main_module_name) in + let main = + match Modules.find modules main_module_name with + | Some m -> m + | None -> + Code_error.raise "link_many: unable to find module" + [ ("main_module_name", Module_name.to_dyn main_module_name) + ; ("modules", Modules.to_dyn modules) + ] + in Dep_graph.top_closed_implementations (CC.dep_graphs cctx).impl [ main ] in let cm_files = let sctx = CC.super_context cctx in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let obj_dir = CC.obj_dir cctx in Cm_files.make ~obj_dir ~modules ~top_sorted_modules ~ext_obj:ctx.lib_config.ext_obj () @@ -260,8 +274,17 @@ let link_many ?link_args ?o_files ?(embed_in_plugin_libraries = []) ?sandbox in Link_time_code_gen.handle_special_libs cc in + let link_args, o_files = + let select_o_files = + Mode.Map.Multi.for_only ~and_all:true o_files + in + match linkage.mode with + | Native -> (link_args, select_o_files Mode.Native) + | Byte | Byte_for_jsoo | Byte_with_stubs_statically_linked_in + -> (link_args, select_o_files Mode.Byte) + in link_exe cctx ~loc ~name ~linkage ~cm_files ~link_time_code_gen - ~promote ?link_args ?o_files ?sandbox) + ~promote ~link_args ~o_files ?sandbox) in top_sorted_modules) in diff --git a/duniverse/dune_/src/dune_rules/exe.mli b/duniverse/dune_/src/dune_rules/exe.mli index 0cfe03674..784a0748e 100644 --- a/duniverse/dune_/src/dune_rules/exe.mli +++ b/duniverse/dune_/src/dune_rules/exe.mli @@ -21,6 +21,9 @@ module Linkage : sig (** Native compilation, extension [.exe] *) val native : t + (** like [custom] but allows for a custom extension *) + val custom_with_ext : ext:string -> Context.t -> t + (** Byte compilation with stubs statically linked in, extension [.exe] *) val custom : Context.t -> t @@ -50,7 +53,7 @@ type dep_graphs = { for_exes : Module.t list Action_builder.t list } between executables without requiring an intermediate library. *) val link_many : ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t - -> ?o_files:Path.t list + -> ?o_files:Path.t Mode.Map.Multi.t -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list -> ?sandbox:Sandbox_config.t -> programs:Program.t list @@ -61,7 +64,7 @@ val link_many : val build_and_link : ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t - -> ?o_files:Path.t list + -> ?o_files:Path.t Mode.Map.Multi.t -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list -> ?sandbox:Sandbox_config.t -> program:Program.t @@ -72,7 +75,7 @@ val build_and_link : val build_and_link_many : ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t - -> ?o_files:Path.t list + -> ?o_files:Path.t Mode.Map.Multi.t -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list -> ?sandbox:Sandbox_config.t -> programs:Program.t list diff --git a/duniverse/dune_/src/dune_rules/exe_rules.ml b/duniverse/dune_/src/dune_rules/exe_rules.ml index a57bc7e5b..10b0ad48b 100644 --- a/duniverse/dune_/src/dune_rules/exe_rules.ml +++ b/duniverse/dune_/src/dune_rules/exe_rules.ml @@ -50,13 +50,20 @@ let programs ~modules ~(exes : Executables.t) = (Module_name.to_string mod_name) ] | None -> - User_error.raise ~loc - [ Pp.textf "Module %S doesn't exist." (Module_name.to_string mod_name) - ]) + let msg = + match Ordered_set_lang.loc exes.buildable.modules with + | None -> + Pp.textf "Module %S doesn't exist." (Module_name.to_string mod_name) + | Some _ -> + Pp.textf + "The name %S is not listed in the (modules) field of this stanza." + (Module_name.to_string mod_name) + in + User_error.raise ~loc [ msg ]) let o_files sctx ~dir ~expander ~(exes : Executables.t) ~linkages ~dir_contents ~requires_compile = - if not (Executables.has_foreign exes) then Memo.return [] + if not (Executables.has_foreign exes) then Memo.return @@ Mode.Map.empty else let what = if List.is_empty exes.buildable.Buildable.foreign_stubs then "archives" @@ -75,12 +82,16 @@ let o_files sctx ~dir ~expander ~(exes : Executables.t) ~linkages ~dir_contents let first_exe = first_exe exes in Foreign_sources.for_exes foreign_sources ~first_exe in + let foreign_o_files = + let { Lib_config.ext_obj; _ } = (Super_context.context sctx).lib_config in + Foreign.Objects.build_paths exes.buildable.extra_objects ~ext_obj ~dir + in let+ o_files = Foreign_rules.build_o_files ~sctx ~dir ~expander ~requires:requires_compile ~dir_contents ~foreign_sources - |> Memo.all_concurrently in - List.map o_files ~f:Path.build + (* [foreign_o_files] are not mode-dependent *) + Mode.Map.Multi.add_all o_files All foreign_o_files let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~embed_in_plugin_libraries (exes : Dune_file.Executables.t) = @@ -99,8 +110,9 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info let linkages = linkages ctx ~exes ~explicit_js_mode in let* flags = Super_context.ocaml_flags sctx ~dir exes.buildable.flags in let* modules, pp = - Buildable_rules.modules_rules sctx exes.buildable expander ~dir scope - modules ~lib_name:None ~empty_intf_modules:(`Exe_mains exes.names) + Buildable_rules.modules_rules sctx + (Executables (exes.buildable, exes.names)) + expander ~dir scope modules in let* cctx = let requires_compile = Lib.Compile.direct_requires compile_info in @@ -147,13 +159,11 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info in let+ flags = link_flags and+ ctypes_cclib_flags = - Ctypes_rules.ctypes_cclib_flags ~scope - ~standard:(Action_builder.return []) ~expander - ~buildable:exes.buildable + Ctypes_rules.ctypes_cclib_flags sctx ~expander ~buildable:exes.buildable in Command.Args.S - [ Command.Args.As flags - ; Command.Args.S + [ As flags + ; S (let ext_lib = ctx.lib_config.ext_lib in let foreign_archives = exes.buildable.foreign_archives |> List.map ~f:snd @@ -161,19 +171,23 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info (* XXX: don't these need the msvc hack being done in lib_rules? *) (* XXX: also the Command.quote_args being done in lib_rules? *) List.map foreign_archives ~f:(fun archive -> - let lib = Foreign.Archive.lib_file ~archive ~dir ~ext_lib in + let lib = + Foreign.Archive.lib_file ~archive ~dir ~ext_lib + ~mode:Mode.Select.All + in Command.Args.S [ A "-cclib"; Dep (Path.build lib) ])) (* XXX: don't these need the msvc hack being done in lib_rules? *) (* XXX: also the Command.quote_args being done in lib_rules? *) - ; Command.Args.As - (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ])) + ; As (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ])) ] in let* o_files = o_files sctx ~dir ~expander ~exes ~linkages ~dir_contents ~requires_compile in - let* () = Check_rules.add_files sctx ~dir o_files in + let* () = + Check_rules.add_files sctx ~dir @@ Mode.Map.Multi.to_flat_list o_files + in let buildable = exes.buildable in match buildable.ctypes with | None -> @@ -202,7 +216,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~preprocess ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) ~ident:(Lib.Compile.merlin_ident compile_info) - () ) + ~modes:`Exe () ) let compile_info ~scope (exes : Dune_file.Executables.t) = let dune_version = Scope.project scope |> Dune_project.dune_version in diff --git a/duniverse/dune_/src/dune_rules/expander.ml b/duniverse/dune_/src/dune_rules/expander.ml index 9207f2e7a..09528a8de 100644 --- a/duniverse/dune_/src/dune_rules/expander.ml +++ b/duniverse/dune_/src/dune_rules/expander.ml @@ -190,7 +190,7 @@ let expand_artifact ~source t a s = ~what:"Module" (Module_name.to_string name) | Some (t, m) -> ( - match Obj_dir.Module.cm_file t m ~kind with + match Obj_dir.Module.cm_file t m ~kind:(Ocaml kind) with | None -> Action_builder.return [ Value.String "" ] | Some path -> dep (Path.build path))) | Lib mode -> ( @@ -610,7 +610,31 @@ let expand_pform_gen ~(context : Context.t) ~bindings ~dir ~source "This file must be a list of lines escaped using \ OCaml's conventions" ] - | Ok s -> s))))) + | Ok s -> s))) + | Coq_config -> + Need_full_expander + (fun t -> + Without + (let open Memo.O in + let* bin = + Artifacts.Bin.binary t.bin_artifacts_host ~loc:None "coqc" + in + match bin with + | Ok bin -> ( + let+ t = Coq_config.make ~bin in + match Coq_config.by_name t s with + | None -> + User_error.raise + ~loc:(Dune_lang.Template.Pform.loc source) + [ Pp.textf "Unknown Coq configuration variable %S" s ] + | Some v -> ( + match v with + | Bool x -> string (string_of_bool x) + | Int x -> string (string_of_int x) + | String x -> string x + | Strings x -> strings x + | Path x -> Value.L.paths [ x ])) + | Error _ -> User_error.raise Pp.[ textf "coqc not found." ])))) (* Make sure to delay exceptions *) let expand_pform_gen ~context ~bindings ~dir ~source pform = diff --git a/duniverse/dune_/src/dune_rules/fdo.ml b/duniverse/dune_/src/dune_rules/fdo.ml index 212301060..4a6240ea4 100644 --- a/duniverse/dune_/src/dune_rules/fdo.ml +++ b/duniverse/dune_/src/dune_rules/fdo.ml @@ -122,9 +122,11 @@ let opt_rule cctx m = let ctx = CC.context cctx in let dir = CC.dir cctx in let obj_dir = CC.obj_dir cctx in - let linear = Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:linear_ext in + let linear = + Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) ~ext:linear_ext + in let linear_fdo = - Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:linear_fdo_ext + Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) ~ext:linear_fdo_ext in let open Memo.O in let flags () = diff --git a/duniverse/dune_/src/dune_rules/file_binding.ml b/duniverse/dune_/src/dune_rules/file_binding.ml index de0a20e85..f833c2e55 100644 --- a/duniverse/dune_/src/dune_rules/file_binding.ml +++ b/duniverse/dune_/src/dune_rules/file_binding.ml @@ -11,6 +11,13 @@ let equal f g { src; dst } t = f src t.src && Option.equal g dst t.dst module Expanded = struct type nonrec t = (Loc.t * Path.Build.t, Loc.t * string) t + let to_dyn { src; dst } = + let open Dyn in + record + [ ("src", pair Loc.to_dyn Path.Build.to_dyn src) + ; ("dst", option (pair Loc.to_dyn string) dst) + ] + let src t = snd t.src let dst t = Option.map ~f:snd t.dst @@ -31,6 +38,13 @@ end module Unexpanded = struct type nonrec t = (String_with_vars.t, String_with_vars.t) t + let to_dyn { src; dst } = + let open Dyn in + record + [ ("src", String_with_vars.to_dyn src) + ; ("dst", option String_with_vars.to_dyn dst) + ] + let equal = equal String_with_vars.equal_no_loc String_with_vars.equal_no_loc let make ~src:(locs, src) ~dst:(locd, dst) = @@ -63,44 +77,41 @@ module Unexpanded = struct in { src; dst } - module L = struct - let decode_file = - let open Dune_lang.Decoder in - let decode = - let+ is_atom = - peek_exn >>| function - | Atom _ -> true - | _ -> false - and+ s = String_with_vars.decode - and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in - if (not is_atom) && version < (1, 6) then - let what = - (if String_with_vars.has_pforms s then "variables" - else "quoted strings") - |> sprintf "Using %s here" - in - Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax - (1, 6) ~what - else s - in - peek_exn >>= function - | Atom _ | Quoted_string _ | Template _ -> - decode >>| fun src -> { src; dst = None } - | List (_, [ _; Atom (_, A "as"); _ ]) -> - enter - (let* src = decode in - keyword "as" - >>> let* dst = decode in - return { src; dst = Some dst }) - | sexp -> - User_error.raise ~loc:(Dune_lang.Ast.loc sexp) - [ Pp.text - "invalid format, or ( as ) expected" - ] - + let decode = + let open Dune_lang.Decoder in let decode = - let open Dune_lang.Decoder in - repeat decode_file + let+ is_atom = + peek_exn >>| function + | Atom _ -> true + | _ -> false + and+ s = String_with_vars.decode + and+ version = Dune_lang.Syntax.get_exn Stanza.syntax in + if (not is_atom) && version < (1, 6) then + let what = + (if String_with_vars.has_pforms s then "variables" + else "quoted strings") + |> sprintf "Using %s here" + in + Dune_lang.Syntax.Error.since (String_with_vars.loc s) Stanza.syntax + (1, 6) ~what + else s + in + peek_exn >>= function + | Atom _ | Quoted_string _ | Template _ -> + decode >>| fun src -> { src; dst = None } + | List (_, [ _; Atom (_, A "as"); _ ]) -> + enter + (let* src = decode in + keyword "as" + >>> let* dst = decode in + return { src; dst = Some dst }) + | sexp -> + User_error.raise ~loc:(Dune_lang.Ast.loc sexp) + [ Pp.text "Invalid format, or ( as ) expected" + ] + + module L = struct + let decode = Dune_lang.Decoder.repeat decode let strings_with_vars { src; dst } = src :: Option.to_list dst diff --git a/duniverse/dune_/src/dune_rules/file_binding.mli b/duniverse/dune_/src/dune_rules/file_binding.mli index 02996d9e4..baf288ae2 100644 --- a/duniverse/dune_/src/dune_rules/file_binding.mli +++ b/duniverse/dune_/src/dune_rules/file_binding.mli @@ -3,6 +3,8 @@ open Import module Expanded : sig type t + val to_dyn : t -> Dyn.t + val src : t -> Path.Build.t val dst : t -> string option @@ -15,10 +17,14 @@ end module Unexpanded : sig type t + val to_dyn : t -> Dyn.t + val equal : t -> t -> bool val make : src:Loc.t * string -> dst:Loc.t * string -> t + val decode : t Dune_lang.Decoder.t + val expand : t -> dir:Path.Build.t diff --git a/duniverse/dune_/src/dune_rules/findlib/findlib.ml b/duniverse/dune_/src/dune_rules/findlib/findlib.ml index 72f41f4aa..53abf9266 100644 --- a/duniverse/dune_/src/dune_rules/findlib/findlib.ml +++ b/duniverse/dune_/src/dune_rules/findlib/findlib.ml @@ -115,7 +115,9 @@ module Config = struct let load path ~toolchain ~context = let path = Path.extend_basename path ~suffix:".d" in let conf_file = Path.relative path (toolchain ^ ".conf") in - let* conf_file_exists = Fs_memo.file_exists conf_file in + let* conf_file_exists = + Fs_memo.file_exists (Path.as_outside_build_dir_exn conf_file) + in if not conf_file_exists then User_error.raise [ Pp.textf "ocamlfind toolchain %s isn't defined in %s (context: %s)" @@ -123,7 +125,9 @@ module Config = struct (Path.to_string_maybe_quoted path) context ]; - let+ meta = Meta.load ~name:None conf_file in + let+ meta = + Meta.load ~name:None (Path.as_outside_build_dir_exn conf_file) + in { vars = String.Map.map meta.vars ~f:Rules.of_meta_rules ; preds = Ps.of_list [ P.make toolchain ] } @@ -276,7 +280,8 @@ end = struct match exists_if with | _ :: _ -> Memo.List.for_all exists_if ~f:(fun fn -> - Fs_memo.file_exists (Path.relative t.dir fn)) + Fs_memo.file_exists + (Path.as_outside_build_dir_exn (Path.relative t.dir fn))) | [] -> ( if not is_builtin then Memo.return true else @@ -291,7 +296,8 @@ end = struct match archives t with | { byte = []; native = [] } -> Memo.return true | { byte; native } -> - Memo.List.exists (byte @ native) ~f:Fs_memo.file_exists) + Memo.List.exists (byte @ native) ~f:(fun p -> + Path.as_outside_build_dir_exn p |> Fs_memo.file_exists)) let to_dune_library t ~(lib_config : Lib_config.t) = let loc = Loc.in_file t.meta_file in @@ -299,7 +305,9 @@ end = struct let dot_dune_file = Path.relative t.dir (sprintf "%s.dune" (Lib_name.to_string t.name)) in - let* dot_dune_exists = Fs_memo.file_exists dot_dune_file in + let* dot_dune_exists = + Fs_memo.file_exists (Path.as_outside_build_dir_exn dot_dune_file) + in if dot_dune_exists then User_warning.emit ~loc:(Loc.in_file dot_dune_file) @@ -310,12 +318,15 @@ end = struct ]; let archives = archives t in let obj_dir = Obj_dir.make_external_no_private ~dir:t.dir in - let modes : Mode.Dict.Set.t = + let modes : Lib_mode.Map.Set.t = (* libraries without archives are compatible with all modes. mainly a hack for compiler-libs which doesn't have any archives *) let discovered = Mode.Dict.map ~f:List.is_non_empty archives in - if Mode.Dict.Set.is_empty discovered then Mode.Dict.Set.all - else discovered + let modes = + if Mode.Dict.Set.is_empty discovered then Mode.Dict.Set.all + else discovered + in + { Lib_mode.Map.ocaml = modes; melange = false } in let+ (info : Path.t Lib_info.t) = let kind = kind t in @@ -354,7 +365,9 @@ end = struct let virtual_ = None in let default_implementation = None in let wrapped = None in - let+ dir_contents = Fs_memo.dir_contents t.dir in + let+ dir_contents = + Fs_memo.dir_contents (Path.as_outside_build_dir_exn t.dir) + in let foreign_archives, native_archives = (* Here we scan [t.dir] and consider all files named [lib*.ext_lib] to be foreign archives, and all other files with the extension @@ -387,6 +400,9 @@ end = struct else Right file else Skip) in + let foreign_archives = + Mode.Map.Multi.create_for_all_modes foreign_archives + in let entry_modules = Lib_info.Source.External (match Vars.get_words t.vars "main_modules" Ps.empty with @@ -496,7 +512,9 @@ end = struct } let load_and_convert db ~dir ~meta_file ~name = - let* meta = Meta.load meta_file ~name:(Some name) in + let* meta = + Meta.load (Path.as_outside_build_dir_exn meta_file) ~name:(Some name) + in dune_package_of_meta db ~dir ~meta_file ~meta let load_builtin db meta = @@ -531,18 +549,24 @@ end = struct let meta_file = Path.relative dir (meta_fn ^ "." ^ Package.Name.to_string name) in - let* file_exists = Fs_memo.file_exists meta_file in + let* file_exists = + Fs_memo.file_exists (Path.as_outside_build_dir_exn meta_file) + in if file_exists then let+ p = load_and_convert db ~dir ~meta_file ~name in Ok p else let dir = Path.relative dir (Package.Name.to_string name) in - let* dir_exists = Fs_memo.dir_exists dir in + let* dir_exists = + Fs_memo.dir_exists (Path.as_outside_build_dir_exn dir) + in if not dir_exists then loop dirs else let dune = Path.relative dir Dune_package.fn in let* exists = - let* exists = Fs_memo.file_exists dune in + let* exists = + Fs_memo.file_exists (Path.as_outside_build_dir_exn dune) + in if exists then Dune_package.Or_meta.load dune else Memo.return (Ok Dune_package.Or_meta.Use_meta) in @@ -552,7 +576,9 @@ end = struct | Ok (Dune_package.Or_meta.Dune_package p) -> Memo.return (Ok p) | Ok Use_meta -> let meta_file = Path.relative dir meta_fn in - let* meta_file_exists = Fs_memo.file_exists meta_file in + let* meta_file_exists = + Fs_memo.file_exists (Path.as_outside_build_dir_exn meta_file) + in if meta_file_exists then let+ p = load_and_convert db ~dir ~meta_file ~name in Ok p @@ -601,7 +627,7 @@ let find t name = let root_packages (db : DB.t) = let+ pkgs = Memo.List.concat_map db.paths ~f:(fun dir -> - Fs_memo.dir_contents dir >>= function + Fs_memo.dir_contents (Path.as_outside_build_dir_exn dir) >>= function | Error (ENOENT, _, _) -> Memo.return [] | Error (unix_error, _, _) -> User_error.raise @@ -613,7 +639,9 @@ let root_packages (db : DB.t) = let dir_contents = Fs_cache.Dir_contents.to_list dir_contents in Memo.List.filter_map dir_contents ~f:(fun (name, _) -> let+ exists = - Fs_memo.file_exists (Path.relative dir (name ^ "/" ^ meta_fn)) + Fs_memo.file_exists + (Path.as_outside_build_dir_exn + (Path.relative dir (name ^ "/" ^ meta_fn))) in if exists then Some (Package.Name.of_string name) else None)) >>| Package.Name.Set.of_list diff --git a/duniverse/dune_/src/dune_rules/findlib/meta.ml b/duniverse/dune_/src/dune_rules/findlib/meta.ml index d8eea662d..f4637a759 100644 --- a/duniverse/dune_/src/dune_rules/findlib/meta.ml +++ b/duniverse/dune_/src/dune_rules/findlib/meta.ml @@ -233,7 +233,9 @@ let pre_ocaml_5_builtins ~stdlib_dir ~version:ocaml_version = Memo.return (simple ()) else let+ cma = - Fs_memo.file_exists (Path.relative stdlib_dir "bigarray.cma") + Fs_memo.file_exists + (Path.as_outside_build_dir_exn + (Path.relative stdlib_dir "bigarray.cma")) in if cma then simple () else dummy "bigarray" in @@ -287,14 +289,19 @@ let pre_ocaml_5_builtins ~stdlib_dir ~version:ocaml_version = in let* base = let+ cma = - Fs_memo.file_exists (Path.relative stdlib_dir "graphics.cma") + Fs_memo.file_exists + (Path.as_outside_build_dir_exn + (Path.relative stdlib_dir "graphics.cma")) in if cma then graphics :: base else base in (* We do not rely on an "exists_if" ocamlfind variable, because it would produce an error message mentioning a "hidden" package (which could be confusing). *) - let+ nums_cma = Fs_memo.file_exists (Path.relative stdlib_dir "nums.cma") in + let+ nums_cma = + Fs_memo.file_exists + (Path.as_outside_build_dir_exn (Path.relative stdlib_dir "nums.cma")) + in if nums_cma then num :: base else base in List.filter_map libs ~f:(fun t -> diff --git a/duniverse/dune_/src/dune_rules/findlib/meta.mli b/duniverse/dune_/src/dune_rules/findlib/meta.mli index cafc840e4..57222259d 100644 --- a/duniverse/dune_/src/dune_rules/findlib/meta.mli +++ b/duniverse/dune_/src/dune_rules/findlib/meta.mli @@ -63,7 +63,8 @@ val complexify : Simplified.t -> t val of_string : string -> name:Package.Name.t option -> Simplified.t -val load : Path.t -> name:Package.Name.t option -> Simplified.t Memo.t +val load : + Path.Outside_build_dir.t -> name:Package.Name.t option -> Simplified.t Memo.t (** Builtin META files for libraries distributed with the compiler. For when ocamlfind is not installed. *) diff --git a/duniverse/dune_/src/dune_rules/foreign.ml b/duniverse/dune_/src/dune_rules/foreign.ml index 6619e9f99..6ace03eee 100644 --- a/duniverse/dune_/src/dune_rules/foreign.ml +++ b/duniverse/dune_/src/dune_rules/foreign.ml @@ -23,13 +23,20 @@ let possible_sources ~language obj ~dune_version = (Foreign_language.equal lang language && dune_version >= version) (obj ^ "." ^ ext)) +let add_mode_suffix mode s = + match mode with + | Mode.Select.All -> s + | Only mode -> String.concat ~sep:"_" [ s; Mode.to_string mode ] + module Archive = struct module Name = struct include String let to_string t = t - let path ~dir t = Path.Build.relative dir t + let path ~dir ~mode archive_name = + let archive_name = add_mode_suffix mode archive_name in + Path.Build.relative dir archive_name let decode = Dune_lang.Decoder.plain_string (fun ~loc s -> @@ -46,11 +53,13 @@ module Archive = struct let lib_file_prefix = "lib" - let lib_file archive_name ~dir ~ext_lib = + let lib_file archive_name ~dir ~ext_lib ~mode = + let archive_name = add_mode_suffix mode archive_name in Path.Build.relative dir (sprintf "%s%s%s" lib_file_prefix archive_name ext_lib) - let dll_file archive_name ~dir ~ext_dll = + let dll_file archive_name ~dir ~ext_dll ~mode = + let archive_name = add_mode_suffix mode archive_name in Path.Build.relative dir (sprintf "dll%s%s" archive_name ext_dll) end @@ -69,7 +78,7 @@ module Archive = struct let dir_path ~dir t = Path.Build.relative dir t.dir - let name t = t.name + let name ~mode t = add_mode_suffix mode t.name let stubs archive_name = { dir = "."; name = Name.stubs archive_name } @@ -78,17 +87,17 @@ module Archive = struct let+ s = string in { dir = Filename.dirname s; name = Filename.basename s } - let lib_file ~archive ~dir ~ext_lib = + let lib_file ~archive ~dir ~ext_lib ~mode = let dir = dir_path ~dir archive in - Name.lib_file archive.name ~dir ~ext_lib + Name.lib_file archive.name ~dir ~ext_lib ~mode - let dll_file ~archive ~dir ~ext_dll = + let dll_file ~archive ~dir ~ext_dll ~mode = let dir = dir_path ~dir archive in - Name.dll_file archive.name ~dir ~ext_dll + Name.dll_file archive.name ~dir ~ext_dll ~mode end module Stubs = struct - module Include_dir = struct + module Include_dir_without_include = struct type t = | Dir of String_with_vars.t | Lib of Loc.t * Lib_name.t @@ -100,31 +109,61 @@ module Stubs = struct Dir s in let parse_lib = - let+ loc, lib_name = sum [ ("lib", located Lib_name.decode) ] in - Lib (loc, lib_name) + sum + [ ( "lib" + , let+ loc, lib_name = located Lib_name.decode in + Lib (loc, lib_name) ) + ] in - parse_lib <|> parse_dir + parse_dir <|> parse_lib + end + + module Include_dir = struct + include + Recursive_include.Make + (Include_dir_without_include) + (struct + let include_keyword = "include" + + let include_allowed_in_versions = `Since (3, 5) + + let non_sexp_behaviour = `Parse_as_base_term + end) + + module Without_include = Include_dir_without_include end type t = { loc : Loc.t ; language : Foreign_language.t ; names : Ordered_set_lang.t + ; mode : Mode.Select.t ; flags : Ordered_set_lang.Unexpanded.t ; include_dirs : Include_dir.t list ; extra_deps : Dep_conf.t list } - let make ~loc ~language ~names ~flags = - { loc; language; names; flags; include_dirs = []; extra_deps = [] } + let make ~loc ~language ~names ~mode ~flags = + { loc; language; names; mode; flags; include_dirs = []; extra_deps = [] } + + let syntax = + let name = "mode_specific_stubs" in + let desc = "syntax extension for mode-specific foreign stubs" in + Dune_lang.Syntax.create ~name ~desc [ ((0, 1), `Since (3, 5)) ] - let decode_stubs = + let () = + Dune_project.Extension.register_simple syntax (Dune_lang.Decoder.return []) + + let decode_stubs ~for_library = let open Dune_lang.Decoder in - let+ loc = loc - and+ loc_archive_name, archive_name = + let* loc = loc in + let+ loc_archive_name, archive_name = located (field_o "archive_name" string) and+ language = field "language" decode_lang and+ names = Ordered_set_lang.field "names" + and+ loc_mode, mode = + located + (field_o "mode" (Dune_lang.Syntax.since syntax (0, 1) >>> Mode.decode)) and+ flags = Ordered_set_lang.Unexpanded.field "flags" and+ include_dirs = field ~default:[] "include_dirs" (repeat Include_dir.decode) @@ -141,9 +180,55 @@ module Stubs = struct (foreign_library ...) stanza." ] in - { loc; language; names; flags; include_dirs; extra_deps } + let () = + match mode with + | Some _ when for_library -> + User_error.raise ~loc:loc_mode + [ Pp.textf "The field \"mode\" is not available for foreign libraries" + ] + | _ -> () + in + let mode = Mode.Select.of_option mode in + { loc; language; names; mode; flags; include_dirs; extra_deps } + + let decode = Dune_lang.Decoder.fields @@ decode_stubs ~for_library:false - let decode = Dune_lang.Decoder.fields decode_stubs + let is_mode_dependent t = Mode.Select.is_not_all t.mode +end + +module Objects = struct + module Object_name = struct + let decode = Dune_lang.Decoder.string + + let filename t ~ext_obj = t ^ ext_obj + + let build_path t ~error_loc ~ext_obj ~dir = + Path.Build.relative ~error_loc dir (filename t ~ext_obj) + end + + (* Associate each object name with its location in the config *) + type t = (Loc.t * string) list + + let empty = [] + + let is_empty = List.is_empty + + let decode = + let open Dune_lang.Decoder in + let+ t = repeat (located Object_name.decode) in + (* Check for duplicate names *) + match String.Map.of_list (List.map t ~f:Tuple.T2.swap) with + | Ok _ -> t + | Error (name, loc, loc') -> + User_error.raise ~loc + [ Pp.textf "Duplicate object name: %s. Already appears at:" name + ; Pp.textf "- %s" (Loc.to_file_colon_line loc') + ] + + let build_paths t ~ext_obj ~dir = + (* Foreign objects are not mode-dependent *) + List.map t ~f:(fun (loc, name) -> + Object_name.build_path name ~error_loc:loc ~ext_obj ~dir |> Path.build) end module Library = struct @@ -158,28 +243,40 @@ module Library = struct fields (let+ archive_name_loc, archive_name = located (field "archive_name" Archive.Name.decode) - and+ stubs = Stubs.decode_stubs in + and+ stubs = Stubs.decode_stubs ~for_library:true in { archive_name; archive_name_loc; stubs }) end module Source = struct + type kind = + | Stubs of Stubs.t + | Ctypes of Ctypes_stanza.t + (* we store the entire [stubs] record even though [t] only describes an individual source file *) type t = - { stubs : Stubs.t + { kind : kind ; path : Path.Build.t } - let language t = t.stubs.language - - let flags t = t.stubs.flags + let language t = + match t.kind with + | Stubs stubs -> stubs.language + | Ctypes _ -> C let path t = t.path - let object_name t = + let mode t = + match t.kind with + | Stubs s -> s.mode + | Ctypes _ -> All + + let user_object_name t = t.path |> Path.Build.split_extension |> fst |> Path.Build.basename - let make ~stubs ~path = { stubs; path } + let object_name t = user_object_name t |> add_mode_suffix (mode t) + + let make kind ~path = { kind; path } end module Sources = struct @@ -191,7 +288,8 @@ module Sources = struct let has_cxx_sources (t : t) = String.Map.exists t ~f:(fun (_loc, source) -> - Foreign_language.(equal Cxx source.stubs.language)) + let language = Source.language source in + Foreign_language.(equal Cxx language)) module Unresolved = struct type t = (Foreign_language.t * Path.Build.t) String.Map.Multi.t diff --git a/duniverse/dune_/src/dune_rules/foreign.mli b/duniverse/dune_/src/dune_rules/foreign.mli index 61d0557a4..c3e9c14a8 100644 --- a/duniverse/dune_/src/dune_rules/foreign.mli +++ b/duniverse/dune_/src/dune_rules/foreign.mli @@ -41,7 +41,7 @@ module Archive : sig val to_string : t -> string - val path : dir:Path.Build.t -> t -> Path.Build.t + val path : dir:Path.Build.t -> mode:Mode.Select.t -> t -> Path.Build.t val decode : t Dune_lang.Decoder.t @@ -49,24 +49,44 @@ module Archive : sig val lib_file_prefix : string - val lib_file : t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t + val lib_file : + t + -> dir:Path.Build.t + -> ext_lib:string + -> mode:Mode.Select.t + -> Path.Build.t - val dll_file : t -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t + val dll_file : + t + -> dir:Path.Build.t + -> ext_dll:string + -> mode:Mode.Select.t + -> Path.Build.t end type t val dir_path : dir:Path.Build.t -> t -> Path.Build.t - val name : t -> Name.t + val name : mode:Mode.Select.t -> t -> Name.t val stubs : string -> t val decode : t Dune_lang.Decoder.t - val lib_file : archive:t -> dir:Path.Build.t -> ext_lib:string -> Path.Build.t - - val dll_file : archive:t -> dir:Path.Build.t -> ext_dll:string -> Path.Build.t + val lib_file : + archive:t + -> dir:Path.Build.t + -> ext_lib:string + -> mode:Mode.Select.t + -> Path.Build.t + + val dll_file : + archive:t + -> dir:Path.Build.t + -> ext_dll:string + -> mode:Mode.Select.t + -> Path.Build.t end (** A type of foreign library "stubs", which includes all fields of the @@ -77,17 +97,28 @@ module Stubs : sig (* Foreign sources can depend on a directly specified directory [Dir] or on a source directory of a library [Lib]. *) module Include_dir : sig - type t = - | Dir of String_with_vars.t - | Lib of Loc.t * Lib_name.t + module Without_include : sig + type t = + | Dir of String_with_vars.t + | Lib of Loc.t * Lib_name.t + end + + type t val decode : t Dune_lang.Decoder.t + + val expand_include : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> Without_include.t list Memo.t end type t = { loc : Loc.t ; language : Foreign_language.t ; names : Ordered_set_lang.t + ; mode : Mode.Select.t ; flags : Ordered_set_lang.Unexpanded.t ; include_dirs : Include_dir.t list ; extra_deps : Dep_conf.t list @@ -98,10 +129,13 @@ module Stubs : sig loc:Loc.t -> language:Foreign_language.t -> names:Ordered_set_lang.t + -> mode:Mode.Select.t -> flags:Ordered_set_lang.Unexpanded.t -> t val decode : t Dune_lang.Decoder.t + + val is_mode_dependent : t -> bool end (** Foreign libraries. @@ -140,22 +174,31 @@ end (** A foreign source file that has a [path] and all information of the corresponding [Foreign.Stubs.t] declaration. *) module Source : sig - type t = - { stubs : Stubs.t + type kind = + | Stubs of Stubs.t + | Ctypes of Ctypes_stanza.t + + type t = private + { kind : kind ; path : Path.Build.t } val language : t -> Foreign_language.t - val flags : t -> Ordered_set_lang.Unexpanded.t + val mode : t -> Mode.Select.t val path : t -> Path.Build.t - (* The name of the corresponding object file; for example, [name] for a source - file [some/path/name.cpp]. *) + (** The name of the corresponding object file; for example, [name] for a + source file [some/path/name.cpp] of [name_mode] if the stub is + mode-specific. *) val object_name : t -> string - val make : stubs:Stubs.t -> path:Path.Build.t -> t + (** The name of the corresponding object file without the mode suffix. This is + useful for messages where the internally suffixed name would be confusing. *) + val user_object_name : t -> string + + val make : kind -> path:Path.Build.t -> t end (** A map from object names to the corresponding sources. *) @@ -182,3 +225,16 @@ module Sources : sig -> t end end + +(** For the [(foreign_objects ...)] field.*) +module Objects : sig + type t + + val empty : t + + val is_empty : t -> bool + + val decode : t Dune_lang.Decoder.t + + val build_paths : t -> ext_obj:string -> dir:Path.Build.t -> Path.t list +end diff --git a/duniverse/dune_/src/dune_rules/foreign_rules.ml b/duniverse/dune_/src/dune_rules/foreign_rules.ml index b8a7b8e53..65aaf57f2 100644 --- a/duniverse/dune_/src/dune_rules/foreign_rules.ml +++ b/duniverse/dune_/src/dune_rules/foreign_rules.ml @@ -11,148 +11,181 @@ module Source_tree_map_reduce = (* Compute command line flags for the [include_dirs] field of [Foreign.Stubs.t] and track all files in specified directories as [Hidden_deps] dependencies. *) -let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) = +let include_dir_flags ~expander ~dir ~include_dirs = let scope = Expander.scope expander in let lib_dir loc lib_name = let open Resolve.Memo.O in let+ lib = Lib.DB.resolve (Scope.libs scope) (loc, lib_name) in Lib_info.src_dir (Lib.info lib) in - Command.Args.S - (List.map stubs.include_dirs ~f:(fun include_dir -> - Resolve.Memo.args - (let open Resolve.Memo.O in - let+ loc, include_dir = - match (include_dir : Foreign.Stubs.Include_dir.t) with - | Dir dir -> - Resolve.Memo.return - (String_with_vars.loc dir, Expander.expand_path expander dir) - | Lib (loc, lib_name) -> - let+ lib_dir = lib_dir loc lib_name in - (loc, Action_builder.return lib_dir) - in - Command.Args.Dyn - (let open Action_builder.O in - let* include_dir = include_dir in - let+ dep_args = - match Path.extract_build_context_dir include_dir with - | None -> - (* This branch corresponds to an external directory. The - current implementation tracks its contents - NON-recursively. *) - (* TODO: Track the contents recursively. One way to implement - this is to change [Build_system.Loaded.Non_build] so that it - contains not only files but also directories and traverse - them recursively in [Build_system.Exported.Pred]. *) - let+ () = - let error msg = - User_error.raise ~loc - [ Pp.textf "Unable to read the include directory." - ; Pp.textf "Reason: %s." msg - ] - in - Action_builder.of_memo @@ Fs_memo.is_directory include_dir - >>| function - | Error msg -> error (Unix_error.Detailed.to_string_hum msg) - | Ok false -> - error - (Printf.sprintf "%S is not a directory" - (Path.to_string include_dir)) - | Ok true -> () - in - let deps = - Dep.Set.singleton - (Dep.file_selector - (File_selector.create ~dir:include_dir - Predicate_with_id.true_)) - in - Command.Args.Hidden_deps deps - | Some (build_dir, source_dir) -> - let open Action_builder.O in - Action_builder.return - @@ Command.Args.Dyn - ((* This branch corresponds to a source directory. We - track its contents recursively. *) - Action_builder.of_memo (Source_tree.find_dir source_dir) - >>= function - | None -> - User_error.raise ~loc - [ Pp.textf "Include directory %S does not exist." - (Path.reach ~from:(Path.build dir) include_dir) - ] - | Some dir -> - let+ l = - Source_tree_map_reduce.map_reduce dir - ~traverse:Sub_dirs.Status.Set.all ~f:(fun t -> - let dir = - Path.append_source build_dir - (Source_tree.Dir.path t) - in - let deps = - Dep.Set.singleton - (Dep.file_selector - (File_selector.create ~dir - Predicate_with_id.true_)) - in - Action_builder.return - (Appendable_list.singleton - (Command.Args.Hidden_deps deps))) - in - Command.Args.S (Appendable_list.to_list l)) - in - Command.Args.S [ A "-I"; Path include_dir; dep_args ])))) + let args_of_include_dir include_dir = + Resolve.Memo.args + (let open Resolve.Memo.O in + let+ loc, include_dir = + match (include_dir : Foreign.Stubs.Include_dir.Without_include.t) with + | Dir dir -> + Resolve.Memo.return + (String_with_vars.loc dir, Expander.expand_path expander dir) + | Lib (loc, lib_name) -> + let+ lib_dir = lib_dir loc lib_name in + (loc, Action_builder.return lib_dir) + in + Command.Args.Dyn + (let open Action_builder.O in + let* include_dir = include_dir in + let+ dep_args = + match Path.extract_build_context_dir include_dir with + | None -> + (* This branch corresponds to an external directory. The + current implementation tracks its contents + NON-recursively. *) + (* TODO: Track the contents recursively. One way to implement + this is to change [Build_system.Loaded.Non_build] so that it + contains not only files but also directories and traverse + them recursively in [Build_system.Exported.Pred]. *) + let+ () = + let error msg = + User_error.raise ~loc + [ Pp.textf "Unable to read the include directory." + ; Pp.textf "Reason: %s." msg + ] + in + Action_builder.of_memo + @@ Fs_memo.is_directory + (Path.as_outside_build_dir_exn include_dir) + >>| function + | Error msg -> error (Unix_error.Detailed.to_string_hum msg) + | Ok false -> + error + (Printf.sprintf "%S is not a directory" + (Path.to_string include_dir)) + | Ok true -> () + in + let deps = + Dep.Set.singleton + (Dep.file_selector + (File_selector.create ~dir:include_dir + Predicate_with_id.true_)) + in + Command.Args.Hidden_deps deps + | Some (build_dir, source_dir) -> + let open Action_builder.O in + Action_builder.return + @@ Command.Args.Dyn + ((* This branch corresponds to a source directory. We + track its contents recursively. *) + Action_builder.of_memo (Source_tree.find_dir source_dir) + >>= function + | None -> + User_error.raise ~loc + [ Pp.textf "Include directory %S does not exist." + (Path.reach ~from:(Path.build dir) include_dir) + ] + | Some dir -> + let+ l = + Source_tree_map_reduce.map_reduce dir + ~traverse:Sub_dirs.Status.Set.all ~f:(fun t -> + let dir = + Path.append_source build_dir + (Source_tree.Dir.path t) + in + let deps = + Dep.Set.singleton + (Dep.file_selector + (File_selector.create ~dir + Predicate_with_id.true_)) + in + Action_builder.return + (Appendable_list.singleton + (Command.Args.Hidden_deps deps))) + in + Command.Args.S (Appendable_list.to_list l)) + in + Command.Args.S [ A "-I"; Path include_dir; dep_args ])) + in + Command.Args.Dyn + (let open Action_builder.O in + let+ include_dirs_expanded = + let expand_str = Expander.No_deps.expand_str expander in + Memo.List.concat_map include_dirs + ~f:(Foreign.Stubs.Include_dir.expand_include ~expand_str ~dir) + |> Action_builder.of_memo + in + Command.Args.S (List.map include_dirs_expanded ~f:args_of_include_dir)) -let build_c ~kind ~sctx ~dir ~expander ~include_flags (loc, src, dst) = +let build_c ~(kind : Foreign_language.t) ~sctx ~dir ~expander ~include_flags + (loc, (src : Foreign.Source.t), dst) = let ctx = Super_context.context sctx in let* project = Scope.DB.find_by_dir dir >>| Scope.project in let use_standard_flags = Dune_project.use_standard_c_and_cxx_flags project in let base_flags = let cfg = ctx.ocaml_config in match kind with - | Foreign_language.C -> ( + | Cxx -> Fdo.cxx_flags ctx + | C -> ( match use_standard_flags with + | Some true -> Fdo.c_flags ctx | None | Some false -> (* In dune < 2.8 flags from ocamlc_config are always added *) List.concat [ Ocaml_config.ocamlc_cflags cfg ; Ocaml_config.ocamlc_cppflags cfg ; Fdo.c_flags ctx - ] - | Some true -> Fdo.c_flags ctx) - | Foreign_language.Cxx -> Fdo.cxx_flags ctx + ]) in let open Memo.O in let* with_user_and_std_flags = - let flags = Foreign.Source.flags src in - (* DUNE3 will have [use_standard_c_and_cxx_flags] enabled by default. To - guide users toward this change we emit a warning when dune_lang is >= - 1.8, [use_standard_c_and_cxx_flags] is not specified in the - [dune-project] file (thus defaulting to [true]), the [:standard] set of - flags has been overridden and we are not in a vendored project *) - let has_standard = Ordered_set_lang.Unexpanded.has_standard flags in - let+ is_vendored = - match Path.Build.drop_build_context dir with - | Some src_dir -> Dune_engine.Source_tree.is_vendored src_dir - | None -> Memo.return false - in - if - Dune_project.dune_version project >= (2, 8) - && Option.is_none use_standard_flags - && (not is_vendored) && not has_standard - then - User_warning.emit ~loc - [ Pp.text - "The flag set for these foreign sources overrides the `:standard` \ - set of flags. However the flags in this standard set are still \ - added to the compiler arguments by Dune. This might cause \ - unexpected issues. You can disable this warning by defining the \ - option `(use_standard_c_and_cxx_flags )` in your \ - `dune-project` file. Setting this option to `true` will \ - effectively prevent Dune from silently adding c-flags to the \ - compiler arguments which is the new recommended behaviour." - ]; - Super_context.foreign_flags sctx ~dir ~expander ~flags ~language:kind - |> Action_builder.map ~f:(List.append base_flags) + match src.kind with + | Ctypes stanza -> + Memo.return + @@ Action_builder.map ~f:(List.append base_flags) + (match stanza.build_flags_resolver with + | Vendored { c_flags; c_library_flags = _ } -> + Super_context.foreign_flags sctx ~dir ~expander ~flags:c_flags + ~language:C + | Pkg_config -> + let dir = Path.Build.parent_exn dst in + let lib = + External_lib_name.to_string stanza.external_library_name + in + let open Action_builder.O in + let* default_flags = + Super_context.default_foreign_flags sctx ~dir ~language:C + in + let+ pkg_config_flags = + Pkg_config.Query.read ~dir (Cflags lib) sctx + in + default_flags @ pkg_config_flags) + | Stubs { Foreign.Stubs.flags; _ } -> + (* DUNE3 will have [use_standard_c_and_cxx_flags] enabled by default. To + guide users toward this change we emit a warning when dune_lang is >= + 1.8, [use_standard_c_and_cxx_flags] is not specified in the + [dune-project] file (thus defaulting to [true]), the [:standard] set of + flags has been overridden and we are not in a vendored project *) + let has_standard = Ordered_set_lang.Unexpanded.has_standard flags in + let+ is_vendored = + match Path.Build.drop_build_context dir with + | Some src_dir -> Dune_engine.Source_tree.is_vendored src_dir + | None -> Memo.return false + in + if + Dune_project.dune_version project >= (2, 8) + && Option.is_none use_standard_flags + && (not is_vendored) && not has_standard + then + User_warning.emit ~loc + [ Pp.text + "The flag set for these foreign sources overrides the \ + `:standard` set of flags. However the flags in this standard \ + set are still added to the compiler arguments by Dune. This \ + might cause unexpected issues. You can disable this warning by \ + defining the option `(use_standard_c_and_cxx_flags )` in \ + your `dune-project` file. Setting this option to `true` will \ + effectively prevent Dune from silently adding c-flags to the \ + compiler arguments which is the new recommended behaviour." + ]; + Super_context.foreign_flags sctx ~dir ~expander ~flags ~language:kind + |> Action_builder.map ~f:(List.append base_flags) and* c_compiler = Super_context.resolve_program ~loc:None ~dir sctx (Ocaml_config.c_compiler ctx.ocaml_config) @@ -185,6 +218,7 @@ let build_c ~kind ~sctx ~dir ~expander ~include_flags (loc, src, dst) = looks like it's a list of libraries we depend on. *) let build_o_files ~sctx ~foreign_sources ~(dir : Path.Build.t) ~expander ~requires ~dir_contents = + let open Memo.O in let ctx = Super_context.context sctx in let all_dirs = Dir_contents.dirs dir_contents in let h_files = @@ -202,17 +236,24 @@ let build_o_files ~sctx ~foreign_sources ~(dir : Path.Build.t) ~expander let+ libs = requires in Command.Args.S [ Lib_flags.L.c_include_flags libs - ; Hidden_deps - (Lib_file_deps.deps libs ~groups:[ Lib_file_deps.Group.Header ]) + ; Hidden_deps (Lib_file_deps.deps libs ~groups:[ Header ]) ]) ] in - String.Map.to_list_map foreign_sources ~f:(fun obj (loc, src) -> + String.Map.to_list_map foreign_sources + ~f:(fun obj (loc, (src : Foreign.Source.t)) -> let dst = Path.Build.relative dir (obj ^ ctx.lib_config.ext_obj) in - let stubs = src.Foreign.Source.stubs in - let extra_flags = include_dir_flags ~expander ~dir src.stubs in + let extra_flags = + include_dir_flags ~expander ~dir + ~include_dirs: + (match src.kind with + | Stubs stubs -> stubs.include_dirs + | Ctypes _ -> []) + in let extra_deps, sandbox = - Dep_conf_eval.unnamed stubs.extra_deps ~expander + match src.kind with + | Stubs stubs -> Dep_conf_eval.unnamed stubs.extra_deps ~expander + | Ctypes _ -> (Action_builder.return (), Sandbox_config.default) in (* We don't sandbox the C compiler, see comment in [build_file] about this. *) @@ -223,9 +264,15 @@ let build_o_files ~sctx ~foreign_sources ~(dir : Path.Build.t) ~expander let include_flags = Command.Args.S [ includes; extra_flags; Dyn extra_deps ] in - let build_file = - match Foreign.Source.language src with - | C -> build_c ~kind:Foreign_language.C - | Cxx -> build_c ~kind:Foreign_language.Cxx + let+ build_file = + build_c + ~kind: + (match Foreign.Source.language src with + | C -> C + | Cxx -> Cxx) + ~sctx ~dir ~expander ~include_flags (loc, src, dst) in - build_file ~sctx ~dir ~expander ~include_flags (loc, src, dst)) + (Foreign.Source.mode src, Path.build build_file)) + |> Memo.all_concurrently + >>| List.fold_left ~init:Mode.Map.empty ~f:(fun tbl (for_mode, file) -> + Mode.Map.Multi.cons tbl for_mode file) diff --git a/duniverse/dune_/src/dune_rules/foreign_rules.mli b/duniverse/dune_/src/dune_rules/foreign_rules.mli index a4fc2bb96..7ddb34eed 100644 --- a/duniverse/dune_/src/dune_rules/foreign_rules.mli +++ b/duniverse/dune_/src/dune_rules/foreign_rules.mli @@ -7,4 +7,4 @@ val build_o_files : -> expander:Expander.t -> requires:Lib.t list Resolve.t -> dir_contents:Dir_contents.t - -> Path.Build.t Memo.t list + -> Path.t Mode.Map.Multi.t Memo.t diff --git a/duniverse/dune_/src/dune_rules/foreign_sources.ml b/duniverse/dune_/src/dune_rules/foreign_sources.ml index b10f27fde..6b8f0fd2c 100644 --- a/duniverse/dune_/src/dune_rules/foreign_sources.ml +++ b/duniverse/dune_/src/dune_rules/foreign_sources.ml @@ -8,7 +8,7 @@ module Library = Dune_file.Library Before this module is removed, there should be a good way to handle new types of source files without shoving everything into [Dir_contents]. - Furthemore, this module is also responsible for details such as handling file + Furthermore, this module is also responsible for details such as handling file extensions and validating filenames. *) type t = { libraries : Foreign.Sources.t Lib_name.Map.t @@ -38,11 +38,32 @@ let valid_name language ~loc s = ] | _ -> s -let eval_foreign_stubs foreign_stubs ~dune_version - ~(sources : Foreign.Sources.Unresolved.t) : Foreign.Sources.t = - let multiple_sources_error ~name ~loc ~paths = +let eval_foreign_stubs foreign_stubs (ctypes : Ctypes_stanza.t option) + ~dune_version ~(sources : Foreign.Sources.Unresolved.t) : Foreign.Sources.t + = + let multiple_sources_error ~name ~mode ~loc ~paths = + let hints = + [ Pp.text + "You can also avoid the name clash by placing the objects into \ + different foreign archives and building them in different \ + directories. Foreign archives can be defined using the \ + (foreign_library ...) stanza." + ] + in + let hints, for_mode = + match mode with + | Mode.Select.All -> (hints, "") + | Mode.Select.Only m -> + let mode_hint = + Pp.text + "You may be missing a mode field that would restrict this stub to \ + some specific mode." + in + (mode_hint :: hints, Printf.sprintf " for mode %s" @@ Mode.to_string m) + in User_error.raise ~loc - [ Pp.textf "Multiple sources map to the same object name %S:" name + [ Pp.textf "Multiple sources map to the same object name %S%s:" name + for_mode ; Pp.enumerate (List.sort ~compare:Path.Build.compare paths) ~f:(fun path -> Pp.text @@ -53,13 +74,18 @@ let eval_foreign_stubs foreign_stubs ~dune_version names." name ] - ~hints: - [ Pp.text - "You can also avoid the name clash by placing the objects into \ - different foreign archives and building them in different \ - directories. Foreign archives can be defined using the \ - (foreign_library ...) stanza." - ] + ~hints + in + let find_source language (loc, name) = + let open Option.O in + let* candidates = String.Map.find sources name in + match + List.filter_map candidates ~f:(fun (l, path) -> + Option.some_if (Foreign_language.equal l language) path) + with + | [ path ] -> Some path + | [] -> None + | _ :: _ :: _ as paths -> multiple_sources_error ~mode:All ~name ~loc ~paths in let eval (stubs : Foreign.Stubs.t) = let language = stubs.language in @@ -74,7 +100,7 @@ let eval_foreign_stubs foreign_stubs ~dune_version Ordered_set_lang.Unordered_string.eval_loc stubs.names ~key:Fun.id ~standard ~parse:(fun ~loc:_ -> Fun.id) in - String.Map.map names ~f:(fun (loc, s) -> + String.Map.fold names ~init:String.Map.empty ~f:(fun (loc, s) acc -> let name = valid_name language ~loc s in let basename = Filename.basename s in if name <> basename then @@ -84,19 +110,11 @@ let eval_foreign_stubs foreign_stubs ~dune_version To include sources in subdirectories, use the \ (include_subdirs ...) stanza." ]; - let open Option.O in - let source = - let* candidates = String.Map.find sources name in - match - List.filter_map candidates ~f:(fun (l, path) -> - Option.some_if (Foreign_language.equal l language) path) - with - | [ path ] -> Some (loc, Foreign.Source.make ~stubs ~path) - | [] -> None - | _ :: _ :: _ as paths -> multiple_sources_error ~name ~loc ~paths - in - match source with - | Some source -> source + match find_source language (loc, name) with + | Some path -> + let src = Foreign.Source.make (Stubs stubs) ~path in + let new_key = Foreign.Source.object_name src in + String.Map.add_exn acc new_key (loc, src) | None -> User_error.raise ~loc [ Pp.textf "Object %S has no source; %s must be present." name @@ -105,10 +123,34 @@ let eval_foreign_stubs foreign_stubs ~dune_version |> List.map ~f:(fun s -> sprintf "%S" s))) ]) in - let stub_maps = List.map foreign_stubs ~f:eval in + let stub_maps = + let init = List.map foreign_stubs ~f:eval in + match ctypes with + | None -> init + | Some ctypes -> + let ctypes = + List.fold_left ~init:String.Map.empty ctypes.function_description + ~f:(fun acc (fd : Ctypes_stanza.Function_description.t) -> + let loc = Loc.none (* TODO *) in + let fname = Ctypes_stanza.c_generated_functions_cout_c ctypes fd in + let name = Filename.chop_extension fname in + let path = + match find_source C (loc, name) with + | Some p -> p + | None -> + (* impossible b/c ctypes stanza generates this *) + assert false + in + let source = Foreign.Source.make (Ctypes ctypes) ~path in + String.Map.add_exn acc name (loc, source)) + in + ctypes :: init + in List.fold_left stub_maps ~init:String.Map.empty ~f:(fun a b -> - String.Map.union a b ~f:(fun name (loc, src1) (_, src2) -> - multiple_sources_error ~name ~loc + String.Map.union a b ~f:(fun _name (loc, src1) (_, src2) -> + let name = Foreign.Source.user_object_name src1 in + let mode = Foreign.Source.mode src1 in + multiple_sources_error ~name ~loc ~mode ~paths:Foreign.Source.[ path src1; path src2 ])) let check_no_qualified (loc, include_subdirs) = @@ -128,12 +170,12 @@ let make stanzas ~(sources : Foreign.Sources.Unresolved.t) ~dune_version | Library lib -> let all = eval_foreign_stubs ~dune_version lib.buildable.foreign_stubs - ~sources + lib.buildable.ctypes ~sources in ((lib, all) :: libs, foreign_libs, exes) | Foreign_library library -> let all = - eval_foreign_stubs ~dune_version [ library.stubs ] ~sources + eval_foreign_stubs ~dune_version [ library.stubs ] ~sources None in ( libs , (library.archive_name, (library.archive_name_loc, all)) @@ -142,7 +184,7 @@ let make stanzas ~(sources : Foreign.Sources.Unresolved.t) ~dune_version | Executables exe | Tests { exes = exe; _ } -> let all = eval_foreign_stubs ~dune_version exe.buildable.foreign_stubs - ~sources + ~sources exe.buildable.ctypes in (libs, foreign_libs, (exe, all) :: exes) | _ -> acc) diff --git a/duniverse/dune_/src/dune_rules/gen_rules.ml b/duniverse/dune_/src/dune_rules/gen_rules.ml index 0e43d3585..579c69e1d 100644 --- a/duniverse/dune_/src/dune_rules/gen_rules.ml +++ b/duniverse/dune_/src/dune_rules/gen_rules.ml @@ -146,6 +146,15 @@ end = struct | true -> let+ () = Mdx.gen_rules ~sctx ~dir ~scope ~expander mdx in empty_none) + | Melange_emit mel -> + let+ cctx, merlin = + Melange_rules.emit_rules ~dir_contents ~dir ~scope ~sctx ~expander mel + in + { merlin = Some merlin + ; cctx = Some (mel.loc, cctx) + ; js = None + ; source_dirs = None + } | _ -> Memo.return empty_none let of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents @@ -200,15 +209,24 @@ let define_all_alias ~dir ~project ~js_targets = let gen_rules sctx dir_contents cctxs expander { Dune_file.dir = src_dir; stanzas; project } ~dir:ctx_dir = - let files_to_install - { Install_conf.section = _; files; package = _; enabled_if = _ } = - Memo.List.map files ~f:(fun fb -> - File_binding.Unexpanded.expand_src ~dir:ctx_dir fb - ~f:(Expander.No_deps.expand_str expander) - >>| Path.build) - >>= fun files -> - Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir) - (Action_builder.paths files) + let files_to_install install_conf = + let expand_str = Expander.No_deps.expand_str expander in + let files_and_dirs = + let* files_expanded = + Install_conf.expand_files install_conf ~expand_str ~dir:ctx_dir + in + let+ dirs_expanded = + Install_conf.expand_dirs install_conf ~expand_str ~dir:ctx_dir + in + List.map (files_expanded @ dirs_expanded) ~f:(fun fb -> + File_binding.Expanded.src fb |> Path.build) + in + let action = + let open Action_builder.O in + let* files_and_dirs = Action_builder.of_memo files_and_dirs in + Action_builder.paths files_and_dirs + in + Rules.Produce.Alias.add_deps (Alias.all ~dir:ctx_dir) action in let* { For_stanza.merlin = merlins ; cctx = cctxs @@ -229,24 +247,25 @@ let gen_rules sctx dir_contents cctxs expander let* () = Memo.parallel_iter stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with - | Menhir.T m -> ( + | Menhir_stanza.T m -> ( Expander.eval_blang expander m.enabled_if >>= function | false -> Memo.return () | true -> ( let* ml_sources = Dir_contents.ocaml dir_contents in match List.find_map (Menhir_rules.module_names m) ~f:(fun name -> - Option.bind (Ml_sources.lookup_module ml_sources name) - ~f:(fun buildable -> + Option.bind (Ml_sources.find_origin ml_sources name) + ~f:(fun origin -> List.find_map cctxs ~f:(fun (loc, cctx) -> - Option.some_if (Loc.equal loc buildable.loc) cctx))) + Option.some_if + (Loc.equal loc (Ml_sources.Origin.loc origin)) + cctx))) with | None -> (* This happens often when passing a [-p ...] option that hides a library *) let file_targets = - List.map - (Dune_file.Menhir.targets m) + List.map (Menhir_stanza.targets m) ~f:(Path.Build.relative ctx_dir) in Super_context.add_rule sctx ~dir:ctx_dir @@ -309,7 +328,7 @@ let gen_rules sctx dir_contents cctxs ~source_dir ~dir : [] (* To be called once per project, when we are generating the rules for the root - diretory of the project *) + directory of the project *) let gen_project_rules sctx project = let+ () = Opam_create.add_rules sctx project and+ () = Install_rules.gen_project_rules sctx project @@ -377,6 +396,12 @@ let gen_rules ~sctx ~dir components : Build_config.gen_rules_result Memo.t = | _ -> S.empty) (fun () -> Jsoo_rules.setup_separate_compilation_rules sctx rest) | "_doc" :: rest -> Odoc.gen_rules sctx rest ~dir + | ".topmod" :: comps -> + has_rules + (match comps with + | [] -> S.All + | _ -> S.empty) + (fun () -> Top_module.gen_rules sctx ~dir ~comps) | ".ppx" :: rest -> has_rules (match rest with @@ -426,18 +451,20 @@ let gen_rules ~sctx ~dir components : Build_config.gen_rules_result Memo.t = in let* cctxs = gen_rules sctx dir_contents [] ~source_dir ~dir in Memo.parallel_iter subdirs ~f:(fun dc -> - gen_rules sctx dir_contents cctxs ~source_dir - ~dir:(Dir_contents.dir dc) - >>| ignore)) + let+ (_ : (Loc.t * Compilation_context.t) list) = + gen_rules sctx dir_contents cctxs ~source_dir + ~dir:(Dir_contents.dir dc) + in + ())) in Memo.return (Rules.union rules rules') in - let subdirs = String.Set.of_keys automatic_sub_dirs_map in let subdirs = + let subdirs = String.Set.of_keys automatic_sub_dirs_map in match components with | [] -> String.Set.union subdirs - (String.Set.of_list [ ".js"; "_doc"; ".ppx"; ".dune" ]) + (String.Set.of_list [ ".js"; "_doc"; ".ppx"; ".dune"; ".topmod" ]) | _ -> subdirs in let+ directory_targets = @@ -459,9 +486,10 @@ let gen_rules ctx_or_install ~dir components = | Install ctx -> with_context ctx ~f:(fun sctx -> let+ subdirs, rules = Install_rules.symlink_rules sctx ~dir in + let directory_targets = Rules.directory_targets rules in Build_config.Rules { build_dir_only_sub_dirs = subdirs - ; directory_targets = Path.Build.Map.empty + ; directory_targets ; rules = Memo.return rules }) | Context ctx -> diff --git a/duniverse/dune_/src/dune_rules/glob_files.ml b/duniverse/dune_/src/dune_rules/glob_files.ml new file mode 100644 index 000000000..251e57ec2 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/glob_files.ml @@ -0,0 +1,167 @@ +open! Import + +type t = + { glob : String_with_vars.t + ; recursive : bool + } + +(* Returns a list containing all descendant directories of the directory whose + path is the concatenation of [relative_dir] onto [base_dir]. E.g., if + [base_dir] is "foo/bar" and [relative_dir] is "baz/qux", then this function + will return the list containing all descendants of the directory + "foo/bar/baz/qux". The descendants of a directory are that directory's + subdirectories, and each of of their subdirectories, and so on ad infinitum. *) +let get_descendants_of_relative_dir_relative_to_base_dir_local ~base_dir + ~relative_dir = + let base_dir = Path.Build.drop_build_context_exn base_dir in + let rec get_descendants_rec relative_dir = + let absolute_dir = Path.Source.relative base_dir relative_dir in + let open Memo.O in + let* children = + Source_tree.find_dir absolute_dir >>| function + | None -> [] + | Some dir -> Source_tree.Dir.sub_dirs dir |> String.Map.keys + in + let+ rest = + Memo.List.concat_map children ~f:(fun child -> + get_descendants_rec (Filename.concat relative_dir child)) + in + relative_dir :: rest + in + get_descendants_rec relative_dir + +(* Takes a path to a directory [new_dir] and a path to a file [old_path] and + returns the path to a file of the same name as that of [old_path], + contained in the directory [new_dir]. *) +let replace_path_dir new_dir old_path = + Filename.concat new_dir (Path.basename old_path) + +let split_glob_string_into_parent_and_pattern glob_string = + (* Extract the component of the string after the last path separator. This + will be the entire string if it contains no path separators. *) + let pattern_str = Filename.basename glob_string in + (* Remove the pattern from the end of the string. This is done directly with + string manipulation rather than [Filename.dirname] so that the result can + be used to reconstruct strings representing paths to files matched by the + glob in the style of the original glob. For example, the globs "*" and + "./*" will match the same files, but we want the results of the latter to + include the "./" prefix, but not the former. *) + let parent_str = + match String.drop_suffix glob_string ~suffix:pattern_str with + | Some x -> x + | None -> + Code_error.raise + (sprintf + "Filename.basename did not return a suffix of the string \"%s\"" + glob_string) + [] + in + (parent_str, pattern_str) + +module Glob_dir = struct + (* The directory component of a glob. Globs can either be relative to some + base dir (typically the directory containing the dune file which contains + the glob) or absolute. *) + type t = + | Absolute of string + | Relative of + { relative_dir : string + ; base_dir : Path.Build.t + } +end + +module Without_vars = struct + (* A glob whose [String_with_vars.t] has been expanded. A [Glob.t] is a + wildcard for matching filenames only, not entire paths. The [relative_dir] + field holds the directory component of the original glob. E.g. for the glob + "foo/bar/*.txt", [relative_dir] would be "foo/bar". *) + type t = + { glob : Glob.t + ; dir : Glob_dir.t + ; recursive : bool + } + + (* Returns a list of pairs (file_selector, relative_path), which correspond + to each directory that will be searched for files matching the glob. If the + glob is not recursive, this list will be of length 1. The returned file + selectors will expand globs relative to [base_dir], and the corresponding + relative paths are the paths to each directory relative to [base_dir]. The + relative paths are required to construct relative paths to the files found + by expanding the glob. *) + let file_selectors_with_relative_dirs { glob; dir; recursive } ~loc = + match (dir : Glob_dir.t) with + | Relative { relative_dir; base_dir } -> + let make_file_selector relative_dir = + let dir = Path.Build.relative base_dir relative_dir in + File_selector.of_glob ~dir:(Path.build dir) glob + in + if recursive then + get_descendants_of_relative_dir_relative_to_base_dir_local ~base_dir + ~relative_dir + |> Memo.map + ~f: + (List.map ~f:(fun relative_dir -> + (make_file_selector relative_dir, relative_dir))) + else Memo.return [ (make_file_selector relative_dir, relative_dir) ] + | Absolute dir -> + if recursive then + User_error.raise ~loc + [ Pp.textf "Absolute paths in recursive globs are not supported." ] + else + Memo.return + [ (File_selector.of_glob ~dir:(Path.of_string dir) glob, dir) ] +end + +module Expand = struct + module Expand + (M : Memo.S) (C : sig + val collect_files : loc:Loc.t -> File_selector.t -> Path.Set.t M.t + end) = + struct + let expand_vars { glob; recursive } ~f ~base_dir = + let open M.O in + let loc = String_with_vars.loc glob in + let+ glob_str = f glob in + let parent_str, pattern_str = + split_glob_string_into_parent_and_pattern glob_str + in + let glob = Glob.of_string_exn loc pattern_str in + let dir : Glob_dir.t = + if Filename.is_relative parent_str then + Relative { relative_dir = parent_str; base_dir } + else Absolute parent_str + in + { Without_vars.glob; dir; recursive } + + let expand t ~f ~base_dir = + let open M.O in + let loc = String_with_vars.loc t.glob in + let* without_vars = expand_vars t ~f ~base_dir in + Without_vars.file_selectors_with_relative_dirs without_vars ~loc + |> M.of_memo + >>= M.List.concat_map ~f:(fun (file_selector, relative_dir) -> + C.collect_files ~loc file_selector + >>| Path.Set.to_list_map ~f:(replace_path_dir relative_dir)) + >>| List.sort ~compare:String.compare + end + + let action_builder = + let module Action_builder = + Expand + (Action_builder) + (struct + let collect_files = Action_builder.paths_matching + end) + in + Action_builder.expand + + let memo = + let module Memo = + Expand + (Memo) + (struct + let collect_files ~loc:_ = Build_system.eval_pred + end) + in + Memo.expand +end diff --git a/duniverse/dune_/src/dune_rules/glob_files.mli b/duniverse/dune_/src/dune_rules/glob_files.mli new file mode 100644 index 000000000..1342d3c18 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/glob_files.mli @@ -0,0 +1,37 @@ +open! Import + +(** A glob stored in a [String_with_vars.t] and functions for expanding the glob + to a list of files, after resolving pforms in the [String_with_vars.t]. + Globs can be recursive (indicated by the [recursive] field), meaning that + all descendant directories of the starting directory will be searched for + files matching the glob. *) +type t = + { glob : String_with_vars.t + ; recursive : bool + } + +module Expand : sig + (** There are different contexts within which globs can be expanded, and this + signature generalizes the [expand] function over them. These contexts + affect the expressive power available in [f] when expanding + [String_with_vars.t]s (e.g. the [Action_builder] context allows evaluating + rules during expansion while the [Memo] context does not). *) + + (** Expand a glob to a memoized list of strings corresponding to paths that + matched the glob. *) + val memo : + t + -> f:(String_with_vars.t -> string Memo.t) + -> base_dir:Path.Build.t + -> string list Memo.t + + (** Expand a glob inside the [Action_builder] context. The result of calling + [Glob_files.Action_builder.expand] is an action builder which will resolve + to the list of strings containing paths matching the glob, and whose + dependencies will include the file selector built from the glob. *) + val action_builder : + t + -> f:(String_with_vars.t -> string Action_builder.t) + -> base_dir:Path.Build.t + -> string list Action_builder.t +end diff --git a/duniverse/dune_/src/dune_rules/import.ml b/duniverse/dune_/src/dune_rules/import.ml index 279ce9a6e..6a0dd6c94 100644 --- a/duniverse/dune_/src/dune_rules/import.ml +++ b/duniverse/dune_/src/dune_rules/import.ml @@ -1,5 +1,7 @@ include Stdune open Dune_util +module Digest = Dune_digest +module Console = Dune_console module Config = Config module Log = Log module Persistent = Persistent diff --git a/duniverse/dune_/src/dune_rules/inline_tests.ml b/duniverse/dune_/src/dune_rules/inline_tests.ml index 7353f069b..891385517 100644 --- a/duniverse/dune_/src/dune_rules/inline_tests.ml +++ b/duniverse/dune_/src/dune_rules/inline_tests.ml @@ -1,5 +1,4 @@ open Import -module SC = Super_context module Backend = struct module M = struct @@ -113,7 +112,7 @@ include Sub_system.Register_end_point (struct in (* Generate the runner file *) let* () = - SC.add_rule sctx ~dir ~loc + Super_context.add_rule sctx ~dir ~loc (let target = Module.file main_module ~ml_kind:Impl |> Option.value_exn |> Path.as_in_build_dir_exn @@ -167,7 +166,8 @@ include Sub_system.Register_end_point (struct match mode with | Native -> Exe.Linkage.native | Best -> Exe.Linkage.native_or_custom (Super_context.context sctx) - | Byte -> Exe.Linkage.byte + | Byte -> + Exe.Linkage.custom_with_ext ~ext:".bc" (Super_context.context sctx) | Javascript -> Exe.Linkage.js) in let* (_ : Exe.dep_graphs) = @@ -224,13 +224,21 @@ include Sub_system.Register_end_point (struct | Native | Best | Byte -> Memo.return Alias.Name.runtest | Javascript -> Super_context.js_of_ocaml_runtest_alias sctx ~dir in - SC.add_alias_action sctx ~dir ~loc:(Some info.loc) + Super_context.add_alias_action sctx ~dir ~loc:(Some info.loc) (Alias.make ~dir runtest_alias) (let exe = Path.build (Path.Build.relative inline_test_dir (name ^ ext)) in let open Action_builder.O in - let deps, sandbox = Dep_conf_eval.unnamed info.deps ~expander in + let deps, sandbox = + let sandbox = + let project = Scope.project scope in + if Dune_project.dune_version project < (3, 5) then + Sandbox_config.no_special_requirements + else Sandbox_config.needs_sandboxing + in + Dep_conf_eval.unnamed ~sandbox info.deps ~expander + in let+ () = deps and+ () = Action_builder.paths source_files and+ () = Action_builder.path exe diff --git a/duniverse/dune_/src/dune_rules/install.ml b/duniverse/dune_/src/dune_rules/install.ml index c6fa9814a..56910c20a 100644 --- a/duniverse/dune_/src/dune_rules/install.ml +++ b/duniverse/dune_/src/dune_rules/install.ml @@ -9,6 +9,8 @@ module Dst : sig val to_string : t -> string + val concat_all : t -> string list -> t + val add_prefix : string -> t -> t val to_install_file : @@ -31,6 +33,8 @@ end = struct let to_string t = t + let concat_all t suffixes = List.fold_left suffixes ~init:t ~f:Filename.concat + let add_prefix p t = Filename.concat p t let explicit t = t @@ -247,10 +251,13 @@ end module Entry = struct type 'src t = { src : 'src + ; kind : [ `File | `Directory ] ; dst : Dst.t ; section : Section.t } + let map_dst t ~f = { t with dst = f t.dst } + module Sourced = struct type source = | User of Loc.t @@ -270,11 +277,12 @@ module Entry = struct } end - let compare compare_src { src; dst; section } t = + let compare compare_src { src; dst; section; kind } t = let open Ordering.O in let= () = Section.compare section t.section in let= () = Dst.compare dst t.dst in - compare_src src t.src + let= () = compare_src src t.src in + Poly.compare kind t.kind let adjust_dst_gen = let error (source_pform : Dune_lang.Template.Pform.t) = @@ -329,13 +337,14 @@ module Entry = struct ~src_suffix:(Full (Path.to_string (Path.build src))) ~dst ~section - let make section ?dst src = + let make section ?dst ~kind src = let dst = adjust_dst' ~src ~dst ~section in - { src; dst; section } + { src; dst; section; kind } - let make_with_site section ?dst get_section src = + let make_with_site (section : Section_with_site.t) ?dst get_section ~kind src + = match section with - | Section_with_site.Section section -> Memo.return (make section ?dst src) + | Section section -> Memo.return (make section ?dst ~kind src) | Site { pkg; site; loc } -> let open Memo.O in let+ section = get_section ~loc ~pkg ~site in @@ -364,7 +373,7 @@ module Entry = struct | Man | Misc -> (section, dst) in - { src; dst; section } + { src; dst; section; kind } let set_src t src = { t with src } @@ -387,6 +396,7 @@ module Entry = struct { src ; section ; dst = Dst.of_install_file ~section ~src_basename:(Path.basename src) dst + ; kind = `File } end diff --git a/duniverse/dune_/src/dune_rules/install.mli b/duniverse/dune_/src/dune_rules/install.mli index fad4c15f4..ef7e7a43c 100644 --- a/duniverse/dune_/src/dune_rules/install.mli +++ b/duniverse/dune_/src/dune_rules/install.mli @@ -6,6 +6,8 @@ module Dst : sig val to_string : t -> string + val concat_all : t -> string list -> t + include Dune_lang.Conv.S with type t := t val to_dyn : t -> Dyn.t @@ -91,6 +93,7 @@ end module Entry : sig type 'src t = private { src : 'src + ; kind : [ `File | `Directory ] ; dst : Dst.t ; section : Section.t } @@ -116,7 +119,12 @@ module Entry : sig -> section:Section.t -> Dst.t - val make : Section.t -> ?dst:string -> Path.Build.t -> Path.Build.t t + val make : + Section.t + -> ?dst:string + -> kind:[ `File | `Directory ] + -> Path.Build.t + -> Path.Build.t t val make_with_site : Section_with_site.t @@ -125,11 +133,14 @@ module Entry : sig -> pkg:Dune_engine.Package.Name.t -> site:Dune_engine.Section.Site.t -> Section.t Memo.t) + -> kind:[ `File | `Directory ] -> Path.Build.t -> Path.Build.t t Memo.t val set_src : _ t -> 'src -> 'src t + val map_dst : 'a t -> f:(Dst.t -> Dst.t) -> 'a t + val relative_installed_path : _ t -> paths:Section.Paths.t -> Path.t val add_install_prefix : diff --git a/duniverse/dune_/src/dune_rules/install_rules.ml b/duniverse/dune_/src/dune_rules/install_rules.ml index eba3b46b4..623ab735f 100644 --- a/duniverse/dune_/src/dune_rules/install_rules.ml +++ b/duniverse/dune_/src/dune_rules/install_rules.ml @@ -65,7 +65,9 @@ end = struct let name = Lib_info.name lib in let files = Foreign_sources.for_lib foreign_sources ~name in Foreign.Sources.object_files files ~dir ~ext_obj - else Memo.return (Lib_info.foreign_archives lib) + else + Memo.return + (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) in List.concat_map ~f:(List.map ~f:(fun f -> (Section.Lib, f))) @@ -93,7 +95,7 @@ end = struct let obj_dir = Lib_info.obj_dir info in let make_entry section ?sub_dir ?dst fn = let entry = - Install.Entry.make section fn + Install.Entry.make section fn ~kind:`File ~dst: (let dst = match dst with @@ -132,7 +134,7 @@ end = struct make_entry Lib source ?dst)) in let { Lib_config.has_native; ext_obj; _ } = lib_config in - let modes = Dune_file.Mode_conf.Set.eval lib.modes ~has_native in + let modes = Dune_file.Mode_conf.Set.eval lib.modes.ocaml ~has_native in let { Mode.Dict.byte; native } = modes in let module_files = let inside_subdir f = @@ -145,14 +147,16 @@ end = struct in let cm_dir m cm_kind = let visibility = Module.visibility m in - let dir' = Obj_dir.cm_dir external_obj_dir cm_kind visibility in + let dir' = Obj_dir.cm_dir external_obj_dir (Ocaml cm_kind) visibility in if Path.equal (Path.build dir) dir' then None else Path.basename dir' |> inside_subdir |> Option.some in let virtual_library = Library.is_virtual lib in let modules = let common m = - let cm_file kind = Obj_dir.Module.cm_file obj_dir m ~kind in + let cm_file kind = + Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml kind) + in let if_ b (cm_kind, f) = if b then match f with @@ -178,7 +182,10 @@ end = struct common m @ List.filter_map Ml_kind.all ~f:(fun ml_kind -> let open Option.O in - let+ cmt = Obj_dir.Module.cmt_file obj_dir m ~ml_kind in + let+ cmt = + Obj_dir.Module.cmt_file obj_dir m ~ml_kind + ~cm_kind:(Ocaml Cmi) + in (Cm_kind.Cmi, cmt)) |> set_dir m) in @@ -207,15 +214,16 @@ end = struct ; List.map lib_files ~f:(fun (section, file) -> make_entry section file) ; List.map execs ~f:(make_entry Libexec) ; List.map dll_files ~f:(fun a -> - let entry = Install.Entry.make Stublibs a in + let entry = Install.Entry.make ~kind:`File Stublibs a in Install.Entry.Sourced.create ~loc entry) ; List.map ~f:(make_entry Lib) install_c_headers ] let keep_if expander ~scope stanza = let+ keep = + let open Dune_file in match (stanza : Stanza.t) with - | Dune_file.Library lib -> + | Library lib -> let* enabled_if = Expander.eval_blang expander lib.enabled_if in if enabled_if then if lib.optional then @@ -223,11 +231,10 @@ end = struct (Dune_file.Library.best_name lib) else Memo.return true else Memo.return false - | Dune_file.Documentation _ -> Memo.return true - | Dune_file.Install { enabled_if; _ } -> - Expander.eval_blang expander enabled_if - | Dune_file.Plugin _ -> Memo.return true - | Dune_file.Executables ({ install_conf = Some _; _ } as exes) -> ( + | Documentation _ -> Memo.return true + | Install { enabled_if; _ } -> Expander.eval_blang expander enabled_if + | Plugin _ -> Memo.return true + | Executables ({ install_conf = Some _; _ } as exes) -> ( Expander.eval_blang expander exes.enabled_if >>= function | false -> Memo.return false | true -> @@ -271,42 +278,59 @@ end = struct | None -> Memo.return None | Some (stanza, package) -> let new_entries = + let open Dune_file in match (stanza : Stanza.t) with - | Dune_file.Install i - | Dune_file.Executables { install_conf = Some i; _ } -> - let path_expander = - File_binding.Unexpanded.expand ~dir - ~f:(Expander.No_deps.expand_str expander) - in + | Install i | Executables { install_conf = Some i; _ } -> let section = i.section in - Memo.List.map i.files ~f:(fun unexpanded -> - let* fb = path_expander unexpanded in - let loc = File_binding.Expanded.src_loc fb in - let src = File_binding.Expanded.src fb in - let dst = File_binding.Expanded.dst fb in - let+ entry = - Install.Entry.make_with_site section - (Sites.section_of_site sites) - src ?dst - in - Install.Entry.Sourced.create ~loc entry) - | Dune_file.Library lib -> + let expand_str = Expander.No_deps.expand_str expander in + let* files_expanded = + Dune_file.Install_conf.expand_files i ~expand_str ~dir + in + let* files = + Memo.List.map files_expanded ~f:(fun fb -> + let loc = File_binding.Expanded.src_loc fb in + let src = File_binding.Expanded.src fb in + let dst = File_binding.Expanded.dst fb in + let+ entry = + Install.Entry.make_with_site ~kind:`File section + (Sites.section_of_site sites) + src ?dst + in + Install.Entry.Sourced.create ~loc entry) + in + let* dirs_expanded = + Dune_file.Install_conf.expand_dirs i ~expand_str ~dir + in + let+ files_from_dirs = + Memo.List.map dirs_expanded ~f:(fun fb -> + let loc = File_binding.Expanded.src_loc fb in + let src = File_binding.Expanded.src fb in + let dst = File_binding.Expanded.dst fb in + let+ entry = + Install.Entry.make_with_site section ~kind:`Directory + (Sites.section_of_site sites) + src ?dst + in + Install.Entry.Sourced.create ~loc entry) + in + files @ files_from_dirs + | Library lib -> let sub_dir = Dune_file.Library.sub_dir lib in let* dir_contents = Dir_contents.get sctx ~dir in lib_install_files sctx ~scope ~dir ~sub_dir lib ~dir_contents | Coq_stanza.Theory.T coqlib -> Coq_rules.install_rules ~sctx ~dir coqlib - | Dune_file.Documentation d -> + | Documentation d -> let* dc = Dir_contents.get sctx ~dir in let+ mlds = Dir_contents.mlds dc d in List.map mlds ~f:(fun mld -> let entry = - Install.Entry.make + Install.Entry.make ~kind:`File ~dst:(sprintf "odoc-pages/%s" (Path.Build.basename mld)) Section.Doc mld in Install.Entry.Sourced.create ~loc:d.loc entry) - | Dune_file.Plugin t -> Plugin_rules.install_rules ~sctx ~sites ~dir t + | Plugin t -> Plugin_rules.install_rules ~sctx ~sites ~dir t | _ -> Memo.return [] in let name = Package.name package in @@ -332,11 +356,11 @@ end = struct Package_paths.deprecated_dune_package_file ctx pkg name in [ Install.Entry.Sourced.create - (Install.Entry.make Lib_root meta_file + (Install.Entry.make Lib_root meta_file ~kind:`File ~dst: (Package.Name.to_string name ^ "/" ^ Findlib.meta_fn)) ; Install.Entry.Sourced.create - (Install.Entry.make Lib_root dune_package_file + (Install.Entry.make Lib_root dune_package_file ~kind:`File ~dst: (Package.Name.to_string name ^ "/" ^ Dune_package.fn)) ]) @@ -344,15 +368,16 @@ end = struct let meta_file = Package_paths.meta_file ctx pkg in let dune_package_file = Package_paths.dune_package_file ctx pkg in Install.Entry.Sourced.create - (Install.Entry.make Lib meta_file ~dst:Findlib.meta_fn) + (Install.Entry.make Lib meta_file ~kind:`File ~dst:Findlib.meta_fn) :: Install.Entry.Sourced.create - (Install.Entry.make Lib dune_package_file ~dst:Dune_package.fn) + (Install.Entry.make Lib dune_package_file ~kind:`File + ~dst:Dune_package.fn) :: (if not pkg.has_opam_file then deprecated_meta_and_dune_files else let opam_file = Package_paths.opam_file ctx pkg in Install.Entry.Sourced.create - (Install.Entry.make Lib opam_file ~dst:"opam") + (Install.Entry.make Lib opam_file ~kind:`File ~dst:"opam") :: deprecated_meta_and_dune_files) in let pkg_dir = Package.dir pkg in @@ -364,7 +389,7 @@ end = struct |> String.Set.fold ~init ~f:(fun fn acc -> if is_odig_doc_file fn then let odig_file = Path.Build.relative pkg_dir fn in - let entry = Install.Entry.make Doc odig_file in + let entry = Install.Entry.make Doc ~kind:`File odig_file in Install.Entry.Sourced.create entry :: acc else acc)) and+ l = @@ -729,7 +754,10 @@ let symlink_installed_artifacts_to_build_install sctx in let rule = let { Action_builder.With_targets.targets; build } = - Action_builder.symlink ~src:(Path.build entry.src) ~dst + (match entry.kind with + | `File -> Action_builder.symlink + | `Directory -> Action_builder.symlink_dir) + ~src:(Path.build entry.src) ~dst in Rule.make ~info:(Rule.Info.of_loc_opt (Some loc)) @@ -832,15 +860,93 @@ let package_deps (pkg : Package.t) files = let+ packages, _rules_seen = loop_files Rule.Set.empty files in packages +include ( + struct + module Spec = struct + type ('path, 'target) t = Path.t Install.Entry.t list * 'target + + let name = "gen-install-file" + + let version = 1 + + let bimap (entries, dst) _ g = (entries, g dst) + + let is_useful_to ~distribute:_ ~memoize = memoize + + let encode (_entries, dst) _path target : Dune_lang.t = + List [ Dune_lang.atom_or_quoted_string name; target dst ] + + let read_dir_recursively (entry : _ Install.Entry.t) = + let rec loop acc dirs = + match dirs with + | [] -> + List.rev_map acc ~f:(fun (path, comps) -> + let comps = List.rev comps in + Install.Entry.set_src entry path + |> Install.Entry.map_dst ~f:(fun dst -> + Install.Dst.concat_all dst comps)) + |> List.sort + ~compare:(fun (x : _ Install.Entry.t) (y : _ Install.Entry.t) + -> Path.compare x.src y.src) + | (dir, comps) :: dirs -> ( + match Path.Untracked.readdir_unsorted_with_kinds dir with + | Error _ -> Code_error.raise "unable to read directory" [] + | Ok files -> + let files, new_dirs = + List.partition_map files ~f:(fun (name, kind) -> + let path = Path.relative dir name in + let comps = name :: comps in + match kind with + | Unix.S_DIR -> Right (path, comps) + | _ -> Left (path, comps)) + in + let acc = List.rev_append files acc in + let dirs = List.rev_append new_dirs dirs in + loop acc dirs) + in + loop [] [ (entry.src, []) ] + + let action (entries, dst) ~ectx:_ ~eenv:_ = + let entries = + List.concat_map entries ~f:(fun (entry : _ Install.Entry.t) -> + match entry.kind with + | `File -> [ entry ] + | `Directory -> read_dir_recursively entry) + |> Install.gen_install_file + in + Io.write_file (Path.build dst) entries; + Fiber.return () + end + + let gen_install_file entries ~dst = + let module M = struct + type path = Path.t + + type target = Path.Build.t + + module Spec = Spec + + let v = (entries, dst) + end in + Dune_engine.Action.Extension (module M) + end : + sig + val gen_install_file : + Path.t Install.Entry.t list -> dst:Path.Build.t -> Action.t + end) + let gen_package_install_file_rules sctx (package : Package.t) = let package_name = Package.name package in let roots = Install.Section.Paths.Roots.opam_from_prefix Path.root in let install_paths = Install.Section.Paths.make ~package:package_name ~roots in - let* entries = symlinked_entries sctx package >>| fst in + let entries = + Action_builder.of_memo (symlinked_entries sctx package >>| fst) + in let ctx = Super_context.context sctx in let pkg_build_dir = Package_paths.build_dir ctx package in let files = - List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> e.entry.src) + Action_builder.map entries + ~f:(List.map ~f:(fun (e : Install.Entry.Sourced.t) -> e.entry.src)) in let* dune_project = let+ scope = Scope.DB.find_by_dir pkg_build_dir in @@ -849,6 +955,7 @@ let gen_package_install_file_rules sctx (package : Package.t) = let strict_package_deps = Dune_project.strict_package_deps dune_project in let packages = let open Action_builder.O in + let* files = files in let+ packages = Action_builder.of_memo (package_deps package files) in (match strict_package_deps with | false -> () @@ -872,6 +979,8 @@ let gen_package_install_file_rules sctx (package : Package.t) = packages in let install_file_deps = + let open Action_builder.O in + let* files = files in Path.Set.of_list_map files ~f:Path.build |> Action_builder.path_set in let* () = @@ -899,45 +1008,50 @@ let gen_package_install_file_rules sctx (package : Package.t) = ~findlib_toolchain:ctx.findlib_toolchain) in let open Action_builder.O in - Action_builder.write_file_dyn install_file - (let+ () = install_file_deps - and+ () = - if strict_package_deps then - Action_builder.map packages ~f:(fun (_ : Package.Id.Set.t) -> ()) - else Action_builder.return () - in - let entries = - match ctx.findlib_toolchain with - | None -> entries - | Some toolchain -> - let toolchain = Context_name.to_string toolchain in - let prefix = Path.of_string (toolchain ^ "-sysroot") in - List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> - { e with - entry = - Install.Entry.add_install_prefix e.entry ~paths:install_paths - ~prefix - }) - in - (if not package.allow_empty then - if - List.for_all entries ~f:(fun (e : Install.Entry.Sourced.t) -> - match e.source with - | Dune -> true - | User _ -> false) - then - let is_error = Dune_project.dune_version dune_project >= (3, 0) in - User_warning.emit ~is_error - [ Pp.textf - "The package %s does not have any user defined stanzas \ - attached to it. If this is intentional, add (allow_empty) to \ - the package definition in the dune-project file" - (Package.Name.to_string package_name) - ]); - Install.gen_install_file - (List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> - Install.Entry.set_src e.entry (Path.build e.entry.src)))) + let entries = + let+ () = install_file_deps + and+ () = + if strict_package_deps then + Action_builder.map packages ~f:(fun (_ : Package.Id.Set.t) -> ()) + else Action_builder.return () + and+ entries = entries in + let entries = + match ctx.findlib_toolchain with + | None -> entries + | Some toolchain -> + let toolchain = Context_name.to_string toolchain in + let prefix = Path.of_string (toolchain ^ "-sysroot") in + List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> + { e with + entry = + Install.Entry.add_install_prefix e.entry ~paths:install_paths + ~prefix + }) + in + (if not package.allow_empty then + if + List.for_all entries ~f:(fun (e : Install.Entry.Sourced.t) -> + match e.source with + | Dune -> true + | User _ -> false) + then + let is_error = Dune_project.dune_version dune_project >= (3, 0) in + User_warning.emit ~is_error + [ Pp.textf + "The package %s does not have any user defined stanzas attached \ + to it. If this is intentional, add (allow_empty) to the \ + package definition in the dune-project file" + (Package.Name.to_string package_name) + ]); + List.map entries ~f:(fun (e : Install.Entry.Sourced.t) -> + Install.Entry.set_src e.entry (Path.build e.entry.src)) + in + Action_builder.with_file_targets ~file_targets:[ install_file ] + (let+ entries = entries in + let action = gen_install_file entries ~dst:install_file in + Action.Full.make action) in + Super_context.add_rule sctx ~dir:pkg_build_dir ~mode: (if promote_install_file ctx then diff --git a/duniverse/dune_/src/dune_rules/jsoo_rules.ml b/duniverse/dune_/src/dune_rules/jsoo_rules.ml index 21d06124c..ade9de8fc 100644 --- a/duniverse/dune_/src/dune_rules/jsoo_rules.ml +++ b/duniverse/dune_/src/dune_rules/jsoo_rules.ml @@ -1,5 +1,4 @@ open Import -module SC = Super_context let install_jsoo_hint = "opam install js_of_ocaml-compiler" @@ -7,7 +6,8 @@ let in_build_dir ~ctx args = Path.Build.L.relative ctx.Context.build_dir (".js" :: args) let jsoo ~dir sctx = - SC.resolve_program sctx ~dir ~loc:None ~hint:install_jsoo_hint "js_of_ocaml" + Super_context.resolve_program sctx ~dir ~loc:None ~hint:install_jsoo_hint + "js_of_ocaml" type sub_command = | Compile @@ -135,7 +135,7 @@ let setup_separate_compilation_rules sctx components = | [] | _ :: _ :: _ -> Memo.return () | [ pkg ] -> ( let pkg = Lib_name.parse_string_exn (Loc.none, pkg) in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let open Memo.O in let* installed_libs = Lib.DB.installed ctx in Lib.DB.find installed_libs pkg >>= function @@ -171,7 +171,7 @@ let setup_separate_compilation_rules sctx components = js_of_ocaml_rule sctx ~sub_command:Compile ~dir ~flags:Js_of_ocaml.Flags.standard ~spec ~target in - SC.add_rule sctx ~dir action_with_targets)) + Super_context.add_rule sctx ~dir action_with_targets)) let build_exe cc ~loc ~in_context ~src ~(cm : Path.t list Action_builder.t) ~promote ~link_time_code_gen = @@ -192,12 +192,12 @@ let build_exe cc ~loc ~in_context ~src ~(cm : Path.t list Action_builder.t) | Separate_compilation -> standalone_runtime_rule cc ~javascript_files ~target:standalone_runtime ~flags - >>= SC.add_rule ~loc sctx ~dir + >>= Super_context.add_rule ~loc sctx ~dir >>> link_rule cc ~runtime:standalone_runtime ~target cm ~flags ~link_time_code_gen - >>= SC.add_rule sctx ~loc ~dir ~mode + >>= Super_context.add_rule sctx ~loc ~dir ~mode | Whole_program -> exe_rule cc ~javascript_files ~src ~target ~flags - >>= SC.add_rule sctx ~loc ~dir ~mode + >>= Super_context.add_rule sctx ~loc ~dir ~mode let runner = "node" diff --git a/duniverse/dune_/src/dune_rules/lib.ml b/duniverse/dune_/src/dune_rules/lib.ml index 20f37a23d..c68dfdc6d 100644 --- a/duniverse/dune_/src/dune_rules/lib.ml +++ b/duniverse/dune_/src/dune_rules/lib.ml @@ -179,14 +179,19 @@ module Error = struct (Path.to_string_maybe_quoted dir)) ] - let private_deps_not_allowed ~loc private_dep = + let private_deps_not_allowed ~kind ~loc private_dep = let name = Lib_info.name private_dep in + User_error.E (User_error.make ~loc [ Pp.textf - "Library %S is private, it cannot be a dependency of a public \ - library. You need to give %S a public name." - (Lib_name.to_string name) (Lib_name.to_string name) + "Library %S is private, it cannot be a dependency of a %s. You \ + need to give %S a public name." + (Lib_name.to_string name) + (match kind with + | `Private_package -> "private library attached to a package" + | `Public -> "public library") + (Lib_name.to_string name) ]) let only_ppx_deps_allowed ~loc dep = @@ -246,8 +251,6 @@ module Id : sig val to_dep_path_lib : t -> Dep_path.Entry.Lib.t - val hash : t -> int - val compare : t -> t -> Ordering.t include Comparator.OPS with type t := t @@ -281,8 +284,6 @@ end = struct include (Comparator.Operators (T) : Comparator.OPS with type t := T.t) - let hash { path; name } = Tuple.T2.hash Path.hash Lib_name.hash (path, name) - let make ~path ~name = { path; name } include Comparable.Make (T) @@ -431,9 +432,10 @@ let wrapped t = assert false (* will always be specified in dune package *) | Some (This x) -> Some x) -let equal l1 l2 = Ordering.is_eq (compare l1 l2) +(* We can't write a structural equality because of all the lazy fields *) +let equal = ( == ) -let hash t = Id.hash t.unique_id +let hash = Poly.hash include Comparable.Make (T) @@ -600,16 +602,17 @@ end = struct end type private_deps = - | From_same_project + | From_same_project of [ `Public | `Private_package ] | Allow_all let check_private_deps lib ~loc ~(private_deps : private_deps) = match private_deps with | Allow_all -> Ok lib - | From_same_project -> ( + | From_same_project kind -> ( match Lib_info.status lib.info with | Private (_, Some _) -> Ok lib - | Private (_, None) -> Error (Error.private_deps_not_allowed ~loc lib.info) + | Private (_, None) -> + Error (Error.private_deps_not_allowed ~kind ~loc lib.info) | _ -> Ok lib) module Vlib : sig @@ -838,8 +841,9 @@ end = struct (* [Allow_all] is used for libraries that are installed because we don't have to check it again. It has been checked when compiling the libraries before their installation *) - | Installed_private | Private _ | Installed -> Allow_all - | Public (_, _) -> From_same_project + | Installed_private | Private (_, None) | Installed -> Allow_all + | Private (_, Some _) -> From_same_project `Private_package + | Public (_, _) -> From_same_project `Public in let resolve name = resolve_dep db name ~private_deps in let* resolved = diff --git a/duniverse/dune_/src/dune_rules/lib_file_deps.ml b/duniverse/dune_/src/dune_rules/lib_file_deps.ml index f99c7479d..32a8942e0 100644 --- a/duniverse/dune_/src/dune_rules/lib_file_deps.ml +++ b/duniverse/dune_/src/dune_rules/lib_file_deps.ml @@ -1,22 +1,30 @@ open Import module Group = struct - type t = + type ocaml = | Cmi | Cmx + + type t = + | Ocaml of ocaml + | Melange of Melange.Cm_kind.t | Header - let all = [ Cmi; Cmx; Header ] + let all = [ Ocaml Cmi; Ocaml Cmx; Melange Cmi; Melange Cmj; Header ] let ext = function - | Cmi -> Cm_kind.ext Cmi - | Cmx -> Cm_kind.ext Cmx + | Ocaml Cmi -> Cm_kind.ext Cmi + | Ocaml Cmx -> Cm_kind.ext Cmx + | Melange Cmi -> Lib_mode.Cm_kind.ext (Melange Cmi) + | Melange Cmj -> Lib_mode.Cm_kind.ext (Melange Cmj) | Header -> Foreign_language.header_extension let obj_dir t obj_dir = match t with - | Cmi -> Obj_dir.public_cmi_dir obj_dir - | Cmx -> Obj_dir.native_dir obj_dir + | Ocaml Cmi -> Obj_dir.public_cmi_ocaml_dir obj_dir + | Ocaml Cmx -> Obj_dir.native_dir obj_dir + | Melange Cmi -> Obj_dir.public_cmi_melange_dir obj_dir + | Melange Cmj -> Obj_dir.melange_dir obj_dir | Header -> Obj_dir.dir obj_dir let to_predicate = diff --git a/duniverse/dune_/src/dune_rules/lib_file_deps.mli b/duniverse/dune_/src/dune_rules/lib_file_deps.mli index 93c0fcb64..edfedac13 100644 --- a/duniverse/dune_/src/dune_rules/lib_file_deps.mli +++ b/duniverse/dune_/src/dune_rules/lib_file_deps.mli @@ -1,9 +1,13 @@ open Import module Group : sig - type t = + type ocaml = | Cmi | Cmx + + type t = + | Ocaml of ocaml + | Melange of Melange.Cm_kind.t | Header end diff --git a/duniverse/dune_/src/dune_rules/lib_flags.ml b/duniverse/dune_/src/dune_rules/lib_flags.ml index 400353217..ea400ae91 100644 --- a/duniverse/dune_/src/dune_rules/lib_flags.ml +++ b/duniverse/dune_/src/dune_rules/lib_flags.ml @@ -22,22 +22,26 @@ module Link_params = struct (* Foreign archives [lib*.a] and [dll*.so] and native archives [lib*.a] are declared as hidden dependencies, and appropriate [-I] flags are provided separately to help the linker locate them. *) + let select_lib_files = Mode.Map.Multi.for_only ~and_all:true lib_files in let+ hidden_deps = match mode with | Byte | Byte_for_jsoo -> Memo.return dll_files - | Byte_with_stubs_statically_linked_in -> Memo.return lib_files + | Byte_with_stubs_statically_linked_in -> + Memo.return @@ select_lib_files Mode.Byte | Native -> let+ native_archives = let+ modules = Dir_contents.modules_of_lib sctx t in Lib_info.eval_native_archives_exn info ~modules in + let lib_files = select_lib_files Mode.Native in List.rev_append native_archives lib_files in let include_dirs = let files = match mode with | Byte | Byte_for_jsoo -> dll_files - | Byte_with_stubs_statically_linked_in | Native -> lib_files + | Byte_with_stubs_statically_linked_in | Native -> + select_lib_files Mode.Native in let files = match Lib_info.exit_module info with @@ -90,37 +94,50 @@ module L = struct | [] -> dirs | lib :: _ -> Path.Set.remove dirs (Lib.lib_config lib).stdlib_dir - let include_paths ?project ts mode = - let visible_cmi = - match project with - | None -> fun _ -> true - | Some project -> ( - let check_project lib = - match Lib.project lib with - | None -> false - | Some project' -> Dune_project.equal project project' + let include_paths = + let add_public_dir ~visible_cmi obj_dir acc mode = + match visible_cmi with + | false -> acc + | true -> + let public_cmi_dir = + (match mode with + | `Byte -> Obj_dir.public_cmi_ocaml_dir + | `Melange -> Obj_dir.public_cmi_melange_dir) + obj_dir in - fun lib -> - match Lib_info.status (Lib.info lib) with - | Private (_, Some _) | Installed_private -> check_project lib - | _ -> true) + Path.Set.add acc public_cmi_dir in - let dirs = - List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> - let obj_dir = Lib_info.obj_dir (Lib.info t) in - let acc = - if visible_cmi t then - let public_cmi_dir = Obj_dir.public_cmi_dir obj_dir in - Path.Set.add acc public_cmi_dir - else acc + fun ?project ts mode -> + let visible_cmi = + match project with + | None -> fun _ -> true + | Some project -> ( + let check_project lib = + match Lib.project lib with + | None -> false + | Some project' -> Dune_project.equal project project' in - match mode with - | Mode.Byte -> acc - | Native -> - let native_dir = Obj_dir.native_dir obj_dir in - Path.Set.add acc native_dir) - in - remove_stdlib dirs ts + fun lib -> + match Lib_info.status (Lib.info lib) with + | Private (_, Some _) | Installed_private -> check_project lib + | _ -> true) + in + let dirs = + List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t -> + let obj_dir = Lib_info.obj_dir (Lib.info t) in + let visible_cmi = visible_cmi t in + match mode with + | Lib_mode.Melange -> + add_public_dir ~visible_cmi obj_dir acc `Melange + | Ocaml mode -> ( + let acc = add_public_dir ~visible_cmi obj_dir acc `Byte in + match mode with + | Byte -> acc + | Native -> + let native_dir = Obj_dir.native_dir obj_dir in + Path.Set.add acc native_dir)) + in + remove_stdlib dirs ts let include_flags ?project ts mode = to_iflags (include_paths ?project ts mode) @@ -142,7 +159,9 @@ module L = struct | [] -> false | _ -> true) in - Path.Set.union (include_paths ts Mode.Byte) (c_include_paths with_dlls) + Path.Set.union + (include_paths ts (Lib_mode.Ocaml Byte)) + (c_include_paths with_dlls) end module Lib_and_module = struct @@ -173,7 +192,7 @@ module Lib_and_module = struct (Command.Args.S (Dep (Obj_dir.Module.cm_file_exn obj_dir m - ~kind:(Mode.cm_kind (Link_mode.mode mode))) + ~kind:(Ocaml (Mode.cm_kind (Link_mode.mode mode)))) :: (match mode with | Native -> diff --git a/duniverse/dune_/src/dune_rules/lib_flags.mli b/duniverse/dune_/src/dune_rules/lib_flags.mli index d64fa3e28..9b1657973 100644 --- a/duniverse/dune_/src/dune_rules/lib_flags.mli +++ b/duniverse/dune_/src/dune_rules/lib_flags.mli @@ -24,9 +24,10 @@ module L : sig val to_iflags : Path.Set.t -> _ Command.Args.t - val include_paths : ?project:Dune_project.t -> t -> Mode.t -> Path.Set.t + val include_paths : ?project:Dune_project.t -> t -> Lib_mode.t -> Path.Set.t - val include_flags : ?project:Dune_project.t -> t -> Mode.t -> _ Command.Args.t + val include_flags : + ?project:Dune_project.t -> t -> Lib_mode.t -> _ Command.Args.t val c_include_flags : t -> _ Command.Args.t diff --git a/duniverse/dune_/src/dune_rules/lib_info.ml b/duniverse/dune_/src/dune_rules/lib_info.ml index faf8e4dd8..8bbf6578c 100644 --- a/duniverse/dune_/src/dune_rules/lib_info.ml +++ b/duniverse/dune_/src/dune_rules/lib_info.ml @@ -301,7 +301,7 @@ type 'path t = ; archives : 'path list Mode.Dict.t ; plugins : 'path list Mode.Dict.t ; foreign_objects : 'path list Source.t - ; foreign_archives : 'path list + ; foreign_archives : 'path Mode.Map.Multi.t ; native_archives : 'path native_archives ; foreign_dll_files : 'path list ; jsoo_runtime : 'path list @@ -319,7 +319,7 @@ type 'path t = ; default_implementation : (Loc.t * Lib_name.t) option ; wrapped : Wrapped.t Inherited.t option ; main_module_name : Main_module_name.t - ; modes : Mode.Dict.Set.t + ; modes : Lib_mode.Map.Set.t ; special_builtin_support : Special_builtin_support.t option ; exit_module : Module_name.t option ; instrumentation_backend : (Loc.t * Lib_name.t) option @@ -379,7 +379,7 @@ let equal (type a) (t : a t) && Mode.Dict.equal (List.equal path_equal) archives t.archives && Mode.Dict.equal (List.equal path_equal) plugins t.plugins && Source.equal (List.equal path_equal) foreign_objects t.foreign_objects - && List.equal path_equal foreign_archives t.foreign_archives + && Mode.Map.Multi.equal ~equal:path_equal foreign_archives t.foreign_archives && equal_native_archives path_equal native_archives t.native_archives && List.equal path_equal foreign_dll_files t.foreign_dll_files && List.equal path_equal jsoo_runtime t.jsoo_runtime @@ -409,7 +409,7 @@ let equal (type a) (t : a t) default_implementation t.default_implementation && Option.equal (Inherited.equal Wrapped.equal) wrapped t.wrapped && Main_module_name.equal main_module_name t.main_module_name - && Mode.Dict.Set.equal modes t.modes + && Lib_mode.Map.Set.equal modes t.modes && Option.equal Special_builtin_support.equal special_builtin_support t.special_builtin_support && Option.equal Module_name.equal exit_module t.exit_module @@ -594,7 +594,7 @@ let map t ~path_kind ~f_path ~f_obj_dir = ; archives = mode_list t.archives ; plugins = mode_list t.plugins ; foreign_objects = Source.map ~f:(List.map ~f) t.foreign_objects - ; foreign_archives = List.map ~f t.foreign_archives + ; foreign_archives = Mode.Map.Multi.map t.foreign_archives ~f ; foreign_dll_files = List.map ~f t.foreign_dll_files ; native_archives ; jsoo_runtime = List.map ~f t.jsoo_runtime @@ -663,7 +663,7 @@ let to_dyn path ; ("archives", Mode.Dict.to_dyn (list path) archives) ; ("plugins", Mode.Dict.to_dyn (list path) plugins) ; ("foreign_objects", Source.to_dyn (list path) foreign_objects) - ; ("foreign_archives", list path foreign_archives) + ; ("foreign_archives", Mode.Map.Multi.to_dyn path foreign_archives) ; ("native_archives", dyn_of_native_archives path native_archives) ; ("foreign_dll_files", list path foreign_dll_files) ; ("jsoo_runtime", list path jsoo_runtime) @@ -682,7 +682,7 @@ let to_dyn path , option (snd Lib_name.to_dyn) default_implementation ) ; ("wrapped", option (Inherited.to_dyn Wrapped.to_dyn) wrapped) ; ("main_module_name", Main_module_name.to_dyn main_module_name) - ; ("modes", Mode.Dict.Set.to_dyn modes) + ; ("modes", Lib_mode.Map.Set.to_dyn modes) ; ( "special_builtin_support" , option Special_builtin_support.to_dyn special_builtin_support ) ; ("exit_module", option Module_name.to_dyn exit_module) diff --git a/duniverse/dune_/src/dune_rules/lib_info.mli b/duniverse/dune_/src/dune_rules/lib_info.mli index 4a6caf4de..317354dc4 100644 --- a/duniverse/dune_/src/dune_rules/lib_info.mli +++ b/duniverse/dune_/src/dune_rules/lib_info.mli @@ -92,8 +92,10 @@ val archives : 'path t -> 'path list Mode.Dict.t (* TODO: Rename [foreign_archives] to [foreign_lib_files] and [native_archives] to [native_lib_files] for consistent naming with [foreign_dll_files]. *) -(** All the [lib*.a] files for stubs *) -val foreign_archives : 'path t -> 'path list +(** All the [lib*.a] files for stubs. A table indexed by [Mode.Select.t] is used + to account for mode-dependent archives. The special key [Mode.Select.All] is + used for archives that should be built in every modes. *) +val foreign_archives : 'path t -> 'path Mode.Map.Multi.t type 'path native_archives = | Needs_module_info of 'path @@ -146,7 +148,7 @@ val wrapped : _ t -> Wrapped.t Inherited.t option val special_builtin_support : _ t -> Special_builtin_support.t option -val modes : _ t -> Mode.Dict.Set.t +val modes : _ t -> Lib_mode.Map.Set.t val implements : _ t -> (Loc.t * Lib_name.t) option @@ -220,7 +222,7 @@ val create : -> plugins:'a list Mode.Dict.t -> archives:'a list Mode.Dict.t -> ppx_runtime_deps:(Loc.t * Lib_name.t) list - -> foreign_archives:'a list + -> foreign_archives:'a Mode.Map.Multi.t -> native_archives:'a native_archives -> foreign_dll_files:'a list -> jsoo_runtime:'a list @@ -233,7 +235,7 @@ val create : -> entry_modules:Module_name.t list Or_exn.t Source.t -> implements:(Loc.t * Lib_name.t) option -> default_implementation:(Loc.t * Lib_name.t) option - -> modes:Mode.Dict.Set.t + -> modes:Lib_mode.Map.Set.t -> wrapped:Wrapped.t Inherited.t option -> special_builtin_support:Special_builtin_support.t option -> exit_module:Module_name.t option diff --git a/duniverse/dune_/src/dune_rules/lib_mode.ml b/duniverse/dune_/src/dune_rules/lib_mode.ml new file mode 100644 index 000000000..76fc2d154 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/lib_mode.ml @@ -0,0 +1,84 @@ +type t = + | Ocaml of Ocaml.Mode.t + | Melange + +module Cm_kind = struct + type t = + | Ocaml of Ocaml.Cm_kind.t + | Melange of Melange.Cm_kind.t + + let choose ocaml melange = function + | Ocaml k -> ocaml k + | Melange k -> melange k + + let source = choose Ocaml.Cm_kind.source Melange.Cm_kind.source + + let ext = choose Ocaml.Cm_kind.ext Melange.Cm_kind.ext + + let cmi = function + | Ocaml _ -> Ocaml Cmi + | Melange _ -> Melange Cmi + + let to_dyn = + let open Dyn in + function + | Ocaml k -> variant "ocaml" [ Ocaml.Cm_kind.to_dyn k ] + | Melange k -> variant "melange" [ Melange.Cm_kind.to_dyn k ] + + module Map = struct + type 'a t = + { ocaml : 'a Ocaml.Cm_kind.Dict.t + ; melange : 'a Melange.Cm_kind.Map.t + } + + let get t = function + | Ocaml k -> Ocaml.Cm_kind.Dict.get t.ocaml k + | Melange k -> ( + match k with + | Cmi -> t.melange.cmi + | Cmj -> t.melange.cmj) + + let make_all x = + { ocaml = Ocaml.Cm_kind.Dict.make_all x + ; melange = Melange.Cm_kind.Map.make_all x + } + end +end + +let of_cm_kind : Cm_kind.t -> t = function + | Ocaml (Cmi | Cmo) -> Ocaml Byte + | Ocaml Cmx -> Ocaml Native + | Melange (Cmi | Cmj) -> Melange + +module Map = struct + type 'a t = + { ocaml : 'a Ocaml.Mode.Dict.t + ; melange : 'a + } + + let equal f { ocaml; melange } t : bool = + Ocaml.Mode.Dict.equal f ocaml t.ocaml && f melange t.melange + + let to_dyn to_dyn { ocaml; melange } = + let open Dyn in + record + [ ("ocaml", Ocaml.Mode.Dict.to_dyn to_dyn ocaml) + ; ("melange", to_dyn melange) + ] + + let map t ~f = + { ocaml = Ocaml.Mode.Dict.map ~f t.ocaml; melange = f t.melange } + + module Set = struct + type nonrec t = bool t + + let equal = equal Bool.equal + + let to_dyn { ocaml; melange } = + let open Dyn in + record + [ ("ocaml", Ocaml.Mode.Dict.Set.to_dyn ocaml) + ; ("melange", bool melange) + ] + end +end diff --git a/duniverse/dune_/src/dune_rules/lib_mode.mli b/duniverse/dune_/src/dune_rules/lib_mode.mli new file mode 100644 index 000000000..e0bea45b5 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/lib_mode.mli @@ -0,0 +1,51 @@ +type t = + | Ocaml of Ocaml.Mode.t + | Melange + +module Cm_kind : sig + type t = + | Ocaml of Ocaml.Cm_kind.t + | Melange of Melange.Cm_kind.t + + val source : t -> Ocaml.Ml_kind.t + + val ext : t -> string + + val cmi : t -> t + + val to_dyn : t -> Dyn.t + + module Map : sig + type cm_kind := t + + type 'a t = + { ocaml : 'a Ocaml.Cm_kind.Dict.t + ; melange : 'a Melange.Cm_kind.Map.t + } + + val get : 'a t -> cm_kind -> 'a + + val make_all : 'a -> 'a t + end +end + +val of_cm_kind : Cm_kind.t -> t + +module Map : sig + type 'a t = + { ocaml : 'a Ocaml.Mode.Dict.t + ; melange : 'a + } + + val to_dyn : ('a -> Dyn.t) -> 'a t -> Dyn.t + + val map : 'a t -> f:('a -> 'b) -> 'b t + + module Set : sig + type nonrec t = bool t + + val to_dyn : t -> Dyn.t + + val equal : t -> t -> bool + end +end diff --git a/duniverse/dune_/src/dune_rules/lib_rules.ml b/duniverse/dune_/src/dune_rules/lib_rules.ml index 5407cf982..b907b96ec 100644 --- a/duniverse/dune_/src/dune_rules/lib_rules.ml +++ b/duniverse/dune_/src/dune_rules/lib_rules.ml @@ -15,20 +15,37 @@ let msvc_hack_cclibs = (* Build an OCaml library. *) let build_lib (lib : Library.t) ~native_archives ~sctx ~expander ~flags ~dir - ~mode ~cm_files ~scope = + ~mode ~cm_files = let ctx = Super_context.context sctx in Memo.Result.iter (Context.compiler ctx mode) ~f:(fun compiler -> let target = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext mode) in let stubs_flags = - List.concat_map (Library.foreign_archives lib) ~f:(fun archive -> - let lname = - "-l" ^ Foreign.Archive.(name archive |> Name.to_string) - in - let cclib = [ "-cclib"; lname ] in - let dllib = [ "-dllib"; lname ] in - match mode with - | Native -> cclib - | Byte -> dllib @ cclib) + let lib_archive = Library.stubs_archive lib in + let foreign_archives = Library.foreign_archives lib in + let make_args ~stub_mode archive = + let lname = + "-l" + ^ Foreign.Archive.(name ~mode:stub_mode archive |> Name.to_string) + in + let cclib = [ "-cclib"; lname ] in + let dllib = [ "-dllib"; lname ] in + match mode with + | Native -> cclib + | Byte -> dllib @ cclib + in + let stub_mode = + if Buildable.has_mode_dependent_foreign_stubs lib.buildable then + Mode.Select.Only mode + else Mode.Select.All + in + let foreign_archives = + List.concat_map foreign_archives + ~f:(make_args ~stub_mode:Mode.Select.All) + in + match lib_archive with + | Some lib_archive -> + make_args ~stub_mode lib_archive @ foreign_archives + | None -> foreign_archives in let map_cclibs = (* https://github.com/ocaml/dune/issues/119 *) @@ -55,8 +72,7 @@ let build_lib (lib : Library.t) ~native_archives ~sctx ~expander ~flags ~dir Expander.expand_and_eval_set expander lib.library_flags ~standard in let ctypes_cclib_flags = - Ctypes_rules.ctypes_cclib_flags ~scope ~standard ~expander - ~buildable:lib.buildable + Ctypes_rules.ctypes_cclib_flags sctx ~expander ~buildable:lib.buildable in Super_context.add_rule ~dir sctx ~loc:lib.buildable.loc (let open Action_builder.With_targets.O in @@ -85,6 +101,9 @@ let build_lib (lib : Library.t) ~native_archives ~sctx ~expander ~flags ~dir ; Dyn (Action_builder.map ctypes_cclib_flags ~f:(fun x -> Command.quote_args "-cclib" (map_cclibs x))) + ; Deps + (Foreign.Objects.build_paths lib.buildable.extra_objects + ~ext_obj:ctx.lib_config.ext_obj ~dir) ])) let gen_wrapped_compat_modules (lib : Library.t) cctx = @@ -118,11 +137,11 @@ let gen_wrapped_compat_modules (lib : Library.t) cctx = (* Rules for building static and dynamic libraries using [ocamlmklib]. *) let ocamlmklib ~loc ~c_library_flags ~sctx ~dir ~o_files ~archive_name - ~build_targets_together = + ~stubs_mode ~build_targets_together = let ctx = Super_context.context sctx in let { Lib_config.ext_lib; ext_dll; _ } = ctx.lib_config in let static_target = - Foreign.Archive.Name.lib_file archive_name ~dir ~ext_lib + Foreign.Archive.Name.lib_file archive_name ~dir ~ext_lib ~mode:stubs_mode in let cclibs = Action_builder.map c_library_flags ~f:(fun cclibs -> @@ -142,7 +161,9 @@ let ocamlmklib ~loc ~c_library_flags ~sctx ~dir ~o_files ~archive_name [ A "-g" ; (if custom then A "-custom" else Command.Args.empty) ; A "-o" - ; Path (Path.build (Foreign.Archive.Name.path ~dir archive_name)) + ; Path + (Path.build + (Foreign.Archive.Name.path ~dir archive_name ~mode:stubs_mode)) ; Deps o_files (* The [c_library_flags] is needed only for the [dynamic_target] case, but we pass them unconditionally for simplicity. *) @@ -152,7 +173,7 @@ let ocamlmklib ~loc ~c_library_flags ~sctx ~dir ~o_files ~archive_name >>| Action.Full.add_sandbox sandbox) in let dynamic_target = - Foreign.Archive.Name.dll_file archive_name ~dir ~ext_dll + Foreign.Archive.Name.dll_file archive_name ~dir ~ext_dll ~mode:stubs_mode in if build_targets_together then (* Build both the static and dynamic targets in one [ocamlmklib] invocation, @@ -194,9 +215,11 @@ let foreign_rules (library : Foreign.Library.t) ~sctx ~expander ~dir >>| Foreign_sources.for_archive ~archive_name in let* o_files = - Foreign_rules.build_o_files ~sctx ~dir ~expander - ~requires:(Resolve.return []) ~dir_contents ~foreign_sources - |> Memo.parallel_map ~f:(Memo.map ~f:Path.build) + let+ o_files_by_mode = + Foreign_rules.build_o_files ~sctx ~dir ~expander + ~requires:(Resolve.return []) ~dir_contents ~foreign_sources + in + Mode.Map.Multi.for_all_modes o_files_by_mode in let* () = Check_rules.add_files sctx ~dir o_files in let* standard = @@ -215,7 +238,7 @@ let foreign_rules (library : Foreign.Library.t) ~sctx ~expander ~dir ~standard in ocamlmklib ~archive_name ~loc:library.stubs.loc ~c_library_flags ~sctx ~dir - ~o_files ~build_targets_together:false + ~o_files ~build_targets_together:false ~stubs_mode:Mode.Select.All (* Build a required set of archives for an OCaml library. *) let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents @@ -226,21 +249,28 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents let name = Library.best_name lib in Foreign_sources.for_lib foreign_sources ~name in - let* lib_o_files = - Foreign_rules.build_o_files ~sctx ~dir ~expander ~requires ~dir_contents - ~foreign_sources - |> Memo.parallel_map ~f:(Memo.map ~f:Path.build) + let* o_files = + let lib_foreign_o_files = + let { Lib_config.ext_obj; _ } = (Super_context.context sctx).lib_config in + Foreign.Objects.build_paths lib.buildable.extra_objects ~ext_obj ~dir + in + let+ tbl = + Foreign_rules.build_o_files ~sctx ~dir ~expander ~requires ~dir_contents + ~foreign_sources + in + Mode.Map.Multi.add_all tbl Mode.Select.All lib_foreign_o_files in - let* () = Check_rules.add_files sctx ~dir lib_o_files in - match vlib_stubs_o_files @ lib_o_files with - | [] -> Memo.return () - | o_files -> + let all_o_files = Mode.Map.Multi.to_flat_list o_files in + let* () = Check_rules.add_files sctx ~dir all_o_files in + if List.for_all ~f:List.is_empty [ all_o_files; vlib_stubs_o_files ] then + Memo.return () + else let ctx = Super_context.context sctx in let lib_name = Lib_name.Local.to_string (snd lib.name) in let archive_name = Foreign.Archive.Name.stubs lib_name in let modes = Compilation_context.modes cctx in let build_targets_together = - modes.native && modes.byte + modes.ocaml.native && modes.ocaml.byte && Dynlink_supported.get lib.dynlink ctx.supports_shared_libraries in let* standard = @@ -253,8 +283,33 @@ let build_stubs lib ~cctx ~dir ~expander ~requires ~dir_contents let c_library_flags = Expander.expand_and_eval_set expander lib.c_library_flags ~standard in - ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~dir ~o_files - ~c_library_flags ~build_targets_together + let lib_o_files_for_all_modes = Mode.Map.Multi.for_all_modes o_files in + let for_all_modes = + List.rev_append vlib_stubs_o_files lib_o_files_for_all_modes + in + if + Mode.Dict.Set.to_list modes.ocaml + |> List.for_all ~f:(fun mode -> + List.is_empty + @@ Mode.Map.Multi.for_only ~and_all:false o_files mode) + then + (* if stubs are not mode dependent *) + let o_files = for_all_modes in + ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~dir ~o_files + ~c_library_flags ~build_targets_together ~stubs_mode:Mode.Select.All + else + let modes = + Mode.Dict.Set.to_list modes.ocaml + |> List.map ~f:(fun mode -> + let o_files_for_mode = + Mode.Map.Multi.for_only ~and_all:false o_files mode + in + ( List.rev_append for_all_modes o_files_for_mode + , Mode.Select.Only mode )) + in + Memo.parallel_iter modes ~f:(fun (o_files, stubs_mode) -> + ocamlmklib ~archive_name ~loc:lib.buildable.loc ~sctx ~dir ~o_files + ~c_library_flags ~build_targets_together ~stubs_mode) let build_shared lib ~native_archives ~sctx ~dir ~flags = let ctx = Super_context.context sctx in @@ -279,6 +334,9 @@ let build_shared lib ~native_archives ~sctx ~dir ~flags = Action_builder.with_no_targets (Action_builder.paths (Library.foreign_lib_files lib ~dir ~ext_lib + ~for_mode:(Mode.Select.Only Byte) + @ Library.foreign_lib_files lib ~dir ~ext_lib + ~for_mode:Mode.Select.All |> List.map ~f:Path.build)) >>> Command.run ~dir:(Path.build ctx.build_dir) (Ok ocamlopt) [ Command.Args.dyn (Ocaml_flags.get flags Native) @@ -300,7 +358,7 @@ let build_shared lib ~native_archives ~sctx ~dir ~flags = Super_context.add_rule sctx build ~dir ~loc:lib.buildable.loc) let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx - ~expander ~scope = + ~expander ~lib_info = let obj_dir = Compilation_context.obj_dir cctx in let dir = Compilation_context.dir cctx in let flags = Compilation_context.flags cctx in @@ -323,7 +381,8 @@ let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx ] |> Memo.parallel_iter ~f:(fun (kind, ext) -> let src = - Path.build (Obj_dir.Module.obj_file obj_dir m ~kind ~ext) + Path.build + (Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml kind) ~ext) in let obj_name = Module.obj_name m in let fname = @@ -340,9 +399,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx [Obj_dir]. That's fragile and will break if the layout of the object directory changes *) let dir = Obj_dir.dir obj_dir in - let* native_archives = - let lib_config = ctx.lib_config in - let+ lib_info = Library.to_lib_info lib ~dir ~lib_config in + let native_archives = Lib_info.eval_native_archives_exn lib_info ~modules:(Some modules) in let cm_files = @@ -357,12 +414,12 @@ let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx ~top_sorted_modules () in let* () = - Mode.Dict.Set.iter_concurrently modes ~f:(fun mode -> - build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~scope + Mode.Dict.Set.iter_concurrently modes.ocaml ~f:(fun mode -> + build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~cm_files) and* () = (* Build *.cma.js *) - Memo.when_ modes.byte (fun () -> + Memo.when_ modes.ocaml.byte (fun () -> let action_with_targets = let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) @@ -378,7 +435,7 @@ let setup_build_archives (lib : Dune_file.Library.t) ~top_sorted_modules ~cctx >>= Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc) in Memo.when_ - (Dynlink_supported.By_the_os.get natdynlink_supported && modes.native) + (Dynlink_supported.By_the_os.get natdynlink_supported && modes.ocaml.native) (fun () -> build_shared ~native_archives ~sctx lib ~dir ~flags) let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope @@ -388,17 +445,16 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope let obj_dir = Library.obj_dir ~dir lib in let ctx = Super_context.context sctx in let* modules, pp = - Buildable_rules.modules_rules sctx lib.buildable expander ~dir scope - source_modules - ~lib_name:(Some (snd lib.name)) - ~empty_intf_modules:`Lib + Buildable_rules.modules_rules sctx + (Library (lib.buildable, snd lib.name)) + expander ~dir scope source_modules in let modules = Vimpl.impl_modules vimpl modules in let requires_compile = Lib.Compile.direct_requires compile_info in let requires_link = Lib.Compile.requires_link compile_info in let modes = let { Lib_config.has_native; _ } = ctx.lib_config in - Dune_file.Mode_conf.Set.eval_detailed lib.modes ~has_native + Dune_file.Mode_conf.Lib.Set.eval_detailed lib.modes ~has_native in let package = Dune_file.Library.package lib in let js_of_ocaml = @@ -436,12 +492,16 @@ let library_rules (lib : Library.t) ~local_lib ~cctx ~source_modules let* () = Check_rules.add_cycle_check sctx ~dir top_sorted_modules in let* () = gen_wrapped_compat_modules lib cctx and* () = Module_compilation.build_all cctx - and* expander = Super_context.expander sctx ~dir in + and* expander = Super_context.expander sctx ~dir + and* lib_info = + let lib_config = (Super_context.context sctx).lib_config in + Library.to_lib_info lib ~dir ~lib_config + in let+ () = Memo.when_ (not (Library.is_virtual lib)) (fun () -> - setup_build_archives lib ~top_sorted_modules ~cctx ~expander ~scope) + setup_build_archives lib ~lib_info ~top_sorted_modules ~cctx ~expander) and+ () = let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in Memo.when_ @@ -470,6 +530,7 @@ let library_rules (lib : Library.t) ~local_lib ~cctx ~source_modules ~preprocess ~libname:(snd lib.name) ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) ~ident:(Lib.Compile.merlin_ident compile_info) + ~modes:(`Lib (Lib_info.modes lib_info)) () ) let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope = diff --git a/duniverse/dune_/src/dune_rules/link_time_code_gen.ml b/duniverse/dune_/src/dune_rules/link_time_code_gen.ml index 2b1022710..a9159dc94 100644 --- a/duniverse/dune_/src/dune_rules/link_time_code_gen.ml +++ b/duniverse/dune_/src/dune_rules/link_time_code_gen.ml @@ -1,6 +1,5 @@ open Import module CC = Compilation_context -module SC = Super_context type t = { to_link : Lib_flags.Lib_and_module.L.t @@ -32,7 +31,7 @@ let generate_and_compile_module cctx ~precompiled_cmi ~name ~lib ~code ~requires in let open Memo.O in let* () = - SC.add_rule ~dir sctx + Super_context.add_rule ~dir sctx (let ml = Module.file module_ ~ml_kind:Impl |> Option.value_exn |> Path.as_in_build_dir_exn @@ -151,6 +150,8 @@ let build_info_code cctx ~libs ~api_version = ((Lib.name lib, v) :: libs, placeholders)) in let libs = List.rev libs in + let context = CC.context cctx in + let ocaml_version = Ocaml.Version.of_ocaml_config context.ocaml_config in let buf = Buffer.create 1024 in (* Parse the replacement format described in [artifact_substitution.ml]. *) pr buf @@ -168,7 +169,11 @@ let build_info_code cctx ~libs ~api_version = None [@@inline never] |ocaml}; - let fmt_eval : _ format6 = "let %s = eval %S" in + let fmt_eval : _ format6 = + if Ocaml.Version.has_sys_opaque_identity ocaml_version then + "let %s = eval (Sys.opaque_identity %S)" + else "let %s = eval %S" + in Path.Source.Map.iteri placeholders ~f:(fun path var -> pr buf fmt_eval var (Artifact_substitution.encode ~min_len:64 (Vcs_describe path))); diff --git a/duniverse/dune_/src/dune_rules/mdx.ml b/duniverse/dune_/src/dune_rules/mdx.ml index 953ff68d2..53571817f 100644 --- a/duniverse/dune_/src/dune_rules/mdx.ml +++ b/duniverse/dune_/src/dune_rules/mdx.ml @@ -355,11 +355,13 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~expander ~mdx_prog = | _ -> Resolve.Memo.return None) in let mode = Context.best_mode (Super_context.context sctx) in - let libs_include_paths = Lib_flags.L.include_paths libs_to_include mode in + let libs_include_paths = + Lib_flags.L.include_paths libs_to_include (Ocaml mode) + in let open Command.Args in let args = - Path.Set.to_list libs_include_paths - |> List.map ~f:(fun p -> S [ A "--directory"; Path p ]) + Path.Set.to_list_map libs_include_paths ~f:(fun p -> + S [ A "--directory"; Path p ]) in S args in diff --git a/duniverse/dune_/src/dune_rules/melange.ml b/duniverse/dune_/src/dune_rules/melange.ml new file mode 100644 index 000000000..9b711d358 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange.ml @@ -0,0 +1,50 @@ +open Import +open Dune_lang.Decoder + +let syntax = + Dune_lang.Syntax.create ~name:"melange" ~desc:"support for Melange compiler" + [ ((0, 1), `Since (3, 6)) ] + +let extension_key = + Dune_project.Extension.register syntax (return ((), [])) Unit.to_dyn + +let js_ext = ".js" + +module Module_system = struct + type t = + | Es6 + | CommonJs + + let to_string = function + | Es6 -> "es6" + | CommonJs -> "commonjs" +end + +module Cm_kind = struct + type t = + | Cmi + | Cmj + + let source = function + | Cmi -> Ocaml.Ml_kind.Intf + | Cmj -> Impl + + let ext = function + | Cmi -> ".cmi" + | Cmj -> ".cmj" + + let to_dyn = + let open Dyn in + function + | Cmi -> variant "cmi" [] + | Cmj -> variant "cmj" [] + + module Map = struct + type 'a t = + { cmi : 'a + ; cmj : 'a + } + + let make_all x = { cmi = x; cmj = x } + end +end diff --git a/duniverse/dune_/src/dune_rules/melange.mli b/duniverse/dune_/src/dune_rules/melange.mli new file mode 100644 index 000000000..751550e7d --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange.mli @@ -0,0 +1,36 @@ +open! Import + +val syntax : Dune_lang.Syntax.t + +val extension_key : unit Dune_engine.Dune_project.Extension.t + +val js_ext : string + +module Module_system : sig + type t = + | Es6 + | CommonJs + + val to_string : t -> string +end + +module Cm_kind : sig + type t = + | Cmi + | Cmj + + val source : t -> Ocaml.Ml_kind.t + + val ext : t -> string + + val to_dyn : t -> Dyn.t + + module Map : sig + type 'a t = + { cmi : 'a + ; cmj : 'a + } + + val make_all : 'a -> 'a t + end +end diff --git a/duniverse/dune_/src/dune_rules/melange_binary.ml b/duniverse/dune_/src/dune_rules/melange_binary.ml new file mode 100644 index 000000000..df0214947 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_binary.ml @@ -0,0 +1,32 @@ +open Import + +let melc sctx ~dir = + (* TODO loc should come from the mode field in the dune file *) + Super_context.resolve_program sctx ~loc:None ~dir ~hint:"opam install melange" + "melc" + +let where = + let impl bin = + let open Memo.O in + let* _ = Build_system.build_file bin in + let+ where = + Memo.of_reproducible_fiber + @@ Process.run_capture_line Process.Strict bin [ "--where" ] + in + Path.of_string where + in + let memo = + Memo.create "melange-where" ~input:(module Path) ~cutoff:Path.equal impl + in + fun sctx ~dir -> + let open Memo.O in + let* env = Super_context.env_node sctx ~dir >>= Env_node.external_env in + match Env.get env "MELANGELIB" with + | Some p -> Memo.return (Some (Path.of_string p)) + | None -> ( + let* melc = melc sctx ~dir in + match melc with + | Error _ -> Memo.return None + | Ok melc -> + let+ res = Memo.exec memo melc in + Some res) diff --git a/duniverse/dune_/src/dune_rules/melange_binary.mli b/duniverse/dune_/src/dune_rules/melange_binary.mli new file mode 100644 index 000000000..fd5533d3e --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_binary.mli @@ -0,0 +1,5 @@ +open Import + +val melc : Super_context.t -> dir:Path.Build.t -> Action.Prog.t Memo.t + +val where : Super_context.t -> dir:Path.Build.t -> Path.t option Memo.t diff --git a/duniverse/dune_/src/dune_rules/melange_rules.ml b/duniverse/dune_/src/dune_rules/melange_rules.ml new file mode 100644 index 000000000..ae2982d51 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_rules.ml @@ -0,0 +1,224 @@ +open Import +module CC = Compilation_context + +let lib_output_dir ~target_dir ~lib_dir = + Path.Build.append_source target_dir + (Path.Build.drop_build_context_exn lib_dir) + +let make_js_name ~dst_dir m = + let name = + Module_name.Unique.artifact_filename (Module.obj_name m) ~ext:Melange.js_ext + in + Path.Build.relative dst_dir name + +let js_includes ~sctx ~target_dir ~requires_link ~scope = + let open Resolve.Memo.O in + Command.Args.memo + (Resolve.Memo.args + (let* (libs : Lib.t list) = requires_link in + let project = Scope.project scope in + let deps_of_lib (lib : Lib.t) = + let lib_name = Lib.name lib in + let lib = Lib.Local.of_lib_exn lib in + let info = Lib.Local.info lib in + let lib_dir = Lib_info.src_dir info in + let dst_dir = lib_output_dir ~target_dir ~lib_dir in + let open Memo.O in + let modules_group = + Dir_contents.get sctx ~dir:lib_dir + >>= Dir_contents.ocaml + >>| Ml_sources.modules ~for_:(Library lib_name) + in + let* source_modules = modules_group >>| Modules.impl_only in + let of_module m = + let output = make_js_name ~dst_dir m in + Dep.file (Path.build output) + in + Resolve.Memo.return + (List.map source_modules ~f:of_module |> Dep.Set.of_list) + in + let* hidden_libs = Resolve.Memo.List.map libs ~f:deps_of_lib in + let hidden_deps = Dep.Set.union_all hidden_libs in + Resolve.Memo.return + (Command.Args.S + [ Lib_flags.L.include_flags ~project libs Melange + ; Hidden_deps hidden_deps + ]))) + +let build_js ~loc ~dir ~pkg_name ~module_system ~dst_dir ~obj_dir ~sctx + ~lib_deps_js_includes m = + let cm_kind = Lib_mode.Cm_kind.Melange Cmj in + let open Memo.O in + let* compiler = Melange_binary.melc sctx ~dir in + let src = Obj_dir.Module.cm_file_exn obj_dir m ~kind:cm_kind in + let output = make_js_name ~dst_dir m in + let obj_dir = + [ Command.Args.A "-I"; Path (Path.build (Obj_dir.melange_dir obj_dir)) ] + in + let melange_package_args = + let pkg_name_args = + match pkg_name with + | None -> [] + | Some pkg_name -> + [ "--bs-package-name"; Package.Name.to_string pkg_name ] + in + + let js_modules_str = Melange.Module_system.to_string module_system in + "--bs-module-type" :: js_modules_str :: pkg_name_args + in + let lib_deps_js_includes = Command.Args.as_any lib_deps_js_includes in + Super_context.add_rule sctx ~dir ?loc + (Command.run + ~dir:(Path.build (Super_context.context sctx).build_dir) + compiler + [ Command.Args.S obj_dir + ; lib_deps_js_includes + ; As melange_package_args + ; A "-o" + ; Target output + ; Dep (Path.build src) + ]) + +let add_rules_for_entries ~sctx ~dir ~expander ~dir_contents ~scope + ~compile_info ~target_dir (mel : Melange_stanzas.Emit.t) = + let open Memo.O in + (* Use "mobjs" rather than "objs" to avoid a potential conflict with a library + of the same name *) + let* modules, obj_dir = + Dir_contents.ocaml dir_contents + >>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target }) + in + let* () = Check_rules.add_obj_dir sctx ~obj_dir in + let* flags = Super_context.ocaml_flags sctx ~dir mel.flags in + let requires_link = Lib.Compile.requires_link compile_info in + let direct_requires = Lib.Compile.direct_requires compile_info in + let* modules, pp = + Buildable_rules.modules_rules sctx + (Melange + { preprocess = mel.preprocess + ; preprocessor_deps = mel.preprocessor_deps + ; (* TODO still needed *) + lint = Preprocess.Per_module.default () + ; (* why is this always false? *) + empty_module_interface_if_absent = false + }) + expander ~dir scope modules + in + let* cctx = + let js_of_ocaml = None in + Compilation_context.create () ~loc:mel.loc ~super_context:sctx ~expander + ~scope ~obj_dir ~modules ~flags ~requires_link + ~requires_compile:direct_requires ~preprocessing:pp ~js_of_ocaml + ~opaque:Inherit_from_settings ~package:mel.package + ~modes: + { ocaml = { byte = None; native = None } + ; melange = Some (Requested Loc.none) + } + in + let pkg_name = Option.map mel.package ~f:Package.name in + let loc = mel.loc in + let requires_link = Memo.Lazy.force requires_link in + let lib_deps_js_includes = + js_includes ~sctx ~target_dir ~requires_link ~scope + in + let* () = Module_compilation.build_all cctx in + let module_list = + Modules.fold_no_vlib modules ~init:[] ~f:(fun x acc -> x :: acc) + in + let dst_dir = + Path.Build.append_source target_dir (Path.Build.drop_build_context_exn dir) + in + let* () = + Memo.parallel_iter module_list ~f:(fun m -> + (* Should we check module kind? *) + build_js ~dir ~loc:(Some loc) ~pkg_name ~module_system:mel.module_system + ~dst_dir ~obj_dir ~sctx ~lib_deps_js_includes m) + in + let* () = + match mel.alias with + | None -> Memo.return () + | Some alias_name -> + let alias = Alias.make alias_name ~dir in + let deps = + List.rev_map module_list ~f:(fun m -> + make_js_name ~dst_dir m |> Path.build) + |> Action_builder.paths + in + Rules.Produce.Alias.add_deps alias deps + in + let* requires_compile = Compilation_context.requires_compile cctx in + let* preprocess = + Resolve.Memo.read_memo + (Preprocess.Per_module.with_instrumentation mel.preprocess + ~instrumentation_backend: + (Lib.DB.instrumentation_backend (Scope.libs scope))) + in + let stdlib_dir = (Super_context.context sctx).stdlib_dir in + Memo.return + ( cctx + , Merlin.make ~requires:requires_compile ~stdlib_dir ~flags ~modules + ~preprocess ~obj_dir + ~dialects:(Dune_project.dialects (Scope.project scope)) + ~ident:(Lib.Compile.merlin_ident compile_info) + ~modes:`Melange_emit () ) + +let add_rules_for_libraries ~dir ~scope ~target_dir ~sctx ~requires_link + (mel : Melange_stanzas.Emit.t) = + Memo.parallel_iter requires_link ~f:(fun lib -> + let open Memo.O in + let lib_name = Lib.name lib in + let* lib, lib_compile_info = + Lib.DB.get_compile_info (Scope.libs scope) lib_name + in + let lib = Lib.Local.of_lib_exn lib in + let info = Lib.Local.info lib in + let lib_dir = Lib_info.src_dir info in + let obj_dir = Lib_info.obj_dir info in + let dst_dir = lib_output_dir ~target_dir ~lib_dir in + let modules_group = + Dir_contents.get sctx ~dir:lib_dir + >>= Dir_contents.ocaml + >>| Ml_sources.modules ~for_:(Library lib_name) + in + let* source_modules = modules_group >>| Modules.impl_only in + let pkg_name = Lib_info.package info in + let requires_link = + Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) + in + let lib_deps_js_includes = + js_includes ~sctx ~target_dir ~requires_link ~scope + in + Memo.parallel_iter source_modules + ~f: + (build_js ~loc:None ~dir ~pkg_name ~module_system:mel.module_system + ~dst_dir ~obj_dir ~sctx ~lib_deps_js_includes)) + +let compile_info ~scope (mel : Melange_stanzas.Emit.t) = + let open Memo.O in + let dune_version = Scope.project scope |> Dune_project.dune_version in + let+ pps = + Resolve.Memo.read_memo + (Preprocess.Per_module.with_instrumentation mel.preprocess + ~instrumentation_backend: + (Lib.DB.instrumentation_backend (Scope.libs scope))) + >>| Preprocess.Per_module.pps + in + Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope) + [ (mel.loc, mel.target) ] + mel.libraries ~pps ~dune_version + +let emit_rules ~dir_contents ~dir ~scope ~sctx ~expander mel = + let open Memo.O in + let* compile_info = compile_info ~scope mel in + let target_dir = Path.Build.relative dir mel.target in + let+ cctx_and_merlin = + add_rules_for_entries ~sctx ~dir ~expander ~dir_contents ~scope + ~compile_info ~target_dir mel + and+ () = + let* requires_link = + Memo.Lazy.force (Lib.Compile.requires_link compile_info) + in + let* requires_link = Resolve.read_memo requires_link in + add_rules_for_libraries ~dir ~scope ~target_dir ~sctx ~requires_link mel + in + cctx_and_merlin diff --git a/duniverse/dune_/src/dune_rules/melange_rules.mli b/duniverse/dune_/src/dune_rules/melange_rules.mli new file mode 100644 index 000000000..220683197 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_rules.mli @@ -0,0 +1,10 @@ +open Import + +val emit_rules : + dir_contents:Dir_contents.t + -> dir:Path.Build.t + -> scope:Scope.t + -> sctx:Super_context.t + -> expander:Expander.t + -> Melange_stanzas.Emit.t + -> (Compilation_context.t * Merlin.t) Memo.t diff --git a/duniverse/dune_/src/dune_rules/melange_stanzas.ml b/duniverse/dune_/src/dune_rules/melange_stanzas.ml new file mode 100644 index 000000000..2c8f16cfa --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_stanzas.ml @@ -0,0 +1,105 @@ +open Import +open Dune_lang.Decoder + +module Emit = struct + type t = + { loc : Loc.t + ; target : string + ; alias : Alias.Name.t option + ; module_system : Melange.Module_system.t + ; entries : Ordered_set_lang.t + ; libraries : Lib_dep.t list + ; package : Package.t option + ; preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t + ; preprocessor_deps : Dep_conf.t list + ; flags : Ocaml_flags.Spec.t + ; root_module : (Loc.t * Module_name.t) option + } + + let decode_lib = + let+ loc = loc + and+ t = + let allow_re_export = false in + repeat (Lib_dep.decode ~allow_re_export) + in + let add kind name acc = + match Lib_name.Map.find acc name with + | None -> Lib_name.Map.set acc name kind + | Some _present -> + User_error.raise ~loc + [ Pp.textf "library %S is present twice" (Lib_name.to_string name) ] + in + ignore + (List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> + match x with + | Lib_dep.Direct (_, s) -> add true s acc + | Lib_dep.Re_export (_, name) -> + User_error.raise ~loc + [ Pp.textf + "library %S is using re_export, which is not supported for \ + melange libraries" + (Lib_name.to_string name) + ] + | Select _ -> + User_error.raise ~loc + [ Pp.textf "select is not supported for melange libraries" ]) + : bool Lib_name.Map.t); + t + + let decode = + fields + (let+ loc = loc + and+ target = + let of_string ~loc s = + match String.is_empty s with + | true -> + User_error.raise ~loc + [ Pp.textf "The field target can not be empty" ] + | false -> ( + match Filename.dirname s with + | "." -> s + | _ -> + User_error.raise ~loc + [ Pp.textf + "The field target must use simple names and can not \ + include paths to other folders. To emit JavaScript files \ + in another folder, move the `melange.emit` stanza to \ + that folder" + ]) + in + field "target" (plain_string (fun ~loc s -> of_string ~loc s)) + and+ alias = field_o "alias" Alias.Name.decode + and+ module_system = + field "module_system" + (enum [ ("es6", Melange.Module_system.Es6); ("commonjs", CommonJs) ]) + and+ entries = Stanza_common.modules_field "entries" + and+ libraries = field "libraries" decode_lib ~default:[] + and+ package = field_o "package" Stanza_common.Pkg.decode + and+ preprocess, preprocessor_deps = Stanza_common.preprocess_fields + and+ loc_instrumentation, instrumentation = Stanza_common.instrumentation + and+ flags = Ocaml_flags.Spec.decode + and+ root_module = field_o "root_module" Module_name.decode_loc in + let preprocess = + let init = + let f libname = Preprocess.With_instrumentation.Ordinary libname in + Module_name.Per_item.map preprocess ~f:(Preprocess.map ~f) + in + List.fold_left instrumentation + ~f:(fun accu ((backend, flags), deps) -> + Preprocess.Per_module.add_instrumentation accu + ~loc:loc_instrumentation ~flags ~deps backend) + ~init + in + { loc + ; target + ; alias + ; module_system + ; entries + ; libraries + ; package + ; preprocess + ; preprocessor_deps + ; flags + ; root_module + }) +end diff --git a/duniverse/dune_/src/dune_rules/melange_stanzas.mli b/duniverse/dune_/src/dune_rules/melange_stanzas.mli new file mode 100644 index 000000000..bb8c0fe1e --- /dev/null +++ b/duniverse/dune_/src/dune_rules/melange_stanzas.mli @@ -0,0 +1,20 @@ +open Import + +(** Stanza to produce JavaScript targets from Melange libraries *) +module Emit : sig + type t = + { loc : Loc.t + ; target : string + ; alias : Alias.Name.t option + ; module_system : Melange.Module_system.t + ; entries : Ordered_set_lang.t + ; libraries : Lib_dep.t list + ; package : Package.t option + ; preprocess : Preprocess.With_instrumentation.t Preprocess.Per_module.t + ; preprocessor_deps : Dep_conf.t list + ; flags : Ocaml_flags.Spec.t + ; root_module : (Loc.t * Module_name.t) option + } + + val decode : t Dune_lang.Decoder.t +end diff --git a/duniverse/dune_/src/dune_rules/menhir_rules.ml b/duniverse/dune_/src/dune_rules/menhir_rules.ml index 90f5decf1..b90c5fa6a 100644 --- a/duniverse/dune_/src/dune_rules/menhir_rules.ml +++ b/duniverse/dune_/src/dune_rules/menhir_rules.ml @@ -1,6 +1,5 @@ open Import open! Action_builder.O -module SC = Super_context (* This module interprets [(menhir ...)] stanzas -- that is, it provides build rules for Menhir parsers. *) @@ -24,7 +23,7 @@ module SC = Super_context (* This signature describes the input of the functor [Run], which follows. *) -type stanza = Dune_file.Menhir.t +type stanza = Menhir_stanza.t module type PARAMS = sig (* [cctx] is the compilation context. *) @@ -59,6 +58,12 @@ module Run (P : PARAMS) = struct let expander = Compilation_context.expander cctx + let sandbox = + let scope = Compilation_context.scope cctx in + let project = Scope.project scope in + if Dune_project.dune_version project < (3, 5) then Sandbox_config.default + else Sandbox_config.needs_sandboxing + (* ------------------------------------------------------------------------ *) (* Naming conventions. *) @@ -94,7 +99,8 @@ module Run (P : PARAMS) = struct (* Rule generation. *) let menhir_binary = - SC.resolve_program sctx ~dir "menhir" ~loc:None ~hint:"opam install menhir" + Super_context.resolve_program sctx ~dir "menhir" ~loc:None + ~hint:"opam install menhir" (* Reminder (from command.mli): @@ -109,11 +115,11 @@ module Run (P : PARAMS) = struct let menhir (args : 'a args) : Action.Full.t Action_builder.With_targets.t Memo.t = Memo.map menhir_binary ~f:(fun prog -> - Command.run ~dir:(Path.build build_dir) prog args) + Command.run ~sandbox ~dir:(Path.build build_dir) prog args) let rule ?(mode = stanza.mode) : Action.Full.t Action_builder.With_targets.t -> unit Memo.t = - SC.add_rule sctx ~dir ~mode ~loc:stanza.loc + Super_context.add_rule sctx ~dir ~mode ~loc:stanza.loc let expand_flags flags = Super_context.menhir_flags sctx ~dir ~expander ~flags @@ -274,8 +280,8 @@ end (* The final glue. *) -let module_names (stanza : Dune_file.Menhir.t) : Module_name.t list = - List.map (Dune_file.Menhir.modules stanza) ~f:(fun s -> +let module_names (stanza : Menhir_stanza.t) : Module_name.t list = + List.map (Menhir_stanza.modules stanza) ~f:(fun s -> (* TODO the loc can improved here *) Module_name.of_string_allow_invalid (stanza.loc, s)) diff --git a/duniverse/dune_/src/dune_rules/menhir_rules.mli b/duniverse/dune_/src/dune_rules/menhir_rules.mli index 5cd2f5b51..803982709 100644 --- a/duniverse/dune_/src/dune_rules/menhir_rules.mli +++ b/duniverse/dune_/src/dune_rules/menhir_rules.mli @@ -3,8 +3,8 @@ open Import (** Return the list of modules that are generated by this stanza. *) -val module_names : Dune_file.Menhir.t -> Module_name.t list +val module_names : Menhir_stanza.t -> Module_name.t list (** Generate the rules for a [(menhir ...)] stanza. *) val gen_rules : - dir:Path.Build.t -> Compilation_context.t -> Dune_file.Menhir.t -> unit Memo.t + dir:Path.Build.t -> Compilation_context.t -> Menhir_stanza.t -> unit Memo.t diff --git a/duniverse/dune_/src/dune_rules/menhir_stanza.ml b/duniverse/dune_/src/dune_rules/menhir_stanza.ml index a7b8a9241..c42d0709e 100644 --- a/duniverse/dune_/src/dune_rules/menhir_stanza.ml +++ b/duniverse/dune_/src/dune_rules/menhir_stanza.ml @@ -1,3 +1,5 @@ +open Import + let syntax = Dune_lang.Syntax.create ~name:"menhir" ~desc:"the menhir extension" [ ((1, 0), `Since (1, 0)) @@ -5,3 +7,49 @@ let syntax = ; ((2, 0), `Since (1, 4)) ; ((2, 1), `Since (2, 2)) ] + +open Dune_lang.Decoder + +type t = + { merge_into : string option + ; flags : Ordered_set_lang.Unexpanded.t + ; modules : string list + ; mode : Rule.Mode.t + ; loc : Loc.t + ; infer : bool + ; enabled_if : Blang.t + } + +let decode = + fields + (let+ merge_into = field_o "merge_into" string + and+ flags = Ordered_set_lang.Unexpanded.field "flags" + and+ modules = field "modules" (repeat string) + and+ mode = Rule_mode_decoder.field + and+ infer = + field_o_b "infer" ~check:(Dune_lang.Syntax.since syntax (2, 0)) + and+ menhir_syntax = Dune_lang.Syntax.get_exn syntax + and+ enabled_if = + Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () + and+ loc = loc in + let infer = + match infer with + | Some infer -> infer + | None -> menhir_syntax >= (2, 0) + in + { merge_into; flags; modules; mode; loc; infer; enabled_if }) + +type Stanza.t += T of t + +let () = + Dune_project.Extension.register_simple syntax + (return [ ("menhir", decode >>| fun x -> [ T x ]) ]) + +let modules (stanza : t) : string list = + match stanza.merge_into with + | Some m -> [ m ] + | None -> stanza.modules + +let targets (stanza : t) : string list = + let f m = [ m ^ ".ml"; m ^ ".mli" ] in + List.concat_map (modules stanza) ~f diff --git a/duniverse/dune_/src/dune_rules/menhir_stanza.mli b/duniverse/dune_/src/dune_rules/menhir_stanza.mli new file mode 100644 index 000000000..5fc87b2ff --- /dev/null +++ b/duniverse/dune_/src/dune_rules/menhir_stanza.mli @@ -0,0 +1,22 @@ +open Import + +val syntax : Syntax.t + +type t = + { merge_into : string option + ; flags : Ordered_set_lang.Unexpanded.t + ; modules : string list + ; mode : Rule.Mode.t + ; loc : Loc.t + ; infer : bool + ; enabled_if : Blang.t + } + +val modules : t -> string list + +(** Return the list of targets that are generated by this stanza. This list of + targets is used by the code that computes the list of modules in the + directory. *) +val targets : t -> string list + +type Stanza.t += T of t diff --git a/duniverse/dune_/src/dune_rules/merlin.ml b/duniverse/dune_/src/dune_rules/merlin.ml index 8039b1b1d..a52049961 100644 --- a/duniverse/dune_/src/dune_rules/merlin.ml +++ b/duniverse/dune_/src/dune_rules/merlin.ml @@ -7,14 +7,28 @@ module Processed = struct one represents a list of preprocessors described by a preprocessing flag and its arguments. *) + module Pp_kind = struct + type t = + | Pp + | Ppx + + let to_flag = function + | Pp -> "-pp" + | Ppx -> "-ppx" + end + type pp_flag = - { flag : string + { flag : Pp_kind.t ; args : string } - (* Most of the configuration is shared accros a same lib/exe... *) + let pp_kind x = x.flag + + let pp_args x = x.args + + (* Most of the configuration is shared across a same lib/exe... *) type config = - { stdlib_dir : Path.t + { stdlib_dir : Path.t option ; obj_dirs : Path.Set.t ; src_dirs : Path.Set.t ; flags : string list @@ -33,7 +47,7 @@ module Processed = struct let name = "merlin-conf" - let version = 2 + let version = 3 let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead" end @@ -59,7 +73,11 @@ module Processed = struct let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) in - let stdlib_dir = [ make_directive_of_path "STDLIB" stdlib_dir ] in + let stdlib_dir = + match stdlib_dir with + | None -> [] + | Some stdlib_dir -> [ make_directive_of_path "STDLIB" stdlib_dir ] + in let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in let obj_dirs = Path.Set.to_list_map obj_dirs ~f:(make_directive_of_path "B") @@ -79,7 +97,9 @@ module Processed = struct match pp with | None -> flags | Some { flag; args } -> - make_directive "FLG" (Sexp.List [ Atom flag; Atom args ]) :: flags + make_directive "FLG" + (Sexp.List [ Atom (Pp_kind.to_flag flag); Atom args ]) + :: flags in let suffixes = List.map extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> @@ -106,7 +126,8 @@ module Processed = struct let print = Buffer.add_string b in Buffer.clear b; print "EXCLUDE_QUERY_DIR\n"; - printf "STDLIB %s\n" (serialize_path stdlib_dir); + Option.iter stdlib_dir ~f:(fun stdlib_dir -> + printf "STDLIB %s\n" (serialize_path stdlib_dir)); Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); List.iter extensions ~f:(fun { Ml_kind.Dict.impl; intf } -> @@ -116,7 +137,8 @@ module Processed = struct ~f: (Module_name.Per_item.fold ~init:() ~f:(fun pp () -> Option.iter pp ~f:(fun { flag; args } -> - printf "# FLG %s\n" (flag ^ " " ^ quote_for_dot_merlin args)))); + printf "# FLG %s\n" + (Pp_kind.to_flag flag ^ " " ^ quote_for_dot_merlin args)))); List.iter flags ~f:(fun flags -> match flags with | [] -> () @@ -190,8 +212,16 @@ module Processed = struct extensions) end +let obj_dir_of_lib kind mode obj_dir = + (match (kind, mode) with + | `Private, `Ocaml -> Obj_dir.byte_dir + | `Private, `Melange -> Obj_dir.melange_dir + | `Public, `Ocaml -> Obj_dir.public_cmi_ocaml_dir + | `Public, `Melange -> Obj_dir.public_cmi_melange_dir) + obj_dir + module Unprocessed = struct - (* We store separate information for each "module". These informations do not + (* We store separate information for each "module". These information do not reflect the actual content of the Merlin configuration yet but are needed for it's elaboration via the function [process : Unprocessed.t ... -> Processed.t] *) @@ -205,6 +235,7 @@ module Unprocessed = struct ; source_dirs : Path.Source.Set.t ; objs_dirs : Path.Set.t ; extensions : string Ml_kind.Dict.t list + ; mode : [ `Ocaml | `Melange ] } type t = @@ -216,15 +247,24 @@ module Unprocessed = struct let make ?(requires = Resolve.return []) ~stdlib_dir ~flags ?(preprocess = Preprocess.Per_module.no_preprocessing ()) ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~ident - () = + ~modes () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) + let mode = + match modes with + | `Exe -> `Ocaml + | `Melange_emit -> `Melange + | `Lib (m : Lib_mode.Map.Set.t) -> + if m.melange && (not m.ocaml.byte) && not m.ocaml.native then `Melange + else `Ocaml + in let requires = match Resolve.peek requires with | Ok l -> Lib.Set.of_list l | Error () -> Lib.Set.empty in let objs_dirs = - Obj_dir.byte_dir obj_dir |> Path.build |> Path.Set.singleton + Path.Set.singleton + @@ obj_dir_of_lib `Private mode (Obj_dir.of_local obj_dir) in let flags = Ocaml_flags.common @@ -239,6 +279,7 @@ module Unprocessed = struct let extensions = Dialect.DB.extensions_for_merlin dialects in let config = { stdlib_dir + ; mode ; requires ; flags ; preprocess @@ -281,7 +322,7 @@ module Unprocessed = struct | Error _ -> None | Ok bin -> let args = encode_command ~bin ~args in - Some { Processed.flag = "-pp"; args } + Some { Processed.flag = Processed.Pp_kind.Pp; args } in Action_builder.map action ~f:(fun act -> match act.action with @@ -291,9 +332,8 @@ module Unprocessed = struct | _ -> None)) | _ -> Action_builder.return None - let pp_flags sctx ~expander libname preprocess : + let pp_flags sctx ~expander lib_name preprocess : Processed.pp_flag option Action_builder.t = - let scope = Expander.scope expander in match Preprocess.remove_future_syntax preprocess ~for_:Merlin (Super_context.context sctx).version @@ -304,42 +344,57 @@ module Unprocessed = struct | Pps { loc; pps; flags; staged = _ } -> let open Action_builder.O in let+ exe, flags = - Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname - ~flags ~scope pps + let scope = Expander.scope expander in + Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name ~flags ~scope + pps in let args = encode_command ~bin:(Path.build exe) ~args:("--as-ppx" :: flags) in - Some { Processed.flag = "-ppx"; args } + Some { Processed.flag = Processed.Pp_kind.Ppx; args } let src_dirs sctx lib = - let open Memo.O in let info = Lib.info lib in - let obj_dir = Lib_info.obj_dir info in - match Path.is_managed (Obj_dir.byte_dir obj_dir) with + match + let obj_dir = Lib_info.obj_dir info in + Path.is_managed (Obj_dir.byte_dir obj_dir) + with | false -> Memo.return (Path.Set.singleton (Lib_info.src_dir info)) | true -> + let open Memo.O in let+ modules = Dir_contents.modules_of_lib sctx lib in let modules = Option.value_exn modules in Path.Set.map ~f:Path.drop_optional_build_context (Modules.source_dirs modules) + let pp_config t sctx ~expander = + Module_name.Per_item.map_action_builder t.config.preprocess + ~f:(pp_flags sctx ~expander t.config.libname) + let process - { modules - ; ident = _ - ; config = - { stdlib_dir - ; extensions - ; flags - ; objs_dirs - ; source_dirs - ; requires - ; preprocess - ; libname - } - } sctx ~more_src_dirs ~expander = + ({ modules + ; ident = _ + ; config = + { stdlib_dir + ; extensions + ; flags + ; objs_dirs + ; source_dirs + ; requires + ; preprocess = _ + ; libname = _ + ; mode + } + } as t) sctx ~dir ~more_src_dirs ~expander = let open Action_builder.O in let+ config = + let* stdlib_dir = + Action_builder.of_memo + @@ + match t.config.mode with + | `Ocaml -> Memo.return (Some stdlib_dir) + | `Melange -> Melange_binary.where sctx ~dir + in let+ flags = flags and+ src_dirs, obj_dirs = Action_builder.of_memo @@ -352,7 +407,8 @@ module Unprocessed = struct ~f:(fun (src_dirs, obj_dirs) (lib, more_src_dirs) -> ( Path.Set.union src_dirs more_src_dirs , let public_cmi_dir = - Lib.info lib |> Lib_info.obj_dir |> Obj_dir.public_cmi_dir + let info = Lib.info lib in + obj_dir_of_lib `Public mode (Lib_info.obj_dir info) in Path.Set.add obj_dirs public_cmi_dir ))) in @@ -361,10 +417,7 @@ module Unprocessed = struct (Path.Set.of_list_map ~f:Path.source more_src_dirs) in { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions } - and+ pp_config = - Module_name.Per_item.map_action_builder preprocess - ~f:(pp_flags sctx ~expander libname) - in + and+ pp_config = pp_config t sctx ~expander in let modules = (* And copy for each module the resulting pp flags *) Modules.fold_no_vlib modules ~init:[] ~f:(fun m acc -> @@ -381,7 +434,7 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = (Action_builder.path (Path.build merlin_file)) in let action = - let merlin = Unprocessed.process t sctx ~more_src_dirs ~expander in + let merlin = Unprocessed.process t sctx ~dir ~more_src_dirs ~expander in Action_builder.With_targets.write_file_dyn merlin_file (Action_builder.with_no_targets (Action_builder.map ~f:Processed.Persist.to_string merlin)) diff --git a/duniverse/dune_/src/dune_rules/merlin.mli b/duniverse/dune_/src/dune_rules/merlin.mli index 7d208eadf..ea29420e5 100644 --- a/duniverse/dune_/src/dune_rules/merlin.mli +++ b/duniverse/dune_/src/dune_rules/merlin.mli @@ -15,6 +15,18 @@ module Processed : sig (** Type of "processed" merlin information *) type t + module Pp_kind : sig + type t = + | Pp + | Ppx + end + + type pp_flag + + val pp_kind : pp_flag -> Pp_kind.t + + val pp_args : pp_flag -> string + val load_file : Path.t -> (t, string) result (** [print_file path] reads the configuration at path [path] and print it as a @@ -40,6 +52,7 @@ val make : -> obj_dir:Path.Build.t Obj_dir.t -> dialects:Dialect.DB.t -> ident:Merlin_ident.t + -> modes:[ `Lib of Lib_mode.Map.Set.t | `Exe | `Melange_emit ] -> unit -> t @@ -52,3 +65,9 @@ val add_rules : -> expander:Expander.t -> t -> unit Memo.t + +val pp_config : + t + -> Super_context.t + -> expander:Expander.t + -> Processed.pp_flag option Module_name.Per_item.t Action_builder.t diff --git a/duniverse/dune_/src/dune_rules/ml_sources.ml b/duniverse/dune_/src/dune_rules/ml_sources.ml index 0169b0d6f..c9177d536 100644 --- a/duniverse/dune_/src/dune_rules/ml_sources.ml +++ b/duniverse/dune_/src/dune_rules/ml_sources.ml @@ -3,21 +3,43 @@ open Dune_file open Memo.O module Modules_group = Modules +module Origin = struct + type t = + | Library of Dune_file.Library.t + | Executables of Dune_file.Executables.t + | Melange of Melange_stanzas.Emit.t + + let loc = function + | Library l -> l.buildable.loc + | Executables e -> e.buildable.loc + | Melange mel -> mel.loc +end + module Modules = struct type t = { libraries : (Modules.t * Path.Build.t Obj_dir.t) Lib_name.Map.t ; executables : (Modules.t * Path.Build.t Obj_dir.t) String.Map.t - ; (* Map from modules to the buildable they are part of *) - rev_map : Buildable.t Module_name.Map.t + ; melange_emits : (Modules.t * Path.Build.t Obj_dir.t) String.Map.t + ; (* Map from modules to the origin they are part of *) + rev_map : Origin.t Module_name.Map.t } let empty = { libraries = Lib_name.Map.empty ; executables = String.Map.empty + ; melange_emits = String.Map.empty ; rev_map = Module_name.Map.empty } - let make (libs, exes) = + type groups = + { libraries : (Library.t * Modules_group.t * Path.Build.t Obj_dir.t) list + ; executables : + (Executables.t * Modules_group.t * Path.Build.t Obj_dir.t) list + ; melange_emits : + (Melange_stanzas.Emit.t * Modules_group.t * Path.Build.t Obj_dir.t) list + } + + let make { libraries = libs; executables = exes; melange_emits = emits } = let libraries = match Lib_name.Map.of_list_map libs ~f:(fun (lib, m, obj_dir) -> @@ -32,8 +54,9 @@ module Modules = struct in let executables = match - String.Map.of_list_map exes ~f:(fun (exes, m, obj_dir) -> - (snd (List.hd exes.Executables.names), (m, obj_dir))) + String.Map.of_list_map exes + ~f:(fun ((exes : Executables.t), m, obj_dir) -> + (snd (List.hd exes.names), (m, obj_dir))) with | Ok x -> x | Error (name, _, (exes2, _, _)) -> @@ -42,23 +65,37 @@ module Modules = struct "Executable %S appears for the second time in this directory" name ] in + let melange_emits = + match + String.Map.of_list_map emits ~f:(fun (mel, m, obj_dir) -> + (mel.target, (m, obj_dir))) + with + | Ok x -> x + | Error (name, _, (mel, _, _)) -> + User_error.raise ~loc:mel.loc + [ Pp.textf "Target %S appears for the second time in this directory" + name + ] + in let rev_map = - let rev_modules = - let by_name buildable = + let modules = + let by_name (origin : Origin.t) = Modules.fold_user_available ~init:[] ~f:(fun m acc -> - (Module.name m, buildable) :: acc) + (Module.name m, origin) :: acc) in - List.rev_append - (List.concat_map libs ~f:(fun (l, m, _) -> by_name l.buildable m)) - (List.concat_map exes ~f:(fun (e, m, _) -> by_name e.buildable m)) + List.concat + [ List.concat_map libs ~f:(fun (l, m, _) -> by_name (Library l) m) + ; List.concat_map exes ~f:(fun (e, m, _) -> by_name (Executables e) m) + ; List.concat_map emits ~f:(fun (l, m, _) -> by_name (Melange l) m) + ] in - match Module_name.Map.of_list rev_modules with + match Module_name.Map.of_list modules with | Ok x -> x | Error (name, _, _) -> let open Module_name.Infix in let locs = - List.filter_map rev_modules ~f:(fun (n, b) -> - Option.some_if (n = name) b.loc) + List.filter_map modules ~f:(fun (n, origin) -> + Option.some_if (n = name) (Origin.loc origin)) |> List.sort ~compare:Loc.compare in User_error.raise @@ -75,7 +112,7 @@ module Modules = struct or executable." ] in - { libraries; executables; rev_map } + { libraries; executables; melange_emits; rev_map } end module Artifacts = struct @@ -91,7 +128,7 @@ module Artifacts = struct let lookup_library { libraries; modules = _ } = Lib_name.Map.find libraries - let make ~dir ~lib_config (libs, exes) = + let make ~dir ~lib_config ~libs ~exes = let+ libraries = Memo.List.map libs ~f:(fun (lib, _, _) -> let name = Lib_name.of_local lib.Library.name in @@ -168,15 +205,17 @@ let modules_of_files ~dialects ~dir ~files = type for_ = | Library of Lib_name.t | Exe of { first_exe : string } + | Melange of { target : string } let modules_and_obj_dir t ~for_ = match for_ with | Library name -> Lib_name.Map.find_exn t.modules.libraries name | Exe { first_exe } -> String.Map.find_exn t.modules.executables first_exe + | Melange { target } -> String.Map.find_exn t.modules.melange_emits target let modules t ~for_ = modules_and_obj_dir t ~for_ |> fst -let lookup_module (t : t) name = Module_name.Map.find t.modules.rev_map name +let find_origin (t : t) name = Module_name.Map.find t.modules.rev_map name let virtual_modules lookup_vlib vlib = let info = Lib.info vlib in @@ -243,7 +282,16 @@ let make_lib_modules ~dir ~libs ~lookup_vlib ~(lib : Library.t) ~modules = (kind, main_module_name, wrapped) in let modules = - Modules_field_evaluator.eval ~modules ~buildable:lib.buildable ~kind + let { Buildable.loc = stanza_loc + ; modules = modules_field + ; modules_without_implementation + ; root_module + ; _ + } = + lib.buildable + in + Modules_field_evaluator.eval ~modules ~stanza_loc ~modules_field + ~modules_without_implementation ~root_module ~kind ~private_modules: (Option.value ~default:Ordered_set_lang.standard lib.private_modules) ~src_dir:dir @@ -254,7 +302,31 @@ let make_lib_modules ~dir ~libs ~lookup_vlib ~(lib : Library.t) ~modules = Modules_group.lib ~stdlib ~implements ~lib_name ~src_dir:dir ~modules ~main_module_name ~wrapped -let libs_and_exes dune_file ~dir ~scope ~lookup_vlib ~modules = +let modules_of_stanzas dune_file ~dir ~scope ~lookup_vlib ~modules = + let rev_filter_partition = + let rec loop l (acc : Modules.groups) = + match l with + | [] -> acc + | x :: l -> ( + match x with + | `Skip -> loop l acc + | `Library y -> loop l { acc with libraries = y :: acc.libraries } + | `Executables y -> + loop l { acc with executables = y :: acc.executables } + | `Melange_emit y -> + loop l { acc with melange_emits = y :: acc.melange_emits }) + in + fun l -> loop l { libraries = []; executables = []; melange_emits = [] } + in + let filter_partition_map l = + let { Modules.libraries; executables; melange_emits } = + rev_filter_partition l + in + { Modules.libraries = List.rev libraries + ; executables = List.rev executables + ; melange_emits = List.rev melange_emits + } + in Memo.parallel_map dune_file.stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with | Library lib -> @@ -268,11 +340,20 @@ let libs_and_exes dune_file ~dir ~scope ~lookup_vlib ~modules = >>= Resolve.read_memo in let obj_dir = Library.obj_dir lib ~dir in - List.Left (lib, modules, obj_dir) + `Library (lib, modules, obj_dir) | Executables exes | Tests { exes; _ } -> let modules = + let { Buildable.loc = stanza_loc + ; modules = modules_field + ; modules_without_implementation + ; root_module + ; _ + } = + exes.buildable + in let modules = - Modules_field_evaluator.eval ~modules ~buildable:exes.buildable + Modules_field_evaluator.eval ~modules ~stanza_loc ~modules_field + ~modules_without_implementation ~root_module ~kind:Modules_field_evaluator.Exe_or_normal_lib ~private_modules:Ordered_set_lang.standard ~src_dir:dir in @@ -290,9 +371,31 @@ let libs_and_exes dune_file ~dir ~scope ~lookup_vlib ~modules = there are multiple executable stanzas in the same directory *) Modules_group.relocate_alias_module modules ~src_dir in - Memo.return (List.Right (exes, modules, obj_dir)) - | _ -> Memo.return List.Skip) - >>| List.filter_partition_map ~f:Fun.id + Memo.return (`Executables (exes, modules, obj_dir)) + | Melange_emit mel -> + let modules = + let modules = + Modules_field_evaluator.eval ~modules ~stanza_loc:mel.loc + ~modules_field:mel.entries + ~modules_without_implementation:Ordered_set_lang.standard + ~root_module:mel.root_module + ~kind:Modules_field_evaluator.Exe_or_normal_lib + ~private_modules:Ordered_set_lang.standard ~src_dir:dir + in + Modules_group.melange_wrapped ~src_dir:dir ~modules + in + let obj_dir = Obj_dir.make_melange_emit ~dir ~name:mel.target in + let modules = + let src_dir = Path.build (Obj_dir.obj_dir obj_dir) in + (* We need to relocate the source of the alias module to its own + directory for executables. This module always has the same name for + executables, therefore it might collide with ether alias modules if + there are multiple executable stanzas in the same directory *) + Modules_group.relocate_alias_module modules ~src_dir + in + Memo.return (`Melange_emit (mel, modules, obj_dir)) + | _ -> Memo.return `Skip) + >>| filter_partition_map let check_no_qualified (loc, include_subdirs) = if include_subdirs = Dune_file.Include_subdirs.Include Qualified then @@ -301,7 +404,7 @@ let check_no_qualified (loc, include_subdirs) = let make dune_file ~dir ~scope ~lib_config ~loc ~lookup_vlib ~include_subdirs ~dirs = - let+ libs_and_exes = + let+ modules_of_stanzas = check_no_qualified include_subdirs; let modules = let dialects = Dune_project.dialects (Scope.project scope) in @@ -319,10 +422,12 @@ let make dune_file ~dir ~scope ~lib_config ~loc ~lookup_vlib ~include_subdirs ; Pp.text "This is not allowed, please rename one of them." ])) in - libs_and_exes dune_file ~dir ~scope ~lookup_vlib ~modules + modules_of_stanzas dune_file ~dir ~scope ~lookup_vlib ~modules in - let modules = Modules.make libs_and_exes in + let modules = Modules.make modules_of_stanzas in let artifacts = - Memo.lazy_ (fun () -> Artifacts.make ~dir ~lib_config libs_and_exes) + Memo.lazy_ (fun () -> + Artifacts.make ~dir ~lib_config ~libs:modules_of_stanzas.libraries + ~exes:modules_of_stanzas.executables) in { modules; artifacts } diff --git a/duniverse/dune_/src/dune_rules/ml_sources.mli b/duniverse/dune_/src/dune_rules/ml_sources.mli index 23db17fb3..73056a64e 100644 --- a/duniverse/dune_/src/dune_rules/ml_sources.mli +++ b/duniverse/dune_/src/dune_rules/ml_sources.mli @@ -5,6 +5,15 @@ open Import +module Origin : sig + type t = + | Library of Dune_file.Library.t + | Executables of Dune_file.Executables.t + | Melange of Melange_stanzas.Emit.t + + val loc : t -> Loc.t +end + module Artifacts : sig type t @@ -24,14 +33,15 @@ type for_ = { first_exe : string (** Name of first executable appearing in executables stanza *) } + | Melange of { target : string } val modules_and_obj_dir : t -> for_:for_ -> Modules.t * Path.Build.t Obj_dir.t -(** Modules attached to a library or executable.*) +(** Modules attached to a library, executable, or melange.emit stanza.*) val modules : t -> for_:for_ -> Modules.t -(** Find out what buildable a module is part of *) -val lookup_module : t -> Module_name.t -> Dune_file.Buildable.t option +(** Find out the origin of the stanza for a given module *) +val find_origin : t -> Module_name.t -> Origin.t option val empty : t diff --git a/duniverse/dune_/src/dune_rules/module.ml b/duniverse/dune_/src/dune_rules/module.ml index f4783c7b7..869c3a997 100644 --- a/duniverse/dune_/src/dune_rules/module.ml +++ b/duniverse/dune_/src/dune_rules/module.ml @@ -101,6 +101,11 @@ module Source = struct | Ml_kind.Impl -> { t with files = { t.files with impl = Some file } } | Intf -> { t with files = { t.files with intf = Some file } } + let set_source t ml_kind file = + match ml_kind with + | Ml_kind.Impl -> { t with files = { t.files with impl = file } } + | Intf -> { t with files = { t.files with intf = file } } + let src_dir t = Path.parent_exn (choose_file t).path let map_files t ~f = @@ -179,6 +184,10 @@ let add_file t kind file = let source = Source.add_file t.source kind file in { t with source } +let set_source t kind file = + let source = Source.set_source t.source kind file in + { t with source } + let map_files t ~f = let source = Source.map_files t.source ~f:(fun kind -> Option.map ~f:(f kind)) diff --git a/duniverse/dune_/src/dune_rules/module.mli b/duniverse/dune_/src/dune_rules/module.mli index a1b7383b9..1557ec220 100644 --- a/duniverse/dune_/src/dune_rules/module.mli +++ b/duniverse/dune_/src/dune_rules/module.mli @@ -68,6 +68,8 @@ val with_wrapper : t -> main_module_name:Module_name.t -> t val add_file : t -> Ml_kind.t -> File.t -> t +val set_source : t -> Ml_kind.t -> File.t option -> t + val map_files : t -> f:(Ml_kind.t -> File.t -> File.t) -> t (** Set preprocessing flags *) diff --git a/duniverse/dune_/src/dune_rules/module_compilation.ml b/duniverse/dune_/src/dune_rules/module_compilation.ml index ebe572e40..5f52e9bcf 100644 --- a/duniverse/dune_/src/dune_rules/module_compilation.ml +++ b/duniverse/dune_/src/dune_rules/module_compilation.ml @@ -1,6 +1,5 @@ open Import module CC = Compilation_context -module SC = Super_context (* Arguments for the compiler to prevent it from being too clever. @@ -9,47 +8,69 @@ module SC = Super_context extension is not .ml or when the .ml and .mli are in different directories. This flags makes the compiler think there is a .mli file and will the read the cmi file rather than create it. *) -let force_read_cmi source_file = [ "-intf-suffix"; Path.extension source_file ] +let force_read_cmi ~(cm_kind : Lib_mode.Cm_kind.t) source_file = + let args = [ "-intf-suffix"; Path.extension source_file ] in + match cm_kind with + | Melange Cmj -> "--bs-read-cmi" :: args + | Ocaml (Cmo | Cmx | Cmi) | Melange Cmi -> args (* Build the cm* if the corresponding source is present, in the case of cmi if the mli is not present it is added as additional target to the .cmo generation *) -let opens modules m = +let open_modules modules m = match Modules.alias_for modules m with - | None -> Command.Args.empty - | Some (m : Module.t) -> As [ "-open"; Module_name.to_string (Module.name m) ] + | None -> [] + | Some (m : Module.t) -> [ Module.name m ] + +let opens modules m = + match open_modules modules m with + | [] -> Command.Args.empty + | modules -> + Command.Args.S + (List.map modules ~f:(fun name -> + Command.Args.As [ "-open"; Module_name.to_string name ])) -let other_cm_files ~opaque ~(cm_kind : Cm_kind.t) ~dep_graph ~obj_dir m = +let other_cm_files ~opaque ~cm_kind ~dep_graph ~obj_dir m = let open Action_builder.O in let+ deps = Dep_graph.deps_of dep_graph m in List.concat_map deps ~f:(fun m -> + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in let deps = - [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmi) ] + [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:cmi_kind) ] in - if Module.has m ~ml_kind:Impl && cm_kind = Cmx && not opaque then - let cmx = Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmx in + if Module.has m ~ml_kind:Impl && cm_kind = Ocaml Cmx && not opaque then + let cmx = Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Ocaml Cmx) in Path.build cmx :: deps + else if Module.has m ~ml_kind:Impl && cm_kind = Melange Cmj then + let cmj = Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Melange Cmj) in + Path.build cmj :: deps else deps) -let copy_interface ~sctx ~dir ~obj_dir m = +let copy_interface ~sctx ~dir ~obj_dir ~cm_kind m = (* symlink the .cmi into the public interface directory *) Memo.when_ (Module.visibility m <> Visibility.Private && Obj_dir.need_dedicated_public_dir obj_dir) (fun () -> - SC.add_rule sctx ~dir + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in + Super_context.add_rule sctx ~dir (Action_builder.symlink - ~src:(Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmi)) - ~dst:(Obj_dir.Module.cm_public_file_exn obj_dir m ~kind:Cmi))) + ~src: + (Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:cmi_kind)) + ~dst:(Obj_dir.Module.cm_public_file_exn obj_dir m ~kind:cmi_kind))) -let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = +let build_cm cctx ~force_write_cmi ~precompiled_cmi ~cm_kind (m : Module.t) + ~(phase : Fdo.phase option) = + if force_write_cmi && precompiled_cmi then + Code_error.raise "force_read_cmi and precompiled_cmi are mutually exclusive" + []; let sctx = CC.super_context cctx in let dir = CC.dir cctx in let obj_dir = CC.obj_dir cctx in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let stdlib = CC.stdlib cctx in - let mode = Mode.of_cm_kind cm_kind in + let mode = Lib_mode.of_cm_kind cm_kind in let sandbox = let default = CC.sandbox cctx in match Module.kind m with @@ -59,53 +80,70 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = Sandbox_config.needs_sandboxing | _ -> default in + let open Memo.O in + let* compiler = + let+ compiler = + match mode with + | Ocaml mode -> Memo.return @@ Context.compiler ctx mode + | Melange -> Melange_binary.melc sctx ~dir + in + Result.to_option compiler + in (let open Option.O in - let* compiler = Result.to_option (Context.compiler ctx mode) in - let ml_kind = Cm_kind.source cm_kind in + let* compiler = compiler in + let ml_kind = Lib_mode.Cm_kind.source cm_kind in let+ src = Module.file m ~ml_kind in let dst = Obj_dir.Module.cm_file_exn obj_dir m ~kind:cm_kind in let obj = - Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:ctx.lib_config.ext_obj + Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) + ~ext:ctx.lib_config.ext_obj in let linear = - Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:Fdo.linear_ext + Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) ~ext:Fdo.linear_ext in let linear_fdo = - Obj_dir.Module.obj_file obj_dir m ~kind:Cmx ~ext:Fdo.linear_fdo_ext + Obj_dir.Module.obj_file obj_dir m ~kind:(Ocaml Cmx) ~ext:Fdo.linear_fdo_ext in let open Memo.O in let* extra_args, extra_deps, other_targets = - if precompiled_cmi then Memo.return (force_read_cmi src, [], []) + if precompiled_cmi then Memo.return (force_read_cmi ~cm_kind src, [], []) else (* If we're compiling an implementation, then the cmi is present *) let public_vlib_module = Module.kind m = Impl_vmodule in match phase with - | Some Fdo.Emit -> Memo.return ([], [], []) - | Some Fdo.Compile | Some Fdo.All | None -> ( + | Some Emit -> Memo.return ([], [], []) + | Some Compile | Some All | None -> ( match (cm_kind, Module.file m ~ml_kind:Intf, public_vlib_module) with (* If there is no mli, [ocamlY -c file.ml] produces both the .cmY and .cmi. We choose to use ocamlc to produce the cmi and to produce the cmx we have to wait to avoid race conditions. *) - | Cmo, None, false -> - let+ () = copy_interface ~dir ~obj_dir ~sctx m in - ([], [], [ Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmi ]) - | Cmo, None, true | (Cmo | Cmx), _, _ -> + | (Ocaml Cmo | Melange Cmj), None, false -> + if force_write_cmi then + Memo.return ([ "-intf-suffix"; ".dummy-ignore-mli" ], [], []) + else + let+ () = copy_interface ~dir ~obj_dir ~sctx ~cm_kind m in + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in + ([], [], [ Obj_dir.Module.cm_file_exn obj_dir m ~kind:cmi_kind ]) + | (Ocaml Cmo | Melange Cmj), None, true + | (Ocaml (Cmo | Cmx) | Melange Cmj), _, _ -> + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in Memo.return - ( force_read_cmi src - , [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmi) ] + ( force_read_cmi ~cm_kind src + , [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:cmi_kind) + ] , [] ) - | Cmi, _, _ -> - let+ () = copy_interface ~dir ~obj_dir ~sctx m in + | (Ocaml Cmi | Melange Cmi), _, _ -> + let+ () = copy_interface ~dir ~obj_dir ~sctx ~cm_kind m in ([], [], [])) in let other_targets = match cm_kind with - | Cmx -> ( + | Ocaml Cmx -> ( match phase with - | Some Fdo.Compile -> linear :: other_targets - | Some Fdo.Emit -> other_targets - | Some Fdo.All | None -> obj :: other_targets) - | Cmi | Cmo -> other_targets + | Some Compile -> linear :: other_targets + | Some Emit -> other_targets + | Some All | None -> obj :: other_targets) + | Ocaml (Cmi | Cmo) | Melange (Cmi | Cmj) -> other_targets in let dep_graph = Ml_kind.Dict.get (CC.dep_graphs cctx) ml_kind in let opaque = CC.opaque cctx in @@ -115,24 +153,32 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = in let other_targets, cmt_args = match cm_kind with - | Cmx -> (other_targets, Command.Args.empty) - | Cmi | Cmo -> + | Ocaml Cmx -> (other_targets, Command.Args.empty) + | Ocaml (Cmi | Cmo) | Melange (Cmi | Cmj) -> if Compilation_context.bin_annot cctx then let fn = - Option.value_exn (Obj_dir.Module.cmt_file obj_dir m ~ml_kind) + Option.value_exn (Obj_dir.Module.cmt_file obj_dir m ~cm_kind ~ml_kind) in (fn :: other_targets, A "-bin-annot") else (other_targets, Command.Args.empty) in let opaque_arg = - let intf_only = cm_kind = Cmi && not (Module.has m ~ml_kind:Impl) in + let intf_only = cm_kind = Ocaml Cmi && not (Module.has m ~ml_kind:Impl) in if opaque || (intf_only && Ocaml.Version.supports_opaque_for_mli ctx.version) then Command.Args.A "-opaque" else Command.Args.empty in let dir = ctx.build_dir in let flags, sandbox = - let flags = Ocaml_flags.get (CC.flags cctx) mode in + let flags = + Ocaml_flags.get (CC.flags cctx) + (match mode with + | Ocaml m -> m + | Melange -> + (* TODO: define Melange default flags somewhere, should melange rules + read from [flags] stanza as well? *) + Byte) + in match Module.pp_flags m with | None -> (flags, sandbox) | Some (pp, sandbox') -> @@ -144,14 +190,14 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = in let output = match phase with - | Some Fdo.Compile -> dst - | Some Fdo.Emit -> obj - | Some Fdo.All | None -> dst + | Some Compile -> dst + | Some Emit -> obj + | Some All | None -> dst in let src = match phase with - | Some Fdo.Emit -> Path.build linear_fdo - | Some Fdo.Compile | Some Fdo.All | None -> src + | Some Emit -> Path.build linear_fdo + | Some Compile | Some All | None -> src in let modules = Compilation_context.modules cctx in let obj_dirs = @@ -159,7 +205,23 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = |> List.concat_map ~f:(fun p -> [ Command.Args.A "-I"; Path (Path.build p) ]) in - SC.add_rule sctx ~dir ?loc:(CC.loc cctx) + let melange_args = + match cm_kind with + | Melange Cmj -> + let pkg_name_args = + match CC.package cctx with + | None -> [] + | Some pkg -> + [ Command.Args.A "--bs-package-name" + ; A (Package.Name.to_string (Package.name pkg)) + ] + in + Command.Args.A "--bs-stop-after-cmj" :: A "--bs-package-output" + :: Command.Args.Path (Path.build (CC.dir cctx)) + :: pkg_name_args + | Ocaml (Cmi | Cmo | Cmx) | Melange Cmi -> [] + in + Super_context.add_rule sctx ~dir ?loc:(CC.loc cctx) (let open Action_builder.With_targets.O in Action_builder.with_no_targets (Action_builder.paths extra_deps) >>> Action_builder.with_no_targets other_cm_files @@ -167,8 +229,10 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = [ Command.Args.dyn flags ; cmt_args ; Command.Args.S obj_dirs - ; Command.Args.as_any (Cm_kind.Dict.get (CC.includes cctx) cm_kind) + ; Command.Args.as_any + (Lib_mode.Cm_kind.Map.get (CC.includes cctx) cm_kind) ; As extra_args + ; S melange_args ; A "-no-alias-deps" ; opaque_arg ; As (Fdo.phase_flags phase) @@ -189,47 +253,55 @@ let build_cm cctx ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = >>| Action.Full.add_sandbox sandbox)) |> Memo.Option.iter ~f:Fun.id -let build_module ?(precompiled_cmi = false) cctx m = +let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m = let open Memo.O in - let* () = build_cm cctx m ~precompiled_cmi ~cm_kind:Cmo ~phase:None - and* () = - let ctx = CC.context cctx in - let can_split = - Ocaml.Version.supports_split_at_emit ctx.version - || Ocaml_config.is_dev_version ctx.ocaml_config - in - match (ctx.fdo_target_exe, can_split) with - | None, _ -> build_cm cctx m ~precompiled_cmi ~cm_kind:Cmx ~phase:None - | Some _, false -> - build_cm cctx m ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.All) - | Some _, true -> - build_cm cctx m ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.Compile) - >>> Fdo.opt_rule cctx m - >>> build_cm cctx m ~precompiled_cmi ~cm_kind:Cmx ~phase:(Some Fdo.Emit) - and* () = - Memo.when_ (not precompiled_cmi) (fun () -> - build_cm cctx m ~precompiled_cmi ~cm_kind:Cmi ~phase:None) + let { Lib_mode.Map.ocaml; melange } = Compilation_context.modes cctx in + let build_cm = build_cm cctx m ~force_write_cmi ~precompiled_cmi in + let* () = + Memo.when_ (ocaml.byte || ocaml.native) (fun () -> + let* () = build_cm ~cm_kind:(Ocaml Cmo) ~phase:None + and* () = + let ctx = CC.context cctx in + let can_split = + Ocaml.Version.supports_split_at_emit ctx.version + || Ocaml_config.is_dev_version ctx.ocaml_config + in + match (ctx.fdo_target_exe, can_split) with + | None, _ -> build_cm ~cm_kind:(Ocaml Cmx) ~phase:None + | Some _, false -> build_cm ~cm_kind:(Ocaml Cmx) ~phase:(Some All) + | Some _, true -> + build_cm ~cm_kind:(Ocaml Cmx) ~phase:(Some Compile) + >>> Fdo.opt_rule cctx m + >>> build_cm ~cm_kind:(Ocaml Cmx) ~phase:(Some Emit) + and* () = + Memo.when_ (not precompiled_cmi) (fun () -> + build_cm ~cm_kind:(Ocaml Cmi) ~phase:None) + in + let obj_dir = CC.obj_dir cctx in + match Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml Cmo) with + | None -> Memo.return () + | Some src -> + Compilation_context.js_of_ocaml cctx + |> Memo.Option.iter ~f:(fun in_context -> + (* Build *.cmo.js *) + let sctx = CC.super_context cctx in + let dir = CC.dir cctx in + let target = Path.Build.extend_basename src ~suffix:".js" in + let action_with_targets = + Jsoo_rules.build_cm cctx ~in_context ~src ~target + in + action_with_targets >>= Super_context.add_rule sctx ~dir)) in - let obj_dir = CC.obj_dir cctx in - match Obj_dir.Module.cm_file obj_dir m ~kind:Cm_kind.Cmo with - | None -> Memo.return () - | Some src -> - Compilation_context.js_of_ocaml cctx - |> Memo.Option.iter ~f:(fun in_context -> - (* Build *.cmo.js *) - let sctx = CC.super_context cctx in - let dir = CC.dir cctx in - let target = Path.Build.extend_basename src ~suffix:".js" in - let action_with_targets = - Jsoo_rules.build_cm cctx ~in_context ~src ~target - in - action_with_targets >>= SC.add_rule sctx ~dir) + Memo.when_ melange (fun () -> + let* () = build_cm ~cm_kind:(Melange Cmj) ~phase:None in + Memo.when_ (not precompiled_cmi) (fun () -> + build_cm ~cm_kind:(Melange Cmi) ~phase:None)) let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = let sctx = CC.super_context cctx in let obj_dir = CC.obj_dir cctx in let dir = CC.dir cctx in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let src = Option.value_exn (Module.file m ~ml_kind:Impl) in let sandbox = Compilation_context.sandbox cctx in let cm_deps = @@ -237,11 +309,12 @@ let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = (let open Action_builder.O in let+ deps = Ml_kind.Dict.get deps Impl in List.concat_map deps ~f:(fun m -> - [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:Cmi) ])) + [ Path.build (Obj_dir.Module.cm_file_exn obj_dir m ~kind:(Ocaml Cmi)) + ])) in let ocaml_flags = Ocaml_flags.get (CC.flags cctx) Mode.Byte in let modules = Compilation_context.modules cctx in - SC.add_rule sctx ~dir + Super_context.add_rule sctx ~dir (Action_builder.With_targets.add ~file_targets:[ output ] (let open Action_builder.With_targets.O in Action_builder.with_no_targets cm_deps @@ -250,7 +323,8 @@ let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = [ Command.Args.dyn ocaml_flags ; A "-I" ; Path (Path.build (Obj_dir.byte_dir obj_dir)) - ; Command.Args.as_any (Cm_kind.Dict.get (CC.includes cctx) Cmo) + ; Command.Args.as_any + (Lib_mode.Cm_kind.Map.get (CC.includes cctx) (Ocaml Cmo)) ; opens modules m ; As flags ; A "-short-paths" @@ -260,43 +334,77 @@ let ocamlc_i ?(flags = []) ~deps cctx (m : Module.t) ~output = ] >>| Action.Full.add_sandbox sandbox)) -(* The alias module is an implementation detail to support wrapping library - modules under a single toplevel name. Since OCaml doesn't have proper support - for namespacing at the moment, in order to expose module `X` of library `foo` - as `Foo.X`, Dune does the following: +module Alias_module = struct + (* The alias module is an implementation detail to support wrapping library + modules under a single toplevel name. Since OCaml doesn't have proper + support for namespacing at the moment, in order to expose module `X` of + library `foo` as `Foo.X`, Dune does the following: - - it compiles x.ml to Foo__X.cmo, Foo__X.cmx, Foo__X.o, ... - it implicitly - exposes a module alias [module X = Foo__X] to all the modules of the `foo` - library + - it compiles x.ml to Foo__X.cmo, Foo__X.cmx, Foo__X.o, ... - it implicitly + exposes a module alias [module X = Foo__X] to all the modules of the `foo` + library - The second point is achieved by implicitly opening a module containing such - aliases for all modules of `foo` when compiling modules of `foo` via the - `-open` option of the compiler. This module is called the alias module and is - implicitly generated by Dune.*) + The second point is achieved by implicitly opening a module containing such + aliases for all modules of `foo` when compiling modules of `foo` via the + `-open` option of the compiler. This module is called the alias module and + is implicitly generated by Dune.*) -let alias_source modules = - let alias new_name old_name = - sprintf "module %s = %s" - (Module_name.to_string new_name) - (Module_name.to_string old_name) - in - let main_module_name = Modules.main_module_name modules |> Option.value_exn in - let aliased_modules = Modules.for_alias modules in - Module_name.Map.values aliased_modules - |> List.map ~f:(fun (m : Module.t) -> - let name = Module.name m in - let obj_name_as_module = - Module.obj_name m |> Module_name.Unique.to_name ~loc:Loc.none - in - sprintf "(** @canonical %s.%s *)\n%s\n" - (Module_name.to_string main_module_name) - (Module_name.to_string name) - (alias name obj_name_as_module)) - |> String.concat ~sep:"\n\n" + type alias = + { local_name : Module_name.t + ; obj_name : Module_name.Unique.t + } + + type t = + { main_module : Module_name.t + ; aliases : alias list + ; shadowed : Module_name.t list + } + + let to_ml { main_module; aliases; shadowed } = + let b = Buffer.create 16 in + Buffer.add_string b "(* generated by dune *)\n"; + let main_module = Module_name.to_string main_module in + List.iter aliases ~f:(fun { local_name; obj_name } -> + let local_name = Module_name.to_string local_name in + Printf.bprintf b "\n(** @canonical %s.%s *)\nmodule %s = %s\n" + main_module local_name local_name + (Module_name.Unique.to_name ~loc:Loc.none obj_name + |> Module_name.to_string)); + List.iter shadowed ~f:(fun shadowed -> + Printf.bprintf b + "\n\ + module %s = struct end\n\ + [@@deprecated \"this module is shadowed\"]\n" + (Module_name.to_string shadowed)); + Buffer.contents b + + let of_modules project modules = + let main_module = Modules.main_module_name modules |> Option.value_exn in + let aliases = + Modules.for_alias modules + |> Module_name.Map.to_list_map ~f:(fun local_name m -> + let obj_name = Module.obj_name m in + { local_name; obj_name }) + in + let shadowed = + if + Dune_project.dune_version project < (3, 5) + || Modules.lib_interface modules = None + then [] + else + match Modules.alias_module modules with + | None -> [] + | Some alias_module -> [ Module.name alias_module ] + in + { main_module; aliases; shadowed } +end let build_alias_module cctx alias_module = let modules = Compilation_context.modules cctx in - let alias_file () = alias_source modules in + let alias_file () = + let project = Compilation_context.scope cctx |> Scope.project in + Alias_module.of_modules project modules |> Alias_module.to_ml + in let cctx = Compilation_context.for_alias_module cctx alias_module in let sctx = Compilation_context.super_context cctx in let file = Option.value_exn (Module.file alias_module ~ml_kind:Impl) in diff --git a/duniverse/dune_/src/dune_rules/module_compilation.mli b/duniverse/dune_/src/dune_rules/module_compilation.mli index 59f5a1199..4108c9502 100644 --- a/duniverse/dune_/src/dune_rules/module_compilation.mli +++ b/duniverse/dune_/src/dune_rules/module_compilation.mli @@ -4,7 +4,13 @@ open Import (** Setup rules to build a single module.*) val build_module : - ?precompiled_cmi:bool -> Compilation_context.t -> Module.t -> unit Memo.t + ?force_write_cmi:bool + -> ?precompiled_cmi:bool + -> Compilation_context.t + -> Module.t + -> unit Memo.t + +val open_modules : Modules.t -> Module.t -> Module_name.t list val ocamlc_i : ?flags:string list diff --git a/duniverse/dune_/src/dune_rules/module_name.ml b/duniverse/dune_/src/dune_rules/module_name.ml index 54e25baf7..2cf8deb79 100644 --- a/duniverse/dune_/src/dune_rules/module_name.ml +++ b/duniverse/dune_/src/dune_rules/module_name.ml @@ -77,6 +77,8 @@ module Unique = struct include T + let equal x y = Ordering.is_eq (compare x y) + (* We make sure that obj's start with a lowercase letter to make it harder to confuse them with a proper module name *) let of_name_assuming_needs_no_mangling name = String.uncapitalize_ascii name diff --git a/duniverse/dune_/src/dune_rules/module_name.mli b/duniverse/dune_/src/dune_rules/module_name.mli index 17d6dd7b5..ba7ba51f2 100644 --- a/duniverse/dune_/src/dune_rules/module_name.mli +++ b/duniverse/dune_/src/dune_rules/module_name.mli @@ -57,6 +57,8 @@ module Unique : sig val compare : t -> t -> Ordering.t + val equal : t -> t -> bool + val artifact_filename : t -> ext:string -> string include Dune_lang.Conv.S with type t := t diff --git a/duniverse/dune_/src/dune_rules/modules.ml b/duniverse/dune_/src/dune_rules/modules.ml index daa373a1e..c9ffcf8ea 100644 --- a/duniverse/dune_/src/dune_rules/modules.ml +++ b/duniverse/dune_/src/dune_rules/modules.ml @@ -147,6 +147,7 @@ module Mangle = struct type t = | Lib of Lib.t | Exe + | Melange let of_lib ~lib_name ~implements ~main_module_name ~modules = let kind : Lib.kind = @@ -172,6 +173,8 @@ module Mangle = struct }) | Exe -> sprintf "dune__exe" |> Module_name.of_string |> Visibility.Map.make_both + | Melange -> + sprintf "melange" |> Module_name.of_string |> Visibility.Map.make_both let make_alias_module t ~src_dir = let prefix = prefix t in @@ -277,6 +280,22 @@ module Wrapped = struct ; wrapped = Simple true } + let melange ~src_dir ~modules = + let mangle = Mangle.Melange in + let prefix = Mangle.prefix mangle in + let alias_module = Mangle.make_alias_module mangle ~src_dir in + let modules = + Module_name.Map.map modules ~f:(fun m -> + Module.with_wrapper m ~main_module_name:prefix.public) + in + { modules + ; wrapped_compat = Module_name.Map.empty + ; alias_module + (* XXX melange's don't have a main module, but this is harmless *) + ; main_module_name = Module.name alias_module + ; wrapped = Simple true + } + let obj_map { modules ; wrapped_compat @@ -394,65 +413,24 @@ let as_singleton m = if Module_name.Map.cardinal m <> 1 then None else Module_name.Map.choose m |> Option.map ~f:snd -(* Pre-1.11 encoding *) -module Old_format = struct - let decode ~implements ~src_dir = - let open Dune_lang.Decoder in - fields - (let+ loc = loc - and+ alias_module = field_o "alias_module" (Module.decode ~src_dir) - and+ main_module_name = field_o "main_module_name" Module_name.decode - and+ modules = - field ~default:[] "modules" (repeat (enter (Module.decode ~src_dir))) - and+ wrapped = field "wrapped" Mode.decode in - let modules = - modules - |> List.map ~f:(fun m -> (Module.name m, m)) - |> Module_name.Map.of_list_exn - in - match wrapped with - | Simple false -> ( - match as_singleton modules with - | Some m -> Singleton m - | None -> Unwrapped modules) - | Yes_with_transition _ | Simple true -> ( - match (main_module_name, alias_module, as_singleton modules) with - | Some main_module_name, _, Some m - when Module.name m = main_module_name && not implements -> - Singleton m - | Some main_module_name, Some alias_module, _ -> - Wrapped - { modules - ; wrapped_compat = Module_name.Map.empty - ; alias_module - ; main_module_name - ; wrapped - } - | None, _, _ | _, None, _ -> - User_error.raise ~loc - [ Pp.text "Cannot wrap without main module name or alias module" ])) -end - let singleton m = Singleton m -let decode ~version ~src_dir ~implements = - if version <= (1, 10) then Old_format.decode ~implements ~src_dir - else - let open Dune_lang.Decoder in - sum - [ ( "singleton" - , let+ m = Module.decode ~src_dir in - Singleton m ) - ; ( "unwrapped" - , let+ modules = Module.Name_map.decode ~src_dir in - Unwrapped modules ) - ; ( "wrapped" - , let+ w = Wrapped.decode ~src_dir in - Wrapped w ) - ; ( "stdlib" - , let+ stdlib = Stdlib.decode ~src_dir in - Stdlib stdlib ) - ] +let decode ~src_dir = + let open Dune_lang.Decoder in + sum + [ ( "singleton" + , let+ m = Module.decode ~src_dir in + Singleton m ) + ; ( "unwrapped" + , let+ modules = Module.Name_map.decode ~src_dir in + Unwrapped modules ) + ; ( "wrapped" + , let+ w = Wrapped.decode ~src_dir in + Wrapped w ) + ; ( "stdlib" + , let+ stdlib = Stdlib.decode ~src_dir in + Stdlib stdlib ) + ] let rec to_dyn = let open Dyn in @@ -562,6 +540,17 @@ let exe_wrapped ~src_dir ~modules = | Some m -> singleton_exe m | None -> Wrapped (Wrapped.exe ~src_dir ~modules) +let singleton_melange m = + Singleton + (let mangle = Mangle.Melange in + let main_module_name = (Mangle.prefix mangle).public in + Module.with_wrapper m ~main_module_name) + +let melange_wrapped ~src_dir ~modules = + match as_singleton modules with + | Some m -> singleton_melange m + | None -> Wrapped (Wrapped.melange ~src_dir ~modules) + let rec impl_only = function | Stdlib w -> Stdlib.impl_only w | Singleton m -> if Module.has ~ml_kind:Impl m then [ m ] else [] @@ -655,7 +644,7 @@ let is_user_written m = match Module.kind m with | Root -> false | Wrapped_compat | Alias -> - (* Logically, this shold be [acc]. But this is unreachable these are stored + (* Logically, this should be [acc]. But this is unreachable these are stored separately *) assert false | _ -> true diff --git a/duniverse/dune_/src/dune_rules/modules.mli b/duniverse/dune_/src/dune_rules/modules.mli index 91c0fb089..e53d6f395 100644 --- a/duniverse/dune_/src/dune_rules/modules.mli +++ b/duniverse/dune_/src/dune_rules/modules.mli @@ -20,11 +20,7 @@ val lib : val encode : t -> Dune_lang.t -val decode : - version:Dune_lang.Syntax.Version.t - -> src_dir:Path.t - -> implements:bool - -> t Dune_lang.Decoder.t +val decode : src_dir:Path.t -> t Dune_lang.Decoder.t val impl : t -> vlib:t -> t @@ -49,6 +45,8 @@ val exe_unwrapped : Module.Name_map.t -> t val exe_wrapped : src_dir:Path.Build.t -> modules:Module.Name_map.t -> t +val melange_wrapped : src_dir:Path.Build.t -> modules:Module.Name_map.t -> t + (** For wrapped libraries, this is the user written entry module for the library. For single module libraries, it's the sole module in the library *) val lib_interface : t -> Module.t option diff --git a/duniverse/dune_/src/dune_rules/modules_field_evaluator.ml b/duniverse/dune_/src/dune_rules/modules_field_evaluator.ml index 14cfdbc22..2c697d78d 100644 --- a/duniverse/dune_/src/dune_rules/modules_field_evaluator.ml +++ b/duniverse/dune_/src/dune_rules/modules_field_evaluator.ml @@ -119,9 +119,9 @@ let find_errors ~modules ~intf_only ~virtual_modules ~private_modules in { errors; unimplemented_virt_modules } -let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules - ~virtual_modules ~private_modules ~existing_virtual_modules - ~allow_new_public_modules = +let check_invalid_module_listing ~stanza_loc ~modules_without_implementation + ~intf_only ~modules ~virtual_modules ~private_modules + ~existing_virtual_modules ~allow_new_public_modules = let { errors; unimplemented_virt_modules } = find_errors ~modules ~intf_only ~virtual_modules ~private_modules ~existing_virtual_modules ~allow_new_public_modules @@ -204,12 +204,12 @@ let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules print [ Pp.text "These modules are declared virtual, but are missing." ] (unimplemented_virt_modules |> Module_name.Set.to_list - |> List.map ~f:(fun name -> (buildable.loc, name))) + |> List.map ~f:(fun name -> (stanza_loc, name))) [ Pp.text "You must provide an implementation for all of these modules." ]; (if missing_intf_only <> [] then - match Ordered_set_lang.loc buildable.modules_without_implementation with + match Ordered_set_lang.loc modules_without_implementation with | None -> - User_error.raise ~loc:buildable.loc + User_error.raise ~loc:stanza_loc [ Pp.text "Some modules don't have an implementation." ; Pp.text "You need to add the following field to this stanza:" ; Pp.nop @@ -241,15 +241,16 @@ let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules ] spurious_modules_virtual []) -let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) - ~buildable:(conf : Buildable.t) ~private_modules ~kind ~src_dir = +let eval ~modules:all_modules ~stanza_loc ~modules_field + ~modules_without_implementation ~root_module ~private_modules ~kind ~src_dir + = (* Fake modules are modules that do not exist but it doesn't matter because they are only removed from a set (for jbuild file compatibility) *) let fake_modules = ref Module_name.Map.empty in - let eval = eval ~loc:conf.loc ~fake_modules ~all_modules in - let modules = eval ~standard:all_modules conf.modules in + let eval = eval ~loc:stanza_loc ~fake_modules ~all_modules in + let modules = eval ~standard:all_modules modules_field in let intf_only = - eval ~standard:Module_name.Map.empty conf.modules_without_implementation + eval ~standard:Module_name.Map.empty modules_without_implementation in let allow_new_public_modules = match kind with @@ -273,9 +274,9 @@ let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) [ Pp.textf "Module %s is excluded but it doesn't exist." (Module_name.to_string m) ]); - check_invalid_module_listing ~buildable:conf ~intf_only ~modules - ~virtual_modules ~private_modules ~existing_virtual_modules - ~allow_new_public_modules; + check_invalid_module_listing ~stanza_loc ~modules_without_implementation + ~intf_only ~modules ~virtual_modules ~private_modules + ~existing_virtual_modules ~allow_new_public_modules; let all_modules = Module_name.Map.map modules ~f:(fun (_, m) -> let name = Module.Source.name m in @@ -294,7 +295,7 @@ let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) in Module.of_source m ~kind ~visibility) in - match conf.root_module with + match root_module with | None -> all_modules | Some (_, name) -> let module_ = Module.generated_root ~src_dir name in diff --git a/duniverse/dune_/src/dune_rules/modules_field_evaluator.mli b/duniverse/dune_/src/dune_rules/modules_field_evaluator.mli index 7a2177b20..b6665a97a 100644 --- a/duniverse/dune_/src/dune_rules/modules_field_evaluator.mli +++ b/duniverse/dune_/src/dune_rules/modules_field_evaluator.mli @@ -21,8 +21,11 @@ type kind = val eval : modules:Module.Source.t Module_name.Map.t - -> buildable:Dune_file.Buildable.t + -> stanza_loc:Loc.t + -> modules_field:Ordered_set_lang.t + -> modules_without_implementation:Ordered_set_lang.t + -> root_module:('a * Module_name.t) option -> private_modules:Ordered_set_lang.t -> kind:kind -> src_dir:Path.Build.t - -> Module.Name_map.t + -> Module.t Module_name.Map.t diff --git a/duniverse/dune_/src/dune_rules/obj_dir.ml b/duniverse/dune_/src/dune_rules/obj_dir.ml index b09a9e9e5..ee6d654bb 100644 --- a/duniverse/dune_/src/dune_rules/obj_dir.ml +++ b/duniverse/dune_/src/dune_rules/obj_dir.ml @@ -8,19 +8,29 @@ module Paths = struct let library_byte_dir ~obj_dir = Path.Build.relative obj_dir "byte" - let library_public_cmi_dir ~obj_dir = Path.Build.relative obj_dir "public_cmi" + let library_melange_dir ~obj_dir = Path.Build.relative obj_dir "melange" + + let library_public_cmi_ocaml_dir ~obj_dir = + Path.Build.relative obj_dir "public_cmi" + + let library_public_cmi_melange_dir ~obj_dir = + Path.Build.relative obj_dir "public_cmi_melange" (* Use "eobjs" rather than "objs" to avoid a potential conflict with a library of the same name *) let executable_object_directory ~dir name = Path.Build.relative dir ("." ^ name ^ ".eobjs") + + let melange_object_directory ~dir name = + Path.Build.relative dir ("." ^ name ^ ".mobjs") end module External = struct type t = { public_dir : Path.t ; private_dir : Path.t option - ; public_cmi_dir : Path.t option + ; public_cmi_ocaml_dir : Path.t option + ; public_cmi_melange_dir : Path.t option } let equal : t -> t -> bool = Poly.equal @@ -29,39 +39,60 @@ module External = struct let private_dir = if has_private_modules then Some (Path.relative dir ".private") else None in - let public_cmi_dir = + let public_cmi_ocaml_dir = if private_lib then Some (Path.relative dir ".public_cmi") else None in - { public_dir = dir; private_dir; public_cmi_dir } + let public_cmi_melange_dir = + if private_lib then Some (Path.relative dir ".public_cmi_melange") + else None + in + { public_dir = dir + ; private_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir + } + + let public_cmi_ocaml_dir t = + Option.value ~default:t.public_dir t.public_cmi_ocaml_dir - let public_cmi_dir t = Option.value ~default:t.public_dir t.public_cmi_dir + let public_cmi_melange_dir t = + Option.value ~default:t.public_dir t.public_cmi_melange_dir - let to_dyn { public_dir; private_dir; public_cmi_dir } = + let to_dyn + { public_dir; private_dir; public_cmi_ocaml_dir; public_cmi_melange_dir } + = let open Dyn in record [ ("public_dir", Path.to_dyn public_dir) ; ("private_dir", option Path.to_dyn private_dir) - ; ("public_cmi_dir", option Path.to_dyn public_cmi_dir) + ; ("public_cmi_ocaml_dir", option Path.to_dyn public_cmi_ocaml_dir) + ; ("public_cmi_melange_dir", option Path.to_dyn public_cmi_melange_dir) ] - let cm_dir t (cm_kind : Cm_kind.t) (visibility : Visibility.t) = + let cm_dir t (cm_kind : Lib_mode.Cm_kind.t) (visibility : Visibility.t) = match (cm_kind, visibility, t.private_dir) with - | Cmi, Private, Some p -> p - | Cmi, Private, None -> + | (Ocaml Cmi | Melange Cmi), Private, Some p -> p + | (Ocaml Cmi | Melange Cmi), Private, None -> Code_error.raise "External.cm_dir" [ ("t", to_dyn t) ] - | Cmi, Public, _ -> public_cmi_dir t - | (Cmo | Cmx), _, _ -> t.public_dir - - let encode { public_dir; private_dir; public_cmi_dir } = + | Ocaml Cmi, Public, _ -> public_cmi_ocaml_dir t + | Melange Cmi, Public, _ -> public_cmi_melange_dir t + | (Ocaml (Cmo | Cmx) | Melange Cmj), _, _ -> t.public_dir + + let encode + { public_dir + ; private_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir = _ + } = let open Dune_lang.Encoder in let extract d = Path.descendant ~of_:public_dir d |> Option.value_exn |> Path.to_string in let private_dir = Option.map ~f:extract private_dir in - let public_cmi_dir = Option.map ~f:extract public_cmi_dir in + let public_cmi_ocaml_dir = Option.map ~f:extract public_cmi_ocaml_dir in record_fields [ field_o "private_dir" string private_dir - ; field_o "public_cmi_dir" string public_cmi_dir + ; field_o "public_cmi_dir" string public_cmi_ocaml_dir ] let decode ~dir = @@ -69,15 +100,23 @@ module External = struct let open Dune_lang.Decoder in fields (let+ private_dir = field_o "private_dir" string - and+ public_cmi_dir = field_o "public_cmi_dir" string in + and+ public_cmi_ocaml_dir = field_o "public_cmi_dir" string in let private_dir = Option.map ~f:(Path.relative dir) private_dir in - let public_cmi_dir = Option.map ~f:(Path.relative dir) public_cmi_dir in - { public_dir; private_dir; public_cmi_dir }) + let public_cmi_ocaml_dir = + Option.map ~f:(Path.relative dir) public_cmi_ocaml_dir + in + { public_dir + ; private_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir = None + }) let byte_dir t = t.public_dir let native_dir t = t.public_dir + let melange_dir t = t.public_dir + let dir t = t.public_dir let obj_dir t = t.public_dir @@ -86,14 +125,26 @@ module External = struct let all_obj_dirs t ~mode:_ = [ t.public_dir ] - let all_cmis { public_dir; private_dir; public_cmi_dir } = - List.filter_opt [ Some public_dir; private_dir; public_cmi_dir ] + let all_cmis + { public_dir + ; private_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir = _ + } = + List.filter_opt + [ Some public_dir + ; private_dir + ; public_cmi_ocaml_dir + (* TODO: might need to pass mode to conditionally include public_cmi_melange_dir *) + ] - let cm_public_dir t (cm_kind : Cm_kind.t) = + let cm_public_dir t (cm_kind : Lib_mode.Cm_kind.t) = match cm_kind with - | Cmx -> native_dir t - | Cmo -> byte_dir t - | Cmi -> public_cmi_dir t + | Ocaml Cmx -> native_dir t + | Ocaml Cmo -> byte_dir t + | Ocaml Cmi -> public_cmi_ocaml_dir t + | Melange Cmj -> melange_dir t + | Melange Cmi -> public_cmi_melange_dir t end module Local = struct @@ -102,30 +153,58 @@ module Local = struct ; obj_dir : Path.Build.t ; native_dir : Path.Build.t ; byte_dir : Path.Build.t - ; public_cmi_dir : Path.Build.t option + ; melange_dir : Path.Build.t + ; public_cmi_ocaml_dir : Path.Build.t option + ; public_cmi_melange_dir : Path.Build.t option ; private_lib : bool } let equal : t -> t -> bool = Poly.equal - let to_dyn { dir; obj_dir; native_dir; byte_dir; public_cmi_dir; private_lib } - = + let to_dyn + { dir + ; obj_dir + ; native_dir + ; byte_dir + ; melange_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir + ; private_lib + } = let open Dyn in record [ ("dir", Path.Build.to_dyn dir) ; ("obj_dir", Path.Build.to_dyn obj_dir) ; ("native_dir", Path.Build.to_dyn native_dir) ; ("byte_dir", Path.Build.to_dyn byte_dir) - ; ("public_cmi_dir", option Path.Build.to_dyn public_cmi_dir) + ; ("melange_dir", Path.Build.to_dyn melange_dir) + ; ("public_cmi_ocaml_dir", option Path.Build.to_dyn public_cmi_ocaml_dir) + ; ( "public_cmi_melange_dir" + , option Path.Build.to_dyn public_cmi_melange_dir ) ; ("private_lib", bool private_lib) ] - let make ~dir ~obj_dir ~native_dir ~byte_dir ~public_cmi_dir ~private_lib = - { dir; obj_dir; native_dir; byte_dir; public_cmi_dir; private_lib } + let make ~dir ~obj_dir ~native_dir ~byte_dir ~melange_dir + ~public_cmi_ocaml_dir ~public_cmi_melange_dir ~private_lib = + { dir + ; obj_dir + ; native_dir + ; byte_dir + ; melange_dir + ; public_cmi_ocaml_dir + ; public_cmi_melange_dir + ; private_lib + } + + let need_dedicated_public_dir t = + Option.is_some t.public_cmi_ocaml_dir + || Option.is_some t.public_cmi_melange_dir - let need_dedicated_public_dir t = Option.is_some t.public_cmi_dir + let public_cmi_ocaml_dir t = + Option.value ~default:t.byte_dir t.public_cmi_ocaml_dir - let public_cmi_dir t = Option.value ~default:t.byte_dir t.public_cmi_dir + let public_cmi_melange_dir t = + Option.value ~default:t.melange_dir t.public_cmi_melange_dir let dir t = t.dir @@ -135,44 +214,69 @@ module Local = struct let native_dir t = t.native_dir + let melange_dir t = t.melange_dir + let odoc_dir t = t.byte_dir - let all_obj_dirs t ~(mode : Mode.t) = - let dirs = [ t.byte_dir; public_cmi_dir t ] in - let dirs = - match mode with - | Byte -> dirs - | Native -> t.native_dir :: dirs - in - Path.Build.Set.of_list dirs |> Path.Build.Set.to_list + let all_obj_dirs t ~(mode : Lib_mode.t) = + match mode with + | Ocaml mode -> + let dirs = [ t.byte_dir; public_cmi_ocaml_dir t ] in + let dirs = + match mode with + | Byte -> dirs + | Native -> t.native_dir :: dirs + in + Path.Build.Set.of_list dirs |> Path.Build.Set.to_list + | Melange -> + [ t.melange_dir; public_cmi_melange_dir t ] + |> Path.Build.Set.of_list |> Path.Build.Set.to_list let make_lib ~dir ~has_private_modules ~private_lib lib_name = let obj_dir = Paths.library_object_directory ~dir lib_name in - let public_cmi_dir = - Option.some_if has_private_modules (Paths.library_public_cmi_dir ~obj_dir) + let public_cmi_ocaml_dir = + Option.some_if has_private_modules + (Paths.library_public_cmi_ocaml_dir ~obj_dir) + in + let public_cmi_melange_dir = + Option.some_if has_private_modules + (Paths.library_public_cmi_melange_dir ~obj_dir) in make ~dir ~obj_dir ~native_dir:(Paths.library_native_dir ~obj_dir) ~byte_dir:(Paths.library_byte_dir ~obj_dir) - ~public_cmi_dir ~private_lib + ~melange_dir:(Paths.library_melange_dir ~obj_dir) + ~public_cmi_ocaml_dir ~public_cmi_melange_dir ~private_lib let make_exe ~dir ~name = let obj_dir = Paths.executable_object_directory ~dir name in make ~dir ~obj_dir ~native_dir:(Paths.library_native_dir ~obj_dir) ~byte_dir:(Paths.library_byte_dir ~obj_dir) - ~public_cmi_dir:None ~private_lib:false + ~melange_dir:(Paths.library_melange_dir ~obj_dir) + ~public_cmi_ocaml_dir:None ~public_cmi_melange_dir:None ~private_lib:false + + let make_melange_emit ~dir ~name = + let obj_dir = Paths.melange_object_directory ~dir name in + make ~dir ~obj_dir + ~native_dir:(Paths.library_native_dir ~obj_dir) + ~byte_dir:(Paths.library_byte_dir ~obj_dir) + ~melange_dir:(Paths.library_melange_dir ~obj_dir) + ~public_cmi_ocaml_dir:None ~public_cmi_melange_dir:None ~private_lib:false - let cm_dir t cm_kind _ = + let cm_dir t (cm_kind : Lib_mode.Cm_kind.t) _ = match cm_kind with - | Cm_kind.Cmx -> native_dir t - | Cmo | Cmi -> byte_dir t + | Ocaml Cmx -> native_dir t + | Ocaml (Cmo | Cmi) -> byte_dir t + | Melange (Cmj | Cmi) -> melange_dir t - let cm_public_dir t (cm_kind : Cm_kind.t) = + let cm_public_dir t (cm_kind : Lib_mode.Cm_kind.t) = match cm_kind with - | Cmx -> native_dir t - | Cmo -> byte_dir t - | Cmi -> public_cmi_dir t + | Ocaml Cmx -> native_dir t + | Ocaml Cmo -> byte_dir t + | Ocaml Cmi -> public_cmi_ocaml_dir t + | Melange Cmj -> melange_dir t + | Melange Cmi -> public_cmi_melange_dir t end type _ t = @@ -222,12 +326,18 @@ let get_path : | Local l' -> l l' | Local_as_path l' -> Path.build (l l') -let public_cmi_dir = get_path ~l:Local.public_cmi_dir ~e:External.public_cmi_dir +let public_cmi_ocaml_dir = + get_path ~l:Local.public_cmi_ocaml_dir ~e:External.public_cmi_ocaml_dir + +let public_cmi_melange_dir = + get_path ~l:Local.public_cmi_melange_dir ~e:External.public_cmi_melange_dir let byte_dir = get_path ~l:Local.byte_dir ~e:External.byte_dir let native_dir = get_path ~l:Local.native_dir ~e:External.native_dir +let melange_dir = get_path ~l:Local.melange_dir ~e:External.melange_dir + let dir = get_path ~l:Local.dir ~e:External.dir let obj_dir = get_path ~l:Local.obj_dir ~e:External.obj_dir @@ -284,10 +394,13 @@ let as_local_exn (t : Path.t t) = let make_exe ~dir ~name = Local (Local.make_exe ~dir ~name) +let make_melange_emit ~dir ~name = Local (Local.make_melange_emit ~dir ~name) + let for_pp ~dir = Local - (Local.make ~dir ~obj_dir:dir ~native_dir:dir ~byte_dir:dir - ~public_cmi_dir:None ~private_lib:false) + (Local.make ~dir ~obj_dir:dir ~native_dir:dir ~byte_dir:dir ~melange_dir:dir + ~public_cmi_ocaml_dir:None ~public_cmi_melange_dir:None + ~private_lib:false) let to_local (t : Path.t t) = match t with @@ -316,28 +429,28 @@ module Module = struct let dir = cm_dir t kind visibility in relative t dir obj_name - let has_impl_if_needed m ~kind = - match (kind : Cm_kind.t) with - | Cmo | Cmx -> Module.has m ~ml_kind:Impl - | Cmi -> true + let has_impl_if_needed m ~(kind : Lib_mode.Cm_kind.t) = + match kind with + | Ocaml (Cmo | Cmx) | Melange Cmj -> Module.has m ~ml_kind:Impl + | Ocaml Cmi | Melange Cmi -> true let raise_no_impl m ~kind = Code_error.raise "module has no implementation" - [ ("m", Module.to_dyn m); ("kind", Cm_kind.to_dyn kind) ] + [ ("m", Module.to_dyn m); ("kind", Lib_mode.Cm_kind.to_dyn kind) ] let o_file t m ~ext_obj = - let kind = Cm_kind.Cmx in - if Module.has m ~ml_kind:Impl then Some (obj_file t m ~kind ~ext:ext_obj) + if Module.has m ~ml_kind:Impl then + Some (obj_file t m ~kind:(Ocaml Cmx) ~ext:ext_obj) else None let o_file_exn t m ~ext_obj = match o_file t m ~ext_obj with | Some o -> o - | None -> raise_no_impl m ~kind:Cmx + | None -> raise_no_impl m ~kind:(Ocaml Cmx) - let cm_file t m ~(kind : Cm_kind.t) = + let cm_file t m ~(kind : Lib_mode.Cm_kind.t) = if has_impl_if_needed m ~kind then - let ext = Cm_kind.ext kind in + let ext = Lib_mode.Cm_kind.ext kind in Some (obj_file t m ~kind ~ext) else None @@ -346,15 +459,15 @@ module Module = struct | Some s -> s | None -> raise_no_impl m ~kind - let cm_public_file (type path) (t : path t) m ~(kind : Cm_kind.t) : + let cm_public_file (type path) (t : path t) m ~(kind : Lib_mode.Cm_kind.t) : path option = let is_private = Module.visibility m = Private in let has_impl = Module.has m ~ml_kind:Impl in match kind with - | (Cmx | Cmo) when not has_impl -> None - | Cmi when is_private -> None + | (Ocaml (Cmx | Cmo) | Melange Cmj) when not has_impl -> None + | (Ocaml Cmi | Melange Cmi) when is_private -> None | _ -> - let ext = Cm_kind.ext kind in + let ext = Lib_mode.Cm_kind.ext kind in let base = cm_public_dir t kind in let obj_name = Module.obj_name m in let fname = Module_name.Unique.artifact_filename obj_name ~ext in @@ -367,21 +480,23 @@ module Module = struct Code_error.raise "cm_public_file_exn: invalid access. module has no implementation or \ is private" - [ ("m", Module.to_dyn m); ("kind", Cm_kind.to_dyn kind) ] + [ ("m", Module.to_dyn m); ("kind", Lib_mode.Cm_kind.to_dyn kind) ] - let cmt_file t m ~(ml_kind : Ml_kind.t) = + let cmt_file t m ~(ml_kind : Ml_kind.t) ~cm_kind = let file = Module.file m ~ml_kind in let ext = Ml_kind.cmt_ext ml_kind in - Option.map file ~f:(fun _ -> obj_file t m ~kind:Cmi ~ext) + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in + Option.map file ~f:(fun _ -> obj_file t m ~kind:cmi_kind ~ext) - let cmti_file t m = + let cmti_file t m ~cm_kind = let ext = Ml_kind.cmt_ext (match Module.file m ~ml_kind:Intf with | None -> Impl | Some _ -> Intf) in - obj_file t m ~kind:Cmi ~ext + let cmi_kind = Lib_mode.Cm_kind.cmi cm_kind in + obj_file t m ~kind:cmi_kind ~ext let odoc t m = let obj_name = Module.obj_name m in @@ -410,7 +525,7 @@ module Module = struct let o_files t modules ~ext_obj = List.filter_map modules ~f:(fun m -> if Module.has m ~ml_kind:Impl then - Some (path_of_build t (obj_file t m ~kind:Cmx ~ext:ext_obj)) + Some (path_of_build t (obj_file t m ~kind:(Ocaml Cmx) ~ext:ext_obj)) else None) let cm_files t modules ~kind = diff --git a/duniverse/dune_/src/dune_rules/obj_dir.mli b/duniverse/dune_/src/dune_rules/obj_dir.mli index aa4f7315d..c0c95d09b 100644 --- a/duniverse/dune_/src/dune_rules/obj_dir.mli +++ b/duniverse/dune_/src/dune_rules/obj_dir.mli @@ -45,14 +45,20 @@ val native_dir : 'path t -> 'path (** The private compiled byte file directories, and all cmi *) val byte_dir : 'path t -> 'path +(** The private compiled melange file directories, and all cmi *) +val melange_dir : 'path t -> 'path + val all_cmis : 'path t -> 'path list -(** The public compiled cmi file directory *) -val public_cmi_dir : 'path t -> 'path +(** The public compiled cmi file directory for ocaml *) +val public_cmi_ocaml_dir : 'path t -> 'path + +(** The public compiled cmi file directory for melange *) +val public_cmi_melange_dir : 'path t -> 'path val odoc_dir : 'path t -> 'path -val all_obj_dirs : 'path t -> mode:Mode.t -> 'path list +val all_obj_dirs : 'path t -> mode:Lib_mode.t -> 'path list (** Create the object directory for a library *) val make_lib : @@ -72,12 +78,14 @@ val decode : dir:Path.t -> Path.t t Dune_lang.Decoder.t val convert_to_external : Path.Build.t t -> dir:Path.t -> Path.t t -val cm_dir : 'path t -> Cm_kind.t -> Visibility.t -> 'path +val cm_dir : 'path t -> Lib_mode.Cm_kind.t -> Visibility.t -> 'path val to_dyn : _ t -> Dyn.t val make_exe : dir:Path.Build.t -> name:string -> Path.Build.t t +val make_melange_emit : dir:Path.Build.t -> name:string -> Path.Build.t t + val for_pp : dir:Path.Build.t -> Path.Build.t t val as_local_exn : Path.t t -> Path.Build.t t @@ -94,33 +102,42 @@ module Module : sig files produced from the compilation of a module (.cmi files, .cmx files, .o files, ...) *) - val cm_file : 'path t -> Module.t -> kind:Cm_kind.t -> 'path option + val cm_file : 'path t -> Module.t -> kind:Lib_mode.Cm_kind.t -> 'path option - val cm_public_file : 'path t -> Module.t -> kind:Cm_kind.t -> 'path option + val cm_public_file : + 'path t -> Module.t -> kind:Lib_mode.Cm_kind.t -> 'path option - val cmt_file : 'path t -> Module.t -> ml_kind:Ml_kind.t -> 'path option + val cmt_file : + 'path t + -> Module.t + -> ml_kind:Ml_kind.t + -> cm_kind:Lib_mode.Cm_kind.t + -> 'path option - val obj_file : 'path t -> Module.t -> kind:Cm_kind.t -> ext:string -> 'path + val obj_file : + 'path t -> Module.t -> kind:Lib_mode.Cm_kind.t -> ext:string -> 'path (** Same as [cm_file] but raises if [cm_kind] is [Cmo] or [Cmx] and the module has no implementation.*) - val cm_file_exn : 'path t -> Module.t -> kind:Cm_kind.t -> 'path + val cm_file_exn : 'path t -> Module.t -> kind:Lib_mode.Cm_kind.t -> 'path val o_file : 'path t -> Module.t -> ext_obj:string -> 'path option val o_file_exn : 'path t -> Module.t -> ext_obj:string -> 'path - val cm_public_file_exn : 'path t -> Module.t -> kind:Cm_kind.t -> 'path + val cm_public_file_exn : + 'path t -> Module.t -> kind:Lib_mode.Cm_kind.t -> 'path (** Either the .cmti, or .cmt if the module has no interface *) - val cmti_file : 'path t -> Module.t -> 'path + val cmti_file : 'path t -> Module.t -> cm_kind:Lib_mode.Cm_kind.t -> 'path val odoc : 'path t -> Module.t -> 'path module L : sig val o_files : 'path t -> Module.t list -> ext_obj:string -> Path.t list - val cm_files : 'path t -> Module.t list -> kind:Cm_kind.t -> Path.t list + val cm_files : + 'path t -> Module.t list -> kind:Lib_mode.Cm_kind.t -> Path.t list end module Dep : sig diff --git a/duniverse/dune_/src/dune_rules/ocamldep.ml b/duniverse/dune_/src/dune_rules/ocamldep.ml index d746a082e..c131a1d6c 100644 --- a/duniverse/dune_/src/dune_rules/ocamldep.ml +++ b/duniverse/dune_/src/dune_rules/ocamldep.ml @@ -1,5 +1,4 @@ open Import -module SC = Super_context module Modules_data = struct type t = @@ -75,13 +74,13 @@ let deps_of ~ml_kind unit = let source = Option.value_exn (Module.source unit ~ml_kind) in let dep = Obj_dir.Module.dep obj_dir in - let context = SC.context sctx in + let context = Super_context.context sctx in let parse_module_names = parse_module_names ~modules in let all_deps_file = dep (Transitive (unit, ml_kind)) in let ocamldep_output = dep (Immediate source) in let open Memo.O in let* () = - SC.add_rule sctx ~dir + Super_context.add_rule sctx ~dir (let open Action_builder.With_targets.O in let flags, sandbox = Option.value (Module.pp_flags unit) @@ -130,7 +129,7 @@ let deps_of Action.Merge_files_into (sources, extras, all_deps_file)) in let+ () = - SC.add_rule sctx ~dir + Super_context.add_rule sctx ~dir (Action_builder.With_targets.map ~f:Action.Full.make action) in let all_deps_file = Path.build all_deps_file in diff --git a/duniverse/dune_/src/dune_rules/odoc.ml b/duniverse/dune_/src/dune_rules/odoc.ml index 5fe86196f..e7fd7f276 100644 --- a/duniverse/dune_/src/dune_rules/odoc.ml +++ b/duniverse/dune_/src/dune_rules/odoc.ml @@ -1,7 +1,6 @@ open Import open Dune_file open Memo.O -module SC = Super_context let ( ++ ) = Path.Build.relative @@ -187,10 +186,6 @@ end = struct let odoc_input t = t end -let odoc sctx = - let dir = (Super_context.context sctx).build_dir in - SC.resolve_program sctx ~dir "odoc" ~loc:None ~hint:"opam install odoc" - let odoc_base_flags sctx build_dir = let open Memo.O in let+ conf = Super_context.odoc sctx ~dir:build_dir in @@ -198,6 +193,23 @@ let odoc_base_flags sctx build_dir = | Fatal -> Command.Args.A "--warn-error" | Nonfatal -> S [] +let run_odoc sctx ~dir command ~flags_for args = + let build_dir = (Super_context.context sctx).build_dir in + let open Memo.O in + let* program = + Super_context.resolve_program sctx ~dir:build_dir "odoc" ~loc:None + ~hint:"opam install odoc" + in + let+ base_flags = + match flags_for with + | None -> Memo.return Command.Args.empty + | Some path -> odoc_base_flags sctx path + in + let deps = Action_builder.env_var "ODOC_SYNTAX" in + let open Action_builder.With_targets.O in + Action_builder.with_no_targets deps + >>> Command.run ~dir program [ A command; base_flags; S args ] + let module_deps (m : Module.t) ~obj_dir ~(dep_graphs : Dep_graph.Ml_kind.t) = Action_builder.dyn_paths_unit (let open Action_builder.O in @@ -216,22 +228,23 @@ let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags) let+ () = let* action_with_targets = let doc_dir = Path.build (Obj_dir.odoc_dir obj_dir) in - let* odoc = odoc sctx in - let+ odoc_base_flags = odoc_base_flags sctx odoc_file in + let+ run_odoc = + run_odoc sctx ~dir:doc_dir "compile" ~flags_for:(Some odoc_file) + [ A "-I" + ; Path doc_dir + ; iflags + ; As [ "--pkg"; pkg_or_lnu ] + ; A "-o" + ; Target odoc_file + ; Dep + (Path.build + (Obj_dir.Module.cmti_file ~cm_kind:(Ocaml Cmi) obj_dir m)) + ] + in let open Action_builder.With_targets.O in Action_builder.with_no_targets file_deps >>> Action_builder.with_no_targets (module_deps m ~obj_dir ~dep_graphs) - >>> Command.run ~dir:doc_dir odoc - [ A "compile" - ; odoc_base_flags - ; A "-I" - ; Path doc_dir - ; iflags - ; As [ "--pkg"; pkg_or_lnu ] - ; A "-o" - ; Target odoc_file - ; Dep (Path.build (Obj_dir.Module.cmti_file obj_dir m)) - ] + >>> run_odoc in add_rule sctx action_with_targets in @@ -241,20 +254,17 @@ let compile_mld sctx (m : Mld.t) ~includes ~doc_dir ~pkg = let open Memo.O in let odoc_file = Mld.odoc_file m ~doc_dir in let odoc_input = Mld.odoc_input m in - let* odoc = odoc sctx in - let* odoc_base_flags = odoc_base_flags sctx odoc_input in - let+ () = - add_rule sctx - (Command.run ~dir:(Path.build doc_dir) odoc - [ A "compile" - ; odoc_base_flags - ; Command.Args.dyn includes - ; As [ "--pkg"; Package.Name.to_string pkg ] - ; A "-o" - ; Target odoc_file - ; Dep (Path.build odoc_input) - ]) + let* run_odoc = + run_odoc sctx ~dir:(Path.build doc_dir) "compile" + ~flags_for:(Some odoc_input) + [ Command.Args.dyn includes + ; As [ "--pkg"; Package.Name.to_string pkg ] + ; A "-o" + ; Target odoc_file + ; Dep (Path.build odoc_input) + ] in + let+ () = add_rule sctx run_odoc in odoc_file let odoc_include_flags ctx pkg requires = @@ -281,21 +291,19 @@ let link_odoc_rules sctx (odoc_file : odoc_artefact) ~pkg ~requires = let ctx = Super_context.context sctx in let deps = Dep.deps ctx pkg requires in let open Memo.O in - let* odoc = odoc sctx - and* odoc_base_flags = odoc_base_flags sctx odoc_file.odoc_file in + let* run_odoc = + run_odoc sctx + ~dir:(Path.build (Paths.html_root ctx)) + "link" ~flags_for:(Some odoc_file.odoc_file) + [ odoc_include_flags ctx pkg requires + ; A "-o" + ; Target odoc_file.odocl_file + ; Dep (Path.build odoc_file.odoc_file) + ] + in add_rule sctx (let open Action_builder.With_targets.O in - Action_builder.with_no_targets deps - >>> Command.run - ~dir:(Path.build (Paths.html_root ctx)) - odoc - [ A "link" - ; odoc_base_flags - ; odoc_include_flags ctx pkg requires - ; A "-o" - ; Target odoc_file.odocl_file - ; Dep (Path.build odoc_file.odoc_file) - ]) + Action_builder.with_no_targets deps >>> run_odoc) let setup_library_odoc_rules cctx (local_lib : Lib.Local.t) = let open Memo.O in @@ -332,14 +340,23 @@ let setup_html sctx (odoc_file : odoc_artefact) = match odoc_file.source with | Mld -> (odoc_file.html_file, []) | Module -> - (* Dummy target so that the bellow rule as at least one target. We do this + (* Dummy target so that the below rule as at least one target. We do this because we don't know the targets of odoc in this case. The proper way to support this would be to have directory targets. *) let dummy = Action_builder.create_file (odoc_file.html_dir ++ ".dummy") in (odoc_file.html_dir, [ dummy ]) in let open Memo.O in - let* odoc = odoc sctx in + let* run_odoc = + run_odoc sctx + ~dir:(Path.build (Paths.html_root ctx)) + "html-generate" ~flags_for:None + [ A "-o" + ; Path (Path.build (Paths.html_root ctx)) + ; Dep (Path.build odoc_file.odocl_file) + ; Hidden_targets [ odoc_file.html_file ] + ] + in add_rule sctx (Action_builder.progn (Action_builder.with_no_targets @@ -347,30 +364,22 @@ let setup_html sctx (odoc_file : odoc_artefact) = (Action.Full.make (Action.Progn [ Action.Remove_tree to_remove - ; Action.Mkdir (Path.build odoc_file.html_dir) + ; Action.Mkdir odoc_file.html_dir ]))) - :: Command.run - ~dir:(Path.build (Paths.html_root ctx)) - odoc - [ A "html-generate" - ; A "-o" - ; Path (Path.build (Paths.html_root ctx)) - ; Dep (Path.build odoc_file.odocl_file) - ; Hidden_targets [ odoc_file.html_file ] - ] - :: dummy)) + :: run_odoc :: dummy)) let setup_css_rule sctx = let open Memo.O in let ctx = Super_context.context sctx in - let* odoc = odoc sctx in - add_rule sctx - (Command.run ~dir:(Path.build ctx.build_dir) odoc - [ A "support-files" - ; A "-o" - ; Path (Path.build (Paths.html_root ctx)) - ; Hidden_targets [ Paths.css_file ctx; Paths.highlight_pack_js ctx ] - ]) + let* run_odoc = + run_odoc sctx ~dir:(Path.build ctx.build_dir) "support-files" + ~flags_for:None + [ A "-o" + ; Path (Path.build (Paths.html_root ctx)) + ; Hidden_targets [ Paths.css_file ctx; Paths.highlight_pack_js ctx ] + ] + in + add_rule sctx run_odoc let sp = Printf.sprintf diff --git a/duniverse/dune_/src/dune_rules/ordered_set_lang.ml b/duniverse/dune_/src/dune_rules/ordered_set_lang.ml index 9dc8d7168..fb50e5bae 100644 --- a/duniverse/dune_/src/dune_rules/ordered_set_lang.ml +++ b/duniverse/dune_/src/dune_rules/ordered_set_lang.ml @@ -262,9 +262,6 @@ module Unexpanded = struct ; context } - let concat ~context ~pos a b = - { ast = Ast.Union [ a.ast; b.ast ]; loc = Some (Loc.of_pos pos); context } - let field ?check name = let decode = match check with diff --git a/duniverse/dune_/src/dune_rules/ordered_set_lang.mli b/duniverse/dune_/src/dune_rules/ordered_set_lang.mli index dc8cd05eb..6295bfdfe 100644 --- a/duniverse/dune_/src/dune_rules/ordered_set_lang.mli +++ b/duniverse/dune_/src/dune_rules/ordered_set_lang.mli @@ -59,8 +59,6 @@ module Unexpanded : sig val include_single : context:Univ_map.t -> pos:string * int * int * int -> string -> t - val concat : context:Univ_map.t -> pos:string * int * int * int -> t -> t -> t - val field : ?check:unit Dune_lang.Decoder.t -> string diff --git a/duniverse/dune_/src/dune_rules/ordered_set_lang_intf.ml b/duniverse/dune_/src/dune_rules/ordered_set_lang_intf.ml index e2a820da1..6f28a870d 100644 --- a/duniverse/dune_/src/dune_rules/ordered_set_lang_intf.ml +++ b/duniverse/dune_/src/dune_rules/ordered_set_lang_intf.ml @@ -5,7 +5,18 @@ module type Key = sig val compare : t -> t -> Ordering.t - module Map : Map.S with type key = t + module Map : sig + type key := t + + type 'a t + + val singleton : key -> 'a -> 'a t + + val empty : 'a t + + val merge : + 'a t -> 'b t -> f:(key -> 'a option -> 'b option -> 'c option) -> 'c t + end end module type Unordered_eval = sig diff --git a/duniverse/dune_/src/dune_rules/pkg_config.ml b/duniverse/dune_/src/dune_rules/pkg_config.ml new file mode 100644 index 000000000..7b8f2b368 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/pkg_config.ml @@ -0,0 +1,60 @@ +open Import + +module Query = struct + type t = + | Libs of string + | Cflags of string + + let file t ~dir = + let dir = Path.Build.relative dir ".pkg-config" in + Path.Build.relative dir + @@ + match t with + | Libs s -> sprintf "%s.libs" s + | Cflags s -> sprintf "%s.cflags" s + + let to_args t : _ Command.Args.t list = + Hidden_deps Dep.(Set.singleton universe) + :: + (match t with + | Libs lib -> [ A "--libs"; A lib ] + | Cflags lib -> [ A "--cflags"; A lib ]) + + let default = function + | Libs lib -> [ sprintf "-l%s" lib ] + | Cflags _ -> [ "-I/usr/include" ] + + let read t sctx ~dir = + let open Action_builder.O in + let* bin = + Action_builder.of_memo + @@ Super_context.resolve_program sctx ~loc:None ~dir "pkg-config" + in + match bin with + | Error _ -> Action_builder.return (default t) + | Ok _ -> + let file = file t ~dir in + let+ contents = Action_builder.contents (Path.build file) in + String.split_lines contents + |> List.hd |> String.extract_blank_separated_words +end + +let gen_rule sctx ~loc ~dir query = + let open Memo.O in + let* bin = + Super_context.resolve_program sctx ~loc:(Some loc) ~dir "pkg-config" + in + match bin with + | Error _ -> Memo.return @@ Error `Not_found + | Ok _ as bin -> + let command = + Command.run ~dir:(Path.build dir) ~stdout_to:(Query.file ~dir query) bin + (Query.to_args query) + in + let+ () = Super_context.add_rule sctx ~loc ~dir command in + Ok () + +let read_flags ~file = + let open Action_builder.O in + let+ contents = Action_builder.contents (Path.build file) in + String.split_lines contents |> List.hd |> String.extract_blank_separated_words diff --git a/duniverse/dune_/src/dune_rules/pkg_config.mli b/duniverse/dune_/src/dune_rules/pkg_config.mli new file mode 100644 index 000000000..14b4b622c --- /dev/null +++ b/duniverse/dune_/src/dune_rules/pkg_config.mli @@ -0,0 +1,21 @@ +open Import + +module Query : sig + type t = + | Libs of string + | Cflags of string + + val file : t -> dir:Path.Build.t -> Path.Build.t + + val read : + t -> Super_context.t -> dir:Path.Build.t -> string list Action_builder.t +end + +val gen_rule : + Super_context.t + -> loc:Loc.t + -> dir:Path.Build.t + -> Query.t + -> (unit, [ `Not_found ]) result Memo.t + +val read_flags : file:Path.Build.t -> string list Action_builder.t diff --git a/duniverse/dune_/src/dune_rules/plugin_rules.ml b/duniverse/dune_/src/dune_rules/plugin_rules.ml index 8ff58283f..b7b109e30 100644 --- a/duniverse/dune_/src/dune_rules/plugin_rules.ml +++ b/duniverse/dune_/src/dune_rules/plugin_rules.ml @@ -48,6 +48,6 @@ let install_rules ~sctx ~sites ~dir ({ name; site = loc, (pkg, site); _ } as t) ~dst:(sprintf "%s/%s" (Package.Name.to_string name) Findlib.meta_fn) (Site { pkg; site; loc }) (Sites.section_of_site sites) - meta + ~kind:`File meta in [ Install.Entry.Sourced.create ~loc entry ] diff --git a/duniverse/dune_/src/dune_rules/preprocessing.ml b/duniverse/dune_/src/dune_rules/preprocessing.ml index bde17aa30..00695b744 100644 --- a/duniverse/dune_/src/dune_rules/preprocessing.ml +++ b/duniverse/dune_/src/dune_rules/preprocessing.ml @@ -1,6 +1,5 @@ open Import open Memo.O -module SC = Super_context (* Encoded representation of a set of library names + scope *) module Key : sig @@ -282,7 +281,7 @@ let ppx_exe (ctx : Context.t) ~key = let build_ppx_driver sctx ~scope ~target ~pps ~pp_names = let open Memo.O in - let ctx = SC.context sctx in + let ctx = Super_context.context sctx in let* driver_and_libs = let ( let& ) t f = Resolve.Memo.bind t ~f in let& pps = Resolve.Memo.lift pps in @@ -306,7 +305,7 @@ let build_ppx_driver sctx ~scope ~target ~pps ~pp_names = |> Option.value_exn |> Path.as_in_build_dir_exn in let* () = - SC.add_rule sctx ~dir + Super_context.add_rule sctx ~dir (Action_builder.write_file_dyn ml_source (Resolve.read (let open Resolve.O in @@ -518,7 +517,7 @@ let setup_dialect_rules sctx ~sandbox ~dir ~expander (m : Module.t) = Option.value_exn (Module.file ml ~ml_kind) |> Path.as_in_build_dir_exn in - SC.add_rule sctx ~dir + Super_context.add_rule sctx ~dir (action_for_pp_with_target ~sandbox ~loc ~expander ~action ~src ~target:dst))) in @@ -538,7 +537,9 @@ let lint_module sctx ~sandbox ~dir ~expander ~lint ~lib_name ~scope = let open Action_builder.O in Staged.stage (let alias = Alias.lint ~dir in - let add_alias build = SC.add_alias_action sctx alias build ~dir in + let add_alias build = + Super_context.add_alias_action sctx alias build ~dir + in let lint = Module_name.Per_item.map lint ~f:(function | Preprocess.No_preprocessing -> fun ~source:_ ~ast:_ -> Memo.return () @@ -642,7 +643,7 @@ let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps action_for_pp_with_target ~sandbox ~loc ~expander ~action ~src ~target:dst in - SC.add_rule sctx ~loc ~dir + Super_context.add_rule sctx ~loc ~dir (let open Action_builder.With_targets.O in Action_builder.with_no_targets preprocessor_deps >>> action)) >>= setup_dialect_rules sctx ~sandbox ~dir ~expander @@ -675,7 +676,7 @@ let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps let* ast = setup_dialect_rules sctx ~sandbox ~dir ~expander m in let* () = Memo.when_ lint (fun () -> lint_module ~ast ~source:m) in pped_module ast ~f:(fun ml_kind src dst -> - SC.add_rule sctx ~loc ~dir + Super_context.add_rule sctx ~loc ~dir (promote_correction_with_target ~suffix:corrected_suffix (Path.as_in_build_dir_exn (Option.value_exn (Module.file m ~ml_kind))) @@ -716,7 +717,8 @@ let make sctx ~dir ~expander ~lint ~preprocess ~preprocessor_deps List.map (List.concat [ [ Path.reach (Path.build exe) - ~from:(Path.build (SC.context sctx).build_dir) + ~from: + (Path.build (Super_context.context sctx).build_dir) ] ; driver_flags ; flags diff --git a/duniverse/dune_/src/dune_rules/recursive_include.ml b/duniverse/dune_/src/dune_rules/recursive_include.ml new file mode 100644 index 000000000..007c9afdd --- /dev/null +++ b/duniverse/dune_/src/dune_rules/recursive_include.ml @@ -0,0 +1,98 @@ +open! Import + +module Include_term = struct + type t = + { context : Univ_map.t + ; path : String_with_vars.t + } + + let decode ~include_keyword ~allowed_in_versions = + let open Dune_lang.Decoder in + let version_check () = + match allowed_in_versions with + | `Since version -> Syntax.since Stanza.syntax version + | `All -> return () + in + sum + [ ( include_keyword + , let+ () = version_check () + and+ context = get_all + and+ path = String_with_vars.decode in + { context; path } ) + ] +end + +module Make (Base_term : sig + type t + + val decode : t Dune_lang.Decoder.t +end) (Config : sig + val include_keyword : string + + val include_allowed_in_versions : [ `Since of Syntax.Version.t | `All ] + + val non_sexp_behaviour : [ `User_error | `Parse_as_base_term ] +end) = +struct + type t = + | Base of Base_term.t + | Include of Include_term.t + + let of_base base = Base base + + let decode = + let open Dune_lang.Decoder in + let base_term_decode = + let+ base_term = Base_term.decode in + Base base_term + in + let include_term_decode = + let+ include_term = + Include_term.decode ~include_keyword:Config.include_keyword + ~allowed_in_versions:Config.include_allowed_in_versions + in + Include include_term + in + include_term_decode <|> base_term_decode + + let load_included_file path ~context = + let open Memo.O in + let+ contents = Build_system.read_file (Path.build path) ~f:Io.read_file in + let ast = + Dune_lang.Parser.parse_string contents ~mode:Single + ~fname:(Path.Build.to_string path) + in + let parse = Dune_lang.Decoder.parse decode context in + match ast with + | List (_loc, terms) -> List.map terms ~f:parse + | other -> ( + match Config.non_sexp_behaviour with + | `User_error -> + let loc = Dune_sexp.Ast.loc other in + User_error.raise ~loc [ Pp.textf "Expected list, got:\n%s" contents ] + | `Parse_as_base_term -> + let term = Dune_lang.Decoder.parse decode context other in + [ term ]) + + let expand_include t ~expand_str ~dir = + let rec expand_include t ~seen = + match t with + | Base base_term -> Memo.return [ base_term ] + | Include { context; path = path_sw } -> + let open Memo.O in + let* path = + expand_str path_sw + >>| Path.Build.relative ~error_loc:(String_with_vars.loc path_sw) dir + in + if Path.Build.Set.mem seen path then + User_error.raise + ~loc:(String_with_vars.loc path_sw) + [ Pp.textf "Include loop detected via: %s" + (Path.Build.to_string path) + ]; + let seen = Path.Build.Set.add seen path in + let* contents = load_included_file path ~context in + Memo.List.concat_map contents ~f:(expand_include ~seen) + in + expand_include t ~seen:Path.Build.Set.empty +end diff --git a/duniverse/dune_/src/dune_rules/recursive_include.mli b/duniverse/dune_/src/dune_rules/recursive_include.mli new file mode 100644 index 000000000..0d2ad6cfb --- /dev/null +++ b/duniverse/dune_/src/dune_rules/recursive_include.mli @@ -0,0 +1,51 @@ +(** Encapsulates the situation where you have a configuration language made up + of a sequence of terms (e.g. a list of directories to search for foreign + header files), and want to add a new term to the language (include ) + which parses a sexp list of terms in the same configuration language from + the file at and effectively replaces the (include ...) statement with + the result of parsing the file. Supports chains of recursively included + files, and detects include loops. *) + +open! Import + +module Make (Base_term : sig + (** The type of a term in the configuration language without (include ...) + terms *) + type t + + val decode : t Dune_lang.Decoder.t +end) (_ : sig + (** The keyword that will be used to identify an include statement (ie. the + "include" in (include ...)) *) + val include_keyword : string + + (** An expected use case for this module is adding (include ...) statements to + existing configuration languages used in dune fields, and in such cases + we'll want to assert that (include ...) statements are only used beyond a + particular version of dune. An error will be throw during parsing if an + (include ...) statement is encountered in versions of dune that don't + satisfy this predicate. *) + val include_allowed_in_versions : [ `Since of Syntax.Version.t | `All ] + + (** What to do if the included file doesn't contain a sexp *) + val non_sexp_behaviour : [ `User_error | `Parse_as_base_term ] +end) : sig + (** The type of terms in the configuration language obtained by adding + (include ...) statements to the base language *) + type t + + val of_base : Base_term.t -> t + + val decode : t Dune_lang.Decoder.t + + (** Recursively expands (include ...) terms in the language, producing a list + of terms in the original language (the language without (include ...) + statements). Paths referred to by (include ) are resolved relative + to [dir]. Paths are given as [String_with_vars.t], and the [expand_str] + function is used to resolve them to strings. *) + val expand_include : + t + -> expand_str:(String_with_vars.t -> string Memo.t) + -> dir:Path.Build.t + -> Base_term.t list Memo.t +end diff --git a/duniverse/dune_/src/dune_rules/resolve.mli b/duniverse/dune_/src/dune_rules/resolve.mli index 2c1c07615..cb054b219 100644 --- a/duniverse/dune_/src/dune_rules/resolve.mli +++ b/duniverse/dune_/src/dune_rules/resolve.mli @@ -5,7 +5,7 @@ Indeed, in many places in the Dune codebase we eagerly resolve library names at "rule generation time". This means that if a library was missing, we - could fail right from the start if we are not caferul. What is more, we + could fail right from the start if we are not careful. What is more, we would fail even if we didn't need to build the item that depended on this library. This would not be good. @@ -120,7 +120,7 @@ val args : 'a Command.Args.t t -> 'a Command.Args.t (** Same as [read] but in the memo build monad. Use with caution! *) val read_memo : 'a t -> 'a Memo.t -(** Read the value immediatly, ignoring actual errors. *) +(** Read the value immediately, ignoring actual errors. *) val peek : 'a t -> ('a, unit) result (** [is_ok t] is the same as [Result.is_ok (peek t)] *) @@ -199,7 +199,7 @@ module Memo : sig val of_result : ('a, exn) result -> 'a t - (** Read the value immediatly, ignoring actual errors. *) + (** Read the value immediately, ignoring actual errors. *) val peek : 'a t -> ('a, unit) result Memo.t end with type 'a resolve := 'a t diff --git a/duniverse/dune_/src/dune_rules/rule_mode_decoder.ml b/duniverse/dune_/src/dune_rules/rule_mode_decoder.ml new file mode 100644 index 000000000..9403e70c8 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/rule_mode_decoder.ml @@ -0,0 +1,96 @@ +open Import +open Dune_lang.Decoder + +module Promote = struct + let into_decode = + let+ loc, dir = located relative_file in + { Rule.Promote.Into.loc; dir } + + let decode : Rule.Promote.t Dune_lang.Decoder.t = + fields + (let+ until_clean = + field_b "until-clean" + ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 10)) + and+ into = + field_o "into" + (Dune_lang.Syntax.since Stanza.syntax (1, 10) >>> into_decode) + and+ only = + field_o "only" + (Dune_lang.Syntax.since Stanza.syntax (1, 10) + >>> Predicate_lang.decode Glob.decode) + in + let only = + Option.map only ~f:(fun only -> + let only = Predicate_lang.map only ~f:Glob.to_predicate in + Predicate_lang.to_predicate only ~standard:Predicate_lang.any) + in + { Rule.Promote.lifetime = + (if until_clean then Until_clean else Unlimited) + ; into + ; only + }) +end + +let mode_decoders = + [ ("standard", return Rule.Mode.Standard) + ; ("fallback", return Rule.Mode.Fallback) + ; ( "promote" + , let+ p = Promote.decode in + Rule.Mode.Promote p ) + ; ( "promote-until-clean" + , let+ () = + Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) + ~extra_info:"Use the (promote (until-clean)) syntax instead." + in + Rule.Mode.Promote { lifetime = Until_clean; into = None; only = None } ) + ; ( "promote-into" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 8) + and+ () = + Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) + ~extra_info:"Use the (promote (into )) syntax instead." + and+ into = Promote.into_decode in + Rule.Mode.Promote { lifetime = Unlimited; into = Some into; only = None } + ) + ; ( "promote-until-clean-into" + , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 8) + and+ () = + Dune_lang.Syntax.deleted_in Stanza.syntax (3, 0) + ~extra_info: + "Use the (promote (until-clean) (into )) syntax instead." + and+ into = Promote.into_decode in + Rule.Mode.Promote + { lifetime = Until_clean; into = Some into; only = None } ) + ] + +module Extended = struct + type t = + | Normal of Rule.Mode.t + | Patch_back_source_tree + + let patch_back_from_source_tree_syntax = + Dune_lang.Syntax.create ~experimental:true ~name:"patch-back-source-tree" + ~desc:"experimental support for (mode patch-back-source-tree)" + [ ((0, 1), `Since (3, 0)) ] + + let () = + Dune_project.Extension.register_simple patch_back_from_source_tree_syntax + (Dune_lang.Decoder.return []) + + let decode = + sum + (( "patch-back-source-tree" + , let+ () = + Dune_lang.Syntax.since patch_back_from_source_tree_syntax (0, 1) + in + Patch_back_source_tree ) + :: List.map mode_decoders ~f:(fun (name, dec) -> + ( name + , let+ x = dec in + Normal x ))) + + let field = field "mode" decode ~default:(Normal Standard) +end + +let decode = sum mode_decoders + +let field = field "mode" decode ~default:Rule.Mode.Standard diff --git a/duniverse/dune_/src/dune_rules/rule_mode_decoder.mli b/duniverse/dune_/src/dune_rules/rule_mode_decoder.mli new file mode 100644 index 000000000..7fbd4c2f2 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/rule_mode_decoder.mli @@ -0,0 +1,19 @@ +open! Import + +module Promote : sig + val decode : Rule.Promote.t Dune_lang.Decoder.t + + val into_decode : Rule.Promote.Into.t Dune_lang.Decoder.t +end + +module Extended : sig + type t = + | Normal of Rule.Mode.t + | Patch_back_source_tree + + val field : t Dune_lang.Decoder.fields_parser +end + +val decode : Rule.Mode.t Dune_lang.Decoder.t + +val field : Rule.Mode.t Dune_lang.Decoder.fields_parser diff --git a/duniverse/dune_/src/dune_rules/simple_rules.ml b/duniverse/dune_/src/dune_rules/simple_rules.ml index 2a1d2978a..119aa8964 100644 --- a/duniverse/dune_/src/dune_rules/simple_rules.ml +++ b/duniverse/dune_/src/dune_rules/simple_rules.ml @@ -1,20 +1,19 @@ open Import open Dune_file -module SC = Super_context open Memo.O module Alias_rules = struct let add sctx ~alias ~loc build = let dir = Alias.dir alias in - SC.add_alias_action sctx alias ~dir ~loc build + Super_context.add_alias_action sctx alias ~dir ~loc build let add_empty sctx ~loc ~alias = let action = Action_builder.return (Action.Full.make Action.empty) in add sctx ~loc ~alias action end -let check_filename ~kind = - let not_in_dir ~error_loc s = +let check_filename = + let not_in_dir ~kind ~error_loc s = User_error.raise ~loc:error_loc [ (match kind with | Targets_spec.Kind.File -> @@ -23,32 +22,32 @@ let check_filename ~kind = Pp.textf "Directory targets must have exactly one path component.") ] in - fun ~error_loc ~dir -> function + fun ~kind ~error_loc ~dir -> function | Value.String ("." | "..") -> User_error.raise ~loc:error_loc [ Pp.text "'.' and '..' are not valid targets" ] | String s -> if Filename.dirname s <> Filename.current_dir_name then - not_in_dir ~error_loc s; + not_in_dir ~kind ~error_loc s; Path.Build.relative ~error_loc dir s | Path p -> ( match Option.equal Path.equal (Path.parent p) (Some (Path.build dir)) with | true -> Path.as_in_build_dir_exn p - | false -> not_in_dir ~error_loc (Path.to_string p)) - | Dir p -> not_in_dir ~error_loc (Path.to_string p) + | false -> not_in_dir ~kind ~error_loc (Path.to_string p)) + | Dir p -> not_in_dir ~kind ~error_loc (Path.to_string p) type rule_kind = - | Alias_only of Alias.Name.t - | Alias_with_targets of Alias.Name.t * Path.Build.t + | Aliases_only of Alias.Name.t list + | Aliases_with_targets of Alias.Name.t list * Path.Build.t | No_alias let rule_kind ~(rule : Rule.t) ~(action : _ Action_builder.With_targets.t) = - match rule.alias with - | None -> No_alias - | Some alias -> ( + match rule.aliases with + | [] -> No_alias + | aliases -> ( match Targets.head action.targets with - | None -> Alias_only alias - | Some target -> Alias_with_targets (alias, target)) + | None -> Aliases_only aliases + | Some target -> Aliases_with_targets (aliases, target)) let interpret_and_add_locks ~expander locks action = let+ locks = Expander.expand_locks expander ~base:`Of_expander locks in @@ -62,17 +61,18 @@ let add_user_rule sctx ~dir ~(rule : Rule.t) ~(action : _ Action_builder.With_targets.t) ~expander = let* build = interpret_and_add_locks ~expander rule.locks action.build in let action = { action with Action_builder.With_targets.build } in - SC.add_rule_get_targets sctx ~dir ~mode:rule.mode ~loc:rule.loc action + Super_context.add_rule_get_targets sctx ~dir ~mode:rule.mode ~loc:rule.loc + action let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) = Expander.eval_blang expander rule.enabled_if >>= function - | false -> ( - match rule.alias with - | None -> Memo.return None - | Some name -> - let alias = Alias.make ~dir name in - let+ () = Alias_rules.add_empty sctx ~alias ~loc:(Some rule.loc) in - None) + | false -> + let aliases = List.map rule.aliases ~f:(Alias.make ~dir) in + let+ () = + Memo.parallel_iter aliases ~f:(fun alias -> + Alias_rules.add_empty sctx ~loc:(Some rule.loc) ~alias) + in + None | true -> ( let* targets = match rule.targets with @@ -96,11 +96,10 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) = | None -> expander | Some bindings -> Expander.add_bindings expander ~bindings in - let action = + let* (action : _ Action_builder.With_targets.t) = Action_unexpanded.expand (snd rule.action) ~loc:(fst rule.action) ~expander ~deps:rule.deps ~targets ~targets_dir:dir in - let* action = action in let action = if rule.patch_back_source_tree then Action_builder.With_targets.map action ~f:(fun action -> @@ -121,18 +120,22 @@ let user_rule sctx ?extra_bindings ~dir ~expander (rule : Rule.t) = | No_alias -> let+ targets = add_user_rule sctx ~dir ~rule ~action ~expander in Some targets - | Alias_with_targets (alias, alias_target) -> + | Aliases_with_targets (aliases, alias_target) -> let* () = - let alias = Alias.make alias ~dir in - Rules.Produce.Alias.add_deps alias - (Action_builder.path (Path.build alias_target)) + let aliases = List.map ~f:(Alias.make ~dir) aliases in + Memo.parallel_iter aliases ~f:(fun alias -> + Rules.Produce.Alias.add_deps alias + (Action_builder.path (Path.build alias_target))) in let+ targets = add_user_rule sctx ~dir ~rule ~action ~expander in Some targets - | Alias_only name -> - let alias = Alias.make ~dir name in + | Aliases_only aliases -> + let aliases = List.map ~f:(Alias.make ~dir) aliases in let* action = interpret_and_add_locks ~expander rule.locks action.build in - let+ () = Alias_rules.add sctx ~alias ~loc:(Some rule.loc) action in + let+ () = + Memo.parallel_iter aliases ~f:(fun alias -> + Alias_rules.add sctx ~alias ~loc:(Some rule.loc) action) + in None) let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) = @@ -170,7 +173,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) = let* exists_or_generated = match src_in_src with | In_build_dir _ -> assert false - | External _ -> Fs_memo.dir_exists src_in_src + | External ext -> Fs_memo.dir_exists (External ext) | In_source_tree src_in_src -> ( Source_tree.dir_exists src_in_src >>= function | true -> Memo.return true @@ -199,7 +202,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) = ~f:(fun file_src -> let basename = Path.basename file_src in let file_dst = Path.Build.relative dir basename in - SC.add_rule sctx ~loc ~dir ~mode:def.mode + Super_context.add_rule sctx ~loc ~dir ~mode:def.mode ((if def.add_line_directive then Copy_line_directive.builder else Action_builder.copy) ~src:file_src ~dst:file_dst)) diff --git a/duniverse/dune_/src/dune_rules/stanza_common.ml b/duniverse/dune_/src/dune_rules/stanza_common.ml index f566f5ee9..cdb7b7bcf 100644 --- a/duniverse/dune_/src/dune_rules/stanza_common.ml +++ b/duniverse/dune_/src/dune_rules/stanza_common.ml @@ -117,3 +117,68 @@ module Pkg = struct end let modules_field name = Ordered_set_lang.field name + +let preprocess_fields = + let+ preprocess = + field "preprocess" Preprocess.Per_module.decode + ~default:(Preprocess.Per_module.default ()) + and+ preprocessor_deps = + field_o "preprocessor_deps" + (let+ loc = loc + and+ l = repeat Dep_conf.decode in + (loc, l)) + and+ syntax = Dune_lang.Syntax.get_exn Stanza.syntax in + let preprocessor_deps = + match preprocessor_deps with + | None -> [] + | Some (loc, deps) -> + let deps_might_be_used = + Module_name.Per_item.exists preprocess ~f:(fun p -> + match (p : _ Preprocess.t) with + | Action _ | Pps _ -> true + | No_preprocessing | Future_syntax _ -> false) + in + if not deps_might_be_used then + User_warning.emit ~loc + ~is_error:(syntax >= (2, 0)) + [ Pp.text + "This preprocessor_deps field will be ignored because no \ + preprocessor that might use them is configured." + ]; + deps + in + (preprocess, preprocessor_deps) + +let instrumentation = + located + (multi_field "instrumentation" + (Dune_lang.Syntax.since Stanza.syntax (2, 7) + >>> fields + (let+ backend = + field "backend" + (let+ libname = located Lib_name.decode + and+ flags = + let* current_ver = + Dune_lang.Syntax.get_exn Stanza.syntax + in + let version_check flag = + let ver = (2, 8) in + if current_ver >= ver then flag + else + let what = + "The possibility to pass arguments to \ + instrumentation backends" + in + Dune_lang.Syntax.Error.since + (String_with_vars.loc flag) + Stanza.syntax ver ~what + in + repeat (String_with_vars.decode >>| version_check) + in + (libname, flags)) + and+ deps = + field "deps" ~default:[] + (Dune_lang.Syntax.since Stanza.syntax (2, 9) + >>> repeat Dep_conf.decode) + in + (backend, deps)))) diff --git a/duniverse/dune_/src/dune_rules/stanza_common.mli b/duniverse/dune_/src/dune_rules/stanza_common.mli index df65d5273..3711e716b 100644 --- a/duniverse/dune_/src/dune_rules/stanza_common.mli +++ b/duniverse/dune_/src/dune_rules/stanza_common.mli @@ -1,19 +1,29 @@ open Import +open Dune_lang.Decoder module Pkg : sig - val decode : Package.t Dune_lang.Decoder.t + val decode : Package.t t val resolve : Dune_project.t -> Package.Name.t -> (Package.t, User_message.t) Result.t - val field : stanza:string -> Package.t Dune_lang.Decoder.fields_parser + val field : stanza:string -> Package.t fields_parser - val field_opt : - ?check:unit Dune_lang.Decoder.t - -> unit - -> Package.t option Dune_lang.Decoder.fields_parser + val field_opt : ?check:unit t -> unit -> Package.t option fields_parser val default_exn : loc:Loc.t -> Dune_project.t -> string -> Package.t end -val modules_field : string -> Ordered_set_lang.t Dune_lang.Decoder.fields_parser +val modules_field : string -> Ordered_set_lang.t fields_parser + +(** [preprocess] and [preprocessor_deps] fields *) +val preprocess_fields : + (Preprocess.Without_instrumentation.t Preprocess.Per_module.t + * Dep_conf.t list) + fields_parser + +(** [instrumentation] multi field *) +val instrumentation : + (Loc.t + * (((Loc.t * Lib_name.t) * String_with_vars.t list) * Dep_conf.t list) list) + fields_parser diff --git a/duniverse/dune_/src/dune_rules/super_context.ml b/duniverse/dune_/src/dune_rules/super_context.ml index c82feb430..ef880bca5 100644 --- a/duniverse/dune_/src/dune_rules/super_context.ml +++ b/duniverse/dune_/src/dune_rules/super_context.ml @@ -291,16 +291,17 @@ let js_of_ocaml_flags t ~dir (spec : Js_of_ocaml.Flags.Spec.t) = Js_of_ocaml.Flags.make ~spec ~default:js_of_ocaml.flags ~eval:(Expander.expand_and_eval_set expander) +let default_foreign_flags t ~dir ~language = + Env_tree.get_node t ~dir >>| Env_node.foreign_flags + >>| (fun dict -> Foreign_language.Dict.get dict language) + |> Action_builder.of_memo_join + let foreign_flags t ~dir ~expander ~flags ~language = let ccg = Context.cc_g (Env_tree.context t) in - let default = - Env_tree.get_node t ~dir >>| Env_node.foreign_flags >>| fun dict -> - Foreign_language.Dict.get dict language - in + let default = default_foreign_flags t ~dir ~language in let open Action_builder.O in let name = Foreign_language.proper_name language in let flags = - let* default = Action_builder.of_memo default in let+ l = Expander.expand_and_eval_set expander flags ~standard:default in l @ ccg in @@ -324,6 +325,8 @@ let menhir_flags t ~dir ~expander ~flags = let local_binaries t ~dir = Env_tree.get_node t ~dir >>= Env_node.local_binaries +let env_node = Env_tree.get_node + let odoc t ~dir = Env_tree.get_node t ~dir >>= Env_node.odoc let coq t ~dir = Env_tree.get_node t ~dir >>= Env_node.coq diff --git a/duniverse/dune_/src/dune_rules/super_context.mli b/duniverse/dune_/src/dune_rules/super_context.mli index f9d2baafb..5a4cff32e 100644 --- a/duniverse/dune_/src/dune_rules/super_context.mli +++ b/duniverse/dune_/src/dune_rules/super_context.mli @@ -35,6 +35,12 @@ val js_of_ocaml_flags : -> Js_of_ocaml.Flags.Spec.t -> string list Action_builder.t Js_of_ocaml.Flags.t Memo.t +val default_foreign_flags : + t + -> dir:Path.Build.t + -> language:Foreign_language.t + -> string list Action_builder.t + val foreign_flags : t -> dir:Path.Build.t @@ -58,6 +64,8 @@ val menhir_flags : val local_binaries : t -> dir:Path.Build.t -> File_binding.Expanded.t list Memo.t +val env_node : t -> dir:Path.Build.t -> Env_node.t Memo.t + (** odoc config in the corresponding [(env)] stanza. *) val odoc : t -> dir:Path.Build.t -> Env_node.Odoc.t Memo.t diff --git a/duniverse/dune_/src/dune_rules/test_rules.ml b/duniverse/dune_/src/dune_rules/test_rules.ml index 61a577082..833ef9902 100644 --- a/duniverse/dune_/src/dune_rules/test_rules.ml +++ b/duniverse/dune_/src/dune_rules/test_rules.ml @@ -26,7 +26,7 @@ let rules (t : Dune_file.Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = | Other { kind = Exe; mode = Byte } -> Some `bc | Other { kind = Js; _ } -> Some `js | Other { kind = C | Object | Shared_object | Plugin; _ } -> - (* We don't know how to run tests in theses cases *) + (* We don't know how to run tests in these cases *) None) |> List.sort_uniq ~compare:Poly.compare in @@ -105,7 +105,7 @@ let rules (t : Dune_file.Tests.t) ~sctx ~dir ~scope ~expander ~dir_contents = ; locks = t.locks ; loc ; enabled_if = t.enabled_if - ; alias = None + ; aliases = [] ; package = t.package } in diff --git a/duniverse/dune_/src/dune_rules/top_module.ml b/duniverse/dune_/src/dune_rules/top_module.ml new file mode 100644 index 000000000..105863a2f --- /dev/null +++ b/duniverse/dune_/src/dune_rules/top_module.ml @@ -0,0 +1,101 @@ +open Import +open Memo.O + +let private_obj_dir (ctx : Context.t) src = + let src = + Path.Build.append_source (Path.Build.relative ctx.build_dir ".topmod") src + in + Obj_dir.for_pp ~dir:src + +let drop_rules f = + let+ res, _ = + Memo.Implicit_output.collect Dune_engine.Rules.implicit_output f + in + res + +let find_module sctx src = + let src = + Path.Build.append_source (Super_context.context sctx).build_dir src + in + let dir = Path.Build.parent_exn src in + let module_name = + let open Option.O in + let* name = + let fname = Path.Build.basename src in + let name = Filename.remove_extension fname in + if String.equal fname name then None else Some name + in + Module_name.of_string_opt name + in + match module_name with + | None -> Memo.return None + | Some module_name -> ( + let* dir_contents = drop_rules @@ fun () -> Dir_contents.get sctx ~dir in + let* ocaml = Dir_contents.ocaml dir_contents in + let stanza = + match Ml_sources.find_origin ocaml module_name with + | Some (Executables exes) -> Some (`Executables exes) + | Some (Library lib) -> Some (`Library lib) + | None | Some (Melange _) -> None + in + match stanza with + | None -> Memo.return None + | Some stanza -> + let* scope = Scope.DB.find_by_dir dir in + let* expander = Super_context.expander sctx ~dir in + let+ cctx, merlin = + drop_rules @@ fun () -> + match stanza with + | `Executables exes -> + Exe_rules.rules ~sctx ~dir ~dir_contents ~scope ~expander exes + | `Library lib -> + Lib_rules.rules lib ~sctx ~dir_contents ~dir ~expander ~scope + in + let modules = Compilation_context.modules cctx in + let module_ = + match Modules.find modules module_name with + | Some m -> m + | None -> User_error.raise [ Pp.textf "module not found" ] + in + Some (module_, cctx, merlin)) + +let module_deps cctx module_ = + let dep_graph = + let dg = Compilation_context.dep_graphs cctx in + Ocaml.Ml_kind.Dict.get dg Impl + in + let action = Dep_graph.deps_of dep_graph module_ in + let+ graph, _ = Action_builder.run action Eager in + graph + +let gen_rules sctx ~dir:rules_dir ~comps = + let src = Path.Source.L.relative Path.Source.root comps in + let* mod_ = find_module sctx src in + match mod_ with + | None -> Memo.return () + | Some (module_, cctx, _merlin) -> + let module_ = Module.set_source module_ Intf None in + let* () = + let* module_deps = module_deps cctx module_ in + let files = + let obj_dir = Compilation_context.obj_dir cctx in + List.filter_map module_deps ~f:(fun module_ -> + Obj_dir.Module.cm_file obj_dir module_ ~kind:(Ocaml Cmi)) + in + Memo.parallel_iter files ~f:(fun file -> + let src = Path.build file in + let dst = Path.Build.relative rules_dir (Path.Build.basename file) in + Super_context.add_rule sctx ~dir:rules_dir + (Action_builder.symlink ~src ~dst)) + in + let cctx = + let obj_dir = private_obj_dir (Super_context.context sctx) src in + Compilation_context.set_obj_dir cctx obj_dir + |> Compilation_context.without_bin_annot + |> Compilation_context.set_modes + ~modes: + { Lib_mode.Map.melange = false + ; ocaml = { byte = true; native = false } + } + in + Module_compilation.build_module ~force_write_cmi:true cctx module_ diff --git a/duniverse/dune_/src/dune_rules/top_module.mli b/duniverse/dune_/src/dune_rules/top_module.mli new file mode 100644 index 000000000..98f52e002 --- /dev/null +++ b/duniverse/dune_/src/dune_rules/top_module.mli @@ -0,0 +1,11 @@ +open Import + +val find_module : + Super_context.t + -> Path.Source.t + -> (Module.t * Compilation_context.t * Merlin.t) option Memo.t + +val private_obj_dir : Context.t -> Path.Source.t -> Path.Build.t Obj_dir.t + +val gen_rules : + Super_context.t -> dir:Path.Build.t -> comps:string list -> unit Memo.t diff --git a/duniverse/dune_/src/dune_rules/toplevel.ml b/duniverse/dune_/src/dune_rules/toplevel.ml index aa2b67692..f9d40c27c 100644 --- a/duniverse/dune_/src/dune_rules/toplevel.ml +++ b/duniverse/dune_/src/dune_rules/toplevel.ml @@ -99,7 +99,7 @@ let setup_module_rules t = Action_builder.write_file_dyn path (let* libs = Resolve.Memo.read requires_compile in let include_dirs = - Path.Set.to_list (Lib_flags.L.include_paths libs Mode.Byte) + Path.Set.to_list (Lib_flags.L.include_paths libs (Ocaml Byte)) in let* pp_ppx = pp_flags t in let pp_dirs = Source.pp_ml t.source ~include_dirs in @@ -124,12 +124,30 @@ let setup_rules_and_return_exe_path t = let setup_rules t = Memo.map (setup_rules_and_return_exe_path t) ~f:ignore -let print_toplevel_init_file ~include_paths ~files_to_load = - let includes = Path.Set.to_list include_paths in - List.iter includes ~f:(fun p -> +type directives = + { include_paths : Path.Set.t + ; files_to_load : Path.t list + ; uses : Path.t list + ; pp : string option + ; ppx : string option + ; code : string list + } + +let print_toplevel_init_file + { include_paths; files_to_load; uses; pp; ppx; code } = + Path.Set.iter include_paths ~f:(fun p -> Printf.printf "#directory %S;;\n" (Path.to_absolute_filename p)); List.iter files_to_load ~f:(fun p -> - Printf.printf "#load %S;;\n" (Path.to_absolute_filename p)) + Printf.printf "#load %S;;\n" (Path.to_absolute_filename p)); + Option.iter pp ~f:(Printf.printf "#pp %S;;\n"); + Option.iter ppx ~f:(Printf.printf "#ppx %S;;\n"); + List.iter uses ~f:(fun p -> + Printf.printf "#use %S;;\n" (Path.to_absolute_filename p)); + match code with + | [] -> () + | code -> + List.iter code ~f:print_endline; + print_endline ";;" module Stanza = struct let setup ~sctx ~dir ~(toplevel : Dune_file.Toplevel.t) = diff --git a/duniverse/dune_/src/dune_rules/toplevel.mli b/duniverse/dune_/src/dune_rules/toplevel.mli index 0ea29ec79..8e4083879 100644 --- a/duniverse/dune_/src/dune_rules/toplevel.mli +++ b/duniverse/dune_/src/dune_rules/toplevel.mli @@ -22,8 +22,16 @@ val make : -> preprocess:Preprocess.Without_instrumentation.t Preprocess.t -> t -val print_toplevel_init_file : - include_paths:Path.Set.t -> files_to_load:Path.t list -> unit +type directives = + { include_paths : Path.Set.t + ; files_to_load : Path.t list + ; uses : Path.t list + ; pp : string option + ; ppx : string option + ; code : string list + } + +val print_toplevel_init_file : directives -> unit module Stanza : sig val setup : diff --git a/duniverse/dune_/src/dune_rules/vimpl.ml b/duniverse/dune_/src/dune_rules/vimpl.ml index 70baec552..bcdc1de52 100644 --- a/duniverse/dune_/src/dune_rules/vimpl.ml +++ b/duniverse/dune_/src/dune_rules/vimpl.ml @@ -25,7 +25,9 @@ let impl_modules t m = let make ~vlib ~impl ~vlib_modules ~vlib_foreign_objects = let impl_cm_kind = let vlib_info = Lib.info vlib in - let { Mode.Dict.byte; native = _ } = Lib_info.modes vlib_info in + let { Lib_mode.Map.ocaml = { byte; native = _ }; melange = _ } = + Lib_info.modes vlib_info + in Mode.cm_kind (if byte then Byte else Native) in let vlib_obj_map = diff --git a/duniverse/dune_/src/dune_rules/virtual_rules.ml b/duniverse/dune_/src/dune_rules/virtual_rules.ml index 9e168c913..c11fcddd1 100644 --- a/duniverse/dune_/src/dune_rules/virtual_rules.ml +++ b/duniverse/dune_/src/dune_rules/virtual_rules.ml @@ -35,8 +35,8 @@ let setup_copy_rules_for_impl ~sctx ~dir vimpl = add_rule ~loc:(Loc.of_pos __POS__) (Action_builder.symlink ~src ~dst) in let { Lib_config.has_native; ext_obj; _ } = ctx.lib_config in - let { Mode.Dict.byte; native } = - Dune_file.Mode_conf.Set.eval impl.modes ~has_native + let { Lib_mode.Map.ocaml = { byte; native }; melange } = + Dune_file.Mode_conf.Lib.Set.eval impl.modes ~has_native in let copy_obj_file m kind = let src = Obj_dir.Module.cm_file_exn vlib_obj_dir m ~kind in @@ -44,23 +44,26 @@ let setup_copy_rules_for_impl ~sctx ~dir vimpl = copy_to_obj_dir ~src ~dst in let open Memo.O in + let copy_interface_to_impl ~src kind () = + let dst = Obj_dir.Module.cm_public_file_exn impl_obj_dir src ~kind in + let src = Obj_dir.Module.cm_public_file_exn vlib_obj_dir src ~kind in + copy_to_obj_dir ~src ~dst + in let copy_objs src = - copy_obj_file src Cmi + Memo.when_ (byte || native) (fun () -> copy_obj_file src (Ocaml Cmi)) + >>> Memo.when_ melange (fun () -> copy_obj_file src (Melange Cmi)) >>> Memo.when_ (Module.visibility src = Public && Obj_dir.need_dedicated_public_dir impl_obj_dir) (fun () -> - let dst = - Obj_dir.Module.cm_public_file_exn impl_obj_dir src ~kind:Cmi - in - let src = - Obj_dir.Module.cm_public_file_exn vlib_obj_dir src ~kind:Cmi - in - copy_to_obj_dir ~src ~dst) + Memo.when_ (byte || native) + (copy_interface_to_impl ~src (Ocaml Cmi)) + >>> Memo.when_ melange (copy_interface_to_impl ~src (Melange Cmi))) >>> Memo.when_ (Module.has src ~ml_kind:Impl) (fun () -> - Memo.when_ byte (fun () -> copy_obj_file src Cmo) + Memo.when_ byte (fun () -> copy_obj_file src (Ocaml Cmo)) + >>> Memo.when_ melange (fun () -> copy_obj_file src (Melange Cmj)) >>> Memo.when_ native (fun () -> - copy_obj_file src Cmx + copy_obj_file src (Ocaml Cmx) >>> let object_file dir = Obj_dir.Module.o_file_exn dir src ~ext_obj diff --git a/duniverse/dune_/src/dune_rules/workspace.ml b/duniverse/dune_/src/dune_rules/workspace.ml index 2b700a344..d7d3e11e5 100644 --- a/duniverse/dune_/src/dune_rules/workspace.ml +++ b/duniverse/dune_/src/dune_rules/workspace.ml @@ -619,7 +619,7 @@ let default_step1 clflags = let load_step1 clflags p = Fs_memo.with_lexbuf_from_file p ~f:(fun lb -> - if Dune_lang.Dune_lexer.eof_reached lb then default_step1 clflags + if Dune_lang.Dune_file_script.eof_reached lb then default_step1 clflags else parse_contents lb ~f:(fun lang -> String_with_vars.set_decoding_env @@ -636,10 +636,10 @@ let workspace_step1 = match clflags.workspace_file with | None -> let p = Path.of_string filename in - let+ exists = Fs_memo.file_exists p in + let+ exists = Fs_memo.file_exists (Path.as_outside_build_dir_exn p) in Option.some_if exists p | Some p -> ( - Fs_memo.file_exists p >>| function + Fs_memo.file_exists (Path.as_outside_build_dir_exn p) >>| function | true -> Some p | false -> User_error.raise @@ -650,7 +650,9 @@ let workspace_step1 = let clflags = { clflags with workspace_file } in match workspace_file with | None -> Memo.return (default_step1 clflags) - | Some p -> load_step1 clflags p + | Some p -> + let p = Path.as_outside_build_dir_exn p in + load_step1 clflags p in let memo = Memo.lazy_ ~name:"workspaces-internal" f in fun () -> Memo.Lazy.force memo diff --git a/duniverse/dune_/src/dune_sexp/atom.ml b/duniverse/dune_/src/dune_sexp/atom.ml index 11ab99cfa..e09ac6177 100644 --- a/duniverse/dune_/src/dune_sexp/atom.ml +++ b/duniverse/dune_/src/dune_sexp/atom.ml @@ -1,4 +1,5 @@ open Stdune +open Import type t = A of string [@@unboxed] diff --git a/duniverse/dune_/src/dune_sexp/atom.mli b/duniverse/dune_/src/dune_sexp/atom.mli index bc26ecb2e..9cbf1554d 100644 --- a/duniverse/dune_/src/dune_sexp/atom.mli +++ b/duniverse/dune_/src/dune_sexp/atom.mli @@ -1,4 +1,4 @@ -open Stdune +open Import type t = private A of string [@@unboxed] diff --git a/duniverse/dune_/src/dune_sexp/decoder.ml b/duniverse/dune_/src/dune_sexp/decoder.ml index f8faa8f02..ef4bce8f1 100644 --- a/duniverse/dune_/src/dune_sexp/decoder.ml +++ b/duniverse/dune_/src/dune_sexp/decoder.ml @@ -268,7 +268,7 @@ let end_of_list (Values (loc, cstr, _)) = let loc = { loc with start = loc.stop } in User_error.raise ~loc [ Pp.text "Premature end of list" ] | Some s -> User_error.raise ~loc [ Pp.textf "Not enough arguments for %s" s ] - [@@inline never] + [@@inline never] [@@specialise never] [@@local never] let next f ctx sexps = match sexps with @@ -474,7 +474,8 @@ let triple a b c = let unit_number_generic ~of_string ~mul name suffixes = let unit_number_of_string ~loc s = let possible_suffixes () = - String.concat ~sep:", " (List.map ~f:fst suffixes) + (* We take the first suffix in the list to be the suggestion *) + String.concat ~sep:", " (List.map ~f:(fun x -> List.hd @@ fst x) suffixes) in let n, suffix = let f c = not (Char.is_digit c) in @@ -484,6 +485,10 @@ let unit_number_generic ~of_string ~mul name suffixes = [ Pp.textf "missing suffix, use one of %s" (possible_suffixes ()) ] | Some i -> String.split_n s i in + let suffixes = + List.map ~f:(fun (xs, y) -> List.map ~f:(fun x -> (x, y)) xs) suffixes + |> List.flatten + in let factor = match List.assoc suffixes suffix with | Some f -> f @@ -502,17 +507,10 @@ let unit_number_int64 = let of_string s = Int64.of_string_opt s in unit_number_generic ~of_string ~mul:Int64.mul -let duration = unit_number "Duration" [ ("s", 1); ("m", 60); ("h", 60 * 60) ] +let duration = + unit_number "Duration" [ ([ "s" ], 1); ([ "m" ], 60); ([ "h" ], 60 * 60) ] -(* CR-someday amokhov: Add KiB, MiB, GiB. *) -let bytes_unit = - unit_number_int64 "Byte amount" - [ ("B", 1L) - ; ("kB", 1000L) - ; ("KB", 1000L) - ; ("MB", 1000_000L) - ; ("GB", 1000_000_000L) - ] +let bytes_unit = unit_number_int64 "Byte amount" Bytes_unit.conversion_table let maybe t = t >>| Option.some <|> return None @@ -546,18 +544,23 @@ let sum ?(force_parens = false) cstrs = | Atom (s_loc, A s) -> find_cstr cstrs s_loc s (Values (loc, Some s, uc)) args)) -let enum cstrs = - next (function - | Quoted_string (loc, _) | Template { loc; _ } | List (loc, _) -> - User_error.raise ~loc [ Pp.text "Atom expected" ] - | Atom (loc, A s) -> ( - match List.assoc cstrs s with - | Some value -> value - | None -> - User_error.raise ~loc - [ Pp.textf "Unknown value %s" s ] - ~hints: - (User_message.did_you_mean s ~candidates:(List.map cstrs ~f:fst)))) +let enum' (type a) (cstrs : (string * a t) list) : a t = + next_with_user_context (fun uc sexp -> + match sexp with + | Quoted_string (loc, _) | Template { loc; _ } | List (loc, _) -> + User_error.raise ~loc [ Pp.text "Atom expected" ] + | Atom (loc, A s) -> ( + match List.assoc cstrs s with + | Some k -> + let ctx = Values (loc, Some s, uc) in + result ctx (k ctx []) + | None -> + User_error.raise ~loc + [ Pp.textf "Unknown value %s" s ] + ~hints: + (User_message.did_you_mean s ~candidates:(List.map cstrs ~f:fst)))) + +let enum cstrs = enum' (List.map cstrs ~f:(fun (name, v) -> (name, return v))) let bool = enum [ ("true", true); ("false", false) ] @@ -577,7 +580,7 @@ let map_validate t ~f ctx state1 = field names: see [field_missing] and [field_present_too_many_times]. *) let field_missing loc name = User_error.raise ~loc [ Pp.textf "field %s missing" name ] - [@@inline never] + [@@inline never] [@@specialise never] [@@local never] let field_present_too_many_times _ name entries = match entries with @@ -594,7 +597,7 @@ let multiple_occurrences ?(on_dup = field_present_too_many_times) uc name last = | Some prev -> collect acc prev in on_dup uc name (collect [] last) - [@@inline never] + [@@inline never] [@@specialise never] [@@local never] let find_single ?on_dup uc (state : Fields.t) name = let res = Name.Map.find state.unparsed name in @@ -686,14 +689,14 @@ let fields_missing_need_exactly_one loc names = [ Pp.textf "fields %s are all missing (exactly one is needed)" (String.concat ~sep:", " names) ] - [@@inline never] + [@@inline never] [@@specialise never] [@@local never] let fields_mutual_exclusion_violation loc names = User_error.raise ~loc [ Pp.textf "fields %s are mutually exclusive" (String.concat ~sep:", " names) ] - [@@inline never] + [@@inline never] [@@specialise never] [@@local never] let fields_mutually_exclusive ?on_dup ?default fields ((Fields (loc, _, _) : _ context) as ctx) state = diff --git a/duniverse/dune_/src/dune_sexp/decoder.mli b/duniverse/dune_/src/dune_sexp/decoder.mli index 3ce83a553..c81fd3c62 100644 --- a/duniverse/dune_/src/dune_sexp/decoder.mli +++ b/duniverse/dune_/src/dune_sexp/decoder.mli @@ -198,6 +198,8 @@ val located : ('a, 'k) parser -> (Loc.t * 'a, 'k) parser val enum : (string * 'a) list -> 'a t +val enum' : (string * 'a t) list -> 'a t + (** Parser that parse a S-expression of the form [( ...)] or []. [] is looked up in the list and the remaining s-expressions are parsed using the corresponding list diff --git a/duniverse/dune_/src/dune_sexp/dune b/duniverse/dune_/src/dune_sexp/dune index e71682c3f..61bdbaae9 100644 --- a/duniverse/dune_/src/dune_sexp/dune +++ b/duniverse/dune_/src/dune_sexp/dune @@ -1,6 +1,6 @@ (library (name dune_sexp) (synopsis "[Internal] S-expression library") - (libraries stdune)) + (libraries dune_digest stdune)) (ocamllex lexer versioned_file_first_line) diff --git a/duniverse/dune_/src/dune_sexp/import.ml b/duniverse/dune_/src/dune_sexp/import.ml new file mode 100644 index 000000000..b90844d81 --- /dev/null +++ b/duniverse/dune_/src/dune_sexp/import.ml @@ -0,0 +1 @@ +module Digest = Dune_digest diff --git a/duniverse/dune_/src/dune_sexp/syntax.ml b/duniverse/dune_/src/dune_sexp/syntax.ml index 50982462b..4e46c49e8 100644 --- a/duniverse/dune_/src/dune_sexp/syntax.ml +++ b/duniverse/dune_/src/dune_sexp/syntax.ml @@ -361,13 +361,13 @@ let renamed_in t ver ~to_ = let+ loc, what = desc () in Error.renamed_in loc t ver ~what ~to_ -let since ?(fatal = true) t ver = +let since ?what ?(fatal = true) t ver = let open Version.Infix in let* current_ver = get_exn t in if current_ver >= ver then return () else - desc () >>= function - | loc, what when fatal -> Error.since loc t ver ~what - | loc, what -> - User_warning.emit ~loc [ Pp.text (Error_msg.since t ver ~what) ]; - return () + let* loc, what_ctx = desc () in + let what = Option.value what ~default:what_ctx in + if fatal then Error.since loc t ver ~what + else User_warning.emit ~loc [ Pp.text (Error_msg.since t ver ~what) ]; + return () diff --git a/duniverse/dune_/src/dune_sexp/syntax.mli b/duniverse/dune_/src/dune_sexp/syntax.mli index c3caa7b5e..08c09d474 100644 --- a/duniverse/dune_/src/dune_sexp/syntax.mli +++ b/duniverse/dune_/src/dune_sexp/syntax.mli @@ -100,8 +100,9 @@ val renamed_in : t -> Version.t -> to_:string -> (unit, _) Decoder.parser (** Indicate the field/constructor being parsed was introduced in the given version. When [fatal] is false, simply emit a warning instead of error. - [fatal] defaults to true. *) -val since : ?fatal:bool -> t -> Version.t -> (unit, _) Decoder.parser + [fatal] defaults to true. [what] allows customizing the error message. *) +val since : + ?what:string -> ?fatal:bool -> t -> Version.t -> (unit, _) Decoder.parser (** {2 Low-level functions} *) diff --git a/duniverse/dune_/src/dune_stats/dune_stats.ml b/duniverse/dune_/src/dune_stats/dune_stats.ml index a0cdcca03..b316efa84 100644 --- a/duniverse/dune_/src/dune_stats/dune_stats.ml +++ b/duniverse/dune_/src/dune_stats/dune_stats.ml @@ -1,4 +1,5 @@ open Stdune +module Timestamp = Chrome_trace.Event.Timestamp module Event = Chrome_trace.Event module Mac = struct @@ -103,6 +104,40 @@ let printf t format_string = let emit t event = printf t "%s" (Json.to_string (Event.to_json event)) +type event_data = + { args : Chrome_trace.Event.args option + ; cat : string list option + ; name : string + } + +type event = + { t : t + ; event_data : event_data + ; start : float + } + +let start t k : event option = + match t with + | None -> None + | Some t -> + let event_data = k () in + let start = Unix.gettimeofday () in + Some { t; event_data; start } + +let finish event = + match event with + | None -> () + | Some { t; start; event_data = { args; cat; name } } -> + let dur = + let stop = Unix.gettimeofday () in + Timestamp.of_float_seconds (stop -. start) + in + let common = + Event.common_fields ?cat ~name ~ts:(Timestamp.of_float_seconds start) () + in + let event = Event.complete ?args common ~dur in + emit t event + module Fd_count = struct type t = | Unknown diff --git a/duniverse/dune_/src/dune_stats/dune_stats.mli b/duniverse/dune_/src/dune_stats/dune_stats.mli index 4d5022822..cb395bf2e 100644 --- a/duniverse/dune_/src/dune_stats/dune_stats.mli +++ b/duniverse/dune_/src/dune_stats/dune_stats.mli @@ -19,6 +19,18 @@ val record_gc_and_fd : t -> unit val close : t -> unit +type event + +type event_data = + { args : Chrome_trace.Event.args option + ; cat : string list option + ; name : string + } + +val start : t option -> (unit -> event_data) -> event option + +val finish : event option -> unit + module Private : sig module Fd_count : sig type t = diff --git a/duniverse/dune_/src/dune_util/dune b/duniverse/dune_/src/dune_util/dune index 21b3872e4..ab109a25e 100644 --- a/duniverse/dune_/src/dune_util/dune +++ b/duniverse/dune_/src/dune_util/dune @@ -1,8 +1,12 @@ (library (name dune_util) + (foreign_stubs + (language c) + (names dune_flock)) (libraries stdune xdg + dune_console build_path_prefix_map dune_sexp memo diff --git a/duniverse/dune_/src/dune_util/dune_flock.c b/duniverse/dune_/src/dune_util/dune_flock.c new file mode 100644 index 000000000..13832f1d4 --- /dev/null +++ b/duniverse/dune_/src/dune_util/dune_flock.c @@ -0,0 +1,51 @@ +#include +#include +#include +#include + +#ifndef _WIN32 +#include +#endif + +#define FD_val(value) Int_val(value) + +CAMLprim value dune_flock_lock(value v_fd, value v_block, value v_exclusive) { +#ifdef _WIN32 + caml_failwith("no flock on win32"); + return Val_unit; +#else + CAMLparam2(v_fd, v_block); + int flags = 0; + if (Bool_val(v_exclusive)) { + flags |= LOCK_EX; + } + if (!Bool_val(v_block)) { + flags |= LOCK_NB; + } + caml_release_runtime_system(); + int ret = flock(FD_val(v_fd), flags); + caml_acquire_runtime_system(); + if (ret == 0) { + CAMLreturn(Val_unit); + } else { + uerror("flock", Nothing); + } +#endif +} + +CAMLprim value dune_flock_unlock(value v_fd) { +#ifdef _WIN32 + caml_failwith("no flock on win32"); + return Val_unit; +#else + CAMLparam1(v_fd); + caml_release_runtime_system(); + int ret = flock(FD_val(v_fd), LOCK_UN); + caml_acquire_runtime_system(); + if (ret == 0) { + CAMLreturn(Val_unit); + } else { + uerror("flock", Nothing); + } +#endif +} diff --git a/duniverse/dune_/src/dune_util/dune_util.ml b/duniverse/dune_/src/dune_util/dune_util.ml index 664548e26..e1bce1643 100644 --- a/duniverse/dune_/src/dune_util/dune_util.ml +++ b/duniverse/dune_/src/dune_util/dune_util.ml @@ -6,6 +6,8 @@ module Stringlike = Stringlike module Stringlike_intf = Stringlike_intf module Value = Value module Build_path_prefix_map = Build_path_prefix_map0 +module Flock = Flock +module Global_lock = Global_lock open Stdune let xdg = diff --git a/duniverse/dune_/src/dune_util/flock.ml b/duniverse/dune_/src/dune_util/flock.ml new file mode 100644 index 000000000..4d5248142 --- /dev/null +++ b/duniverse/dune_/src/dune_util/flock.ml @@ -0,0 +1,34 @@ +type t = Unix.file_descr + +let create x = x + +external gen_lock : t -> block:bool -> exclusive:bool -> unit + = "dune_flock_lock" + +type lock = + | Shared + | Exclusive + +let is_exclusive = function + | Exclusive -> true + | Shared -> false + +let lock_block t lock = + match gen_lock t ~block:true ~exclusive:(is_exclusive lock) with + | () -> Ok () + | exception Unix.Unix_error (err, _, _) -> Error err + +let lock_non_block t lock = + match gen_lock t ~block:false ~exclusive:(is_exclusive lock) with + | () -> Ok `Success + | exception Unix.Unix_error ((EWOULDBLOCK | EAGAIN), _, _) -> Ok `Failure + | exception Unix.Unix_error (err, _, _) -> Error err + +external unlock : t -> unit = "dune_flock_unlock" + +let unlock t = + match unlock t with + | () -> Ok () + | exception Unix.Unix_error (err, _, _) -> Error err + +let fd x = x diff --git a/duniverse/dune_/src/dune_util/flock.mli b/duniverse/dune_/src/dune_util/flock.mli new file mode 100644 index 000000000..4c08c0d84 --- /dev/null +++ b/duniverse/dune_/src/dune_util/flock.mli @@ -0,0 +1,18 @@ +(** Wrapper around [flock]. Implements dune's global locking. Mostly exposed for + testing *) + +type t + +val fd : t -> Unix.file_descr + +val create : Unix.file_descr -> t + +type lock = + | Shared + | Exclusive + +val lock_block : t -> lock -> (unit, Unix.error) result + +val lock_non_block : t -> lock -> ([ `Success | `Failure ], Unix.error) result + +val unlock : t -> (unit, Unix.error) result diff --git a/duniverse/dune_/src/dune_util/global_lock.ml b/duniverse/dune_/src/dune_util/global_lock.ml new file mode 100644 index 000000000..6ee31ee36 --- /dev/null +++ b/duniverse/dune_/src/dune_util/global_lock.ml @@ -0,0 +1,136 @@ +open Stdune + +let lock_file = Path.Build.(relative root ".lock") + +let with_timeout ~timeout f = + let now () = Unix.gettimeofday () in + let deadline = now () +. timeout in + let rec loop () = + if now () >= deadline then `Timed_out + else + match f () with + | `Continue -> loop () + | `Stop -> `Success + in + loop () + +module type S = sig + val lock : unit -> [ `Success | `Failure ] + + val unlock : unit -> unit +end + +let write_pid fd = + let pid = Int.to_string (Unix.getpid ()) in + let len = String.length pid in + let res = Unix.write fd (Bytes.of_string pid) 0 len in + assert (res = len) + +module Win () : S = struct + let t = ref None + + let create () = + Path.ensure_build_dir_exists (); + match + Unix.openfile + (Path.Build.to_string lock_file) + [ O_CREAT; O_EXCL; O_WRONLY ] + 0o600 + with + | exception _ -> None + | fd -> + Unix.set_close_on_exec fd; + write_pid fd; + Some fd + + let () = + at_exit (fun () -> + match !t with + | None -> () + | Some fd -> + Unix.close fd; + Path.rm_rf (Path.build lock_file)) + + let lock () = + match !t with + | Some _ -> `Success + | None -> ( + match create () with + | None -> `Failure + | Some fd -> + t := Some fd; + `Success) + + let unlock () = + match !t with + | None -> () + | Some fd -> + Unix.close fd; + Path.rm_rf (Path.build lock_file) +end + +module Unix () : S = struct + let t = + lazy + (Path.ensure_build_dir_exists (); + let fd = + Unix.openfile + (Path.Build.to_string lock_file) + [ Unix.O_CREAT; O_WRONLY ] 0o600 + in + Unix.set_close_on_exec fd; + Flock.create fd) + + let or_raise_unix ~name = function + | Ok s -> s + | Error _unix -> Code_error.raise "lock" [ ("name", Dyn.string name) ] + + let lock () = + let t = Lazy.force t in + let res = Flock.lock_non_block t Exclusive |> or_raise_unix ~name:"lock" in + (match res with + | `Failure -> () + | `Success -> + let fd = Flock.fd t in + write_pid fd); + res + + let unlock () = Lazy.force t |> Flock.unlock |> or_raise_unix ~name:"unlock" +end + +module Lock = (val if Sys.win32 then (module Win ()) else (module Unix ()) : S) + +let locked = ref false + +let lock_exn ~timeout = + if not !locked then + let res = + match timeout with + | None -> Lock.lock () + | Some timeout -> ( + match + with_timeout ~timeout (fun () -> + match Lock.lock () with + | `Success -> `Stop + | `Failure -> `Continue) + with + | `Timed_out -> `Failure + | `Success -> `Success) + in + match res with + | `Success -> locked := true + | `Failure -> + User_error.raise + [ Pp.textf + "A running dune%s instance has locked the build directory. If this \ + is not the case, please delete %s" + (match Io.read_file (Path.build lock_file) with + | exception _ -> "" + | pid -> sprintf " (pid: %s)" pid) + (Path.Build.to_string_maybe_quoted lock_file) + ] + +let unlock () = + if !locked then ( + Lock.unlock (); + locked := false) diff --git a/duniverse/dune_/src/dune_util/global_lock.mli b/duniverse/dune_/src/dune_util/global_lock.mli new file mode 100644 index 000000000..cd6260e87 --- /dev/null +++ b/duniverse/dune_/src/dune_util/global_lock.mli @@ -0,0 +1,10 @@ +(** global lock shared between dune processes. + + Before starting rpc, writing to the build dir, this lock should be locked. *) + +(** attempt to acquire a lock. once a lock is locked, subsequent locks always + succeed *) +val lock_exn : timeout:float option -> unit + +(** release a lock and allow it be re-acquired *) +val unlock : unit -> unit diff --git a/duniverse/dune_/src/dune_util/import.ml b/duniverse/dune_/src/dune_util/import.ml new file mode 100644 index 000000000..b002483ab --- /dev/null +++ b/duniverse/dune_/src/dune_util/import.ml @@ -0,0 +1 @@ +module Console = Dune_console diff --git a/duniverse/dune_/src/dune_util/log.ml b/duniverse/dune_/src/dune_util/log.ml index 23cc48e43..28ca6ddde 100644 --- a/duniverse/dune_/src/dune_util/log.ml +++ b/duniverse/dune_/src/dune_util/log.ml @@ -1,4 +1,5 @@ open Stdune +module Console = Dune_console module File = struct type t = diff --git a/duniverse/dune_/src/dune_util/report_error.ml b/duniverse/dune_/src/dune_util/report_error.ml index 22ff2fcc2..4ff8424dd 100644 --- a/duniverse/dune_/src/dune_util/report_error.ml +++ b/duniverse/dune_/src/dune_util/report_error.ml @@ -1,4 +1,5 @@ open Stdune +open Import exception Already_reported diff --git a/duniverse/dune_/src/fiber/core.ml b/duniverse/dune_/src/fiber/core.ml index 00d361907..a571e69e4 100644 --- a/duniverse/dune_/src/fiber/core.ml +++ b/duniverse/dune_/src/fiber/core.ml @@ -98,7 +98,7 @@ let apply2 f x y = let exn = Exn_with_backtrace.capture exn in Reraise exn -let[@inlined always] fork a b = +let[@inline always] fork a b = match apply a () with | End_of_fiber () -> b () | eff -> Fork (eff, b) @@ -349,13 +349,6 @@ let parallel_iter_set (type a s) (module S : Set.S with type elt = a and type t = s) set ~(f : a -> unit t) = parallel_iter_seq (S.to_seq set) ~f -let record_metrics t ~tag = - of_thunk (fun () -> - let timer = Metrics.Timer.start tag in - let+ res = t in - Metrics.Timer.stop timer; - res) - module Make_map_traversals (Map : Map.S) = struct let parallel_iter t ~f = parallel_iter_seq (Map.to_seq t) ~f:(fun (k, v) -> f k v) diff --git a/duniverse/dune_/src/fiber/fiber.mli b/duniverse/dune_/src/fiber/fiber.mli index 1df22e528..7bf3b131a 100644 --- a/duniverse/dune_/src/fiber/fiber.mli +++ b/duniverse/dune_/src/fiber/fiber.mli @@ -114,13 +114,6 @@ val parallel_iter_set : val sequential_iter_seq : 'a Seq.t -> f:('a -> unit t) -> unit t -(** Returns a fiber which wraps the given fiber with calls to - Metrics.Timer.start/stop. - - Note: This will measure the wall clock time between when the fiber starts - and finishes, including any time that it is inactive *) -val record_metrics : 'a t -> tag:string -> 'a t - (** Provide efficient parallel iter/map functions for maps. *) module Make_map_traversals (Map : Map.S) : sig val parallel_iter : 'a Map.t -> f:(Map.key -> 'a -> unit t) -> unit t @@ -434,7 +427,7 @@ end (** {1 Fiber cancellation} *) module Cancel : sig (** This module provides a way to cancel long running computations. - Cancellation is fully explicit and fibers must explicitely check for it at + Cancellation is fully explicit and fibers must explicitly check for it at strategic points. *) type t diff --git a/duniverse/dune_/src/fiber/scheduler.ml b/duniverse/dune_/src/fiber/scheduler.ml index 7b5b981d2..f3c2ac679 100644 --- a/duniverse/dune_/src/fiber/scheduler.ml +++ b/duniverse/dune_/src/fiber/scheduler.ml @@ -23,8 +23,12 @@ module Jobs = struct let fill_ivar ivar x jobs = match ivar.state with | Full _ -> failwith "Fiber.Ivar.fill" - | (Empty | Empty_with_readers _) as readers -> + | Empty -> + ivar.state <- Full x; + jobs + | Empty_with_readers (ctx, k, readers) -> ivar.state <- Full x; + let jobs = Job (ctx, k, x, jobs) in enqueue_readers readers x jobs let rec exec_fills fills acc = diff --git a/duniverse/dune_/src/fsevents/fsevents.ml b/duniverse/dune_/src/fsevents/fsevents.ml index 6619b1711..2ad3d11ba 100644 --- a/duniverse/dune_/src/fsevents/fsevents.ml +++ b/duniverse/dune_/src/fsevents/fsevents.ml @@ -194,10 +194,11 @@ module Event = struct let kind t = kind t.flags type action = - | Unknown | Create | Remove | Modify + | Rename + | Unknown external action : Int32.t -> action = "dune_fsevents_action" @@ -209,7 +210,8 @@ module Event = struct | Create -> "Create" | Remove -> "Remove" | Modify -> "Modify" - | Unknown -> "Unknown") + | Unknown -> "Unknown" + | Rename -> "Rename") let to_dyn t = let open Dyn in diff --git a/duniverse/dune_/src/fsevents/fsevents.mli b/duniverse/dune_/src/fsevents/fsevents.mli index 4c1c07b97..66fad2f60 100644 --- a/duniverse/dune_/src/fsevents/fsevents.mli +++ b/duniverse/dune_/src/fsevents/fsevents.mli @@ -44,17 +44,17 @@ module Event : sig val kind : t -> kind type action = + | Create (* [path t] guaranteed to exist *) + | Remove (* [path t] guaranteed to be absent *) + | Modify (* [path t] guaranteed to exist *) + | Rename | Unknown (** multiple actions merged into one by debouncing or an uninformative "rename". inspect the FS to see what happened *) - | Create (* [path t] guaranteed to exist *) - | Remove (* [path t] guaranteed to be absent *) - | Modify - (* [path t] guaranteed to exist *) val dyn_of_action : action -> Dyn.t - (** [action t] describes the action occured to [path t] *) + (** [action t] describes the action occurred to [path t] *) val action : t -> action end diff --git a/duniverse/dune_/src/fsevents/fsevents_stubs.c b/duniverse/dune_/src/fsevents/fsevents_stubs.c index c1c657972..7a6c27817 100644 --- a/duniverse/dune_/src/fsevents/fsevents_stubs.c +++ b/duniverse/dune_/src/fsevents/fsevents_stubs.c @@ -7,10 +7,8 @@ #include #if defined(__APPLE__) -#include -#endif -#if __MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 +#include #include #include @@ -89,9 +87,13 @@ static void dune_fsevents_callback(const FSEventStreamRef streamRef, if (!(interesting_flags & flags)) { continue; } + CFStringRef cf_path; +#if __MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 CFDictionaryRef details = CFArrayGetValueAtIndex(eventPaths, i); - CFStringRef cf_path = - CFDictionaryGetValue(details, kFSEventStreamEventExtendedDataPathKey); + cf_path = CFDictionaryGetValue(details, kFSEventStreamEventExtendedDataPathKey); +#else + cf_path = (CFStringRef) CFArrayGetValueAtIndex(eventPaths, i); +#endif CFIndex len = CFStringGetLength(cf_path); CFIndex byte_len; CFIndex res = @@ -152,7 +154,9 @@ CAMLprim value dune_fsevents_create(value v_paths, value v_latency, const FSEventStreamEventFlags flags = kFSEventStreamCreateFlagNoDefer | +#if __MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 kFSEventStreamCreateFlagUseExtendedData | +#endif kFSEventStreamCreateFlagUseCFTypes | kFSEventStreamCreateFlagFileEvents; dune_fsevents_t *t; @@ -266,29 +270,16 @@ CAMLprim value dune_fsevents_action(value v_flags) { CAMLlocal1(v_action); uint32_t flags = Int32_val(v_flags) & action_mask; - // XXX slow - int count = 0; - while (flags) { - count += (flags & 1); - flags >>= 1; - } - - flags = Int32_val(v_flags); - if (count >= 2 || flags & kFSEventStreamEventFlagItemRenamed) { - // we don't bother tracking renamed acurately for now. macos makes it - // tricky by not telling is which path is created and which one is deleted. - // it is possible to reverse engineer this from the chain of inodes in the - // events, but it's also error prone as inodes can be reused. so for now, we - // avoid this is and treat renamed as unknown + if (flags & kFSEventStreamEventFlagItemCreated) { v_action = Val_int(0); - } else if (flags & kFSEventStreamEventFlagItemCreated) { - v_action = Val_int(1); } else if (flags & kFSEventStreamEventFlagItemRemoved) { - v_action = Val_int(2); + v_action = Val_int(1); } else if (flags & kFSEventStreamEventFlagItemModified) { + v_action = Val_int(2); + } else if (flags & kFSEventStreamEventFlagItemRenamed) { v_action = Val_int(3); } else { - caml_failwith("fsevents: unexpected event action"); + v_action = Val_int(4); } CAMLreturn(v_action); @@ -316,7 +307,9 @@ static const FSEventStreamEventFlags all_flags[] = { kFSEventStreamEventFlagOwnEvent, kFSEventStreamEventFlagItemIsHardlink, kFSEventStreamEventFlagItemIsLastHardlink, +#if __MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 kFSEventStreamEventFlagItemCloned, +#endif }; CAMLprim value dune_fsevents_raw(value v_flags) { @@ -338,8 +331,7 @@ CAMLprim value dune_fsevents_available(value unit) { #else -static char *unavailable_message = - "fsevents is only available on macos >= 10.13"; +static char *unavailable_message = "fsevents is only available on macos"; CAMLprim value dune_fsevents_stop(value v_t) { caml_failwith(unavailable_message); diff --git a/duniverse/dune_/src/memo/dune b/duniverse/dune_/src/memo/dune index b65cce57c..b5bb7c653 100644 --- a/duniverse/dune_/src/memo/dune +++ b/duniverse/dune_/src/memo/dune @@ -1,4 +1,4 @@ (library (name memo) - (libraries stdune dyn dune_graph dag fiber unix) + (libraries stdune dyn dune_graph dag fiber dune_console unix) (synopsis "Incremental computation library that powers Dune")) diff --git a/duniverse/dune_/src/memo/memo.ml b/duniverse/dune_/src/memo/memo.ml index 31fd36dd7..18b370cc3 100644 --- a/duniverse/dune_/src/memo/memo.ml +++ b/duniverse/dune_/src/memo/memo.ml @@ -1,6 +1,7 @@ open! Stdune open Fiber.O module Graph = Dune_graph.Graph +module Console = Dune_console module Debug = struct let track_locations_of_lazy_values = ref false diff --git a/duniverse/dune_/src/ocaml/mode.ml b/duniverse/dune_/src/ocaml/mode.ml index 84adce7c7..66675c5f6 100644 --- a/duniverse/dune_/src/ocaml/mode.ml +++ b/duniverse/dune_/src/ocaml/mode.ml @@ -45,10 +45,6 @@ let cm_kind = choose Cm_kind.Cmo Cmx let exe_ext = choose ".bc" ".exe" -let of_cm_kind : Cm_kind.t -> t = function - | Cmi | Cmo -> Byte - | Cmx -> Native - module Dict = struct let mode_equal = equal @@ -81,6 +77,8 @@ module Dict = struct f Byte t.byte; f Native t.native + let foldi t ~init ~f = f Native t.native @@ f Byte t.byte init + let make_both x = { byte = x; native = x } let make ~byte ~native = { byte; native } @@ -135,3 +133,92 @@ module Dict = struct { byte; native }) end end + +module Select = struct + type nonrec t = + | Only of t + | All + + let compare x y = + match (x, y) with + | All, All -> Eq + | All, _ -> Lt + | _, All -> Gt + | Only x, Only y -> compare x y + + let of_option = function + | None -> All + | Some m -> Only m + + let is_not_all = function + | All -> false + | Only _ -> true + + let equal t t' = + match (t, t') with + | Only m, Only m' -> equal m m' + | All, All -> true + | _, _ -> false + + let to_dyn t = + let open Dyn in + match t with + | All -> Variant ("All", []) + | Only m -> Variant ("Only", [ to_dyn m ]) + + let encode t = + let open Dune_sexp.Encoder in + match t with + | All -> string "all" + | Only m -> encode m + + let decode = + let open Dune_sexp.Decoder in + let+ value = either (keyword "all") decode in + match value with + | Left () -> All + | Right mode -> Only mode +end + +module Map = struct + (* Here we use a Map to be able in the future to use more variants than + just "Byte, Native or All" *) + include Map.Make (Select) + + module Multi = struct + include Multi + + let create_for_all_modes l = Multi.add_all empty All l + + let for_all_modes t = find t All + + let for_only ~and_all t mode = + let all = if and_all then for_all_modes t else [] in + List.rev_append all @@ find t (Only mode) + end + + let encode encoder t = + let open Dune_sexp.Encoder in + let fields = + foldi t ~init:[] ~f:(fun for_ files acc -> + if List.is_empty files then acc + else + let field_for = field "for" Select.encode for_ in + let field_files = field_l "files" encoder files in + field_l "archives" Fun.id (record_fields [ field_for; field_files ]) + :: acc) + in + record_fields fields + + let decode decoder = + let open Dune_sexp.Decoder in + let+ fields = + fields + @@ multi_field "archives" + (fields + (let+ for_ = field "for" Select.decode + and+ files = field "files" (repeat decoder) in + (for_, files))) + in + of_list_exn fields +end diff --git a/duniverse/dune_/src/ocaml/mode.mli b/duniverse/dune_/src/ocaml/mode.mli index bade9968a..c3e9a9d2f 100644 --- a/duniverse/dune_/src/ocaml/mode.mli +++ b/duniverse/dune_/src/ocaml/mode.mli @@ -8,6 +8,8 @@ val equal : t -> t -> bool val compare : t -> t -> Ordering.t +val encode : t -> Dune_sexp.t + val decode : t Dune_sexp.Decoder.t val all : t list @@ -22,8 +24,6 @@ val plugin_ext : t -> string val cm_kind : t -> Cm_kind.t -val of_cm_kind : Cm_kind.t -> t - val variant : t -> Variant.t val to_string : t -> string @@ -69,6 +69,8 @@ module Dict : sig val iteri : 'a t -> f:(mode -> 'a -> unit) -> unit + val foldi : 'a t -> init:'b -> f:(mode -> 'a -> 'b -> 'b) -> 'b + val make_both : 'a -> 'a t val make : byte:'a -> native:'a -> 'a t @@ -94,3 +96,51 @@ module Dict : sig end end with type mode := t + +(** [Select] is a utility module that represents a mode selection. *) +module Select : sig + type mode = t + + type nonrec t = + | Only of t + | All + + include Dune_sexp.Conv.S with type t := t + + val of_option : mode option -> t + + val equal : t -> t -> bool + + val is_not_all : t -> bool +end +with type mode := t + +(** [Map] is a data-structure that can store values that are indexed by keys of + the type [Select.t]. The key [Select.All] is meant to store values that + apply to any mode while keys of the form [Select.Only _] designate values + that apply to specific modes. *) +module Map : sig + type mode = t + + include Map.S with type key = Select.t + + module Multi : sig + include module type of Multi + + (** Creates an new map and populate the [All] key with the given list *) + val create_for_all_modes : 'a list -> 'a t + + (** Returns the list of values associated to the [All] key. *) + val for_all_modes : 'a t -> 'a list + + (** Returns the list of values associated to a specific mode. If the + [and_all] option is set to true then values associated to the [All] key + are also returned. *) + val for_only : and_all:bool -> 'a t -> mode -> 'a list + end + + val encode : ('a -> Dune_sexp.t) -> 'a Multi.t -> Dune_sexp.t list + + val decode : 'a Dune_sexp.Decoder.t -> 'a Multi.t Dune_sexp.Decoder.t +end +with type mode := t diff --git a/duniverse/dune_/src/upgrader/dune b/duniverse/dune_/src/upgrader/dune index 8173abcb2..d3f4cfd81 100644 --- a/duniverse/dune_/src/upgrader/dune +++ b/duniverse/dune_/src/upgrader/dune @@ -1,4 +1,11 @@ (library (name dune_upgrader) - (libraries stdune memo opam_file_format dune_lang dune_engine fiber) + (libraries + stdune + dune_console + memo + opam_file_format + dune_lang + dune_engine + fiber) (synopsis "Internal Dune library, do not use!")) diff --git a/duniverse/dune_/src/upgrader/dune_upgrader.ml b/duniverse/dune_/src/upgrader/dune_upgrader.ml index 95e0fd0f1..90b36a004 100644 --- a/duniverse/dune_/src/upgrader/dune_upgrader.ml +++ b/duniverse/dune_/src/upgrader/dune_upgrader.ml @@ -4,6 +4,7 @@ open! Stdune engine *) module Dune_project = Dune_engine.Dune_project module Source_tree = Dune_engine.Source_tree +module Console = Dune_console module Sub_dirs = Dune_engine.Sub_dirs type rename_and_edit = @@ -258,7 +259,7 @@ module V2 = struct let fn = Path.Source.relative path Source_tree.Dune_file.fname in if Io.with_lexbuf_from_file (Path.source fn) - ~f:Dune_lang.Dune_lexer.is_script + ~f:Dune_lang.Dune_file_script.is_script then User_warning.emit ~loc:(Loc.in_file (Path.source fn)) diff --git a/duniverse/dune_/stdune.opam b/duniverse/dune_/stdune.opam index 5452400da..968147ebf 100644 --- a/duniverse/dune_/stdune.opam +++ b/duniverse/dune_/stdune.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "3.4.1" +version: "3.6.1" synopsis: "Dune's unstable standard library" description: "This library offers no backwards compatibility guarantees. Use at your own risk." @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08.0"} "base-unix" "dyn" {= version} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t b/duniverse/dune_/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t index 7537231df..64e79a574 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/actions/action-stdxxx-on-success.t @@ -125,7 +125,7 @@ However, re-executing the second action was not necessary given that its stdout was empty. Dune could have recorded the fact that the second action had an empty stdout and so was unaffected by the status of --action-stdout-on-success. Dune could also cache the -stdout/stderr of actions accross builds and only re-print them rather +stdout/stderr of actions across builds and only re-print them rather than re-execute actions entirely. In case of errors diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/alias-module-generated.t b/duniverse/dune_/test/blackbox-tests/test-cases/alias-module-generated.t new file mode 100644 index 000000000..28148a64c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/alias-module-generated.t @@ -0,0 +1,22 @@ +Test alias module for wrapped libraries that don't have a main module, i.e. the +wrap module is generated by dune. + + $ cat >dune-project < (lang dune 3.5) + > EOF + + $ cat >dune < (library + > (name foo)) + > EOF + $ touch bar.ml + + $ dune build + $ cat _build/default/foo.ml-gen + (* generated by dune *) + + (** @canonical Foo.Bar *) + module Bar = Foo__Bar + +The final `Foo` module should not be marked as deprecated/shadowed, since it +does not shadow any module. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/alias-module.t b/duniverse/dune_/test/blackbox-tests/test-cases/alias-module.t new file mode 100644 index 000000000..d2bd92837 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/alias-module.t @@ -0,0 +1,21 @@ +Test alias module for wrapped libraries: + + $ cat >dune-project < (lang dune 3.5) + > EOF + + $ cat >dune < (library + > (name foo)) + > EOF + $ touch foo.ml bar.ml + + $ dune build + $ cat _build/default/foo__.ml-gen + (* generated by dune *) + + (** @canonical Foo.Bar *) + module Bar = Foo__Bar + + module Foo__ = struct end + [@@deprecated "this module is shadowed"] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/alias-multiple.t b/duniverse/dune_/test/blackbox-tests/test-cases/alias-multiple.t new file mode 100644 index 000000000..ad5a8be25 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/alias-multiple.t @@ -0,0 +1,105 @@ +Testing multiple aliases in rules stanza + +First we start with a dune-project before alias was introduced: + $ cat > dune-project << EOF + > (lang dune 1.9) + > EOF + + $ cat > dune << EOF + > (rule + > (alias a) + > (action (echo "I have run"))) + > EOF + + $ dune build @a + File "dune", line 2, characters 1-10: + 2 | (alias a) + ^^^^^^^^^ + Error: 'alias' is only available since version 2.0 of the dune language. + Please update your dune-project file to have (lang dune 2.0). + [1] + +Next we update the dune-project file to use dune 2.0: + $ cat > dune-project << EOF + > (lang dune 2.0) + > EOF + + $ dune build @a + I have run + +We now update the dune file to use multiple aliases + $ cat > dune << EOF + > (rule + > (alias a b) + > (action (echo "I have run"))) + > EOF + + $ dune build @a + File "dune", line 2, characters 10-11: + 2 | (alias a b) + ^ + Error: Too many argument for alias + [1] + +That doesn't work so we use the aliases field + $ cat > dune << EOF + > (rule + > (aliases a b) + > (action (echo "I have run"))) + > EOF + + $ dune build @a @b + File "dune", line 2, characters 1-14: + 2 | (aliases a b) + ^^^^^^^^^^^^^ + Error: 'aliases' is only available since version 3.5 of the dune language. + Please update your dune-project file to have (lang dune 3.5). + [1] + +Updating the dune-project file to use dune 3.5 allows the build to succeed: + $ cat > dune-project << EOF + > (lang dune 3.5) + > EOF + + $ dune build @a + I have run + $ dune build @b + I have run + +Also note having both the alias and aliases fields in the same rule stanza is +not allowed + + $ cat > dune << EOF + > (rule + > (alias a) + > (aliases b) + > (action (echo "I have run"))) + > EOF + + $ dune build @a + File "dune", line 1, characters 0-60: + 1 | (rule + 2 | (alias a) + 3 | (aliases b) + 4 | (action (echo "I have run"))) + Error: The 'alias' and 'aliases' fields are mutually exclusive. Please use + only the 'aliases' field. + [1] + +Even if the aliases list is empty + $ cat > dune << EOF + > (rule + > (alias a) + > (aliases) + > (action (echo "I have run"))) + > EOF + + $ dune build @a + File "dune", line 1, characters 0-58: + 1 | (rule + 2 | (alias a) + 3 | (aliases) + 4 | (action (echo "I have run"))) + Error: The 'alias' and 'aliases' fields are mutually exclusive. Please use + only the 'aliases' field. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/run.t deleted file mode 100644 index d2de8a09c..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/run.t +++ /dev/null @@ -1,76 +0,0 @@ -@all builds private exe's - - $ dune build --display short --root private-exe @all - Entering directory 'private-exe' - ocamldep .foo.eobjs/foo.ml.d - ocamlc .foo.eobjs/byte/foo.{cmi,cmo,cmt} - ocamlopt .foo.eobjs/native/foo.{cmx,o} - ocamlc foo.bc - ocamlc foo.bc-for-jsoo - ocamlopt foo.exe - -@all builds private libs - - $ dune build --display short --root private-lib @all - Entering directory 'private-lib' - ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} - ocamlopt .bar.objs/native/bar.{cmx,o} - ocamlc bar.cma - ocamlopt bar.{a,cmxa} - ocamlopt bar.cmxs - -@all builds custom install stanzas - - $ dune build --root install-stanza @subdir/all - Entering directory 'install-stanza' - Error: No rule found for subdir/foobar - -> required by alias subdir/all - [1] - -@all builds user defined rules - - $ dune build --display short --root user-defined @all - Entering directory 'user-defined' - echo foo - -@all includes user defined install alias - - $ dune build --display short --root install-alias @all - Entering directory 'install-alias' - echo foo - -@all does not depend directly on file copies from the source tree - - $ mkdir -p source-file-copies - $ cd source-file-copies - $ cat > dune-project < (lang dune 3.0) - > EOF - -Add two files - - $ touch a.ml b.ml - -An empty project, should not copy any file. - - $ dune build - $ find _build/default -name '*.ml' - -A project that only uses a.ml, should not copy b.ml - - $ cat > dune < (library (name a) (modules a)) - > EOF - $ dune build - $ find _build/default -name '*.ml' - _build/default/a.ml - -A project that uses both files, should copy both. - - $ cat > dune < (library (name a)) - > EOF - $ dune build - $ find _build/default -name '*.ml' | sort - _build/default/a.ml - _build/default/b.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-alias/dune b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-alias/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-alias/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-alias/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/run.t new file mode 100644 index 000000000..67234ddba --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-alias.t/run.t @@ -0,0 +1,4 @@ +@all includes user defined install alias + + $ dune build --display short @all + echo foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/run.t new file mode 100644 index 000000000..5c208b292 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/run.t @@ -0,0 +1,6 @@ +@all builds custom install stanzas + + $ dune build @subdir/all + Error: No rule found for subdir/foobar + -> required by alias subdir/all + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/subdir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/subdir/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/install-stanza/subdir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/install-stanza.t/subdir/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-exe/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/run.t new file mode 100644 index 000000000..a2fd6a2c8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-exe.t/run.t @@ -0,0 +1,9 @@ +@all builds private exe's + + $ dune build @all --display short + ocamldep .foo.eobjs/foo.ml.d + ocamlc .foo.eobjs/byte/foo.{cmi,cmo,cmt} + ocamlopt .foo.eobjs/native/foo.{cmx,o} + ocamlc foo.bc + ocamlc foo.bc-for-jsoo + ocamlopt foo.exe diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/private-lib/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/run.t new file mode 100644 index 000000000..770ae8fc0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/private-lib.t/run.t @@ -0,0 +1,8 @@ +@all builds private libs + + $ dune build --display short @all + ocamlc .bar.objs/byte/bar.{cmi,cmo,cmt} + ocamlopt .bar.objs/native/bar.{cmx,o} + ocamlc bar.cma + ocamlopt bar.{a,cmxa} + ocamlopt bar.cmxs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/source-file-copies.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/source-file-copies.t new file mode 100644 index 000000000..921e518d8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/source-file-copies.t @@ -0,0 +1,33 @@ +@all does not depend directly on file copies from the source tree + + $ cat > dune-project < (lang dune 3.0) + > EOF + +Add two files + + $ touch a.ml b.ml + +An empty project, should not copy any file. + + $ dune build + $ find _build/default -name '*.ml' + +A project that only uses a.ml, should not copy b.ml + + $ cat > dune < (library (name a) (modules a)) + > EOF + $ dune build + $ find _build/default -name '*.ml' + _build/default/a.ml + +A project that uses both files, should copy both. + + $ cat > dune < (library (name a)) + > EOF + $ dune build + $ find _build/default -name '*.ml' | sort + _build/default/a.ml + _build/default/b.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/user-defined/dune b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/user-defined/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/user-defined/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/all-alias.t/user-defined/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/run.t new file mode 100644 index 000000000..cf0ac7e2a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/all-alias/user-defined.t/run.t @@ -0,0 +1,4 @@ +@all builds user defined rules + + $ dune build --display short @all + echo foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/run.t deleted file mode 100644 index 91266a67d..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/run.t +++ /dev/null @@ -1,15 +0,0 @@ - $ dune runtest --root absolute-path - Entering directory 'absolute-path' - File "dune", line 4, characters 9-17: - 4 | (alias /foo/bar))) - ^^^^^^^^ - Error: Invalid alias! - Tried to reference path outside build dir: "/foo/bar" - [1] - $ dune runtest --root outside-workspace - Entering directory 'outside-workspace' - File "dune", line 4, characters 9-42: - 4 | (alias %{workspace_root}/../../../foobar))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: path outside the workspace: ./../../../foobar from default - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/absolute-path/dune b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/absolute-path/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/absolute-path/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/absolute-path/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/run.t new file mode 100644 index 000000000..0a440a7dc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/absolute-path.t/run.t @@ -0,0 +1,7 @@ + $ dune runtest + File "dune", line 4, characters 9-17: + 4 | (alias /foo/bar))) + ^^^^^^^^ + Error: Invalid alias! + Tried to reference path outside build dir: "/foo/bar" + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/outside-workspace/dune b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/outside-workspace/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/outside-workspace/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error.t/outside-workspace/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/run.t new file mode 100644 index 000000000..55e6014e4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/bad-alias-error/outside-workspace.t/run.t @@ -0,0 +1,6 @@ + $ dune runtest + File "dune", line 4, characters 9-42: + 4 | (alias %{workspace_root}/../../../foobar))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: path outside the workspace: ./../../../foobar from default + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bin-available.t b/duniverse/dune_/test/blackbox-tests/test-cases/bin-available.t index 36dd0b4d4..406c557ee 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/bin-available.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/bin-available.t @@ -11,7 +11,7 @@ Test for %{bin-available:...} > (progn > (echo "dune: %{bin-available:dune}\n") > (echo "local program foo: %{bin-available:foo}\n") - > (echo "non existant program: %{bin-available:*}\n")))) + > (echo "non existent program: %{bin-available:*}\n")))) > > (executable (public_name foo)) > EOF @@ -20,4 +20,4 @@ Test for %{bin-available:...} $ dune build dune: true local program foo: true - non existant program: false + non existent program: false diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/github3473.t b/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/github3473.t deleted file mode 100644 index e7ecba5e7..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/github3473.t +++ /dev/null @@ -1,26 +0,0 @@ - $ cat >dune-project < (lang dune 2.5) - > EOF - - $ cat >dune < (library - > (name hello) - > (bisect_ppx)) - > EOF - - $ cat >dune-workspace < (lang dune 2.6) - > - > (context default) - > (context (default (name coverage) (bisect_enabled true))) - > EOF - - $ dune build @all 2>&1 | grep -v 'file "' - File "dune", line 3, characters 1-13: - 3 | (bisect_ppx)) - ^^^^^^^^^^^^ - Error: 'bisect_ppx' is available only when bisect_ppx is enabled in the - dune-project file. It cannot be enabled automatically because the currently - selected version of dune (2.5) does not support this plugin. - You must enable it using (using bisect_ppx ..) in your dune-project file. The - first version of this plugin 1.0 was introduced in dune 2.6. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/main.t b/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/main.t deleted file mode 100644 index 1993f3be6..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/bisect-ppx/main.t +++ /dev/null @@ -1,103 +0,0 @@ ----------------------------------------------------------------------------------- -Testsuite for (bisect_ppx) field for libraries/executables. - - $ cat >dune-project < (lang dune 2.6) - > (using bisect_ppx 1.0) - > EOF - - - $ cat >dune-workspace.dev < (lang dune 2.6) - > (context (default (bisect_enabled true))) - > EOF - - $ echo "let run () = print_endline \"Hello, world!\"" > hello.ml - $ echo "let () = Hello.run ()" > test.ml - ----------------------------------------------------------------------------------- -* (preprocess (pps bisect_ppx)) produces the correct coverage files. - - $ cat >dune < (executable - > (name test) - > (preprocess (per_module - > ((pps bisect_ppx) hello)))) - > EOF - - $ dune exec ./test.exe - Hello, world! - - $ dune exec bisect-ppx-report -- html - Info: found coverage files in './' - - $ find . -name "hello.ml.html" - ./_coverage/hello.ml.html - - $ find . -name "test.ml.html" - $ rm *.coverage - $ rm -rf _coverage - ----------------------------------------------------------------------------------- -Test that bisect_ppx is enabled and produces *.coverage file for libraries. - - $ cat >dune < (library - > (name hello) - > (modules hello) - > (bisect_ppx)) - > - > (executable - > (name test) - > (modules test) - > (libraries hello)) - > EOF - - $ dune exec ./test.exe - Hello, world! - - $ dune exec bisect-ppx-report -- html - Error: no coverage files given on command line or found - [1] - - $ dune exec ./test.exe --workspace dune-workspace.dev - Hello, world! - - $ dune exec bisect-ppx-report -- html - Info: found coverage files in './' - - $ find . -name "hello.ml.html" - ./_coverage/hello.ml.html - $ rm *.coverage - $ rm -rf _coverage - -Test that bisect_ppx is enabled and produces *.coverage file for executables. - $ cat >dune < (library - > (name hello) - > (modules hello)) - > - > (executable - > (name test) - > (modules test) - > (bisect_ppx) - > (libraries hello)) - > EOF - - $ dune exec ./test.exe - Hello, world! - - $ dune exec bisect-ppx-report -- html - Error: no coverage files given on command line or found - [1] - - $ dune exec ./test.exe --workspace dune-workspace.dev - Hello, world! - - $ dune exec bisect-ppx-report -- html - Info: found coverage files in './' - - $ find . -name "test.ml.html" - ./_coverage/test.ml.html - $ rm *.coverage - $ rm -rf _coverage diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cinaps/runtime-deps.t b/duniverse/dune_/test/blackbox-tests/test-cases/cinaps/runtime-deps.t new file mode 100644 index 000000000..273bf1bd0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cinaps/runtime-deps.t @@ -0,0 +1,30 @@ +Runtime dependencies for running cinaps + + $ cat > dune-project < (lang dune 3.5) + > (using cinaps 1.1) + > EOF + + $ cat > foo < hello world + > EOF + + $ cat > dune < (cinaps + > (files *.ml) + > (runtime_deps foo)) + > EOF + + $ cat > test.ml < (*$ let f = open_in "foo" in print_endline (input_line f); close_in f *) + > (*$*) + > EOF + + $ dune build @cinaps --auto-promote + File "test.ml", line 1, characters 0-0: + Error: Files _build/default/test.ml and + _build/default/test.ml.cinaps-corrected differ. + Promoting _build/default/test.ml.cinaps-corrected to test.ml. + [1] + $ cat test.ml + (*$ let f = open_in "foo" in print_endline (input_line f); close_in f *)hello world diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cmdline/profile.t b/duniverse/dune_/test/blackbox-tests/test-cases/cmdline/profile.t index fdf63160f..152505382 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/cmdline/profile.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cmdline/profile.t @@ -1,9 +1,9 @@ # Bug #4632 $ dune build -p - dune build: option `-p' needs an argument - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '-p' needs an argument + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --root . --verbose 2>&1 | grep "; profile" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t old mode 100755 new mode 100644 index 6d3706cce..2213ae138 --- a/duniverse/dune_/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t @@ -14,13 +14,13 @@ [1] $ dune build "(fi" - dune build: TARGET... arguments: unclosed parenthesis at end of input - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: TARGET… arguments: unclosed parenthesis at end of input + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build "()" - dune build: TARGET... arguments: Unexpected list - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: TARGET… arguments: Unexpected list + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/run.t deleted file mode 100644 index 4a62a73ef..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/run.t +++ /dev/null @@ -1,86 +0,0 @@ -Test that (copy_files ...) works - - $ dune build --root test1 test.exe .merlin-conf/lib-foo .merlin-conf/exe-test - Entering directory 'test1' - $ dune build --root test1 @bar-source - Entering directory 'test1' - #line 1 "include/bar.h" - int foo () {return 42;} - $ dune build --root test2 @foo/cat - Entering directory 'test2' - # 1 "dummy.txt" - hello - -Test (alias ...) and (mode ...) fields: - - $ mkdir -p test3 - $ cat >test3/dune-project < (lang dune 2.6) - > EOF - $ cat >test3/dune < (copy_files - > (alias foo) - > (mode promote-until-clean) - > (files subdir/*.txt)) - > EOF - $ mkdir -p test3/subdir - $ echo Foo >test3/subdir/foo.txt - - $ dune build --root test3 @foo - Entering directory 'test3' - File "dune", line 2, characters 1-12: - 2 | (alias foo) - ^^^^^^^^^^^ - Error: 'alias' is only available since version 2.7 of the dune language. - Please update your dune-project file to have (lang dune 2.7). - [1] - - $ cat >test3/dune-project < (lang dune 2.7) - > EOF - - $ dune build --root test3 @foo - Entering directory 'test3' - - $ cat test3/foo.txt - Foo - -Test external paths: - - $ mkdir -p test4 - $ cat >test4/dune-project < (lang dune 2.7) - > EOF - $ P=$(mktemp) - $ echo Hola > $P - $ cat >test4/dune < (copy_files $P) - > EOF - $ dune build --root test4 $(basename $P) - Entering directory 'test4' - $ cat test4/_build/default/$(basename $P) - Hola - -Test (enabled_if ...) - - $ mkdir -p test5/subdir - $ cat >test5/dune-project < (lang dune 2.8) - > EOF - $ cat >test5/subdir/dune < (rule (with-stdout-to foo.txt (progn))) - > EOF - $ cat >test5/dune < (copy_files (enabled_if false) (files subdir/foo.txt)) - > EOF - $ dune build --root test5 - Entering directory 'test5' - $ ls test5/_build/default | grep foo.txt - [1] - $ cat >test5/dune < (copy_files (enabled_if true) (files subdir/foo.txt)) - > EOF - $ dune build --root test5 - Entering directory 'test5' - $ ls test5/_build/default | grep foo.txt - foo.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/bar.c b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/bar.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/bar.c rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/bar.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/include/bar.h b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/include/bar.h similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/include/bar.h rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/include/bar.h diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/lexers/dune b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/lexers/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/lexers/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/lexers/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/lexers/lexer1.mll b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/lexers/lexer1.mll similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/lexers/lexer1.mll rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/lexers/lexer1.mll diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/run.t new file mode 100644 index 000000000..2696c0b50 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/run.t @@ -0,0 +1,6 @@ +Test that (copy_files ...) works + + $ dune build test.exe .merlin-conf/lib-foo .merlin-conf/exe-test + $ dune build @bar-source + #line 1 "include/bar.h" + int foo () {return 42;} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test1/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test1.t/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/foo/dune b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/foo/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/copy_files.t/test2/foo/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/foo/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/run.t new file mode 100644 index 000000000..7b77d65b0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test2.t/run.t @@ -0,0 +1,5 @@ +Test that (copy_files ...) works + + $ dune build @foo/cat + # 1 "dummy.txt" + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test3.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test3.t new file mode 100644 index 000000000..728c0f274 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test3.t @@ -0,0 +1,30 @@ +Test (alias ...) and (mode ...) fields: + + $ cat >dune-project < (lang dune 2.6) + > EOF + $ cat >dune < (copy_files + > (alias foo) + > (mode promote-until-clean) + > (files subdir/*.txt)) + > EOF + $ mkdir -p subdir + $ echo Foo >subdir/foo.txt + + $ dune build @foo + File "dune", line 2, characters 1-12: + 2 | (alias foo) + ^^^^^^^^^^^ + Error: 'alias' is only available since version 2.7 of the dune language. + Please update your dune-project file to have (lang dune 2.7). + [1] + + $ cat >dune-project < (lang dune 2.7) + > EOF + + $ dune build @foo + + $ cat foo.txt + Foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test4.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test4.t new file mode 100644 index 000000000..ca3a5edfc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test4.t @@ -0,0 +1,13 @@ +Test external paths: + + $ cat >dune-project < (lang dune 2.7) + > EOF + $ P=$(mktemp) + $ echo Hola > $P + $ cat >dune < (copy_files $P) + > EOF + $ dune build $(basename $P) + $ cat _build/default/$(basename $P) + Hola diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test5.t b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test5.t new file mode 100644 index 000000000..ed0e2daa7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/copy_files/test5.t @@ -0,0 +1,21 @@ +Test (enabled_if ...) + + $ mkdir -p subdir + $ cat >dune-project < (lang dune 2.8) + > EOF + $ cat >subdir/dune < (rule (with-stdout-to foo.txt (progn))) + > EOF + $ cat >dune < (copy_files (enabled_if false) (files subdir/foo.txt)) + > EOF + $ dune build + $ ls _build/default | grep foo.txt + [1] + $ cat >dune < (copy_files (enabled_if true) (files subdir/foo.txt)) + > EOF + $ dune build + $ ls _build/default | grep foo.txt + foo.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/base-unsound.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/base-unsound.t/run.t index 4d7f98a49..f704c496a 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/base-unsound.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/base-unsound.t/run.t @@ -1,5 +1,5 @@ $ dune build --display short --profile unsound --debug-dependency-path @all coqdep bar.v.d coqdep foo.v.d - coqc .foo.aux,foo.{glob,vo} - coqc .bar.aux,bar.{glob,vo} + coqc foo.{glob,vo} + coqc bar.{glob,vo} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/base.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/base.t/run.t index 8ac016d27..e5bccec4b 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/base.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/base.t/run.t @@ -1,8 +1,8 @@ $ dune build --display short --debug-dependency-path @all coqdep bar.v.d coqdep foo.v.d - coqc .foo.aux,foo.{glob,vo} - coqc .bar.aux,bar.{glob,vo} + coqc foo.{glob,vo} + coqc bar.{glob,vo} $ dune build --debug-dependency-path @default lib: [ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodeps.t/B/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodeps.t/B/b.v index 46e4b397d..4c127dbd6 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodeps.t/B/b.v +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodeps.t/B/b.v @@ -1 +1 @@ -Inductive Begining := Of | The | Universe. +Inductive Beginning := Of | The | Universe. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/A.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/A.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/A.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/A.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/a.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/a.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/a.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/A/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/A/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/B.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/B.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/B.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/B.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/b.v new file mode 100644 index 000000000..4c127dbd6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/b.v @@ -0,0 +1 @@ +Inductive Beginning := Of | The | Universe. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/B/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/run.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nodups.t/run.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/a.v new file mode 100644 index 000000000..110ee9e41 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/a.v @@ -0,0 +1,6 @@ +Print LoadPath. +Fail Print Prelude. +From Coq Require Import Prelude. +Print Prelude. +Require Import mytheory. +Check Hello. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune new file mode 100644 index 000000000..2ea19719d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune @@ -0,0 +1,4 @@ +(coq.theory + (name A) + (stdlib no) + (theories Coq)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune-project new file mode 100644 index 000000000..4dad2a1c9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/A/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/b.v new file mode 100644 index 000000000..3d8121dab --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/b.v @@ -0,0 +1,4 @@ +Print LoadPath. +Print Prelude. +Require Import mytheory. +Check Hello. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune new file mode 100644 index 000000000..094a2674e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune @@ -0,0 +1,4 @@ +(coq.theory + (name B) + (stdlib yes) + (theories Coq)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune-project new file mode 100644 index 000000000..4dad2a1c9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/B/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/subtheory.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/Coq.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/subtheory.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/Coq.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/Init/Prelude.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/Init/Prelude.v new file mode 100644 index 000000000..9de480a5a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/Init/Prelude.v @@ -0,0 +1,2 @@ +Unset Elimination Schemes. +Inductive BootType := boot | type. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune new file mode 100644 index 000000000..323f2d22b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune @@ -0,0 +1,6 @@ +(coq.theory + (name Coq) + (package Coq) + (boot)) + +(include_subdirs qualified) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune-project new file mode 100644 index 000000000..05af5ca5d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.3) +(using coq 0.4) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/mytheory.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/mytheory.v new file mode 100644 index 000000000..831752c56 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/Coq/mytheory.v @@ -0,0 +1,2 @@ + +Inductive Hello := World | Bye. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/dune-workspace new file mode 100644 index 000000000..7b17fb2d3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/dune-workspace @@ -0,0 +1 @@ +(lang dune 3.3) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/run.t new file mode 100644 index 000000000..7fb935fb7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-nostdlib.t/run.t @@ -0,0 +1,36 @@ +Testing composition of theories across a Dune workspace with a boot library and +importing ``stdlib`` enabled or disabled. + +Composing library A depending on Coq but having `(stdlib no)`: + + $ dune build A + Logical Path / Physical path: + A + $TESTCASE_ROOT/_build/default/A + Coq + $TESTCASE_ROOT/_build/default/Coq + Coq.Init + $TESTCASE_ROOT/_build/default/Coq/Init + Module + Prelude + := Struct Inductive BootType : Set := boot : BootType | type : BootType. End + + Hello + : Set + +Composing library B depending on Coq but having `(stdlib yes)`: + + $ dune build B + Logical Path / Physical path: + B + $TESTCASE_ROOT/_build/default/B + Coq + $TESTCASE_ROOT/_build/default/Coq + Coq.Init + $TESTCASE_ROOT/_build/default/Coq/Init + Module + Prelude + := Struct Inductive BootType : Set := boot : BootType | type : BootType. End + + Hello + : Set diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/p.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/coq-boot.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/p.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/coq-boot.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/dune-project new file mode 100644 index 000000000..3367dfcd5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.4) + +(using coq 0.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/p.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/boot_plugin.mlpack similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/p.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/boot_plugin.mlpack diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/dune new file mode 100644 index 000000000..c9a2d0618 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/dune @@ -0,0 +1,4 @@ +(library + (name boot_plugin) + (public_name coq-boot.boot_plugin)) + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/main.ml b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/main.ml new file mode 100644 index 000000000..752bae9ce --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/plugins/main.ml @@ -0,0 +1 @@ +let () = Format.eprintf "plugin loaded@\n%!" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/Init/Prelude.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/Init/Prelude.v new file mode 100644 index 000000000..feece511f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/Init/Prelude.v @@ -0,0 +1,2 @@ +Declare ML Module "boot_plugin:coq-boot.boot_plugin". +Inductive AnotherBegining := Of | The | Universe. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/dune new file mode 100644 index 000000000..023768c38 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/Coq/theories/dune @@ -0,0 +1,7 @@ +(coq.theory + (name Coq) + (boot) + (package coq-boot) + (plugins coq-boot.boot_plugin)) + +(include_subdirs qualified) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/p.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/coq-user.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/p.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/coq-user.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune new file mode 100644 index 000000000..dc2eb8516 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune @@ -0,0 +1,5 @@ +(coq.theory + (name User) + (package coq-user)) + + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune-project new file mode 100644 index 000000000..3367dfcd5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.4) + +(using coq 0.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/user.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/user.v new file mode 100644 index 000000000..3bc2f0810 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/User/user.v @@ -0,0 +1 @@ +Definition from_boot : AnotherBegining := Universe. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/dune-workspace new file mode 100644 index 000000000..d58d45f56 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/dune-workspace @@ -0,0 +1 @@ +(lang dune 3.4) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/run.t new file mode 100644 index 000000000..3d8759752 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot-plugins.t/run.t @@ -0,0 +1,5 @@ +Testing composition with a boot library with plugins + + $ dune build + plugin loaded + plugin loaded diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/b.v deleted file mode 100644 index 46e4b397d..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-boot.t/B/b.v +++ /dev/null @@ -1 +0,0 @@ -Inductive Begining := Of | The | Universe. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/a/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/A/a.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/a/a.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/A/a.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/a/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/A/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/a/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/A/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/b/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/B/b.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/b/b.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/B/b.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/b/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/B/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/b/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/B/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/run.t index 6a76d2598..13b65eea3 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-cycle.t/run.t @@ -5,7 +5,7 @@ We check cycles are detected -> theory B in B -> theory A in A -> required by _build/default/A/a.v.d - -> required by _build/default/A/.a.aux + -> required by _build/default/A/a.glob -> required by alias A/all -> required by alias default [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-installed.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-installed.t/run.t index 361fdc9d6..223e50bd5 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-installed.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-installed.t/run.t @@ -13,7 +13,7 @@ TODO: Currently this is not supported so the output is garbage Theory B not found -> required by theory A in . -> required by _build/default/a.v.d - -> required by _build/default/.a.aux + -> required by _build/default/a.glob -> required by alias all -> required by alias default [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/run.t index 78b691f29..578cf0d9c 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/run.t @@ -23,5 +23,5 @@ ocamlopt src_b/ml_plugin_b.{a,cmxa} ocamlopt src_a/ml_plugin_a.cmxs ocamlopt src_b/ml_plugin_b.cmxs - coqc thy1/.a.aux,thy1/a.{glob,vo} - coqc thy2/.a.aux,thy2/a.{glob,vo} + coqc thy1/a.{glob,vo} + coqc thy2/a.{glob,vo} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/src_a/gram.mlg b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/src_a/gram.mlg index 80481ac46..f54a2e951 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/src_a/gram.mlg +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/src_a/gram.mlg @@ -1,4 +1,4 @@ -DECLARE PLUGIN "gram" +DECLARE PLUGIN "cplugin.ml_plugin_a" { diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy1/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy1/a.v index 340c0d8ab..4c2f52c94 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy1/a.v +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy1/a.v @@ -1,3 +1,3 @@ -Declare ML Module "ml_plugin_a". -Declare ML Module "ml_plugin_b". +Declare ML Module "ml_plugin_a:cplugin.ml_plugin_a". +Declare ML Module "ml_plugin_b:cplugin.ml_plugin_b". diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy2/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy2/a.v index 340c0d8ab..4c2f52c94 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy2/a.v +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-plugin.t/thy2/a.v @@ -1,3 +1,3 @@ -Declare ML Module "ml_plugin_a". -Declare ML Module "ml_plugin_b". +Declare ML Module "ml_plugin_a:cplugin.ml_plugin_a". +Declare ML Module "ml_plugin_b:cplugin.ml_plugin_b". diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-boot.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-boot.t/run.t index 9924728e6..c629be622 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-boot.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-boot.t/run.t @@ -1,4 +1,4 @@ -Testing composition of theories accross a dune workspace with a boot library. A +Testing composition of theories across a dune workspace with a boot library. A boot library must have the following: - Under the module prefix "Coq" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-cycle.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-cycle.t/run.t index acf813e80..69986b89c 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-cycle.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-cycle.t/run.t @@ -1,4 +1,4 @@ -Testing composition of theories accross a dune workspace with cyclic +Testing composition of theories across a dune workspace with cyclic dependencies. $ dune build A @@ -8,7 +8,9 @@ dependencies. -> theory C in C -> theory A in A -> required by _build/default/A/a.v.d - -> required by _build/default/A/.a.aux + -> required by _build/default/A/a.vo + -> required by _build/install/default/lib/coq/user-contrib/A/a.vo + -> required by _build/default/A/A.install -> required by alias A/all -> required by alias A/default [1] @@ -20,7 +22,9 @@ dependencies. -> theory A in A -> theory B in B -> required by _build/default/B/b.v.d - -> required by _build/default/B/.b.aux + -> required by _build/default/B/b.vo + -> required by _build/install/default/lib/coq/user-contrib/B/b.vo + -> required by _build/default/B/B.install -> required by alias B/all -> required by alias B/default [1] @@ -32,7 +36,9 @@ dependencies. -> theory B in B -> theory C in C -> required by _build/default/C/c.v.d - -> required by _build/default/C/.c.aux + -> required by _build/default/C/c.vo + -> required by _build/install/default/lib/coq/user-contrib/C/c.vo + -> required by _build/default/C/C.install -> required by alias C/all -> required by alias C/default [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-missing.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-missing.t/run.t index 61d86ca1a..1badfd008 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-missing.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects-missing.t/run.t @@ -1,4 +1,4 @@ -Testing composition of theories accross a dune workspace with a missing +Testing composition of theories across a dune workspace with a missing dependency. $ dune build C @@ -9,7 +9,9 @@ dependency. -> required by theory B in B -> required by theory C in C -> required by _build/default/C/c.v.d - -> required by _build/default/C/.c.aux + -> required by _build/default/C/c.vo + -> required by _build/install/default/lib/coq/user-contrib/C/c.vo + -> required by _build/default/C/C.install -> required by alias C/all -> required by alias C/default [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects.t/run.t index 9ac12fbe5..0a11ec4c8 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-projects.t/run.t @@ -1,4 +1,4 @@ -Testing composition of theories accross a dune workspace +Testing composition of theories across a dune workspace $ dune build B Hello : Set diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-self.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-self.t/run.t index 3bb751183..94f362f5a 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-self.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-self.t/run.t @@ -3,7 +3,7 @@ Composing a theory with itself should cause a cycle Error: Dependency cycle between: theory A in A -> required by _build/default/A/a.v.d - -> required by _build/default/A/.a.aux + -> required by _build/default/A/a.glob -> required by alias A/all -> required by alias default [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/a/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/A/a.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/a/a.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/A/a.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/a/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/A/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/a/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/A/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/b/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/B/b.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/b/b.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/B/b.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/b/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/B/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/b/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-simple.t/B/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/a/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/A/a.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/a/a.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/A/a.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/a/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/A/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/a/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/A/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/b/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/B/b.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/b/b.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/B/b.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/b/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/B/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/b/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/B/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/etc/findlib.conf b/duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/Subtheory.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/etc/findlib.conf rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/compose-sub-theory.t/Subtheory.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune new file mode 100644 index 000000000..fe61d87f9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune @@ -0,0 +1,29 @@ +(rule + (action + (with-outputs-to + config.output + (progn + (echo "COQLIB=%{coq:coqlib}\n") + (echo "COQ_NATIVE_COMPILER_DEFAULT=%{coq:coq_native_compiler_default}\n") + (echo "") + (echo "%{coq:version} %{coq:ocaml-version}\n") + (echo + "%{coq:version.major}.%{coq:version.minor}%{coq:version.suffix} %{coq:ocaml-version}\n"))))) + +(rule + (action + (with-outputs-to + config.expected + (progn + (pipe-outputs + ; We need to scrub ignored config values + (run %{bin:coqc} --config) + (run sed "/^COQCORELIB=/d") + (run sed "/^DOCDIR=/d") + (run sed "/^OCAMLFIND=/d") + (run sed "/^CAMLFLAGS=/d") + (run sed "/^WARN=/d") + (run sed "/^HASNATDYNLINK=/d") + (run sed "/^COQ_SRC_SUBDIRS=/d")) + (run %{bin:coqc} -print-version) + (run %{bin:coqc} -print-version))))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune-project new file mode 100644 index 000000000..339d32d18 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.4) +(using coq 0.4) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/run.t new file mode 100644 index 000000000..122462013 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coq-config.t/run.t @@ -0,0 +1,8 @@ +Testing the Coq macro + + $ dune build + + $ cd _build/default + +Testing the output of the version and configuration values + $ diff config.output config.expected diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdep-on-rebuild.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdep-on-rebuild.t/run.t index 24b83fc99..536144c99 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdep-on-rebuild.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdep-on-rebuild.t/run.t @@ -17,9 +17,9 @@ coqdep a/a.v.d coqdep b/b.v.d coqdep b/d.v.d - coqc a/.a.aux,a/a.{glob,vo} - coqc b/.b.aux,b/b.{glob,vo} - coqc b/.d.aux,b/d.{glob,vo} + coqc a/a.{glob,vo} + coqc b/b.{glob,vo} + coqc b/d.{glob,vo} $ cat > b/b.v < From a Require Import a. > Definition bar := a.foo. @@ -27,4 +27,4 @@ > EOF $ dune build --display short --debug-dependency-path coqdep b/b.v.d - coqc b/.b.aux,b/b.{glob,vo} + coqc b/b.{glob,vo} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdoc.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdoc.t/run.t index e2174daaf..6078f8921 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdoc.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqdoc.t/run.t @@ -9,7 +9,7 @@ Now we inspect it: index.html toc.html -We buuild the coqdoc latex target: +We build the coqdoc latex target: $ dune build basic.tex/ Now we inspect it: diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/dune-project new file mode 100644 index 000000000..b0ba69558 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.6) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/gram.mlg b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/gram.mlg new file mode 100644 index 000000000..f54a2e951 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/gram.mlg @@ -0,0 +1,9 @@ +DECLARE PLUGIN "cplugin.ml_plugin_a" + +{ + +(* We don't use any coqpp specific macros as to make the test more + resilient on different Coq versions *) +let foo = 3 + +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/marg.mlg b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/marg.mlg new file mode 100644 index 000000000..d3fe5d787 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/marg.mlg @@ -0,0 +1,4 @@ +DECLARE PLUGIN "cplugin.ml_plugin_b" +{ + let bar = Gram.foo + 4 +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/run.t new file mode 100644 index 000000000..138e0ac8b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqpp.t/run.t @@ -0,0 +1,82 @@ +Testing the coqpp stanza + + $ cat > dune << EOF + > (coq.pp + > (modules gram)) + > (library + > (name foo) + > (flags -rectypes) + > (libraries coq-core.vernac)) + > EOF + + $ ls + dune + dune-project + gram.mlg + marg.mlg + + $ dune build + + $ ls _build/default/ + foo.a + foo.cma + foo.cmxa + foo.cmxs + foo.ml-gen + gram.ml + gram.mlg + +Testing the :standard field with a .mlg file depending on another .mlg file + $ cat > dune << EOF + > (coq.pp + > (modules :standard)) + > (library + > (name foo) + > (flags -rectypes) + > (libraries coq-core.vernac)) + > EOF + + $ ls + _build + dune + dune-project + gram.mlg + marg.mlg + + $ dune build + + $ ls _build/default/ + foo.a + foo.cma + foo.cmxa + foo.cmxs + foo.ml-gen + gram.ml + gram.mlg + marg.ml + marg.mlg + +Same again but with one .mlg file removed + $ cat > dune << EOF + > (coq.pp + > (modules :standard \ gram)) + > (library + > (name foo) + > (flags -rectypes) + > (libraries coq-core.vernac)) + > EOF + + $ dune build + File "marg.mlg", line 3, characters 12-20: + Error: Unbound module Gram + [1] + + $ ls _build/default/ + foo.a + foo.cma + foo.cmxa + foo.cmxs + foo.ml-gen + gram.mlg + marg.ml + marg.mlg diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/run.t deleted file mode 100644 index 898299ae2..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/run.t +++ /dev/null @@ -1,8 +0,0 @@ -Checking that we compute the directory and file for dune coq top correctly - - $ dune build theories/c.vo - $ dune build theories/b/b.vo - $ dune coq top --toplevel=echo theories/c.v - -topfile $TESTCASE_ROOT/_build/default/theories/c.v -R $TESTCASE_ROOT/_build/default/theories foo - $ dune coq top --toplevel=echo theories/b/b.v - -topfile $TESTCASE_ROOT/_build/default/theories/b/b.v -R $TESTCASE_ROOT/_build/default/theories foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/Test.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/Test.v new file mode 100644 index 000000000..55d1fa98f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/Test.v @@ -0,0 +1 @@ +Inductive foo := . diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune new file mode 100644 index 000000000..c4d7124db --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune @@ -0,0 +1,3 @@ +(coq.theory + (name minimal) + (flags -w -notation-overridden)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune-project new file mode 100644 index 000000000..b0ba69558 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.6) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/run.t new file mode 100644 index 000000000..72e628916 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-flags.t/run.t @@ -0,0 +1,9 @@ +Testing that the correct flags are being passed to dune coq top + +The flags passed to coqc: + $ dune build && tail -1 _build/log | sed 's/(cd .*coqc/coqc/' | sed 's/$ //' + coqc -w -notation-overridden -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R . minimal Test.v) + +The flags passed to coqtop: + $ dune coq top --toplevel=echo Test.v | sed 's/-nI .*coq-core/some-coq-core/' + -topfile $TESTCASE_ROOT/_build/default/Test.v -w -notation-overridden -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default minimal diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-gen-file.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-gen-file.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-gen-file.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-gen-file.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-ln.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-ln.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-ln.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-ln.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/run.t new file mode 100644 index 000000000..11629aeef --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/run.t @@ -0,0 +1,8 @@ +Checking that we compute the directory and file for dune coq top correctly + + $ dune build theories/c.vo + $ dune build theories/b/b.vo + $ dune coq top --toplevel=echo theories/c.v + -topfile $TESTCASE_ROOT/_build/default/theories/c.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/theories foo + $ dune coq top --toplevel=echo theories/b/b.v + -topfile $TESTCASE_ROOT/_build/default/theories/b/b.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/theories foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/a/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/a/a.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/a/a.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/a/a.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/b/b.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/b/b.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/b/b.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/b/b.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/c.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/c.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/c.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/c.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/d.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/d.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/d.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/d.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-nested.t/theories/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-nested.t/theories/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-no-stanza.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-no-stanza.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-no-stanza.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-no-stanza.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-recomp.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-recomp.t similarity index 54% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-recomp.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-recomp.t index b9c992cff..8c22f2bfa 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-recomp.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-recomp.t @@ -21,18 +21,18 @@ https://github.com/ocaml/dune/pull/5457#issuecomment-1084161587). $ dune coq top --display short --toplevel echo dir/bar.v coqdep dir/bar.v.d coqdep dir/foo.v.d - coqc dir/.foo.aux,dir/foo.{glob,vo} - -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -R $TESTCASE_ROOT/_build/default/dir basic + coqc dir/foo.{glob,vo} + -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/dir basic $ dune coq top --display short --toplevel echo dir/bar.v - -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -R $TESTCASE_ROOT/_build/default/dir basic + -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/dir basic $ dune clean $ (cd dir && dune coq top --root .. --display short --toplevel echo dir/bar.v) Entering directory '..' coqdep dir/bar.v.d coqdep dir/foo.v.d - coqc dir/.foo.aux,dir/foo.{glob,vo} - -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -R $TESTCASE_ROOT/_build/default/dir basic + coqc dir/foo.{glob,vo} + -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/dir basic $ (cd dir && dune coq top --root .. --display short --toplevel echo dir/bar.v) Entering directory '..' - -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -R $TESTCASE_ROOT/_build/default/dir basic + -topfile $TESTCASE_ROOT/_build/default/dir/bar.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/dir basic diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/run.t similarity index 72% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/run.t index 60f0ce511..0bdac23a4 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/run.t @@ -1,7 +1,7 @@ All dune commands work when you run them in sub-directories, so this should be no exception. $ dune coq top --toplevel=echo -- theories/foo.v - -topfile $TESTCASE_ROOT/_build/default/theories/foo.v -R $TESTCASE_ROOT/_build/default/theories foo + -topfile $TESTCASE_ROOT/_build/default/theories/foo.v -q -w -deprecated-native-compiler-option -w -native-compiler-disabled -native-compiler ondemand -R $TESTCASE_ROOT/_build/default/theories foo $ cd theories This test is currently broken due to the workspace resolution being faulty #5899. @@ -14,5 +14,5 @@ This test is currently broken due to the workspace resolution being faulty #5899 1 | (coq.theory 2 | (name foo)) Error: 'coq.theory' is available only when coq is enabled in the dune-project - file. You must enable it using (using coq 0.5) in your dune-project file. + file. You must enable it using (using coq 0.6) in your dune-project file. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/theories/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/theories/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/theories/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/theories/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/theories/foo.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/theories/foo.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop-root.t/theories/foo.v rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop-root.t/theories/foo.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop.t rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/coqtop/coqtop.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/bar.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/bar.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/bar.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/bar.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/run.t index dfd0a43d7..94a3429b3 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-libraries.t/run.t @@ -1,40 +1,42 @@ The libraries field is deprecated $ cat > dune << EOF > (library + > (public_name bar.foo) > (name foo)) > - > (coq.theory + > (coq.theory > (name bar) - > (libraries foo)) + > (libraries bar.foo)) > EOF $ dune build - File "dune", line 6, characters 1-16: - 6 | (libraries foo)) - ^^^^^^^^^^^^^^^ + File "dune", line 7, characters 1-20: + 7 | (libraries bar.foo)) + ^^^^^^^^^^^^^^^^^^^ Warning: 'libraries' was deprecated in version 0.5 of the Coq language. It has been renamed to 'plugins'. Having both a libraries and plugins field is an error $ cat > dune << EOF > (library + > (public_name bar.foo) > (name foo)) > - > (coq.theory + > (coq.theory > (name bar) - > (libraries foo) - > (plugins foo)) + > (libraries bar.foo) + > (plugins bar.foo)) > EOF $ dune build - File "dune", line 6, characters 1-16: - 6 | (libraries foo) - ^^^^^^^^^^^^^^^ + File "dune", line 7, characters 1-20: + 7 | (libraries bar.foo) + ^^^^^^^^^^^^^^^^^^^ Warning: 'libraries' was deprecated in version 0.5 of the Coq language. It has been renamed to 'plugins'. - File "dune", line 6, characters 12-15: - 6 | (libraries foo) - ^^^ + File "dune", line 7, characters 12-19: + 7 | (libraries bar.foo) + ^^^^^^^ Error: Cannot both use 'plugins' and 'libraries', please remove 'libraries' as it has been deprecated since version 0.5 of the Coq language. It will be removed before version 1.0. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-public_name.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-public_name.t/run.t index ec30a31bd..d0046e1be 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-public_name.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/deprecate-public_name.t/run.t @@ -31,5 +31,5 @@ both package and public_name field is an error ^^^ Error: Cannot both use 'package' and 'public_name', please remove 'public_name' as it has been deprecated since version 0.5 of the Coq - langugage. It will be removed before version 1.0. + language. It will be removed before version 1.0. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/dune index ded21db95..2cc80288f 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/dune @@ -2,10 +2,13 @@ ; TODO Enable tests when ready (cram - (applies_to native-compose native-single) + (applies_to :whole_subtree) + (deps %{bin:coqc} %{bin:coqdep}) + (alias runtest-coq) (enabled_if - (<> %{system} macosx))) + (= %{env:DUNE_COQ_TEST=disable} enable))) (cram - (applies_to :whole_subtree) - (deps %{bin:coqc} %{bin:coqdep})) + (applies_to native-compose native-single) + (enabled_if + (<> %{system} macosx))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/github3624.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/github3624.t index 8a95533a1..42fd0c8af 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/github3624.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/github3624.t @@ -16,5 +16,5 @@ that the error message is good when the coq extension is not enabled. 1 | (coq.theory 2 | (name foo)) Error: 'coq.theory' is available only when coq is enabled in the dune-project - file. You must enable it using (using coq 0.5) in your dune-project file. + file. You must enable it using (using coq 0.6) in your dune-project file. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/run.t index 0f8a19357..b6cfeccb5 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/run.t @@ -22,4 +22,4 @@ ocamlopt src_b/ml_plugin_b.{a,cmxa} ocamlopt src_a/ml_plugin_a.cmxs ocamlopt src_b/ml_plugin_b.cmxs - coqc theories/.a.aux,theories/a.{glob,vo} + coqc theories/a.{glob,vo} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/src_a/gram.mlg b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/src_a/gram.mlg index 80481ac46..4724c8819 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/src_a/gram.mlg +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/src_a/gram.mlg @@ -1,4 +1,4 @@ -DECLARE PLUGIN "gram" +DECLARE PLUGIN "ml_lib.ml_plugin_a" { diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/theories/a.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/theories/a.v index 340c0d8ab..f133e69b0 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/theories/a.v +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/ml-lib.t/theories/a.v @@ -1,3 +1,3 @@ -Declare ML Module "ml_plugin_a". -Declare ML Module "ml_plugin_b". +Declare ML Module "ml_plugin_a:ml_lib.ml_plugin_a". +Declare ML Module "ml_plugin_b:ml_lib.ml_plugin_b". diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-compose.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-compose.t/run.t index c1c724c70..4981aec7e 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-compose.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-compose.t/run.t @@ -2,9 +2,9 @@ coqdep bar/bar.v.d coqdep foo/foo.v.d coqdep foo/a/a.v.d - coqc foo/.foo.aux,foo/Nfoo_foo.{cmi,cmxs},foo/foo.{glob,vo} - coqc foo/a/.a.aux,foo/a/Nfoo_a_a.{cmi,cmxs},foo/a/a.{glob,vo} - coqc bar/.bar.aux,bar/Nbar_baz_bar.{cmi,cmxs},bar/bar.{glob,vo} + coqc foo/Nfoo_foo.{cmi,cmxs},foo/foo.{glob,vo} + coqc foo/a/Nfoo_a_a.{cmi,cmxs},foo/a/a.{glob,vo} + coqc bar/Nbar_baz_bar.{cmi,cmxs},bar/bar.{glob,vo} $ dune build --profile=release --debug-dependency-path @default lib: [ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-single.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-single.t/run.t index 1b01b3673..fa6122475 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-single.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/native-single.t/run.t @@ -1,8 +1,8 @@ $ dune build --profile=release --display short --debug-dependency-path @all coqdep bar.v.d coqdep foo.v.d - coqc .foo.aux,Nbasic_foo.{cmi,cmxs},foo.{glob,vo} - coqc .bar.aux,Nbasic_bar.{cmi,cmxs},bar.{glob,vo} + coqc Nbasic_foo.{cmi,cmxs},foo.{glob,vo} + coqc Nbasic_bar.{cmi,cmxs},bar.{glob,vo} $ dune build --profile=release --debug-dependency-path @default lib: [ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/bar.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/bar.v new file mode 100644 index 000000000..53e0ce1b1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/bar.v @@ -0,0 +1 @@ +Definition mynat := nat. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune new file mode 100644 index 000000000..5e049f634 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune @@ -0,0 +1,5 @@ +(coq.theory + (name basic) + (package no-stdlib) + (stdlib no) + (synopsis "Test Coq library")) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune-project new file mode 100644 index 000000000..4effa102d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.5) + +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/foo.v b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/foo.v new file mode 100644 index 000000000..4e944c79f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/foo.v @@ -0,0 +1 @@ +From Coq Require Import Prelude. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/etc/findlib.conf.d/foo.conf b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/no-stdlib.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/etc/findlib.conf.d/foo.conf rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/no-stdlib.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/run.t new file mode 100644 index 000000000..15144d49c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/no-stdlib.t/run.t @@ -0,0 +1,20 @@ +Test that when `(stdlib no)` is provided, the standard library is not bound to `Coq` +and the prelude is not imported + + $ dune build --display=short foo.vo + coqdep foo.v.d + *** Warning: in file foo.v, library Prelude is required from root Coq and has not been found in the loadpath! + coqc foo.{glob,vo} (exit 1) + File "./foo.v", line 1, characters 0-32: + Error: Cannot find a physical path bound to logical path + Prelude with prefix Coq. + + [1] + + $ dune build --display=short bar.vo + coqdep bar.v.d + coqc bar.{glob,vo} (exit 1) + File "./bar.v", line 1, characters 20-23: + Error: The reference nat was not found in the current environment. + + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/bar.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/bar.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/bar.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/bar.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/p.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/bar.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/p.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/bar.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/dune-project new file mode 100644 index 000000000..4dad2a1c9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/foo.ml new file mode 100644 index 000000000..4b3fcfa72 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/foo.ml @@ -0,0 +1 @@ +let foo = "bar" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/run.t new file mode 100644 index 000000000..20097849b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-meta.t/run.t @@ -0,0 +1,15 @@ +The META file for plugins is built before calling coqdep + $ cat > dune << EOF + > (library + > (public_name bar.foo) + > (name foo)) + > + > (coq.theory + > (name bar) + > (plugins bar.foo)) + > EOF + + $ dune build bar.v.d + $ ls _build/install/default/lib/bar + META + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/p.opam b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/bar.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/p.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/bar.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/.ocamlformat b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/bar.v similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/.ocamlformat rename to duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/bar.v diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/dune-project new file mode 100644 index 000000000..4dad2a1c9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using coq 0.6) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/foo.ml new file mode 100644 index 000000000..4b3fcfa72 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/foo.ml @@ -0,0 +1 @@ +let foo = "bar" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/run.t new file mode 100644 index 000000000..81dac547d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/plugin-private.t/run.t @@ -0,0 +1,16 @@ +In Coq >= 0.6, depending on a private library as a plugin is an error. + $ cat > dune << EOF + > (library + > (name foo)) + > + > (coq.theory + > (name bar) + > (plugins foo)) + > EOF + + $ dune build + File "dune", line 6, characters 10-13: + 6 | (plugins foo)) + ^^^ + Error: Using private library foo as a Coq plugin is not supported + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/coq/rec-module.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/coq/rec-module.t/run.t index 99fba5a0c..f92896391 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/coq/rec-module.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/coq/rec-module.t/run.t @@ -3,10 +3,10 @@ coqdep b/foo.v.d coqdep c/d/bar.v.d coqdep c/ooo.v.d - coqc b/.foo.aux,b/foo.{glob,vo} - coqc c/d/.bar.aux,c/d/bar.{glob,vo} - coqc c/.ooo.aux,c/ooo.{glob,vo} - coqc a/.bar.aux,a/bar.{glob,vo} + coqc b/foo.{glob,vo} + coqc c/d/bar.{glob,vo} + coqc c/ooo.{glob,vo} + coqc a/bar.{glob,vo} $ dune build --debug-dependency-path @default lib: [ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cram/custom-build-dir.t b/duniverse/dune_/test/blackbox-tests/test-cases/cram/custom-build-dir.t new file mode 100644 index 000000000..ecee5abb7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cram/custom-build-dir.t @@ -0,0 +1,30 @@ +Create a cram test and try to run it with DUNE_BUILD_DIR set to an absolute +path + + $ cat >dune-project < (lang dune 3.5) + > EOF + + $ cat >foo.t < $ echo " $ echo bar" >bar.t + > $ dune runtest + > EOF + + $ DUNE_BUILD_DIR=$PWD/tmp dune runtest --auto-promote + File "foo.t", line 1, characters 0-0: + Error: Files + $TESTCASE_ROOT/tmp/default/foo.t + and + $TESTCASE_ROOT/tmp/default/foo.t.corrected + differ. + Promoting + $TESTCASE_ROOT/tmp/default/foo.t.corrected + to foo.t. + [1] + $ sed -E 's/\(pid: [0-9]+\)/(pid: ###)/' foo.t + $ echo " $ echo bar" >bar.t + $ dune runtest + Error: A running dune (pid: ###) instance has locked the build directory. + If this is not the case, please delete + $TESTCASE_ROOT/tmp/.lock + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cram/git-access.t b/duniverse/dune_/test/blackbox-tests/test-cases/cram/git-access.t index 2326f026e..f0a42babd 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/cram/git-access.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cram/git-access.t @@ -1,4 +1,4 @@ -Check that actions don't have access to the outter git repository. +Check that actions don't have access to the outer git repository. $ mkdir git $ cd git diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cram/hg-access.t b/duniverse/dune_/test/blackbox-tests/test-cases/cram/hg-access.t index 28632e3eb..39ac2d7e4 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/cram/hg-access.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cram/hg-access.t @@ -1,4 +1,4 @@ -Check that actions don't have access to the outter hg repository. +Check that actions don't have access to the outer hg repository. $ mkdir hg $ cd hg diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/cram/public-name.t b/duniverse/dune_/test/blackbox-tests/test-cases/cram/public-name.t new file mode 100644 index 000000000..3f46ee4f5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/cram/public-name.t @@ -0,0 +1,30 @@ +Cram and public binaries with an absolute build directory + + $ cat >dune-project < (lang dune 2.8) + > (cram enable) + > (name public-name-exe-test) + > EOF + $ touch public-name-exe-test.opam + + $ mkdir helper + $ cat >helper/dune < (executable (public_name helper)) + > EOF + $ cat >helper/helper.ml < print_endline "Helper launched successfully";; + > EOF + + $ mkdir tests + $ cat >tests/run.t < $ helper + > Helper launched successfully + > EOF + $ echo "(cram (deps %{bin:helper}))" > tests/dune + +Running `dune runtest` with a relative build directory works + + $ DUNE_BUILD_DIR=./_other_build dune runtest + + $ export NEW_BUILD_DIR="$PWD/_other_build" + $ DUNE_BUILD_DIR="$NEW_BUILD_DIR" dune runtest --auto-promote diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/github-5561-name-mangle.t b/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/github-5561-name-mangle.t new file mode 100644 index 000000000..9c46546fd --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/github-5561-name-mangle.t @@ -0,0 +1,39 @@ + $ cat >dune-project < (lang dune 3.5) + > (using ctypes 0.1) + > EOF + + $ cat >dune < (library + > (name foo) + > (ctypes + > (external_library_name fooBar) + > (generated_entry_point Types_generated2) + > (type_description + > (instance Type) + > (functor Type_description)))) + > EOF + + $ dune build + File "fooBar__type_gen.ml", line 3, characters 12-34: + 3 | (module Type_description.Types) + ^^^^^^^^^^^^^^^^^^^^^^ + Error: Unbound module Type_description + File "dune", line 1, characters 0-177: + 1 | (library + 2 | (name foo) + 3 | (ctypes + 4 | (external_library_name fooBar) + 5 | (generated_entry_point Types_generated2) + 6 | (type_description + 7 | (instance Type) + 8 | (functor Type_description)))) + Error: No rule found for libfoo_stubs.a + File "dune", line 2, characters 7-10: + 2 | (name foo) + ^^^ + Package fooBar was not found in the pkg-config search path. + Perhaps you should add the directory containing `fooBar.pc' + to the PKG_CONFIG_PATH environment variable + No package 'fooBar' found + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/lib-return-errno.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/lib-return-errno.t/dune index abb40ece8..3a5798308 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/lib-return-errno.t/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ctypes/lib-return-errno.t/dune @@ -1,3 +1,3 @@ (executable - (name example) - (libraries integers examplelib)) + (name example) + (libraries integers examplelib)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/run.t deleted file mode 100644 index 78699ce3f..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/run.t +++ /dev/null @@ -1,55 +0,0 @@ - $ dune build --root ./normal --display short file @install - Entering directory 'normal' - ocamldep .p.eobjs/p.ml.d - ocamldep .p.eobjs/p.ml.d [cross] - ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} - ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} [cross] - ocamlopt .p.eobjs/native/p.{cmx,o} - ocamlopt .p.eobjs/native/p.{cmx,o} [cross] - ocamlopt p.exe - ocamlopt p.exe [cross] - p file - p file [cross] - - $ cat normal/_build/cross/file - 137 - - $ dune build --root ./bad-configuration --display short file @install - Entering directory 'bad-configuration' - File "dune-workspace", line 5, characters 9-50: - 5 | (context (default - 6 | (name cross-1) - 7 | (host default))) - Error: Context 'cross-1' is both a host (for 'cross-2') and a target (for - 'default'). - [1] - - $ dune build --root ./topological-loop --display short file @install - Entering directory 'topological-loop' - File "dune-workspace", line 13, characters 9-50: - 13 | (context (default - 14 | (name cross-3) - 15 | (host cross-2))) - Error: Context 'cross-3' is both a host (for 'cross-1') and a target (for - 'cross-2'). - [1] - - $ env OCAMLFIND_CONF=$PWD/target-and-host/etc/findlib.conf dune build --root ./target-and-host --display short file @install - Entering directory 'target-and-host' - File "dune-workspace", line 5, characters 9-65: - 5 | (context (default - 6 | (name cross-1) - 7 | (targets foo) - 8 | (host default))) - Error: `targets` and `host` options cannot be used in the same context. - [1] - - - $ dune build --root ./context-not-found --display short file @install - Entering directory 'context-not-found' - File "dune-workspace", line 5, characters 9-47: - 5 | (context (default - 6 | (name cross-1) - 7 | (host oups))) - Error: Undefined host context 'oups' for 'cross-1'. - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/p.ml b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/p.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/bad-configuration/p.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/p.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.mf b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/p.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.mf rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/p.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/run.t new file mode 100644 index 000000000..5a3fa3e6a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/bad-configuration.t/run.t @@ -0,0 +1,8 @@ + $ dune build file @install + File "dune-workspace", line 5, characters 9-50: + 5 | (context (default + 6 | (name cross-1) + 7 | (host default))) + Error: Context 'cross-1' is both a host (for 'cross-2') and a target (for + 'default'). + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/p.ml b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/p.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/context-not-found/p.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/p.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.mfi b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/p.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.mfi rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/p.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/run.t new file mode 100644 index 000000000..1fdf984f5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/context-not-found.t/run.t @@ -0,0 +1,7 @@ + $ dune build file @install + File "dune-workspace", line 5, characters 9-47: + 5 | (context (default + 6 | (name cross-1) + 7 | (host oups))) + Error: Undefined host context 'oups' for 'cross-1'. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/p.ml b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/p.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/normal/p.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/p.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.opam b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/p.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/main.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/p.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/run.t new file mode 100644 index 000000000..6b0ab0e28 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/normal.t/run.t @@ -0,0 +1,14 @@ + $ dune build --display short file @install + ocamldep .p.eobjs/p.ml.d + ocamldep .p.eobjs/p.ml.d [cross] + ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} + ocamlc .p.eobjs/byte/p.{cmi,cmo,cmt} [cross] + ocamlopt .p.eobjs/native/p.{cmx,o} + ocamlopt .p.eobjs/native/p.{cmx,o} [cross] + ocamlopt p.exe + ocamlopt p.exe [cross] + p file + p file [cross] + + $ cat _build/cross/file + 137 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/foo.c b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/etc/findlib.conf similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/foo.c rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/etc/findlib.conf diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/foo.cpp b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/etc/findlib.conf.d/foo.conf similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/foo.cpp rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/etc/findlib.conf.d/foo.conf diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/p.ml b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/p.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/target-and-host/p.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/p.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/foo.c b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/p.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/foo.c rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/p.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/run.t new file mode 100644 index 000000000..fd5123b52 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/target-and-host.t/run.t @@ -0,0 +1,8 @@ + $ env OCAMLFIND_CONF=$PWD/etc/findlib.conf dune build file @install + File "dune-workspace", line 5, characters 9-65: + 5 | (context (default + 6 | (name cross-1) + 7 | (targets foo) + 8 | (host default))) + Error: `targets` and `host` options cannot be used in the same context. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/p.ml b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/p.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation.t/topological-loop/p.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/p.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/foo.cpp b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/p.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/foo.cpp rename to duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/p.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/run.t new file mode 100644 index 000000000..aec374847 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/custom-cross-compilation/topological-loop.t/run.t @@ -0,0 +1,8 @@ + $ dune build file @install + File "dune-workspace", line 13, characters 9-50: + 13 | (context (default + 14 | (name cross-3) + 15 | (host cross-2))) + Error: Context 'cross-3' is both a host (for 'cross-1') and a target (for + 'cross-2'). + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/run.t deleted file mode 100644 index d2a18b079..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/run.t +++ /dev/null @@ -1,19 +0,0 @@ -Generates targets when modes is set for binaries: - $ dune build --root bins --display short @all 2>&1 | grep '\.bc\|\.exe' - ocamlc byteandnative.bc - ocamlc byteandnative.bc-for-jsoo - ocamlc bytecodeonly.bc - ocamlc bytecodeonly.bc-for-jsoo - ocamlc bytecodeonly.exe - ocamlopt byteandnative.exe - ocamlopt nativeonly.exe - -Generate targets when modes are set for libraries - - $ dune build --root libs --display short @all 2>&1 | grep 'cma\|cmxa\|cmxs' - ocamlc byteandnative.cma - ocamlc byteonly.cma - ocamlopt byteandnative.{a,cmxa} - ocamlopt nativeonly.{a,cmxa} - ocamlopt byteandnative.cmxs - ocamlopt nativeonly.cmxs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/bins/dune b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/bins/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/bins/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/bins/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/run.t new file mode 100644 index 000000000..38a1b5d29 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/bins.t/run.t @@ -0,0 +1,9 @@ +Generates targets when modes is set for binaries: + $ dune build --display short @all 2>&1 | grep '\.bc\|\.exe' + ocamlc byteandnative.bc + ocamlc byteandnative.bc-for-jsoo + ocamlc bytecodeonly.bc + ocamlc bytecodeonly.bc-for-jsoo + ocamlc bytecodeonly.exe + ocamlopt byteandnative.exe + ocamlopt nativeonly.exe diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/libs/dune b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/libs/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/libs/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/default-targets.t/libs/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/run.t new file mode 100644 index 000000000..2545419d2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/default-targets/libs.t/run.t @@ -0,0 +1,9 @@ +Generate targets when modes are set for libraries + + $ dune build --display short @all 2>&1 | grep 'cma\|cmxa\|cmxs' + ocamlc byteandnative.cma + ocamlc byteonly.cma + ocamlopt byteandnative.{a,cmxa} + ocamlopt nativeonly.{a,cmxa} + ocamlopt byteandnative.cmxs + ocamlopt nativeonly.cmxs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/describe.t b/duniverse/dune_/test/blackbox-tests/test-cases/describe.t index 790bbac1d..99bc332af 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/describe.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/describe.t @@ -207,6 +207,14 @@ Setup > EOF $ touch virtual_impl2/virtual.ml + $ mkdir subdir + $ mkdir subdir/subfolder + $ cat >subdir/subfolder/dune < (library + > (name subfolder_lib)) + > EOF + $ touch subdir/subfolder/subfolder_lib.ml + Describe various things ----------------------- @@ -217,7 +225,9 @@ are reproducible, and are kept consistent between different machines. not stable across different setups. $ dune describe workspace --lang 0.1 --sanitize-for-tests - ((executables + ((root /WORKSPACE_ROOT) + (build_context _build/default) + (executables ((names (refmt)) (requires ()) (modules @@ -621,6 +631,20 @@ not stable across different setups. (source_dir /FINDLIB//stdlib-shims) (modules ()) (include_dirs (/FINDLIB//stdlib-shims)))) + (library + ((name subfolder_lib) + (uid edb8ce3704b7983446d5ffb4cea0b51e) + (local true) + (requires ()) + (source_dir _build/default/subdir/subfolder) + (modules + (((name Subfolder_lib) + (impl (_build/default/subdir/subfolder/subfolder_lib.ml)) + (intf ()) + (cmt + (_build/default/subdir/subfolder/.subfolder_lib.objs/byte/subfolder_lib.cmt)) + (cmti ())))) + (include_dirs (_build/default/subdir/subfolder/.subfolder_lib.objs/byte)))) (library ((name virtual) (uid f0299ba46dc29b8d4bd2f5d1cf82587c) @@ -676,7 +700,9 @@ not stable across different setups. (include_dirs (_build/default/virtual_impl2/.virtual_impl2.objs/byte))))) $ dune describe workspace --lang 0.1 --with-deps --sanitize-for-tests - ((executables + ((root /WORKSPACE_ROOT) + (build_context _build/default) + (executables ((names (refmt)) (requires ()) (modules @@ -1180,6 +1206,21 @@ not stable across different setups. (source_dir /FINDLIB//stdlib-shims) (modules ()) (include_dirs (/FINDLIB//stdlib-shims)))) + (library + ((name subfolder_lib) + (uid edb8ce3704b7983446d5ffb4cea0b51e) + (local true) + (requires ()) + (source_dir _build/default/subdir/subfolder) + (modules + (((name Subfolder_lib) + (impl (_build/default/subdir/subfolder/subfolder_lib.ml)) + (intf ()) + (cmt + (_build/default/subdir/subfolder/.subfolder_lib.objs/byte/subfolder_lib.cmt)) + (cmti ()) + (module_deps ((for_intf ()) (for_impl ())))))) + (include_dirs (_build/default/subdir/subfolder/.subfolder_lib.objs/byte)))) (library ((name virtual) (uid f0299ba46dc29b8d4bd2f5d1cf82587c) @@ -1247,12 +1288,28 @@ not stable across different setups. (for_impl ())))))) (include_dirs (_build/default/virtual_impl2/.virtual_impl2.objs/byte))))) + $ dune describe workspace --lang 0.1 --sanitize-for-tests virtual + ((root /WORKSPACE_ROOT) + (build_context _build/default) + (library + ((name virtual) + (uid f0299ba46dc29b8d4bd2f5d1cf82587c) + (local true) + (requires ()) + (source_dir _build/default/virtual) + (modules + (((name Virtual) + (impl ()) + (intf (_build/default/virtual/virtual.mli)) + (cmt ()) + (cmti (_build/default/virtual/.virtual.objs/byte/virtual.cmti))))) + (include_dirs (_build/default/virtual/.virtual.objs/byte))))) Test other formats ------------------ $ dune describe workspace --format csexp --lang 0.1 --sanitize-for-tests | cut -c 1-85 - ((11:executables((5:names(5:refmt))(8:requires())(7:modules(((4:name5:Refmt)(4:impl(2 + ((4:root15:/WORKSPACE_ROOT)(13:build_context14:_build/default)(11:executables((5:name Test errors ----------- @@ -1263,16 +1320,21 @@ Test errors [1] $ dune describe --lang 0.1 workspace xxx - Error: Too many argument for workspace + Error: No such file or directory: xxx + [1] + + $ touch yyy + $ dune describe --lang 0.1 workspace yyy + Error: File exists, but is not a directory: yyy [1] $ dune describe --lang 1.0 - dune describe: Only --lang 0.1 is available at the moment as this command is not yet - stabilised. If you would like to release a software that relies on the output - of 'dune describe', please open a ticket on - https://github.com/ocaml/dune. - Usage: dune describe [OPTION]... [STRING]... - Try `dune describe --help' or `dune --help' for more information. + dune: Only --lang 0.1 is available at the moment as this command is not yet + stabilised. If you would like to release a software that relies on the output + of 'dune describe', please open a ticket on + https://github.com/ocaml/dune. + Usage: dune describe [OPTION]… [STRING]… + Try 'dune describe --help' or 'dune --help' for more information. [1] opam file listing diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/run.t deleted file mode 100644 index 277baf291..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/run.t +++ /dev/null @@ -1,35 +0,0 @@ -Test the (dialect ...) stanza inside the dune-project file. - - $ dune exec --root good ./main.exe - Entering directory 'good' - - $ dune build --root good @fmt - Entering directory 'good' - Formatting main.mf - Formatting main.mfi - - $ dune build --root bad1 - Entering directory 'bad1' - File "dune-project", line 9, characters 1-74: - 9 | (name d) - 10 | (implementation (extension foo2)) - 11 | (interface (extension bar2))) - Error: dialect "d" is already defined - [1] - - $ dune build --root bad2 - Entering directory 'bad2' - File "dune-project", line 9, characters 1-74: - 9 | (name d2) - 10 | (implementation (extension foo)) - 11 | (interface (extension bar2))) - Error: extension "foo" is already registered by dialect "d" - [1] - - $ dune build --root bad3 - Entering directory 'bad3' - File "dune-project", line 5, characters 28-32: - 5 | (implementation (extension .foo)) - ^^^^ - Error: extension must not contain '.' - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad1/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad1.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad1/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad1.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad1.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad1.t/run.t new file mode 100644 index 000000000..b333c5d91 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad1.t/run.t @@ -0,0 +1,9 @@ +Duplicate dialect + + $ dune build + File "dune-project", line 9, characters 1-74: + 9 | (name d) + 10 | (implementation (extension foo2)) + 11 | (interface (extension bar2))) + Error: dialect "d" is already defined + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad2/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad2.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad2/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad2.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad2.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad2.t/run.t new file mode 100644 index 000000000..767671f65 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad2.t/run.t @@ -0,0 +1,10 @@ +Exntesion registered twice + + $ dune build + File "dune-project", line 9, characters 1-74: + 9 | (name d2) + 10 | (implementation (extension foo)) + 11 | (interface (extension bar2))) + Error: extension "foo" is already registered by dialect "d" + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad3/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad3.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/bad3/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad3.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad3.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad3.t/run.t new file mode 100644 index 000000000..1eb6acbdc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/bad3.t/run.t @@ -0,0 +1,6 @@ + $ dune build + File "dune-project", line 5, characters 28-32: + 5 | (implementation (extension .foo)) + ^^^^ + Error: extension must not contain '.' + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/foo.c b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/.ocamlformat similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/foo.c rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/.ocamlformat diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/dune b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/fmt.ml b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/fmt.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dialects.t/good/fmt.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/fmt.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/foo.cpp b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.mf similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/foo.cpp rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.mf diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/eif.opam b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.mfi similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/eif.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.mfi diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/main.opam b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/main.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/main.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/run.t new file mode 100644 index 000000000..2ed0d0069 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dialects/good.t/run.t @@ -0,0 +1,7 @@ +Test the (dialect ...) stanza inside the dune-project file. + + $ dune exec ./main.exe + + $ dune build @fmt + Formatting main.mf + Formatting main.mfi diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-dir-with-symlink.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-dir-with-symlink.t new file mode 100644 index 000000000..d40d5df86 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-dir-with-symlink.t @@ -0,0 +1,29 @@ +Test creating directory targets by symlinking: + + $ cat > dune-project < (lang dune 3.3) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (rule + > (targets (dir symlinked)) + > ;; not exactly correctly, but it's just a test + > (deps bar/foo (sandbox always)) + > (action (system "ln -s ./bar symlinked"))) + > EOF + + $ mkdir bar && touch bar/foo + + $ dune build ./symlinked + + $ { + > path=_build/default/symlinked + > if [ -e $path ] + > then + > printf "symlink exists and points to: %s" "$(readlink $path)" + > else + > echo symlink does not exist + > fi + > } + symlink exists and points to: ./bar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t index 6f5b68174..c14ef8b34 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/create-target-chdir.t @@ -16,16 +16,10 @@ Attempt to create a directory with chdir + with-stdout-to: > EOF $ dune build foobar/ - File "dune", line 1, characters 0-130: - 1 | (rule - 2 | (targets (dir output)) - 3 | (deps (sandbox always)) - 4 | (action - 5 | (progn - 6 | (chdir output + File "dune", line 7, characters 20-21: 7 | (with-stdout-to x (echo foobar)))))) - Error: Rule has targets in different directories. - Targets: + ^ + Error: This action has targets in a different directory than the current one, + this is not allowed by dune at the moment: - output/x - - output [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune new file mode 100644 index 000000000..dae19fbf1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune @@ -0,0 +1,7 @@ +(rule + (targets (dir foo)) + (action (run mkdir foo))) + +(rule + (targets (dir foo)) + (action (run mkdir foo))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune-project new file mode 100644 index 000000000..1b57a260f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using directory-targets 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/run.t new file mode 100644 index 000000000..17509d430 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/duplicate-target.t/run.t @@ -0,0 +1,7 @@ +Duplicate directory targets + + $ dune build + Error: Multiple rules generated for _build/default/foo: + - dune:1 + - dune:5 + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/dune b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/dune new file mode 100644 index 000000000..5f3276148 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/dune @@ -0,0 +1,11 @@ +(executable + (name fakenpm) + (modules fakenpm) + (libraries unix)) + +(env + (_ + (binaries fakenpm.exe))) + +(cram + (deps fakenpm.exe)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/fakenpm.ml b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/fakenpm.ml new file mode 100644 index 000000000..14d423b84 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/fakenpm.ml @@ -0,0 +1,4 @@ +let () = + Sys.mkdir "fakenode_modules" 0o777; + Sys.mkdir "fakenode_modules/foo" 0o777; + Unix.symlink "file" "./fakenode_modules/foo/bar" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/github6168.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/github6168.t new file mode 100644 index 000000000..9f43706f6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/github6168/github6168.t @@ -0,0 +1,18 @@ +Testing a bug with npm creating a directory target with a symlink inside but +Dune not recognizing it + + $ cat > dune-project << EOF + > (lang dune 3.5) + > (using directory-targets 0.1) + > EOF + + $ cat > dune << EOF + > (rule + > (alias fakenode) + > (targets + > (dir fakenode_modules)) + > (action + > (run ./fakenpm.exe))) + > EOF + + $ dune build @fakenode diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/install-dir-target.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/install-dir-target.t new file mode 100644 index 000000000..d6f255109 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/install-dir-target.t @@ -0,0 +1,67 @@ +Allow directories to be installable + + $ cat >dune-project < (lang dune 3.5) + > (package (name foo)) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (install + > (dirs rules/bar) + > (section share)) + > (install + > (dirs (rules/another-dir as renamed) (rules/nested as some/nesting/here)) + > (section lib)) + > EOF + + $ mkdir rules + $ cat >rules/dune < (rule + > (target (dir bar)) + > (deps (sandbox always)) + > (action (bash "mkdir -p %{target}/baz && touch %{target}/{x,y,z} && touch %{target}/baz/{a,b}"))) + > (rule + > (target (dir another-dir)) + > (deps (sandbox always)) + > (action (chdir %{target} (run touch x)))) + > (rule + > (target (dir nested)) + > (deps (sandbox always)) + > (action (chdir %{target} (run touch x)))) + > EOF + + $ dune build foo.install + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/renamed/x" {"renamed/x"} + "_build/install/default/lib/foo/some/nesting/here/x" {"some/nesting/here/x"} + ] + share: [ + "_build/install/default/share/foo/bar/baz/a" {"bar/baz/a"} + "_build/install/default/share/foo/bar/baz/b" {"bar/baz/b"} + "_build/install/default/share/foo/bar/x" {"bar/x"} + "_build/install/default/share/foo/bar/y" {"bar/y"} + "_build/install/default/share/foo/bar/z" {"bar/z"} + ] + + $ mkdir ./installation + $ dune install --prefix ./installation + Installing installation/lib/foo/META + Installing installation/lib/foo/dune-package + Installing installation/lib/foo/renamed/x + Installing installation/lib/foo/some/nesting/here/x + Installing installation/share/foo/bar/baz/a + Installing installation/share/foo/bar/baz/b + Installing installation/share/foo/bar/x + Installing installation/share/foo/bar/y + Installing installation/share/foo/bar/z + $ ls ./installation/lib/foo + META + dune-package + renamed + some + $ ls ./installation/lib/foo/some/nesting/here + x diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/loading-inside-directory-target.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/loading-inside-directory-target.t new file mode 100644 index 000000000..91a9575ee --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/loading-inside-directory-target.t @@ -0,0 +1,57 @@ +This test tries to load the rules in a directory that is a target of another +rule. + + $ cat > dune-project < (lang dune 3.4) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (rule + > (deps (sandbox always)) + > (targets (dir output)) + > (action (bash "echo creating output dir && mkdir -p output/a && touch output/a/b"))) + > EOF + + $ dune build --debug-load-dir output/ + Loading build directory _build/default + Loading build directory _build/default/.dune + Loading build directory _build + creating output dir + $ find _build/default/output + _build/default/output + _build/default/output/a + _build/default/output/a/b + +We are loading the rules in output/a and while making sure that we don't delete +and re-create output/b. The following should not re-run the rule that recreates +output/ + + $ dune build --debug-load-dir output/a/b + Loading build directory _build/default/output/a + Loading build directory _build/default + Loading build directory _build/default/.dune + Loading build directory _build + $ find _build/default/output + _build/default/output + _build/default/output/a + _build/default/output/a/b + +Now we try loading the rules in output/a and make sure that nothing is deleted: + + $ dune rules --debug-load-dir output/a/ + Loading build directory _build/default/output + Loading build directory _build/default + Loading build directory _build/default/.dune + Loading build directory _build + ((deps ()) + (targets ((files ()) (directories (default/output)))) + (context default) + (action + (chdir + _build/default + (bash "echo creating output dir && mkdir -p output/a && touch output/a/b")))) + $ find _build/default/output + _build/default/output + _build/default/output/a + _build/default/output/a/b diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/main.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/main.t index bb520172b..25aac8a75 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/main.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/main.t @@ -24,17 +24,6 @@ Directory targets require an extension. > (using directory-targets 0.1) > EOF -Directory targets are not allowed for non-sandboxed rules. - - $ dune build output/x - File "dune", line 1, characters 0-56: - 1 | (rule - 2 | (targets (dir output)) - 3 | (action (bash "true"))) - Error: Rules with directory targets must be sandboxed. - Hint: Add (sandbox always) to the (deps ) field of the rule. - [1] - Ensure directory targets are produced. $ cat > dune < output/x; echo y > output/y' $ dune rules output - Error: Printing rules with directory targets is currently not supported - [1] + ((deps ((File (In_build_dir _build/default/src_x)))) + (targets ((files ()) (directories (default/output)))) + (context default) + (action + (chdir + _build/default + (bash "mkdir output; cat src_x > output/x; echo y > output/y")))) Error when requesting a missing subdirectory of a directory target. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/no-sandboxing.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/no-sandboxing.t new file mode 100644 index 000000000..3bc6c562e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/no-sandboxing.t @@ -0,0 +1,88 @@ +Tests for directory targets that are produced by unsandboxed rule + + $ cat > dune-project < (lang dune 3.4) + > (using directory-targets 0.1) + > EOF + +Build directory target from the command line without sandboxing + + $ cat > dune < (rule + > (targets (dir output)) + > (action (system "mkdir output; echo x > output/x; echo y > output/y"))) + > EOF + + $ dune build output/x + $ cat _build/default/output/x + x + $ cat _build/default/output/y + y + +We ask to build a file that doesn't exist inside the directory: + + $ dune build output/fake + File "dune", line 1, characters 0-102: + 1 | (rule + 2 | (targets (dir output)) + 3 | (action (system "mkdir output; echo x > output/x; echo y > output/y"))) + Error: This rule defines a directory target "output" that matches the + requested path "output/fake" but the rule's action didn't produce it + [1] + +When we fail to create the directory, dune complains: + + $ cat > dune < (rule + > (targets (dir output)) + > (action (system "true"))) + > EOF + + $ dune build output/ + File "dune", line 1, characters 0-56: + 1 | (rule + 2 | (targets (dir output)) + 3 | (action (system "true"))) + Error: Rule failed to produce directory "output" + [1] + +Check that Dune clears stale files from directory targets. + + $ cat >dune < (rule + > (deps src_a src_b src_c) + > (targets (dir output)) + > (action (bash "\| echo running; + > "\| mkdir -p output/subdir; + > "\| cat src_a > output/new-a; + > "\| cat src_b > output/subdir/b + > ))) + > (rule + > (deps output) + > (target contents) + > (action (bash "echo running; echo 'new-a:' > contents; cat output/new-a >> contents; echo 'b:' >> contents; cat output/subdir/b >> contents"))) + > EOF + + $ echo a > src_a + $ echo b > src_b + $ echo c > src_c + $ dune build contents + running + running +Directory target whose name conflicts with an internal directory used by Dune. + + $ cat > dune < (rule + > (targets (dir .dune)) + > (action (bash "mkdir .dune; echo hello > .dune/hello"))) + > EOF + + $ dune build .dune/hello + File "dune", line 1, characters 0-88: + 1 | (rule + 2 | (targets (dir .dune)) + 3 | (action (bash "mkdir .dune; echo hello > .dune/hello"))) + Error: This rule defines a target ".dune" whose name conflicts with an + internal directory used by Dune. Please use a different name. + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/remove-write-permissions.t b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/remove-write-permissions.t new file mode 100644 index 000000000..c89aaf839 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/directory-targets/remove-write-permissions.t @@ -0,0 +1,21 @@ +Write permissions on directory targets. + + $ cat >dune-project < (lang dune 3.4) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (rule + > (action (system "mkdir -p foo/foo2 && touch foo/foo2/bar")) + > (targets (dir foo))) + > EOF + + $ dune build ./foo + $ dir=_build/default/foo + $ dune_cmd stat permissions $dir + 755 + $ dune_cmd stat permissions $dir/foo2 + 755 + $ dune_cmd stat permissions $dir/foo2/bar + 444 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune b/duniverse/dune_/test/blackbox-tests/test-cases/dune index 5db14f7b8..d69a4bf94 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune @@ -2,12 +2,6 @@ (_ (binaries ../utils/dune_cmd.exe ../utils/dunepp.exe))) -(alias - (name test-deps) - (deps - %{bin:dune_cmd} - (package dune))) - (cram (applies_to pp-cwd) (deps %{bin:dunepp})) @@ -15,12 +9,8 @@ (cram (applies_to :whole_subtree) (deps - (alias test-deps))) - -(subdir - coq - (cram - (alias runtest-coq))) + %{bin:dune_cmd} + (package dune))) (subdir jsoo @@ -34,11 +24,6 @@ ; DISABLED TESTS -(subdir - bisect-ppx - (cram - (enabled_if false))) - (subdir env (cram @@ -64,6 +49,10 @@ (applies_to error) (enabled_if false))) +(cram + (applies_to sandboxing) + (deps %{bin:file})) + ; CONDITIONALLY DISABLED TESTS (cram diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/mode-copy.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/mode-copy.t index aac3f96ce..f0abc521e 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/mode-copy.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/mode-copy.t @@ -89,21 +89,21 @@ Test that the cache stores all historical build results. > EOF $ cat > dune-v1 < (rule - > (targets t1) - > (action (bash "echo running; echo v1 > t1"))) + > (targets t1) + > (action (bash "echo running; echo v1 > t1"))) > (rule - > (deps t1) - > (targets t2) - > (action (bash "echo running; cat t1 t1 > t2"))) + > (deps t1) + > (targets t2) + > (action (bash "echo running; cat t1 t1 > t2"))) > EOF $ cat > dune-v2 < (rule - > (targets t1) - > (action (bash "echo running; echo v2 > t1"))) + > (targets t1) + > (action (bash "echo running; echo v2 > t1"))) > (rule - > (deps t1) - > (targets t2) - > (action (bash "echo running; cat t1 t1 > t2"))) + > (deps t1) + > (targets t2) + > (action (bash "echo running; cat t1 t1 > t2"))) > EOF $ cp dune-v1 dune $ dune build --config-file=config t2 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/trim.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/trim.t index 3a178e48a..cd8a7eb34 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/trim.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-cache/trim.t @@ -34,7 +34,7 @@ Function to reset build tree and cache. Check that trimming does not crash when the cache directory does not exist. $ dune cache trim --size 0B - Freed 0 bytes + Freed 0B Check that the digest scheme for executable and non-executable digests hasn't changed. If it has, make sure to increment the version of the cache. Note that @@ -91,7 +91,7 @@ all metadata entries in [meta/v4] since they are broken: remember, we moved all $ find "$PWD/.xdg-cache/dune/db/meta/v4" -mindepth 2 -maxdepth 2 -type f | dune_cmd count-lines 4 $ dune cache trim --trimmed-size 1B - Freed 287 bytes + Freed 287B $ dune_cmd stat hardlinks _build/default/target_a 2 $ dune_cmd stat hardlinks _build/default/target_b @@ -104,7 +104,7 @@ trimmed. $ rm -f _build/default/target_a _build/default/beacon_a _build/default/beacon_b $ dune cache trim --trimmed-size 1B - Freed 79 bytes + Freed 79B $ dune build target_a target_b $ dune_cmd stat hardlinks _build/default/target_a 2 @@ -150,7 +150,7 @@ by the existence of [beacon_b]. $ dune_cmd wait-for-fs-clock-to-advance $ rm -f _build/default/beacon_a _build/default/target_a $ dune cache trim --trimmed-size 1B - Freed 79 bytes + Freed 79B $ dune build target_a target_b $ dune_cmd stat hardlinks _build/default/target_a 2 @@ -170,7 +170,7 @@ thus making the trimmer delete [target_a] instead of [target_b] as above. $ dune_cmd wait-for-fs-clock-to-advance $ rm -f _build/default/beacon_b _build/default/target_b $ dune cache trim --trimmed-size 1B - Freed 79 bytes + Freed 79B $ dune build target_a target_b $ dune_cmd stat hardlinks _build/default/target_a 2 @@ -188,7 +188,7 @@ are part of the same rule. $ dune build multi_a multi_b $ rm -f _build/default/multi_a _build/default/multi_b $ dune cache trim --trimmed-size 1B - Freed 123 bytes + Freed 123B TODO: Test trimming priority in the [copy] mode. In PR #4497 we added a test but it turned out to be flaky so we subsequently deleted it in #4511. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-init.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-init.t/run.t index 6f4050b9c..1a1d084d0 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-init.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-init.t/run.t @@ -251,36 +251,16 @@ Comments in dune files are preserved Will not create components with invalid names $ dune init lib invalid-component-name ./_test_lib - dune init: NAME argument: invalid component name - `invalid-component-name' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: NAME argument: invalid component name `invalid-component-name' + Library names must be non-empty and composed only of the + following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Usage: dune init library [OPTION]… NAME [PATH] + Try 'dune init library --help' or 'dune --help' for more information. [1] $ test -f ./_test_lib [1] -Will fail and inform user when invalid component command is given - - $ dune init foo blah - dune init: COMPONENT argument: invalid value `foo', expected one of - `executable', `library', `project' or `test' - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. - [1] - -Will fail and inform user when an invalid option is given to a component - - $ dune init test test_foo --public - Error: The `test' component does not support the `--public' option - [1] - $ dune init exe test_exe --inline-tests - Error: The `executable' component does not support the `--inline-tests' - option - [1] - Adding fields to existing stanzas --------------------------------- @@ -383,7 +363,7 @@ And the opam file will be generated as expected bug-reports: "https://github.com/username/reponame/issues" depends: [ "ocaml" - $dune {>= "3.4"} + $dune {>= "3.6"} "odoc" {with-doc} ] build: [ @@ -466,13 +446,8 @@ In particular, the dune-project file has the expected content: We can build and install the project: - $ dune build --root test_lib_proj @install --display short + $ dune build --root test_lib_proj @install Entering directory 'test_lib_proj' - ocamlc lib/.test_lib_proj.objs/byte/test_lib_proj.{cmi,cmo,cmt} - ocamlopt lib/.test_lib_proj.objs/native/test_lib_proj.{cmx,o} - ocamlc lib/test_lib_proj.cma - ocamlopt lib/test_lib_proj.{a,cmxa} - ocamlopt lib/test_lib_proj.cmxs And the opam file will be generated as expected @@ -490,7 +465,7 @@ And the opam file will be generated as expected bug-reports: "https://github.com/username/reponame/issues" depends: [ "ocaml" - "dune" {>= "3.4"} + "dune" {>= "3.6"} "odoc" {with-doc} ] build: [ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-lower/dune b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-lower/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-lower/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-lower/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/run.t new file mode 100644 index 000000000..a423ebc63 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-lower.t/run.t @@ -0,0 +1,3 @@ +All builtin variables are lower cased in Dune: + + $ dune runtest diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-upper/dune b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-upper/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-upper/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/dune-upper/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/run.t similarity index 67% rename from duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/run.t index 4ca33eac9..ff99f4e88 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-jbuild-var-case/dune-upper.t/run.t @@ -1,10 +1,6 @@ All builtin variables are lower cased in Dune: - $ dune runtest --root dune-lower - Entering directory 'dune-lower' - - $ dune runtest --root dune-upper - Entering directory 'dune-upper' + $ dune runtest File "dune", line 3, characters 39-46: 3 | (action (with-stdout-to %{null} (echo %{MAKE})))) ^^^^^^^ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-ppx-driver-system.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-ppx-driver-system.t/run.t index 15ad167b6..5c4c17a35 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-ppx-driver-system.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-ppx-driver-system.t/run.t @@ -55,12 +55,12 @@ Same, but with error pointing to .ppx $ dune build --root driver-tests .ppx/foo.ppx1+foo.ppx2/ppx.exe Entering directory 'driver-tests' - Error: invalid ppx key for default/.ppx/foo.ppx1+foo.ppx2/ppx.exe + Error: invalid ppx key for _build/default/.ppx/foo.ppx1+foo.ppx2/ppx.exe [1] $ dune build --root driver-tests .ppx/foo.ppx-other/ppx.exe Entering directory 'driver-tests' - Error: invalid ppx key for default/.ppx/foo.ppx-other/ppx.exe + Error: invalid ppx key for _build/default/.ppx/foo.ppx-other/ppx.exe [1] Test the argument syntax diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file.t new file mode 100644 index 000000000..cfd5dae4b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/bad-opam-file.t @@ -0,0 +1,17 @@ +Fatal error with opam file that is not listed in the dune-project file: + + $ cat >dune-project < (lang dune 1.10) + > (version 1.0.0) + > (generate_opam_files true) + > (package (name bar)) + > EOF + + $ echo "cannot parse me" > foo.opam + $ dune build @install + File "foo.opam", line 1, characters 0-0: + Error: This opam file doesn't have a corresponding (package ...) stanza in + the dune-project file. Since you have at least one other (package ...) stanza + in your dune-project file, you must a (package ...) stanza for each opam + package in your project. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/basic-generate.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/basic-generate.t new file mode 100644 index 000000000..3bf0b3f42 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/basic-generate.t @@ -0,0 +1,91 @@ +Simple test +----------- + +The `dune build` should generate the opam file + + $ cat >dune-project < (lang dune 1.10) + > (version 1.0.0) + > (name cohttp) + > (source (github mirage/ocaml-cohttp)) + > (license ISC) + > (authors "Anil Madhavapeddy" "Rudi Grinberg") + > ; + > (generate_opam_files true) + > ; + > (package + > (name cohttp) + > (synopsis "An OCaml library for HTTP clients and servers") + > (description "A longer description") + > (depends + > (alcotest :with-test) + > (dune (and :build (> 1.5))) + > (foo (and :dev (> 1.5) (< 2.0))) + > (uri (>= 1.9.0)) + > (uri (< 2.0.0)) + > (fieldslib (> v0.12)) + > (fieldslib (< v0.13)))) + > ; + > (package + > (name cohttp-async) + > (synopsis "HTTP client and server for the Async library") + > (description "A _really_ long description") + > (depends + > (cohttp (>= 1.0.2)) + > (conduit-async (>= 1.0.3)) + > (async (>= v0.10.0)) + > (async (< v0.12)))) + > EOF + + $ dune build @install + + $ cat cohttp.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} + ] + authors: ["Anil Madhavapeddy" "Rudi Grinberg"] + bug-reports: "https://github.com/mirage/ocaml-cohttp/issues" + homepage: "https://github.com/mirage/ocaml-cohttp" + license: "ISC" + version: "1.0.0" + dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" + synopsis: "An OCaml library for HTTP clients and servers" + description: "A longer description" + depends: [ + "alcotest" {with-test} + "dune" {build & > "1.5"} + "foo" {dev & > "1.5" & < "2.0"} + "uri" {>= "1.9.0"} + "uri" {< "2.0.0"} + "fieldslib" {> "v0.12"} + "fieldslib" {< "v0.13"} + ] + + $ cat cohttp-async.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} + ] + authors: ["Anil Madhavapeddy" "Rudi Grinberg"] + bug-reports: "https://github.com/mirage/ocaml-cohttp/issues" + homepage: "https://github.com/mirage/ocaml-cohttp" + license: "ISC" + version: "1.0.0" + dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" + synopsis: "HTTP client and server for the Async library" + description: "A _really_ long description" + depends: [ + "cohttp" {>= "1.0.2"} + "conduit-async" {>= "1.0.3"} + "async" {>= "v0.10.0"} + "async" {< "v0.12"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/binops.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/binops.t new file mode 100644 index 000000000..7f8265e36 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/binops.t @@ -0,0 +1,36 @@ +Using binary operators for dependencies +--------------------------------------- + +Not supported before 2.1: + + $ cat > dune-project < (lang dune 2.0) + > (name foo) + > (generate_opam_files true) + > (package + > (name foo) + > (depends (conf-libX11 (<> :os win32)))) + > EOF + + $ dune build @install + File "dune-project", line 6, characters 23-37: + 6 | (depends (conf-libX11 (<> :os win32)))) + ^^^^^^^^^^^^^^ + Error: Passing two arguments to <> is only available since version 2.1 of the + dune language. Please update your dune-project file to have (lang dune 2.1). + [1] + +Supported since 2.1: + + $ cat > dune-project < (lang dune 2.1) + > (name foo) + > (generate_opam_files true) + > (package + > (name foo) + > (depends (conf-libX11 (<> :os win32)))) + > EOF + + $ dune build @install + $ grep conf-libX11 foo.opam + "conf-libX11" {os != "win32"} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/dune-dep.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/dune-dep.t new file mode 100644 index 000000000..6cc883a8a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/dune-dep.t @@ -0,0 +1,242 @@ +Version constraint on dune deps +------------------------------- + +Without the dune dependency declared in the dune-project file, we +generate a dune dependency with a constraint: + + $ cat > dune-project < (lang dune 2.1) + > (name foo) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ dune build foo.opam + $ grep -A2 ^depends: foo.opam + depends: [ + "dune" {>= "2.1"} + ] + +With the dune dependency declared in the dune-project file and version +of the language < 2.6 we don't add the constraint: + + $ cat > dune-project < (lang dune 2.5) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends dune)) + > EOF + + $ dune build foo.opam + $ grep ^depends: foo.opam + depends: ["dune"] + +Same with version of the language >= 2.6, we now add the constraint: + + $ cat > dune-project < (lang dune 2.6) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends dune)) + > EOF + + $ dune build foo.opam + $ grep -A2 ^depends: foo.opam + depends: [ + "dune" {>= "2.6"} + ] + +When the version of the language >= 2.7 we use dev instead of pinned +when calling dune subst: + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ dune build foo.opam + $ grep -A13 ^build: foo.opam + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + +When the version of the language >= 2.7, odoc is automatically added to +the doc dependencies: + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ dune build foo.opam + $ grep -A3 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "odoc" {with-doc} + ] + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends something)) + > EOF + + $ dune build foo.opam + $ grep -A4 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "something" + "odoc" {with-doc} + ] + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends odoc something)) + > EOF + + $ dune build foo.opam + $ grep -A4 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "odoc" + "something" + ] + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends (odoc :with-doc) something)) + > EOF + + $ dune build foo.opam + $ grep -A4 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "odoc" {with-doc} + "something" + ] + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends (odoc (and :with-doc (>= 1.5.0))) something)) + > EOF + + $ dune build foo.opam + $ grep -A4 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "odoc" {with-doc & >= "1.5.0"} + "something" + ] + + $ cat > dune-project < (lang dune 2.7) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends (odoc :with-test) something)) + > EOF + + $ dune build foo.opam + $ grep -A5 ^depends: foo.opam + depends: [ + "dune" {>= "2.7"} + "odoc" {with-test} + "something" + "odoc" {with-doc} + ] + + $ cat > dune-project < (lang dune 2.9) + > (name foo) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ dune build foo.opam + $ grep -A16 ^build: foo.opam + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] + ] + + $ cat > dune-project < (lang dune 3.0) + > (name foo) + > (generate_opam_files true) + > (subst disabled) + > (package (name foo) (depends (odoc :with-test) something)) + > EOF + + $ dune build foo.opam + $ grep -A15 ^build: foo.opam + build: [ + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + + $ cat > dune-project < (lang dune 3.0) + > (name foo) + > (generate_opam_files true) + > (subst enabled) + > (package (name foo) (depends (odoc :with-test) something)) + > EOF + + $ dune build foo.opam + $ grep -A16 ^build: foo.opam + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/license.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/license.t new file mode 100644 index 000000000..5db1e2997 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/license.t @@ -0,0 +1,69 @@ +Reject multiple licences in version [1.9, 3.2) +---------------------------------------------- + + $ mkdir multi-licence-v1.9 + $ cat > dune-project < (lang dune 1.9) + > (name foo) + > (generate_opam_files true) + > (license MIT ISC) + > (package (name foo) (allow_empty)) + > EOF + + $ dune build + File "dune-project", line 4, characters 0-17: + 4 | (license MIT ISC) + ^^^^^^^^^^^^^^^^^ + Error: Parsing several licenses is only available since version 3.2 of the + dune language. Please update your dune-project file to have (lang dune 3.2). + [1] + +Allow multiple licences in version >= 3.2 +----------------------------------------- + + $ mkdir multi-license-v3.2 + $ cat > dune-project < (lang dune 3.2) + > (name foo) + > (generate_opam_files true) + > (license MIT ISC) + > (package (name foo) (allow_empty)) + > EOF + + $ dune build + $ grep "license:" foo.opam + license: ["MIT" "ISC"] + +Handle single license in version >= 3.2 +--------------------------------------- + + $ mkdir single-license-v3.2 + $ cat > dune-project < (lang dune 3.2) + > (name foo) + > (generate_opam_files true) + > (license ISC) + > (package (name foo) (allow_empty)) + > EOF + + $ dune build + $ grep "license:" foo.opam + license: "ISC" + +Reject empty license +--------------------------------------- + + $ cat > dune-project < (lang dune 3.2) + > (name foo) + > (generate_opam_files true) + > (license) + > (package (name foo) (allow_empty)) + > EOF + + $ dune build + File "dune-project", line 4, characters 0-9: + 4 | (license) + ^^^^^^^^^ + Error: Not enough arguments for license + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/dune-project deleted file mode 100644 index d2a7e4f51..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/dune-project +++ /dev/null @@ -1,30 +0,0 @@ -(lang dune 1.10) -(name cohttp) -(source (github mirage/ocaml-cohttp)) -(license ISC) -(authors "Anil Madhavapeddy" "Rudi Grinberg") - -(generate_opam_files true) - -(package - (name cohttp) - (synopsis "An OCaml library for HTTP clients and servers") - (description "A longer description") - (depends - (alcotest :with-test) - (dune (and :build (> 1.5))) - (foo (and :dev (> 1.5) (< 2.0))) - (uri (>= 1.9.0)) - (uri (< 2.0.0)) - (fieldslib (> v0.12)) - (fieldslib (< v0.13)))) - -(package - (name cohttp-async) - (synopsis "HTTP client and server for the Async library") - (description "A _really_ long description") - (depends - (cohttp (>= 1.0.2)) - (conduit-async (>= 1.0.3)) - (async (>= v0.10.0)) - (async (< v0.12)))) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/foo.opam deleted file mode 100644 index c6381ff2d..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/bad-opam-file/foo.opam +++ /dev/null @@ -1 +0,0 @@ -cannot parse me diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/run.t deleted file mode 100644 index 3abc61185..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/run.t +++ /dev/null @@ -1,663 +0,0 @@ -Test generation of opam files, as well as handling of versions - -Simple test ------------ - -The `dune build` should generate the opam file - - $ mkdir test1 - - $ cat >test1/dune-project < (lang dune 1.10) - > (version 1.0.0) - > (name cohttp) - > (source (github mirage/ocaml-cohttp)) - > (license ISC) - > (authors "Anil Madhavapeddy" "Rudi Grinberg") - > ; - > (generate_opam_files true) - > ; - > (package - > (name cohttp) - > (synopsis "An OCaml library for HTTP clients and servers") - > (description "A longer description") - > (depends - > (alcotest :with-test) - > (dune (and :build (> 1.5))) - > (foo (and :dev (> 1.5) (< 2.0))) - > (uri (>= 1.9.0)) - > (uri (< 2.0.0)) - > (fieldslib (> v0.12)) - > (fieldslib (< v0.13)))) - > ; - > (package - > (name cohttp-async) - > (synopsis "HTTP client and server for the Async library") - > (description "A _really_ long description") - > (depends - > (cohttp (>= 1.0.2)) - > (conduit-async (>= 1.0.3)) - > (async (>= v0.10.0)) - > (async (< v0.12)))) - > EOF - - $ dune build @install --root test1 - Entering directory 'test1' - - $ cat test1/cohttp.opam - # This file is generated by dune, edit dune-project instead - opam-version: "2.0" - build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "-p" name "@doc"] {with-doc} - ] - authors: ["Anil Madhavapeddy" "Rudi Grinberg"] - bug-reports: "https://github.com/mirage/ocaml-cohttp/issues" - homepage: "https://github.com/mirage/ocaml-cohttp" - license: "ISC" - version: "1.0.0" - dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" - synopsis: "An OCaml library for HTTP clients and servers" - description: "A longer description" - depends: [ - "alcotest" {with-test} - "dune" {build & > "1.5"} - "foo" {dev & > "1.5" & < "2.0"} - "uri" {>= "1.9.0"} - "uri" {< "2.0.0"} - "fieldslib" {> "v0.12"} - "fieldslib" {< "v0.13"} - ] - - $ cat test1/cohttp-async.opam - # This file is generated by dune, edit dune-project instead - opam-version: "2.0" - build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "-p" name "@doc"] {with-doc} - ] - authors: ["Anil Madhavapeddy" "Rudi Grinberg"] - bug-reports: "https://github.com/mirage/ocaml-cohttp/issues" - homepage: "https://github.com/mirage/ocaml-cohttp" - license: "ISC" - version: "1.0.0" - dev-repo: "git+https://github.com/mirage/ocaml-cohttp.git" - synopsis: "HTTP client and server for the Async library" - description: "A _really_ long description" - depends: [ - "cohttp" {>= "1.0.2"} - "conduit-async" {>= "1.0.3"} - "async" {>= "v0.10.0"} - "async" {< "v0.12"} - ] - -Fatal error with opam file that is not listed in the dune-project file: - - $ echo "cannot parse me" > test1/foo.opam - $ dune build @install --root test1 - Entering directory 'test1' - File "foo.opam", line 1, characters 0-0: - Error: This opam file doesn't have a corresponding (package ...) stanza in - the dune-project_file. Since you have at least one other (package ...) stanza - in your dune-project file, you must a (package ...) stanza for each opam - package in your project. - [1] - -Package information fields can be overridden per-package: - - $ mkdir test2 - $ cat >test2/dune-project < (lang dune 2.5) - > (name foo) - > (version 1.0.0) - > (source (github mirage/ocaml-cohttp)) - > (license ISC) - > (authors "Anil Madhavapeddy" "Rudi Grinberg") - > (homepage https://my.home.page) - > ; - > (generate_opam_files true) - > ; - > (package - > (name foo) - > (version 1.0.1) - > (source (github mirage/foo)) - > (license MIT) - > (authors "Foo" "Bar")) - > EOF - - $ dune build @install --root test2 - Entering directory 'test2' - - $ cat test2/foo.opam - # This file is generated by dune, edit dune-project instead - opam-version: "2.0" - version: "1.0.1" - authors: ["Foo" "Bar"] - license: "MIT" - homepage: "https://my.home.page" - bug-reports: "https://github.com/mirage/foo/issues" - depends: [ - "dune" {>= "2.5"} - ] - build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ] - dev-repo: "git+https://github.com/mirage/foo.git" - -Version generated in opam and META files ----------------------------------------- - -After calling `dune subst`, dune should embed the version inside the -generated META and opam files. - -### With opam files and no package stanzas - - $ mkdir version - - $ cat > version/dune-project < (lang dune 1.10) - > (name foo) - > EOF - - $ cat > version/foo.opam < EOF - - $ cat > version/dune < (library (public_name foo)) - > EOF - - $ (cd version - > git init -q - > git add . - > git commit -qm _ - > git tag -a 1.0 -m 1.0 - > dune subst) - - $ dune build --root version foo.opam META.foo - Entering directory 'version' - - $ grep ^version version/foo.opam - version: "1.0" - - $ grep ^version version/_build/default/META.foo - version = "1.0" - -### With package stanzas and generating the opam files - - $ rm -rf version - $ mkdir version - - $ cat > version/dune-project < (lang dune 1.10) - > (name foo) - > (generate_opam_files true) - > (package (name foo)) - > EOF - - $ cat > version/foo.opam < EOF - - $ cat > version/dune < (library (public_name foo)) - > EOF - - $ (cd version - > git init -q - > git add . - > git commit -qm _ - > git tag -a 1.0 -m 1.0 - > dune subst) - - $ dune build --root version foo.opam META.foo - Entering directory 'version' - - $ grep ^version version/foo.opam - version: "1.0" - - $ grep ^version version/_build/default/META.foo - version = "1.0" - -Generation of opam files with lang dune >= 1.11 ------------------------------------------------ - - $ mkdir gen-v1.11 - $ cat > gen-v1.11/dune-project < (lang dune 1.11) - > (name test) - > (generate_opam_files true) - > (package (name test)) - > EOF - - $ dune build @install --root gen-v1.11 - Entering directory 'gen-v1.11' - $ cat gen-v1.11/test.opam - # This file is generated by dune, edit dune-project instead - opam-version: "2.0" - depends: [ - "dune" {>= "1.11"} - ] - build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ] - -Templates ---------- - - $ mkdir template - - $ cat > template/dune-project < (lang dune 2.0) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends bar)) - > EOF - -Test various fields in the template file. Fields coming from the -template are always put at the end. Fields generated by Dune are -sorted in a way that pleases "opam lint". - - $ cat > template/foo.opam.template < x-foo: "blah" - > EOF - $ dune build @install --root template - Entering directory 'template' - $ tail -n 1 template/foo.opam - x-foo: "blah" - - $ cat > template/foo.opam.template < libraries: [ "blah" ] - > EOF - $ dune build @install --root template - Entering directory 'template' - $ tail -n 1 template/foo.opam - libraries: [ "blah" ] - - $ cat > template/foo.opam.template < depends: [ "overridden" ] - > EOF - $ dune build @install --root template - Entering directory 'template' - $ tail -n 1 template/foo.opam - depends: [ "overridden" ] - -Using binary operators for dependencies ---------------------------------------- - - $ mkdir binops - -Not supported before 2.1: - - $ cat > binops/dune-project < (lang dune 2.0) - > (name foo) - > (generate_opam_files true) - > (package - > (name foo) - > (depends (conf-libX11 (<> :os win32)))) - > EOF - - $ dune build @install --root binops - Entering directory 'binops' - File "dune-project", line 6, characters 23-37: - 6 | (depends (conf-libX11 (<> :os win32)))) - ^^^^^^^^^^^^^^ - Error: Passing two arguments to <> is only available since version 2.1 of the - dune language. Please update your dune-project file to have (lang dune 2.1). - [1] - -Supported since 2.1: - - $ cat > binops/dune-project < (lang dune 2.1) - > (name foo) - > (generate_opam_files true) - > (package - > (name foo) - > (depends (conf-libX11 (<> :os win32)))) - > EOF - - $ dune build @install --root binops - Entering directory 'binops' - $ grep conf-libX11 binops/foo.opam - "conf-libX11" {os != "win32"} - -Version constraint on dune deps -------------------------------- - - $ mkdir dune-dep - $ cd dune-dep - -Without the dune dependency declared in the dune-project file, we -generate a dune dependency with a constraint: - - $ cat > dune-project < (lang dune 2.1) - > (name foo) - > (generate_opam_files true) - > (package (name foo)) - > EOF - - $ dune build foo.opam - $ grep -A2 ^depends: foo.opam - depends: [ - "dune" {>= "2.1"} - ] - -With the dune dependency declared in the dune-project file and version -of the language < 2.6 we don't add the constraint: - - $ cat > dune-project < (lang dune 2.5) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends dune)) - > EOF - - $ dune build foo.opam - $ grep ^depends: foo.opam - depends: ["dune"] - -Same with version of the language >= 2.6, we now add the constraint: - - $ cat > dune-project < (lang dune 2.6) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends dune)) - > EOF - - $ dune build foo.opam - $ grep -A2 ^depends: foo.opam - depends: [ - "dune" {>= "2.6"} - ] - -When the version of the language >= 2.7 we use dev instead of pinned -when calling dune subst: - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo)) - > EOF - - $ dune build foo.opam - $ grep -A13 ^build: foo.opam - build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ] - -When the version of the language >= 2.7, odoc is automatically added to -the doc dependencies: - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo)) - > EOF - - $ dune build foo.opam - $ grep -A3 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "odoc" {with-doc} - ] - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends something)) - > EOF - - $ dune build foo.opam - $ grep -A4 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "something" - "odoc" {with-doc} - ] - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends odoc something)) - > EOF - - $ dune build foo.opam - $ grep -A4 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "odoc" - "something" - ] - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends (odoc :with-doc) something)) - > EOF - - $ dune build foo.opam - $ grep -A4 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "odoc" {with-doc} - "something" - ] - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends (odoc (and :with-doc (>= 1.5.0))) something)) - > EOF - - $ dune build foo.opam - $ grep -A4 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "odoc" {with-doc & >= "1.5.0"} - "something" - ] - - $ cat > dune-project < (lang dune 2.7) - > (name foo) - > (generate_opam_files true) - > (package (name foo) (depends (odoc :with-test) something)) - > EOF - - $ dune build foo.opam - $ grep -A5 ^depends: foo.opam - depends: [ - "dune" {>= "2.7"} - "odoc" {with-test} - "something" - "odoc" {with-doc} - ] - - $ cat > dune-project < (lang dune 2.9) - > (name foo) - > (generate_opam_files true) - > (package (name foo)) - > EOF - - $ dune build foo.opam - $ grep -A16 ^build: foo.opam - build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "--promote-install-files=false" - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ["dune" "install" "-p" name "--create-install-files" name] - ] - - $ cat > dune-project < (lang dune 3.0) - > (name foo) - > (generate_opam_files true) - > (subst disabled) - > (package (name foo) (depends (odoc :with-test) something)) - > EOF - - $ dune build foo.opam - $ grep -A15 ^build: foo.opam - build: [ - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ] - - $ cat > dune-project < (lang dune 3.0) - > (name foo) - > (generate_opam_files true) - > (subst enabled) - > (package (name foo) (depends (odoc :with-test) something)) - > EOF - - $ dune build foo.opam - $ grep -A16 ^build: foo.opam - build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ] - -Reject multiple licences in version [1.9, 3.2) ----------------------------------------------- - - $ mkdir multi-licence-v1.9 - $ cat > dune-project < (lang dune 1.9) - > (name foo) - > (generate_opam_files true) - > (license MIT ISC) - > (package (name foo) (allow_empty)) - > EOF - - $ dune build - File "dune-project", line 4, characters 13-16: - 4 | (license MIT ISC) - ^^^ - Error: Too many argument for license - [1] - -Allow multiple licences in version >= 3.2 ------------------------------------------ - - $ mkdir multi-license-v3.2 - $ cat > dune-project < (lang dune 3.2) - > (name foo) - > (generate_opam_files true) - > (license MIT ISC) - > (package (name foo) (allow_empty)) - > EOF - - $ dune build - $ grep "license:" foo.opam - license: ["MIT" "ISC"] - -Handle single license in version >= 3.2 ---------------------------------------- - - $ mkdir single-license-v3.2 - $ cat > dune-project < (lang dune 3.2) - > (name foo) - > (generate_opam_files true) - > (license ISC) - > (package (name foo) (allow_empty)) - > EOF - - $ dune build - $ grep "license:" foo.opam - license: "ISC" - -Reject empty license ---------------------------------------- - - $ cat > dune-project < (lang dune 3.2) - > (name foo) - > (generate_opam_files true) - > (license) - > (package (name foo) (allow_empty)) - > EOF - - $ dune build - File "dune-project", line 4, characters 0-9: - 4 | (license) - ^^^^^^^^^ - Error: Not enough arguments for license - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-override/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-override/dune-project deleted file mode 100644 index 603b5f737..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-override/dune-project +++ /dev/null @@ -1,16 +0,0 @@ -(lang dune 2.5) -(name foo) -(version 1.0.0) -(source (github mirage/ocaml-cohttp)) -(license ISC) -(authors "Anil Madhavapeddy" "Rudi Grinberg") -(homepage https://my.home.page) - -(generate_opam_files true) - -(package - (name foo) - (version 1.0.1) - (source (github mirage/foo)) - (license MIT) - (authors "Foo" "Bar")) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/dune-project deleted file mode 100644 index 5ba1197d7..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/dune-project +++ /dev/null @@ -1,60 +0,0 @@ -(lang dune 2.0) -(name github) - -(generate_opam_files true) - -(license MIT) -(maintainers "Anil Madhavapeddy ") -(authors "Anil Madhavapeddy" "David Sheets" "Andy Ray" - "Jeff Hammerbacher" "Thomas Gazagnaire" "Rudi Grinberg" - "Qi Li" "Jeremy Yallop" "Dave Tucker") -(source (github mirage/ocaml-github)) -(documentation "https://mirage.github.io/ocaml-github/") - -(package - (name github) - (tags (org:mirage org:xapi-project git)) - (depends - (ocaml (>= 4.03.0)) - (uri (>= 1.9.0)) - (cohttp (>= 0.99.0)) - (cohttp-lwt (>= 0.99)) - (lwt (>= 2.4.4)) - (atdgen (>= 2.0.0)) - (yojson (>= 1.6.0)) - stringext) - (synopsis "GitHub APIv3 OCaml library") - (description "This library provides an OCaml interface to the -[GitHub APIv3](https://developer.github.com/v3/) (JSON). - -It is compatible with [MirageOS](https://mirage.io) and also compiles to pure -JavaScript via [js_of_ocaml](http://ocsigen.org/js_of_ocaml).")) - -(package - (name github-jsoo) - (tags (org:mirage org:xapi-project git)) - (depends - (ocaml (>= 4.03.0)) - (github (= :version)) - (cohttp (>= 0.99.0)) - (cohttp-lwt-jsoo (>= 0.99.0)) - (js_of_ocaml-lwt (>= 3.4.0))) - (synopsis "GitHub APIv3 JavaScript library") - (description "This library provides an OCaml interface to the [GitHub APIv3](https://developer.github.com/v3/) -(JSON). This library installs the JavaScript version, which uses [js_of_ocaml](http://ocsigen.org/js_of_ocaml).")) - -(package - (name github-unix) - (tags (org:mirage org:xapi-project git)) - (depends - (ocaml (>= 4.03.0)) - (github (= :version)) - (cohttp (>= 0.99.0)) - (cohttp-lwt-unix (>= 0.99.0)) - stringext - (lambda-term (>= 2.0)) - (cmdliner (>= 0.9.8)) - base-unix) - (synopsis "GitHub APIv3 Unix library") - (description "This library provides an OCaml interface to the [GitHub APIv3](https://developer.github.com/v3/) -(JSON). This package installs the Unix (Lwt) version.")) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github-unix.opam.template b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github-unix.opam.template deleted file mode 100644 index b0d9b5317..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github-unix.opam.template +++ /dev/null @@ -1 +0,0 @@ -libraries: [ "github_unix" ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github.opam.template b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github.opam.template deleted file mode 100644 index 2acd5090a..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields-with-tmpl/github.opam.template +++ /dev/null @@ -1 +0,0 @@ -x-foo: "an extension field" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields/dune-project deleted file mode 100644 index 423ed979e..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/main.t/test-fields/dune-project +++ /dev/null @@ -1,31 +0,0 @@ -(lang dune 1.10) -(name cohttp) -(version 1.0.0) -(source (github mirage/ocaml-cohttp)) -(license ISC) -(authors "Anil Madhavapeddy" "Rudi Grinberg") - -(generate_opam_files true) - -(package - (name cohttp) - (synopsis "An OCaml library for HTTP clients and servers") - (description "A longer description") - (depends - (alcotest :with-test) - (dune (and :build (> 1.5))) - (foo (and :dev (> 1.5) (< 2.0))) - (uri (>= 1.9.0)) - (uri (< 2.0.0)) - (fieldslib (> v0.12)) - (fieldslib (< v0.13)))) - -(package - (name cohttp-async) - (synopsis "HTTP client and server for the Async library") - (description "A _really_ long description") - (depends - (cohttp (>= 1.0.2)) - (conduit-async (>= 1.0.3)) - (async (>= v0.10.0)) - (async (< v0.12)))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/override.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/override.t new file mode 100644 index 000000000..61d0f549b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/override.t @@ -0,0 +1,49 @@ +Package information fields can be overridden per-package: + + $ cat >dune-project < (lang dune 2.5) + > (name foo) + > (version 1.0.0) + > (source (github mirage/ocaml-cohttp)) + > (license ISC) + > (authors "Anil Madhavapeddy" "Rudi Grinberg") + > (homepage https://my.home.page) + > ; + > (generate_opam_files true) + > ; + > (package + > (name foo) + > (version 1.0.1) + > (source (github mirage/foo)) + > (license MIT) + > (authors "Foo" "Bar")) + > EOF + + $ dune build @install + + $ cat foo.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + version: "1.0.1" + authors: ["Foo" "Bar"] + license: "MIT" + homepage: "https://my.home.page" + bug-reports: "https://github.com/mirage/foo/issues" + depends: [ + "dune" {>= "2.5"} + ] + build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + dev-repo: "git+https://github.com/mirage/foo.git" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/template.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/template.t new file mode 100644 index 000000000..8ff150f71 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/template.t @@ -0,0 +1,34 @@ +Templates +--------- + + $ cat > dune-project < (lang dune 2.0) + > (name foo) + > (generate_opam_files true) + > (package (name foo) (depends bar)) + > EOF + +Test various fields in the template file. Fields coming from the +template are always put at the end. Fields generated by Dune are +sorted in a way that pleases "opam lint". + + $ cat > foo.opam.template < x-foo: "blah" + > EOF + $ dune build @install + $ tail -n 1 foo.opam + x-foo: "blah" + + $ cat > foo.opam.template < libraries: [ "blah" ] + > EOF + $ dune build @install + $ tail -n 1 foo.opam + libraries: [ "blah" ] + + $ cat > foo.opam.template < depends: [ "overridden" ] + > EOF + $ dune build @install + $ tail -n 1 foo.opam + depends: [ "overridden" ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/v11-1.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/v11-1.t new file mode 100644 index 000000000..7c96631b9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/v11-1.t @@ -0,0 +1,31 @@ +Generation of opam files with lang dune >= 1.11 +----------------------------------------------- + + $ cat > dune-project < (lang dune 1.11) + > (name test) + > (generate_opam_files true) + > (package (name test)) + > EOF + + $ dune build @install + $ cat test.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + depends: [ + "dune" {>= "1.11"} + ] + build: [ + ["dune" "subst"] {pinned} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/version.t b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/version.t new file mode 100644 index 000000000..46551cebd --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/dune-project-meta/version.t @@ -0,0 +1,56 @@ +Version generated in opam and META files +---------------------------------------- + +After calling `dune subst`, dune should embed the version inside the +generated META and opam files. + +### With opam files and no package stanzas + + $ cat > dune-project < (lang dune 1.10) + > (name foo) + > EOF + + $ cat > foo.opam < EOF + + $ cat > dune < (library (public_name foo)) + > EOF + + $ (git init -q + > git add . + > git commit -qm _ + > git tag -a 1.0 -m 1.0 + > dune subst) + + $ dune build foo.opam META.foo + + $ grep ^version foo.opam + version: "1.0" + + $ grep ^version _build/default/META.foo + version = "1.0" + +With package stanzas and generating the opam files + + $ cat > dune-project < (lang dune 1.10) + > (name foo) + > (generate_opam_files true) + > (package (name foo)) + > EOF + + $ (git tag -d 1.0 >/dev/null + > git add . + > git commit -qm _ + > git tag -a 1.0 -m 1.0 + > dune subst) + + $ dune build foo.opam META.foo + + $ grep ^version foo.opam + version: "1.0" + + $ grep ^version _build/default/META.foo + version = "1.0" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/dune b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/diff-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/foo.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/foo.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/foo.cpp similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/foo.cpp diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/run.t new file mode 100644 index 000000000..a1bed7688 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/diff-stanza.t/run.t @@ -0,0 +1,11 @@ +This test showcases that although libraries can technically have non overlapping +stubs names, things are still broken if their .o files overlap: + + $ dune build @all 2>&1 | dune_cmd sanitize + File "dune", line 4, characters 10-13: + 4 | (c_names foo)) + ^^^ + Error: Multiple definitions for the same object file "foo$ext_obj". See another + definition at dune:9. + Hint: You can avoid the name clash by renaming one of the objects, or by + placing it into a different directory. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/foo.c b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/foo.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/foo.c rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/foo.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/run.t similarity index 65% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/run.t index 65598f18a..f7f118967 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/run.t @@ -1,28 +1,17 @@ This test showcases that although libraries can technically have non overlapping stubs names, things are still broken if their .o files overlap: - $ cat >same-stanza/dune <dune < (library > (name foo) > (c_names foo sub/foo)) > EOF - $ dune build --root diff-stanza @all 2>&1 | dune_cmd sanitize - Entering directory 'diff-stanza' - File "dune", line 4, characters 10-13: - 4 | (c_names foo)) - ^^^ - Error: Multiple definitions for the same object file "foo$ext_obj". See another - definition at dune:9. - Hint: You can avoid the name clash by renaming one of the objects, or by - placing it into a different directory. - Another form of this bug is if the same source is present in different directories. In this case, the rules are fine, but this is probably not what the user intended. - $ dune build --root same-stanza @all - Entering directory 'same-stanza' + $ dune build @all File "dune", line 3, characters 14-21: 3 | (c_names foo sub/foo)) ^^^^^^^ @@ -30,15 +19,14 @@ user intended. include sources in subdirectories, use the (include_subdirs ...) stanza. [1] - $ cat >same-stanza/dune <dune < (include_subdirs unqualified) > (library > (name foo) > (c_names foo)) > EOF - $ dune build --root same-stanza @all - Entering directory 'same-stanza' + $ dune build @all File "dune", line 4, characters 10-13: 4 | (c_names foo)) ^^^ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/sub/foo.c b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/sub/foo.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj.t/same-stanza/sub/foo.c rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx-obj/same-stanza.t/sub/foo.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/dune b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/diff-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/foo.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/foo.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/foo.cpp similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/foo.cpp diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/run.t new file mode 100644 index 000000000..45ec340f5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/diff-stanza.t/run.t @@ -0,0 +1,10 @@ +c_names with overlapping names in different stanzas + + $ dune build @all 2>&1 | dune_cmd sanitize + File "dune", line 4, characters 10-13: + 4 | (c_names foo)) + ^^^ + Error: Multiple definitions for the same object file "foo$ext_obj". See another + definition at dune:9. + Hint: You can avoid the name clash by renaming one of the objects, or by + placing it into a different directory. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/dune b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/same-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/foo_byte.ml b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/foo.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/foo_byte.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/foo.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/foo.cpp similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/foo.cpp diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/run.t similarity index 50% rename from duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/run.t index 816753587..70c55ad17 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/duplicate-c-cxx/same-stanza.t/run.t @@ -1,6 +1,6 @@ c_names and cxx_names with overlapping names in the same stanza - $ dune build --root same-stanza @all - Entering directory 'same-stanza' + + $ dune build @all File "dune", line 4, characters 12-15: 4 | (cxx_names foo)) ^^^ @@ -12,14 +12,3 @@ c_names and cxx_names with overlapping names in the same stanza foreign archives and building them in different directories. Foreign archives can be defined using the (foreign_library ...) stanza. [1] - -c_names with overlapping names in different stanzas - $ dune build --root diff-stanza @all 2>&1 | dune_cmd sanitize - Entering directory 'diff-stanza' - File "dune", line 4, characters 10-13: - 4 | (c_names foo)) - ^^^ - Error: Multiple definitions for the same object file "foo$ext_obj". See another - definition at dune:9. - Hint: You can avoid the name clash by renaming one of the objects, or by - placing it into a different directory. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/run.t deleted file mode 100644 index 206eff0cd..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/run.t +++ /dev/null @@ -1,105 +0,0 @@ -Test that `enabled_if` fields work as expected for executables. -Since 2.3. - -This executable is disabled, any attempt to build it should fail: - $ dune build dis.exe - Error: Don't know how to build dis.exe - [1] - $ dune exec ./dis.exe - Error: Program "./dis.exe" not found! - [1] - -This one is enabled - $ dune exec ./main.exe - Pong - -Installing should silently ignore disabled executables - $ dune build @install - -Tests for enabled_if in install stanza. Only bar.x should be installed. - $ dune build @install --root install - Entering directory 'install' - $ ls install/_build/install/default/bin - bar.x - -Tests for enabled_if in install stanza using forbidden variable. - $ dune build @install --root install/forbidden_var - Entering directory 'install/forbidden_var' - File "dune", line 6, characters 16-31: - 6 | (enabled_if (= %{project_root} "")) - ^^^^^^^^^^^^^^^ - Error: Only architecture, system, model, os_type, ccomp_type, profile, - ocaml_version and context_name variables are allowed in this 'enabled_if' - field. If you think that project_root should also be allowed, please file an - issue about it. - [1] - -The next ones use forbidden variables -For dune 2.3 -> 2.5 it is a warning - $ cat > forbidden_var/dune-project < (lang dune 2.3) - > EOF - $ dune exec ./foo.exe --root forbidden_var - Entering directory 'forbidden_var' - File "dune", line 3, characters 17-32: - 3 | (enabled_if (<> %{project_root} ""))) - ^^^^^^^^^^^^^^^ - Warning: Only architecture, system, model, os_type, ccomp_type, profile, - ocaml_version and context_name variables are allowed in this 'enabled_if' - field. If you think that project_root should also be allowed, please file an - issue about it. - bar - -For dune >= 2.6 it is an error - $ cat > forbidden_var/dune-project < (lang dune 2.6) - > EOF - $ dune exec ./foo.exe --root forbidden_var - Entering directory 'forbidden_var' - File "dune", line 3, characters 17-32: - 3 | (enabled_if (<> %{project_root} ""))) - ^^^^^^^^^^^^^^^ - Error: Only architecture, system, model, os_type, ccomp_type, profile, - ocaml_version and context_name variables are allowed in this 'enabled_if' - field. If you think that project_root should also be allowed, please file an - issue about it. - [1] - - -For dune < 2.7 context_name is not allowed - $ cat > var_context_name/dune-project < (lang dune 2.6) - > EOF - $ dune exec ./foo.exe --root var_context_name - Entering directory 'var_context_name' - File "dune", line 3, characters 16-31: - 3 | (enabled_if (= %{context_name} "default"))) - ^^^^^^^^^^^^^^^ - Error: %{context_name} is only available since version 2.7 of the dune - language. Please update your dune-project file to have (lang dune 2.7). - [1] - -For dune >= 2.7 context_name allowed - $ cat > var_context_name/dune-project < (lang dune 2.7) - > EOF - $ dune exec ./foo.exe --root var_context_name - Entering directory 'var_context_name' - bar - -For dune >= 3.2, negating expressions is allowed - $ mkdir negated - $ cat > negated/dune-project < (lang dune 3.2) - > EOF - $ cat > negated/dune < (executable - > (name foo) - > (enabled_if (not false))) - > EOF - $ cat > negated/foo.ml < print_endline "runs";; - > EOF - $ dune exec ./foo.exe --root negated - Entering directory 'negated' - runs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/forbidden_var/dune b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/forbidden_var/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/forbidden_var/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/forbidden_var/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/run.t new file mode 100644 index 000000000..dc3733620 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-exec-forbidden_var.t/run.t @@ -0,0 +1,28 @@ +The next ones use forbidden variables For dune 2.3 -> 2.5 it is a warning + + $ cat > dune-project < (lang dune 2.3) + > EOF + $ dune exec ./foo.exe + File "dune", line 3, characters 17-32: + 3 | (enabled_if (<> %{project_root} ""))) + ^^^^^^^^^^^^^^^ + Warning: Only architecture, system, model, os_type, ccomp_type, profile, + ocaml_version and context_name variables are allowed in this 'enabled_if' + field. If you think that project_root should also be allowed, please file an + issue about it. + bar + +For dune >= 2.6 it is an error + $ cat > dune-project < (lang dune 2.6) + > EOF + $ dune exec ./foo.exe + File "dune", line 3, characters 17-32: + 3 | (enabled_if (<> %{project_root} ""))) + ^^^^^^^^^^^^^^^ + Error: Only architecture, system, model, os_type, ccomp_type, profile, + ocaml_version and context_name variables are allowed in this 'enabled_if' + field. If you think that project_root should also be allowed, please file an + issue about it. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/bar.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/bar.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/dune b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/run.t new file mode 100644 index 000000000..a3c62dc62 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install-forbidden_var.t/run.t @@ -0,0 +1,10 @@ +Tests for enabled_if in install stanza using forbidden variable. + $ dune build @install + File "dune", line 6, characters 16-31: + 6 | (enabled_if (= %{project_root} "")) + ^^^^^^^^^^^^^^^ + Error: Only architecture, system, model, os_type, ccomp_type, profile, + ocaml_version and context_name variables are allowed in this 'enabled_if' + field. If you think that project_root should also be allowed, please file an + issue about it. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/bar.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/bar.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/dune b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/install/forbidden_var/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/run.t new file mode 100644 index 000000000..5d055aa58 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-install.t/run.t @@ -0,0 +1,5 @@ +Tests for enabled_if in install stanza. Only bar.x should be installed. + + $ dune build @install + $ ls _build/install/default/bin + bar.x diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/var_context_name/dune b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/var_context_name/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/var_context_name/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/var_context_name/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/run.t new file mode 100644 index 000000000..a5c4c8184 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/eif-var_context_name.t/run.t @@ -0,0 +1,18 @@ +For dune < 2.7 context_name is not allowed + $ cat > dune-project < (lang dune 2.6) + > EOF + $ dune exec ./foo.exe + File "dune", line 3, characters 16-31: + 3 | (enabled_if (= %{context_name} "default"))) + ^^^^^^^^^^^^^^^ + Error: %{context_name} is only available since version 2.7 of the dune + language. Please update your dune-project file to have (lang dune 2.7). + [1] + +For dune >= 2.7 context_name allowed + $ cat > dune-project < (lang dune 2.7) + > EOF + $ dune exec ./foo.exe + bar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dis.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dis.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dis.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dis.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/share1 b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/eif.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/share1 rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/eif.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/main.ml b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/main.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/enabled_if-exec.t/main.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/main.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/run.t new file mode 100644 index 000000000..64d05f597 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/enabled_if-exec.t/run.t @@ -0,0 +1,17 @@ +Test that `enabled_if` fields work as expected for executables. +Since 2.3. + +This executable is disabled, any attempt to build it should fail: + $ dune build dis.exe + Error: Don't know how to build dis.exe + [1] + $ dune exec ./dis.exe + Error: Program "./dis.exe" not found! + [1] + +This one is enabled + $ dune exec ./main.exe + Pong + +Installing should silently ignore disabled executables + $ dune build @install diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/negated.t b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/negated.t new file mode 100644 index 000000000..9d7b5fa83 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/enabled_if/negated.t @@ -0,0 +1,14 @@ +For dune >= 3.2, negating expressions is allowed + $ cat > dune-project < (lang dune 3.2) + > EOF + $ cat > dune < (executable + > (name foo) + > (enabled_if (not false))) + > EOF + $ cat > foo.ml < print_endline "runs";; + > EOF + $ dune exec ./foo.exe + runs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/dune new file mode 100644 index 000000000..5f7557089 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/dune @@ -0,0 +1,3 @@ +(cram + (applies_to envs-and-contexts) + (deps ${bin:opam})) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/run.t deleted file mode 100644 index ab5a5e2c7..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/run.t +++ /dev/null @@ -1,36 +0,0 @@ -Basic test that we can use private binaries as public ones - $ dune build --root private-bin-import - Entering directory 'private-bin-import' - Executing priv as priv - PATH: - $TESTCASE_ROOT/private-bin-import/_build/default/using-priv/.bin - $TESTCASE_ROOT/private-bin-import/_build/install/default/bin - Executing priv as priv-renamed - PATH: - $TESTCASE_ROOT/private-bin-import/_build/default/using-priv/.bin - $TESTCASE_ROOT/private-bin-import/_build/install/default/bin - -Override public binary in env - $ dune build --root override-bins - Entering directory 'override-bins' - private binary - public binary - -Nest env binaries - $ dune build --root nested-env - Entering directory 'nested-env' - Executing priv as priv - PATH: - $TESTCASE_ROOT/nested-env/_build/default/using-priv/nested/.bin - $TESTCASE_ROOT/nested-env/_build/default/using-priv/.bin - $TESTCASE_ROOT/nested-env/_build/install/default/bin - Executing priv as priv-renamed - PATH: - $TESTCASE_ROOT/nested-env/_build/default/using-priv/nested/.bin - $TESTCASE_ROOT/nested-env/_build/default/using-priv/.bin - $TESTCASE_ROOT/nested-env/_build/install/default/bin - Executing priv as priv-renamed-nested - PATH: - $TESTCASE_ROOT/nested-env/_build/default/using-priv/nested/.bin - $TESTCASE_ROOT/nested-env/_build/default/using-priv/.bin - $TESTCASE_ROOT/nested-env/_build/install/default/bin diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/priv/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/priv/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/priv/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/priv/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/priv/priv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/priv/priv.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/priv/priv.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/priv/priv.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/run.t new file mode 100644 index 000000000..47497971d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/run.t @@ -0,0 +1,17 @@ +Nest env binaries + $ dune build + Executing priv as priv + PATH: + $TESTCASE_ROOT/_build/default/using-priv/nested/.bin + $TESTCASE_ROOT/_build/default/using-priv/.bin + $TESTCASE_ROOT/_build/install/default/bin + Executing priv as priv-renamed + PATH: + $TESTCASE_ROOT/_build/default/using-priv/nested/.bin + $TESTCASE_ROOT/_build/default/using-priv/.bin + $TESTCASE_ROOT/_build/install/default/bin + Executing priv as priv-renamed-nested + PATH: + $TESTCASE_ROOT/_build/default/using-priv/nested/.bin + $TESTCASE_ROOT/_build/default/using-priv/.bin + $TESTCASE_ROOT/_build/install/default/bin diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/using-priv/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/using-priv/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/using-priv/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/using-priv/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/using-priv/nested/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/using-priv/nested/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/nested-env/using-priv/nested/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/nested-env.t/using-priv/nested/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/priv/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/priv/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/priv/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/priv/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/priv/priv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/priv/priv.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/priv/priv.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/priv/priv.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/pub/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/pub/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/pub/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/pub/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/pub/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/pub/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/pub/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/pub/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/run.t new file mode 100644 index 000000000..7aaa07863 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/run.t @@ -0,0 +1,5 @@ +Override public binary in env + + $ dune build + private binary + public binary diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/test/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/test/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/override-bins/test/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/override-bins.t/test/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/priv/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/priv/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/priv/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/priv/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/priv/priv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/priv/priv.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/priv/priv.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/priv/priv.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/run.t new file mode 100644 index 000000000..08d391544 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/run.t @@ -0,0 +1,11 @@ +Basic test that we can use private binaries as public ones + + $ dune build + Executing priv as priv + PATH: + $TESTCASE_ROOT/_build/default/using-priv/.bin + $TESTCASE_ROOT/_build/install/default/bin + Executing priv as priv-renamed + PATH: + $TESTCASE_ROOT/_build/default/using-priv/.bin + $TESTCASE_ROOT/_build/install/default/bin diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/using-priv/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/using-priv/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins.t/private-bin-import/using-priv/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-bins/private-bin-import.t/using-priv/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/run.t deleted file mode 100644 index a2fcee0a0..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/run.t +++ /dev/null @@ -1,22 +0,0 @@ -env vars set in env should be visible to all subdirs - $ dune build --root env-subdir - Entering directory 'env-subdir' - PASS - -env vars interpreted in various fields, such as flags - $ dune build --force --root flag-field - Entering directory 'flag-field' - var visible from dune: -principal - DUNE_FOO: -principal - -global vars are overridden - $ DUNE_FOO=blarg dune build --force --root flag-field - Entering directory 'flag-field' - var visible from dune: -principal - DUNE_FOO: -principal - -proper inheritance chain of env stanzas - $ dune build --root inheritance - Entering directory 'inheritance' - DUNE_FOO: foo-sub - DUNE_BAR: bar-parent diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/run.t new file mode 100644 index 000000000..e625e2828 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/run.t @@ -0,0 +1,3 @@ +env vars set in env should be visible to all subdirs + $ dune build + PASS diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/sub/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/sub/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/env-subdir/sub/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/env-subdir.t/sub/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/flag-field/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/run.t new file mode 100644 index 000000000..6b8f87980 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/flag-field.t/run.t @@ -0,0 +1,11 @@ +env vars interpreted in various fields, such as flags + + $ dune build --force + var visible from dune: -principal + DUNE_FOO: -principal + +global vars are overridden + + $ DUNE_FOO=blarg dune build --force + var visible from dune: -principal + DUNE_FOO: -principal diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/run.t new file mode 100644 index 000000000..e33d144d6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/run.t @@ -0,0 +1,5 @@ +proper inheritance chain of env stanzas + + $ dune build + DUNE_FOO: foo-sub + DUNE_BAR: bar-parent diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/sub/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/sub/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file.t/inheritance/sub/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-dune-file/inheritance.t/sub/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/run.t deleted file mode 100644 index 5d1e5e566..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/run.t +++ /dev/null @@ -1,72 +0,0 @@ -Make sure that we require a default value regardless of the context - - $ dune build --root missing-default-in-action @echo - Entering directory 'missing-default-in-action' - File "dune", line 3, characters 15-34: - 3 | (action (echo %{env:DUNE_ENV_VAR}))) - ^^^^^^^^^^^^^^^^^^^ - Error: %{env:..} must always come with a default value. - Hint: the syntax is %{env:VAR=DEFAULT-VALUE} - [1] - $ dune build --root missing-default-in-blang @echo - Entering directory 'missing-default-in-blang' - File "dune", line 3, characters 21-40: - 3 | (enabled_if (= true %{env:DUNE_ENV_VAR})) - ^^^^^^^^^^^^^^^^^^^ - Error: %{env:..} must always come with a default value. - Hint: the syntax is %{env:VAR=DEFAULT-VALUE} - [1] - -Actually test that the environment changes are properly tracked, i.e. that -incrementality works properly, that (setenv ...) is taken into account, etc. - - $ dune build --root correct @echo1 - Entering directory 'correct' - true - $ DUNE_ENV_VAR=true dune build --root correct @echo1 - Entering directory 'correct' - $ DUNE_ENV_VAR=false dune build --root correct @echo1 - Entering directory 'correct' - false - $ DUNE_ENV_VAR=false dune build --root correct @echo1 - Entering directory 'correct' - $ DUNE_ENV_VAR=true dune build --root correct @echo1 - Entering directory 'correct' - -This test is broken because previous/new values should differ in these tests. In -the dune file, the environment variable ends up being set locally, but this -isn't reflected on a per action basis. - $ dune build --root correct @echo2 - Entering directory 'correct' - previous env: unset - new env:set by setenv - $ DUNE_ENV_VAR=true dune build --root correct @echo2 - Entering directory 'correct' - previous env: true - new env:set by setenv - $ DUNE_ENV_VAR=false dune build --root correct @echo2 - Entering directory 'correct' - previous env: false - new env:set by setenv - - $ dune build --root correct @enabled - Entering directory 'correct' - enabled! - $ DUNE_ENV_VAR=true dune build --root correct @enabled - Entering directory 'correct' - $ DUNE_ENV_VAR=false dune build --root correct @enabled - Entering directory 'correct' - - $ dune build --root correct @disabled - Entering directory 'correct' - $ DUNE_ENV_VAR=true dune build --root correct @disabled - Entering directory 'correct' - enabled! - $ DUNE_ENV_VAR=false dune build --root correct @disabled - Entering directory 'correct' - - $ dune build --root nesting - Entering directory 'nesting' - Initial value of unset - Now set: XXXX - From bar: from bar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/correct/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/correct/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/correct/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/correct/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/run.t new file mode 100644 index 000000000..b531612b3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/correct.t/run.t @@ -0,0 +1,34 @@ +Actually test that the environment changes are properly tracked, i.e. that +incrementality works properly, that (setenv ...) is taken into account, etc. + + $ dune build @echo1 + true + $ DUNE_ENV_VAR=true dune build @echo1 + $ DUNE_ENV_VAR=false dune build @echo1 + false + $ DUNE_ENV_VAR=false dune build @echo1 + $ DUNE_ENV_VAR=true dune build @echo1 + +This test is broken because previous/new values should differ in these tests. In +the dune file, the environment variable ends up being set locally, but this +isn't reflected on a per action basis. + + $ dune build @echo2 + previous env: unset + new env:set by setenv + $ DUNE_ENV_VAR=true dune build @echo2 + previous env: true + new env:set by setenv + $ DUNE_ENV_VAR=false dune build @echo2 + previous env: false + new env:set by setenv + + $ dune build @enabled + enabled! + $ DUNE_ENV_VAR=true dune build @enabled + $ DUNE_ENV_VAR=false dune build @enabled + + $ dune build @disabled + $ DUNE_ENV_VAR=true dune build @disabled + enabled! + $ DUNE_ENV_VAR=false dune build @disabled diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-action/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-action/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-action/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-action/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/run.t new file mode 100644 index 000000000..d184ad12a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-action.t/run.t @@ -0,0 +1,16 @@ +Make sure that we require a default value regardless of the context + + $ dune build @echo + File "dune", line 3, characters 15-34: + 3 | (action (echo %{env:DUNE_ENV_VAR}))) + ^^^^^^^^^^^^^^^^^^^ + Error: %{env:..} must always come with a default value. + Hint: the syntax is %{env:VAR=DEFAULT-VALUE} + [1] + $ dune build @echo + File "dune", line 3, characters 15-34: + 3 | (action (echo %{env:DUNE_ENV_VAR}))) + ^^^^^^^^^^^^^^^^^^^ + Error: %{env:..} must always come with a default value. + Hint: the syntax is %{env:VAR=DEFAULT-VALUE} + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-blang/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-blang/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-blang/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/missing-default-in-blang/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/run.t new file mode 100644 index 000000000..6bc52baac --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/missing-default-in-blang.t/run.t @@ -0,0 +1,7 @@ + $ dune build @echo + File "dune", line 3, characters 21-40: + 3 | (enabled_if (= true %{env:DUNE_ENV_VAR})) + ^^^^^^^^^^^^^^^^^^^ + Error: %{env:..} must always come with a default value. + Hint: the syntax is %{env:VAR=DEFAULT-VALUE} + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/nesting/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/nesting/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/nesting/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion.t/nesting/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/run.t new file mode 100644 index 000000000..244e5039c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-var-expansion/nesting.t/run.t @@ -0,0 +1,4 @@ + $ dune build + Initial value of unset + Now set: XXXX + From bar: from bar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/run.t deleted file mode 100644 index 6f03a2922..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/run.t +++ /dev/null @@ -1,30 +0,0 @@ -Environment variables defined in (env) are set during execution. - -They can be set from the workspace: - - $ dune exec --root precedence ./printenv.exe VARIABLE_FROM_WORKSPACE - Entering directory 'precedence' - VARIABLE_FROM_WORKSPACE=value1 - -From a (context) stanza in the workspace: - - $ dune exec --root precedence ./printenv.exe VARIABLE_FROM_CONTEXT - Entering directory 'precedence' - VARIABLE_FROM_CONTEXT=value2 - -When a variable is set from both a context and a global one, the context one is -used. - - $ dune exec --root precedence ./printenv.exe VARIABLE_FROM_BOTH - Entering directory 'precedence' - VARIABLE_FROM_BOTH=from_workspace - -When a variable is repeated, an error message is displayed: - - $ dune build --root duplicate - Entering directory 'duplicate' - File "dune-workspace", line 6, characters 3-41: - 6 | (VARIABLE value1) - 7 | (VARIABLE value2)))) - Error: Variable VARIABLE is specified several times - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/duplicate/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/duplicate.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/duplicate/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/duplicate.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/duplicate.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/duplicate.t/run.t new file mode 100644 index 000000000..cb53afb00 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/duplicate.t/run.t @@ -0,0 +1,8 @@ +When a variable is repeated, an error message is displayed: + + $ dune build + File "dune-workspace", line 6, characters 3-41: + 6 | (VARIABLE value1) + 7 | (VARIABLE value2)))) + Error: Variable VARIABLE is specified several times + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/printenv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/printenv.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables.t/precedence/printenv.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/printenv.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/run.t new file mode 100644 index 000000000..f1af374df --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/env/env-variables/precedence.t/run.t @@ -0,0 +1,17 @@ +Environment variables defined in (env) are set during execution. + +They can be set from the workspace: + + $ dune exec ./printenv.exe VARIABLE_FROM_WORKSPACE + VARIABLE_FROM_WORKSPACE=value1 + +From a (context) stanza in the workspace: + + $ dune exec ./printenv.exe VARIABLE_FROM_CONTEXT + VARIABLE_FROM_CONTEXT=value2 + +When a variable is set from both a context and a global one, the context one is +used. + + $ dune exec ./printenv.exe VARIABLE_FROM_BOTH + VARIABLE_FROM_BOTH=from_workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/run.t deleted file mode 100644 index a45eabba2..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/run.t +++ /dev/null @@ -1,20 +0,0 @@ -These tests show that (wrapped_executables true) addresses the problem of compilation -units of exes colliding with libraries. - -Single module case. Here we technically don't need an alias module - - $ dune build --root single-module - Entering directory 'single-module' - this module is unlinkable - this module is unlinkable - -The multi module case always requires an alias. - - $ dune build --root multi-module - Entering directory 'multi-module' - not directly usable - -Multiple executables defined in the same directory - - $ dune build --root multi-exe-same-dir - Entering directory 'multi-exe-same-dir' diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-exe-same-dir/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/run.t new file mode 100644 index 000000000..8dbfc3893 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-exe-same-dir.t/run.t @@ -0,0 +1,6 @@ +These tests show that (wrapped_executables true) addresses the problem of compilation +units of exes colliding with libraries. + +Multiple executables defined in the same directory + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/baz.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/baz.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/baz.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/baz.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/multi-module/foo/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/foo/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/run.t new file mode 100644 index 000000000..1f33bbe3e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/multi-module.t/run.t @@ -0,0 +1,7 @@ +These tests show that (wrapped_executables true) addresses the problem of compilation +units of exes colliding with libraries. + +The multi module case always requires an alias. + + $ dune build + not directly usable diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/collisionlib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/collisionlib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/collisionlib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/collisionlib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/exe.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/collision-lib/exe.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/collision-lib/exe.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/exe.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/exe.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/exe.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/foo/dune b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/foo/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/foo/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/foo/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/foo/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/foo/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle.t/single-module/foo/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/foo/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/run.t new file mode 100644 index 000000000..7bfc25f07 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/exe-name-mangle/single-module.t/run.t @@ -0,0 +1,9 @@ +These tests show that (wrapped_executables true) addresses the problem of compilation +units of exes colliding with libraries. + +Single module case. Here we technically don't need an alias module + + $ dune build + this module is unlinkable + this module is unlinkable + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps.t b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps.t deleted file mode 100644 index 1ba689c12..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps.t +++ /dev/null @@ -1,5 +0,0 @@ -external-lib-deps is no more. - - $ dune external-lib-deps - dune external-lib-deps: This subcommand is no longer implemented. - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune new file mode 100644 index 000000000..74a11e366 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune @@ -0,0 +1,3 @@ +(library + (name foo) + (libraries inter_lib a)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune-project new file mode 100644 index 000000000..64e88da56 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 1.9) +(name foo) +(allow_approximate_merlin true) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/lib/dune new file mode 100644 index 000000000..ba729d769 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/lib/dune @@ -0,0 +1,3 @@ +(library + (name inter_lib) + (libraries a)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/run.t new file mode 100644 index 000000000..1574fe7bc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/exclude-internal-deps.t/run.t @@ -0,0 +1,8 @@ +Expected: The dependency "inter_lib" in ./dune file was printed, the "inter_lib" lib is already +an internal lib that declared in ./lib/dune file. The command "dune describe external-lib-deps" +print only the external libraries by dir. + + $ dune describe external-lib-deps + (default + ((. ((a required))) + (lib ((a required))))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune new file mode 100644 index 000000000..1df0d1f36 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune @@ -0,0 +1,18 @@ +(library + (name foo) + (modules :standard \ prog) + (libraries a________ b________ c________) + (preprocess (pps d________ e________ f________))) + +(rule + (with-stdout-to file.ml + (echo %{lib-available:optional}))) + +(rule (with-stdout-to foo.ml (run prog))) + +(executable + (name prog) + (modules prog) + (libraries h________ i________ j________)) + +(rule (with-stdout-to prog.ml (echo ""))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune-project new file mode 100644 index 000000000..4def4fa3e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/dune-project @@ -0,0 +1,4 @@ +(lang dune 1.9) +(name foo) + +(allow_approximate_merlin true) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/run.t new file mode 100644 index 000000000..5dbf60015 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple-pps.t/run.t @@ -0,0 +1,14 @@ +Expected: To get all required and pps packages + + $ dune describe external-lib-deps + (default + ((. + ((a________ required) + (b________ required) + (c________ required) + (d________ required) + (e________ required) + (f________ required) + (h________ required) + (i________ required) + (j________ required))))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t new file mode 100644 index 000000000..06b446fe5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/external-lib-deps/simple.t/run.t @@ -0,0 +1,11 @@ +external library dependencies of a simple project + + $ echo "(lang dune 2.3)" > dune-project + $ touch dummypkg.opam + $ cat >dune < (library + > (public_name dummypkg) + > (libraries base doesnotexist.foo)) + > EOF + $ dune describe external-lib-deps + (default ((. ((base required) (doesnotexist.foo required))))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-compile-with-rule.t b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-compile-with-rule.t new file mode 100644 index 000000000..206241277 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-compile-with-rule.t @@ -0,0 +1,35 @@ +---------------------------------------------------------------------------------- +Build an executable which depends on foreign object files compiled with a rule. + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (executable + > (name calc) + > (extra_objects add mul)) + > (rule + > (targets add.o mul.o) + > (deps add.c mul.c) + > (action (run %{cc} -c -I %{ocaml_where} %{deps}))) + > EOF + + $ cat >calc.ml < external add : int -> int -> int = "add" + > external mul : int -> int -> int = "mul" + > let calc x y z = mul (add x y) z + > let () = print_int (calc 3 4 6) + > let () = print_string "\n" + > EOF + + $ cat >add.c < #include + > value add(value x, value y) { return Val_int(Int_val(x) + Int_val(y)); } + > EOF + + $ cat >mul.c < #include + > value mul(value x, value y) { return Val_int(Int_val(x) * Int_val(y)); } + > EOF + + $ dune exec ./calc.exe + 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-error-on-duplicate.t b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-error-on-duplicate.t new file mode 100644 index 000000000..d40938bc6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-error-on-duplicate.t @@ -0,0 +1,18 @@ +---------------------------------------------------------------------------------- +Test that duplicate foreign objects results in an error + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (executable + > (name foo) + > (extra_objects foo foo)) + > EOF + + $ dune build + File "dune", line 3, characters 16-19: + 3 | (extra_objects foo foo)) + ^^^ + Error: Duplicate object name: foo. Already appears at: + - dune:3 + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-exe.t b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-exe.t new file mode 100644 index 000000000..689a0a867 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-exe.t @@ -0,0 +1,73 @@ +---------------------------------------------------------------------------------- +Build an executable which depends on foreign object files. + +---------------------------------------------------------------------------------- +* (extra_objects ...) is unavailable before Dune 3.5. + + $ echo "(lang dune 3.4)" > dune-project + $ mkdir -p bin + + $ cat >bin/dune < (executable + > (name calc) + > (extra_objects add mul)) + > EOF + + $ dune build + File "bin/dune", line 3, characters 1-24: + 3 | (extra_objects add mul)) + ^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'extra_objects' is only available since version 3.5 of the dune + language. Please update your dune-project file to have (lang dune 3.5). + [1] + +---------------------------------------------------------------------------------- +* Error for missing object file + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >bin/calc.ml < external add : int -> int -> int = "add" + > external mul : int -> int -> int = "mul" + > let calc x y z = mul (add x y) z + > let () = print_int (calc 3 4 6) + > let () = print_string "\n" + > EOF + + $ dune build + File "bin/dune", line 2, characters 7-11: + 2 | (name calc) + ^^^^ + Error: No rule found for bin/add.o + File "bin/dune", line 2, characters 7-11: + 2 | (name calc) + ^^^^ + Error: No rule found for bin/mul.o + [1] + +---------------------------------------------------------------------------------- +* Successful build when all object files are available + + $ cat >bin/add.c < #include + > value add(value x, value y) { return Val_int(Int_val(x) + Int_val(y)); } + > EOF + + $ cat >bin/mul.c < #include + > value mul(value x, value y) { return Val_int(Int_val(x) * Int_val(y)); } + > EOF + + $ cat >>bin/dune < (rule + > (target mul.o) + > (deps mul.c) + > (action (run %{bin:ocamlc} mul.c))) + > (rule + > (target add.o) + > (deps add.c) + > (action (run %{bin:ocamlc} add.c))) + > EOF + + $ dune exec ./bin/calc.exe + 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-lib.t b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-lib.t new file mode 100644 index 000000000..efae45bfd --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/extra-objects/extra-objects-lib.t @@ -0,0 +1,95 @@ +---------------------------------------------------------------------------------- +Build a library which depends on foreign object files. + +---------------------------------------------------------------------------------- +* (extra_objects ...) is unavailable before Dune 3.5. + + $ echo "(lang dune 3.4)" > dune-project + $ mkdir -p lib + + $ cat >lib/dune < (library + > (name calc) + > (extra_objects add mul)) + > EOF + + $ dune build + File "lib/dune", line 3, characters 1-24: + 3 | (extra_objects add mul)) + ^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'extra_objects' is only available since version 3.5 of the dune + language. Please update your dune-project file to have (lang dune 3.5). + [1] + +---------------------------------------------------------------------------------- +* Error for missing object file + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >lib/calc.ml < external add : int -> int -> int = "add" + > external mul : int -> int -> int = "mul" + > let calc x y z = mul (add x y) z + > EOF + + $ cat >lib/calc.mli < val calc : int -> int -> int -> int + > EOF + + $ dune build + File "lib/dune", line 1, characters 0-47: + 1 | (library + 2 | (name calc) + 3 | (extra_objects add mul)) + Error: No rule found for lib/add.o + File "lib/dune", line 1, characters 0-47: + 1 | (library + 2 | (name calc) + 3 | (extra_objects add mul)) + Error: No rule found for lib/mul.o + [1] + +---------------------------------------------------------------------------------- +* Successful build when all object files are available + + $ cat >lib/add.c < #include + > value add(value x, value y) { return Val_int(Int_val(x) + Int_val(y)); } + > EOF + + $ cat >lib/mul.c < #include + > value mul(value x, value y) { return Val_int(Int_val(x) * Int_val(y)); } + > EOF + + $ cat >>lib/dune < (rule + > (target mul.o) + > (deps mul.c) + > (action (run %{bin:ocamlc} mul.c))) + > (rule + > (target add.o) + > (deps add.c) + > (action (run %{bin:ocamlc} add.c))) + > EOF + + $ dune build + +---------------------------------------------------------------------------------- +* Add an executable to test that we can link against the foreign object files + + $ mkdir -p bin + + $ cat >bin/dune < (executable + > (name main) + > (libraries calc)) + > EOF + + $ cat >bin/main.ml < let () = print_int (Calc.calc 3 4 6) + > let () = print_string "\n" + > EOF + + $ dune exec ./bin/main.exe + 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/run.t deleted file mode 100644 index 31dae32d5..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/run.t +++ /dev/null @@ -1,21 +0,0 @@ -fallback isn't allowed in dune - - $ dune build --root dune1 - Entering directory 'dune1' - File "dune", line 2, characters 1-11: - 2 | (fallback) - ^^^^^^^^^^ - Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the - dune language - [1] - -2nd fallback form isn't allowed either - - $ dune build --root dune2 - Entering directory 'dune2' - File "dune", line 2, characters 1-17: - 2 | (fallback false) - ^^^^^^^^^^^^^^^^ - Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the - dune language - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune1/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune1/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/run.t new file mode 100644 index 000000000..ed1f94086 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune1.t/run.t @@ -0,0 +1,9 @@ +fallback isn't allowed in dune + + $ dune build + File "dune", line 2, characters 1-11: + 2 | (fallback) + ^^^^^^^^^^ + Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the + dune language + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune2/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune.t/dune2/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/run.t new file mode 100644 index 000000000..ef71f8012 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/fallback-dune/dune2.t/run.t @@ -0,0 +1,9 @@ +2nd fallback form isn't allowed either + + $ dune build + File "dune", line 2, characters 1-17: + 2 | (fallback false) + ^^^^^^^^^^^^^^^^ + Error: 'fallback' was renamed to '(mode fallback)' in the 1.0 version of the + dune language + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs.t b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-field.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs.t rename to duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-field.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs.c new file mode 100644 index 000000000..e24b2584b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(1); +#else + return Val_int(0); +#endif +} \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs_same.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs_same.c new file mode 100644 index 000000000..e50b09a9c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/c_stubs_same.c @@ -0,0 +1,6 @@ +#include "caml/mlvalues.h" + +value caml_b_and_n(value unit) +{ + return Val_int(0); +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/dune new file mode 100644 index 000000000..da369f2d9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/dune @@ -0,0 +1,27 @@ +(executable + (modes native byte_complete) + (modules stubs_exe) + (name stubs_exe) + (foreign_stubs + (language c) + (mode byte) + (names c_stubs)) + (foreign_stubs + (language c) + (mode native) + (flags :standard -DNATIVE_CODE) + (names c_stubs))) + +(executable + (modes native byte_complete) + (modules stubs_lib) + (name stubs_lib) + (libraries mode_dep_stubs)) + +(executable + (modes native byte_complete) + (modules stubs_same_exe) + (name stubs_same_exe) + (foreign_stubs + (language c) + (names c_stubs_same))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/c_stubs_lib.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/c_stubs_lib.c new file mode 100644 index 000000000..acc273cf9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/c_stubs_lib.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(1); +#else + return Val_int(0); +#endif +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/dune new file mode 100644 index 000000000..db7159ed8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/dune @@ -0,0 +1,11 @@ +(library + (name mode_dep_stubs) + (foreign_stubs + (language c) + (mode byte) + (names c_stubs_lib)) + (foreign_stubs + (language c) + (mode native) + (flags :standard -DNATIVE_CODE) + (names c_stubs_lib))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/mode_dep_stubs.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/mode_dep_stubs.ml new file mode 100644 index 000000000..df32d06b1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/lib/mode_dep_stubs.ml @@ -0,0 +1 @@ +external stub_byte_or_native : unit -> int = "caml_b_or_n" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/run.t new file mode 100644 index 000000000..9a3d79ae8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/run.t @@ -0,0 +1,104 @@ +############## +Project Toggle +############## + +Without the toggle, we get an error message for using the new mode subfield + $ cat >dune-project < (lang dune 3.5) + > EOF + + $ dune build 2>&1 | head -n 6 + File "dune", line 11, characters 3-16: + 11 | (mode native) + ^^^^^^^^^^^^^ + Error: 'mode' is available only when mode_specific_stubs is enabled in the + dune-project file. You must enable it using (using mode_specific_stubs 0.1) + in your dune-project file. + +But the toggle only exists in Dune 3.5 + $ cat >dune-project < (lang dune 3.1) + > (using mode_specific_stubs 0.1) + > EOF + + $ dune build + File "dune-project", line 2, characters 27-30: + 2 | (using mode_specific_stubs 0.1) + ^^^ + Error: Version 0.1 of syntax extension for mode-specific foreign stubs is not + supported until version 3.5 of the dune language. + There are no supported versions of this extension in version 3.1 of the dune + language. + + [1] + +With Dune 3.5 no error is displayed + $ cat >dune-project < (lang dune 3.5) + > (using mode_specific_stubs 0.1) + > EOF + + $ dune build + $ dune clean + +########### +Executables +########### + +Native executables should output 1, others 0 if they have mode-dependent stubs + $ dune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + + $ dune exec ./stubs_exe.bc.exe + Byte (0) or native (1) ? 0 + +But stubs_same_exe which does not have mode dependent stubs and should +always output 0 + $ dune exec ./stubs_same_exe.exe + Byte (0) and native (0) ? 0 + + $ dune exec ./stubs_same_exe.bc.exe + Byte (0) and native (0) ? 0 + +There should be two different object files for the mode-dependent stub `c_stub` +but only one for the non-mode-dependent stub `c_stub_same` + $ ls _build/default/*.o + _build/default/c_stubs_byte.o + _build/default/c_stubs_native.o + _build/default/c_stubs_same.o + + $ dune clean + +######### +Libraries +######### + + + + $ dune exec ./stubs_lib.exe + Byte (0) or native (1) ? 1 + + $ dune exec ./stubs_lib.bc.exe + Byte (0) or native (1) ? 0 + + + $ dune clean + +Now we try will being in the sandbox + $ cat >sdune <<'EOF' + > #!/usr/bin/env bash + > DUNE_SANDBOX=symlink dune "$@" + > EOF + $ chmod +x sdune + + $ ./sdune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + + $ ./sdune exec ./stubs_exe.bc.exe + Byte (0) or native (1) ? 0 + + $ ./sdune exec ./stubs_lib.exe + Byte (0) or native (1) ? 1 + + $ ./sdune exec ./stubs_lib.bc.exe + Byte (0) or native (1) ? 0 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_exe.ml new file mode 100644 index 000000000..62cebfddb --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_exe.ml @@ -0,0 +1,3 @@ +external stub_byte_or_native : unit -> int = "caml_b_or_n" + +let () = Printf.printf "Byte (0) or native (1) ? %i\n" (stub_byte_or_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_lib.ml new file mode 100644 index 000000000..b7028a678 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_lib.ml @@ -0,0 +1 @@ +let () = Printf.printf "Byte (0) or native (1) ? %i\n" (Mode_dep_stubs.stub_byte_or_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_same_exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_same_exe.ml new file mode 100644 index 000000000..354bc7854 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-exe.t/stubs_same_exe.ml @@ -0,0 +1,3 @@ +external stub_byte_and_native : unit -> int = "caml_b_and_n" + +let () = Printf.printf "Byte (0) and native (0) ? %i\n" (stub_byte_and_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune new file mode 100644 index 000000000..292868993 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune @@ -0,0 +1,4 @@ +(executable + (name stubs_exe) + (modes native byte_complete) + (libraries stubs_lib stubs_liboth)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune-project new file mode 100644 index 000000000..eaf11b9f9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using mode_specific_stubs 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/c_stubs.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/c_stubs.c new file mode 100644 index 000000000..acc273cf9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/c_stubs.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(1); +#else + return Val_int(0); +#endif +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/dune new file mode 100644 index 000000000..98c450a03 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/dune @@ -0,0 +1,12 @@ +(library + (name stubs_lib) + (modes byte native) + (foreign_stubs + (language c) + (mode byte) + (names c_stubs)) + (foreign_stubs + (language c) + (mode native) + (flags :standard -DNATIVE_CODE) + (names c_stubs))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/stubs_lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/stubs_lib.ml new file mode 100644 index 000000000..084077526 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/lib/stubs_lib.ml @@ -0,0 +1,5 @@ +external stub_byte_or_native : unit -> int = "caml_b_or_n" + +let byte_or_native () = + Printf.printf "Running[]: Byte (0) or native (1) ? %i\n" + (stub_byte_or_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/c_stubs.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/c_stubs.c new file mode 100644 index 000000000..7a4d206e1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/c_stubs.c @@ -0,0 +1,6 @@ +#include "caml/mlvalues.h" + +value caml_42(value unit) +{ + return Val_int(42); +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/dune new file mode 100644 index 000000000..88de06e04 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/dune @@ -0,0 +1,5 @@ +(library + (name stubs_liboth) + (foreign_stubs + (language c) + (names c_stubs))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/stubs_liboth.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/stubs_liboth.ml new file mode 100644 index 000000000..213ce9c2a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/liboth/stubs_liboth.ml @@ -0,0 +1,5 @@ +external stub_byte_and_native : unit -> int = "caml_42" + +let byte_or_native () = + Printf.printf "Running[]: Byte and native (42) ? %i\n" + (stub_byte_and_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/run.t new file mode 100644 index 000000000..aa816f944 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/run.t @@ -0,0 +1,14 @@ + $ opam_prefix="$(opam var prefix)" + $ export BUILD_PATH_PREFIX_MAP=\ + > "/OPAM_PREFIX=$opam_prefix:$BUILD_PATH_PREFIX_MAP" + +In the following tests, the first line of the output should be different +depending on the compilation mode but not the second one: + + $ dune exec ./stubs_exe.exe + Running[]: Byte (0) or native (1) ? 1 + Running[]: Byte and native (42) ? 42 + + $ dune exec ./stubs_exe.bc.exe + Running[]: Byte (0) or native (1) ? 0 + Running[]: Byte and native (42) ? 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/stubs_exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/stubs_exe.ml new file mode 100644 index 000000000..a956451d2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-lib.t/stubs_exe.ml @@ -0,0 +1,2 @@ +let () = Stubs_lib.byte_or_native () +let () = Stubs_liboth.byte_or_native () diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs.c new file mode 100644 index 000000000..acc273cf9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(1); +#else + return Val_int(0); +#endif +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs2.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs2.c new file mode 100644 index 000000000..2f97200d8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/c_stubs2.c @@ -0,0 +1,6 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n2(value unit) +{ + return Val_int(42); +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/dune-project new file mode 100644 index 000000000..eaf11b9f9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using mode_specific_stubs 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/run.t new file mode 100644 index 000000000..49b55dbdf --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-mixed-errors.t/run.t @@ -0,0 +1,140 @@ + $ cat >stubs_exe.ml < external stub_byte_or_native : unit -> int = "caml_b_or_n" + > let () = + > Printf.printf "Byte (0) or native (1) ? %i\n" (stub_byte_or_native ()) + > EOF + + +We can have one stub that is mode-dependent: + $ cat >dune < (executable + > (modes native byte_complete) + > (modules stubs_exe) + > (name stubs_exe) + > (foreign_stubs + > (mode native) + > (language c) + > (flags :standard -DNATIVE_CODE) + > (names c_stubs)) + > (foreign_stubs + > (mode byte) + > (language c) + > (flags :standard) + > (names c_stubs))) + > EOF + + $ dune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + + $ dune exec ./stubs_exe.bc.exe + Byte (0) or native (1) ? 0 + +If one of the two is not specified, it will be used for both byte and native mode +and then a duplicated symbol error will happen + $ cat >dune < (executable + > (modes native byte_complete) + > (modules stubs_exe) + > (name stubs_exe) + > (foreign_stubs + > (language c) + > (flags :standard -DNATIVE_CODE) + > (names c_stubs)) + > (foreign_stubs + > (mode byte) + > (language c) + > (flags :standard) + > (names c_stubs))) + > EOF + + $ dune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + +FIXME: we could detect this earlier and display a better error message + $ dune exec ./stubs_exe.bc.exe 2>&1 | grep -q 'duplicate symbol\|multiple definition' + +But two foreign stubs for the same file and mode is an error: + $ cat >dune < (executable + > (modes native byte_complete) + > (modules stubs_exe) + > (name stubs_exe) + > (foreign_stubs + > (mode byte) + > (language c) + > (flags :standard -DNATIVE_CODE) + > (names c_stubs)) + > (foreign_stubs + > (mode byte) + > (language c) + > (flags :standard) + > (names c_stubs))) + > EOF + + $ dune exec ./stubs_exe.exe + File "dune", line 9, characters 9-16: + 9 | (names c_stubs)) + ^^^^^^^ + Error: Multiple sources map to the same object name "c_stubs" for mode byte: + - c_stubs.c + - c_stubs.c + This is not allowed; please rename them or remove "c_stubs" from object + names. + Hint: You may be missing a mode field that would restrict this stub to some + specific mode. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. + [1] + + $ dune exec ./stubs_exe.bc.exe + File "dune", line 9, characters 9-16: + 9 | (names c_stubs)) + ^^^^^^^ + Error: Multiple sources map to the same object name "c_stubs" for mode byte: + - c_stubs.c + - c_stubs.c + This is not allowed; please rename them or remove "c_stubs" from object + names. + Hint: You may be missing a mode field that would restrict this stub to some + specific mode. + Hint: You can also avoid the name clash by placing the objects into different + foreign archives and building them in different directories. Foreign archives + can be defined using the (foreign_library ...) stanza. + [1] + +We can have some mode-dependent stubs and some non-dependent other stubs + $ cat >dune < (executable + > (modes native byte_complete) + > (modules stubs_exe) + > (name stubs_exe) + > (foreign_stubs + > (language c) + > (flags :standard -DNATIVE_CODE) + > (names c_stubs2)) + > (foreign_stubs + > (mode native) + > (language c) + > (flags :standard -DNATIVE_CODE) + > (names c_stubs)) + > (foreign_stubs + > (mode byte) + > (language c) + > (flags :standard) + > (names c_stubs))) + > EOF + + $ cat >>stubs_exe.ml < external stub_byte_or_native2 : unit -> int = "caml_b_or_n2" + > let () = + > Printf.printf "Byte (0) or native (1) 2 ? %i\n" (stub_byte_or_native2 ()) + > EOF + + $ dune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + Byte (0) or native (1) 2 ? 42 + + $ dune exec ./stubs_exe.bc.exe + Byte (0) or native (1) ? 0 + Byte (0) or native (1) 2 ? 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/c_stubs.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/c_stubs.c new file mode 100644 index 000000000..acc273cf9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/c_stubs.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(1); +#else + return Val_int(0); +#endif +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune new file mode 100644 index 000000000..93f19f950 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune @@ -0,0 +1,20 @@ +(executable + (modes native byte_complete) + (modules stubs_exe) + (name stubs_exe) + (foreign_stubs + (mode native) + (language c) + (flags :standard -DNATIVE_CODE) + (names c_stubs)) + (foreign_stubs + (mode byte) + (language c) + (flags :standard) + (names c_stubs))) + +(executable + (modes native byte_complete) + (modules stubs_lib) + (name stubs_lib) + (libraries lib_with_md_stubs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune-project new file mode 100644 index 000000000..eaf11b9f9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(using mode_specific_stubs 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/c_stubs_lib.c b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/c_stubs_lib.c new file mode 100644 index 000000000..9439cb424 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/c_stubs_lib.c @@ -0,0 +1,10 @@ +#include "caml/mlvalues.h" + +value caml_b_or_n(value unit) +{ +#ifdef NATIVE_CODE + return Val_int(42); +#else + return Val_int(0); +#endif +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/dune new file mode 100644 index 000000000..f3aba8cf7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/dune @@ -0,0 +1,11 @@ +(library + (name lib_with_md_stubs) + (foreign_stubs + (language c) + (mode byte) + (names c_stubs_lib)) + (foreign_stubs + (language c) + (mode native) + (flags :standard -DNATIVE_CODE) + (names c_stubs_lib))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/lib_with_md_stubs.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/lib_with_md_stubs.ml new file mode 100644 index 000000000..df32d06b1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/lib/lib_with_md_stubs.ml @@ -0,0 +1 @@ +external stub_byte_or_native : unit -> int = "caml_b_or_n" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/run.t new file mode 100644 index 000000000..4780e3dec --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/run.t @@ -0,0 +1,11 @@ + $ dune exec ./stubs_exe.exe + Byte (0) or native (1) ? 1 + + $ dune exec ./stubs_exe.bc.exe + Byte (0) or native (1) ? 0 + + $ dune exec ./stubs_lib.exe + Byte (0) or native (1) ? 42 + + $ dune exec ./stubs_lib.bc.exe + Byte (0) or native (1) ? 0 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_exe.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_exe.ml new file mode 100644 index 000000000..62cebfddb --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_exe.ml @@ -0,0 +1,3 @@ +external stub_byte_or_native : unit -> int = "caml_b_or_n" + +let () = Printf.printf "Byte (0) or native (1) ? %i\n" (stub_byte_or_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_lib.ml new file mode 100644 index 000000000..d1e461dc3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/foreign-stubs/fs-mode-dependent/fsmd-simple.t/stubs_lib.ml @@ -0,0 +1 @@ +let () = Printf.printf "Byte (0) or native (1) ? %i\n" (Lib_with_md_stubs.stub_byte_or_native ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/run.t deleted file mode 100644 index 0122a1870..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/run.t +++ /dev/null @@ -1,143 +0,0 @@ -stubs and js files installed - - $ dune build --root stubs | dune_cmd sanitize - Entering directory 'stubs' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/cfoo.h" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/foo$ext_lib" - "_build/install/default/lib/foo/foo.cma" - "_build/install/default/lib/foo/foo.cmi" - "_build/install/default/lib/foo/foo.cmt" - "_build/install/default/lib/foo/foo.cmx" - "_build/install/default/lib/foo/foo.cmxa" - "_build/install/default/lib/foo/foo.js" - "_build/install/default/lib/foo/foo.ml" - "_build/install/default/lib/foo/libfoo_stubs$ext_lib" - "_build/install/default/lib/foo/opam" - ] - libexec: [ - "_build/install/default/lib/foo/foo.cmxs" - ] - stublibs: [ - "_build/install/default/lib/stublibs/dllfoo_stubs$ext_dll" - ] - -install stanza is respected - - $ dune build --root install-stanza - Entering directory 'install-stanza' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/opam" - ] - share: [ - "_build/install/default/share/foo/foobar" - "_build/install/default/share/foo/share1" - ] - -public exes are installed - - $ dune build --root exe - Entering directory 'exe' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/opam" - ] - bin: [ - "_build/install/default/bin/bar" - ] - -mld files are installed - - $ dune build --root mld - Entering directory 'mld' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/opam" - ] - doc: [ - "_build/install/default/doc/foo/odoc-pages/doc.mld" {"odoc-pages/doc.mld"} - ] - -unwrapped libraries have the correct artifacts - - $ dune build --root lib-unwrapped | dune_cmd sanitize - Entering directory 'lib-unwrapped' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/foo$ext_lib" - "_build/install/default/lib/foo/foo.cma" - "_build/install/default/lib/foo/foo.cmi" - "_build/install/default/lib/foo/foo.cmt" - "_build/install/default/lib/foo/foo.cmti" - "_build/install/default/lib/foo/foo.cmx" - "_build/install/default/lib/foo/foo.cmxa" - "_build/install/default/lib/foo/foo.ml" - "_build/install/default/lib/foo/foo.mli" - "_build/install/default/lib/foo/opam" - ] - libexec: [ - "_build/install/default/lib/foo/foo.cmxs" - ] - -wrapped lib with lib interface module - - $ dune build --root lib-wrapped-alias | dune_cmd sanitize - Entering directory 'lib-wrapped-alias' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/bar.ml" - "_build/install/default/lib/foo/bar.mli" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/foo$ext_lib" - "_build/install/default/lib/foo/foo.cma" - "_build/install/default/lib/foo/foo.cmi" - "_build/install/default/lib/foo/foo.cmt" - "_build/install/default/lib/foo/foo.cmx" - "_build/install/default/lib/foo/foo.cmxa" - "_build/install/default/lib/foo/foo.ml" - "_build/install/default/lib/foo/foo__.cmi" - "_build/install/default/lib/foo/foo__.cmt" - "_build/install/default/lib/foo/foo__.cmx" - "_build/install/default/lib/foo/foo__.ml" - "_build/install/default/lib/foo/foo__Bar.cmi" - "_build/install/default/lib/foo/foo__Bar.cmt" - "_build/install/default/lib/foo/foo__Bar.cmti" - "_build/install/default/lib/foo/foo__Bar.cmx" - "_build/install/default/lib/foo/opam" - ] - libexec: [ - "_build/install/default/lib/foo/foo.cmxs" - ] - -wrapped lib without lib interface module - - $ dune build --root lib-wrapped-no-alias | dune_cmd sanitize - Entering directory 'lib-wrapped-no-alias' - lib: [ - "_build/install/default/lib/foo/META" - "_build/install/default/lib/foo/bar.ml" - "_build/install/default/lib/foo/bar.mli" - "_build/install/default/lib/foo/dune-package" - "_build/install/default/lib/foo/foo$ext_lib" - "_build/install/default/lib/foo/foo.cma" - "_build/install/default/lib/foo/foo.cmi" - "_build/install/default/lib/foo/foo.cmt" - "_build/install/default/lib/foo/foo.cmx" - "_build/install/default/lib/foo/foo.cmxa" - "_build/install/default/lib/foo/foo.ml" - "_build/install/default/lib/foo/foo__Bar.cmi" - "_build/install/default/lib/foo/foo__Bar.cmt" - "_build/install/default/lib/foo/foo__Bar.cmti" - "_build/install/default/lib/foo/foo__Bar.cmx" - "_build/install/default/lib/foo/opam" - ] - libexec: [ - "_build/install/default/lib/foo/foo.cmxs" - ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/byte-only/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/share2 b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/foo_byte.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/share2 rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/foo_byte.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/run.t new file mode 100644 index 000000000..860423a4f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/byte-only.t/run.t @@ -0,0 +1,12 @@ +byte code only library + + $ dune build + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/byte/foo_byte.cma" {"byte/foo_byte.cma"} + "_build/install/default/lib/foo/byte/foo_byte.cmi" {"byte/foo_byte.cmi"} + "_build/install/default/lib/foo/byte/foo_byte.cmt" {"byte/foo_byte.cmt"} + "_build/install/default/lib/foo/byte/foo_byte.ml" {"byte/foo_byte.ml"} + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/opam" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/exe/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/run.t new file mode 100644 index 000000000..32b752aad --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/exe.t/run.t @@ -0,0 +1,11 @@ +public exes are installed + + $ dune build + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/opam" + ] + bin: [ + "_build/install/default/bin/bar" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/install-stanza/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/run.t new file mode 100644 index 000000000..7650c95ec --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/run.t @@ -0,0 +1,12 @@ +install stanza is respected + + $ dune build + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/opam" + ] + share: [ + "_build/install/default/share/foo/foobar" + "_build/install/default/share/foo/share1" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.mli b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/share1 similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/foo.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/share1 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/bar.mli b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/share2 similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/bar.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/install-stanza.t/share2 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-unwrapped/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exe/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exe/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/bar.mli b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/bar.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/run.t new file mode 100644 index 000000000..632d8a974 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-unwrapped.t/run.t @@ -0,0 +1,20 @@ +unwrapped libraries have the correct artifacts + + $ dune build | dune_cmd sanitize + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/foo$ext_lib" + "_build/install/default/lib/foo/foo.cma" + "_build/install/default/lib/foo/foo.cmi" + "_build/install/default/lib/foo/foo.cmt" + "_build/install/default/lib/foo/foo.cmti" + "_build/install/default/lib/foo/foo.cmx" + "_build/install/default/lib/foo/foo.cmxa" + "_build/install/default/lib/foo/foo.ml" + "_build/install/default/lib/foo/foo.mli" + "_build/install/default/lib/foo/opam" + ] + libexec: [ + "_build/install/default/lib/foo/foo.cmxs" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/doc.mld b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/bar.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/doc.mld rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/bar.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-alias/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/run.t new file mode 100644 index 000000000..fd1c74a3c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-alias.t/run.t @@ -0,0 +1,28 @@ +wrapped lib with lib interface module + + $ dune build | dune_cmd sanitize + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/bar.ml" + "_build/install/default/lib/foo/bar.mli" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/foo$ext_lib" + "_build/install/default/lib/foo/foo.cma" + "_build/install/default/lib/foo/foo.cmi" + "_build/install/default/lib/foo/foo.cmt" + "_build/install/default/lib/foo/foo.cmx" + "_build/install/default/lib/foo/foo.cmxa" + "_build/install/default/lib/foo/foo.ml" + "_build/install/default/lib/foo/foo__.cmi" + "_build/install/default/lib/foo/foo__.cmt" + "_build/install/default/lib/foo/foo__.cmx" + "_build/install/default/lib/foo/foo__.ml" + "_build/install/default/lib/foo/foo__Bar.cmi" + "_build/install/default/lib/foo/foo__Bar.cmt" + "_build/install/default/lib/foo/foo__Bar.cmti" + "_build/install/default/lib/foo/foo__Bar.cmx" + "_build/install/default/lib/foo/opam" + ] + libexec: [ + "_build/install/default/lib/foo/foo.cmxs" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/cfoo.h b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/bar.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/cfoo.h rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/bar.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/lib-wrapped-no-alias/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/run.t new file mode 100644 index 000000000..8d38ed115 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/lib-wrapped-no-alias.t/run.t @@ -0,0 +1,24 @@ +wrapped lib without lib interface module + + $ dune build | dune_cmd sanitize + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/bar.ml" + "_build/install/default/lib/foo/bar.mli" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/foo$ext_lib" + "_build/install/default/lib/foo/foo.cma" + "_build/install/default/lib/foo/foo.cmi" + "_build/install/default/lib/foo/foo.cmt" + "_build/install/default/lib/foo/foo.cmx" + "_build/install/default/lib/foo/foo.cmxa" + "_build/install/default/lib/foo/foo.ml" + "_build/install/default/lib/foo/foo__Bar.cmi" + "_build/install/default/lib/foo/foo__Bar.cmt" + "_build/install/default/lib/foo/foo__Bar.cmti" + "_build/install/default/lib/foo/foo__Bar.cmx" + "_build/install/default/lib/foo/opam" + ] + libexec: [ + "_build/install/default/lib/foo/foo.cmxs" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/foo.js b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/doc.mld similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/foo.js rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/doc.mld diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/mld/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/run.t new file mode 100644 index 000000000..32df0f1bc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/mld.t/run.t @@ -0,0 +1,11 @@ +mld files are installed + + $ dune build + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/opam" + ] + doc: [ + "_build/install/default/doc/foo/odoc-pages/doc.mld" {"odoc-pages/doc.mld"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/ppx-new/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/ppx-new/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/ppx-new/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/ppx-new/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/ppx-new/foo_ppx_rewriter_dune.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/ppx-new/foo_ppx_rewriter_dune.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/ppx/ppx-new/foo_ppx_rewriter_dune.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/ppx-new/foo_ppx_rewriter_dune.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/run.t new file mode 100644 index 000000000..0f57950d5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/ppx.t/run.t @@ -0,0 +1,18 @@ +ppx artifacts + $ dune build + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/opam" + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.a" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.a"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cma" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cma"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cmi" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cmi"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cmt" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cmt"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cmx" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cmx"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cmxa" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cmxa"} + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.ml" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.ml"} + ] + libexec: [ + "_build/install/default/lib/foo/ppx_rewriter_dune/foo_ppx_rewriter_dune.cmxs" {"ppx_rewriter_dune/foo_ppx_rewriter_dune.cmxs"} + "_build/install/default/lib/foo/ppx_rewriter_dune/ppx.exe" {"ppx_rewriter_dune/ppx.exe"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/c.c b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/c.c similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/c.c rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/c.c diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/no_dir b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/cfoo.h similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/no_dir rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/cfoo.h diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/cpp.cpp b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/cpp.cpp similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/cpp.cpp rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/cpp.cpp diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/dune b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file.t/stubs/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/private.ml b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/foo.js similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/private.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/foo.js diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/run.t new file mode 100644 index 000000000..6a8b99920 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/gen-opam-install-file/stubs.t/run.t @@ -0,0 +1,25 @@ +stubs and js files installed + + $ dune build | dune_cmd sanitize + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/cfoo.h" + "_build/install/default/lib/foo/dune-package" + "_build/install/default/lib/foo/foo$ext_lib" + "_build/install/default/lib/foo/foo.cma" + "_build/install/default/lib/foo/foo.cmi" + "_build/install/default/lib/foo/foo.cmt" + "_build/install/default/lib/foo/foo.cmx" + "_build/install/default/lib/foo/foo.cmxa" + "_build/install/default/lib/foo/foo.js" + "_build/install/default/lib/foo/foo.ml" + "_build/install/default/lib/foo/libfoo_stubs$ext_lib" + "_build/install/default/lib/foo/opam" + ] + libexec: [ + "_build/install/default/lib/foo/foo.cmxs" + ] + stublibs: [ + "_build/install/default/lib/stublibs/dllfoo_stubs$ext_dll" + ] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/generate-sources.t b/duniverse/dune_/test/blackbox-tests/test-cases/generate-sources.t index 4bb7bb369..42c14200d 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/generate-sources.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/generate-sources.t @@ -2,19 +2,20 @@ Generate the source of an executable in a subdir: $ cat >dune-project < (lang dune 3.2) + > (using directory-targets 0.1) > EOF $ cat >dune < (rule - > (with-stdout-to foo/bar.ml (echo "let foo = 42;;"))) + > (targets (dir foo)) + > (action (bash "mkdir foo && cat 'print_endline \"42\";;' > foo/bar.ml"))) > (include_subdirs unqualified) > (executable (name bar)) > EOF - $ dune exec --display short ./bar.exe - ocamlc .bar.eobjs/byte/dune__exe__Bar.{cmi,cmti} - File "dune", line 4, characters 0-23: - 4 | (executable (name bar)) - ^^^^^^^^^^^^^^^^^^^^^^^ - Error: No rule found for bar.ml + $ dune exec ./bar.exe + File "dune", line 5, characters 18-21: + 5 | (executable (name bar)) + ^^^ + Error: Module "Bar" doesn't exist. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/run.t deleted file mode 100644 index 9c0074b24..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/run.t +++ /dev/null @@ -1,19 +0,0 @@ -If the source directory does not exist, an error message is printed: - - $ dune build --root no-dir demo.exe - Entering directory 'no-dir' - File "dune", line 1, characters 13-23: - 1 | (copy_files# "no_dir/*") - ^^^^^^^^^^ - Error: Cannot find directory: no_dir - [1] - -This works also is a file exists with the same name: - - $ dune build --root file-with-same-name demo.exe - Entering directory 'file-with-same-name' - File "dune", line 1, characters 13-23: - 1 | (copy_files# "no_dir/*") - ^^^^^^^^^^ - Error: Cannot find directory: no_dir - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/demo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/demo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/demo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/demo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/dune b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/file-with-same-name/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/baz.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/no_dir similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/baz.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/no_dir diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/run.t new file mode 100644 index 000000000..1953be413 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/file-with-same-name.t/run.t @@ -0,0 +1,8 @@ +This works also is a file exists with the same name: + + $ dune build demo.exe + File "dune", line 1, characters 13-23: + 1 | (copy_files# "no_dir/*") + ^^^^^^^^^^ + Error: Cannot find directory: no_dir + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/demo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/demo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/demo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/demo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github1099.t/no-dir/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/run.t new file mode 100644 index 000000000..bda0bc490 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github1099/no-dir.t/run.t @@ -0,0 +1,8 @@ +If the source directory does not exist, an error message is printed: + + $ dune build demo.exe + File "dune", line 1, characters 13-23: + 1 | (copy_files# "no_dir/*") + ^^^^^^^^^^ + Error: Cannot find directory: no_dir + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github1645.t b/duniverse/dune_/test/blackbox-tests/test-cases/github1645.t new file mode 100644 index 000000000..5654c1992 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github1645.t @@ -0,0 +1,43 @@ +We create two libraries `l.one` and `l.two` with a conflicting module. +They build fine, are not co-linkable, but documentation should be able to be +built. See #1645. + + $ cat > dune-project << EOF + > (lang dune 1.0) + > (package (name l)) + > EOF + + $ mkdir one + $ cat > one/dune << EOF + > (library + > (name l_one) + > (public_name l.one) + > (wrapped false)) + > EOF + $ touch one/module.ml + + $ mkdir two + $ cat > two/dune << EOF + > (library + > (name l_two) + > (public_name l.two) + > (wrapped false)) + > EOF + $ touch two/module.ml + + $ dune build @install + $ dune build @doc + Error: Multiple rules generated for + _build/default/_doc/_html/l/Module/.dummy: + - + - + -> required by alias _doc/_html/l/doc + -> required by alias doc + Error: Multiple rules generated for + _build/default/_doc/_odocls/l/module.odocl: + - + - + -> required by _build/default/_doc/_html/l/index.html + -> required by alias _doc/_html/l/doc + -> required by alias doc + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github3046.t b/duniverse/dune_/test/blackbox-tests/test-cases/github3046.t index 6fe7849a1..cfb9536e1 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/github3046.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github3046.t @@ -7,29 +7,28 @@ are given as parameters `dune init exe main --libs="str gsl"` returns an informative parsing error $ dune init exe main --libs="str gsl" - dune init: option `--libs': invalid element in list (`str gsl'): expected a - valid dune atom - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--libs': invalid element in list ('str gsl'): expected a valid + dune atom + Usage: dune init executable [OPTION]… NAME [PATH] + Try 'dune init executable --help' or 'dune --help' for more information. [1] `dune init lib foo --ppx="foo bar"` returns an informative parsing error $ dune init lib foo --ppx="foo bar" - dune init: option `--ppx': invalid element in list (`foo bar'): expected a - valid dune atom - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--ppx': invalid element in list ('foo bar'): expected a valid + dune atom + Usage: dune init library [OPTION]… NAME [PATH] + Try 'dune init library --help' or 'dune --help' for more information. [1] `dune init lib foo --public="some/invalid&name!"` returns an informative parsing error $ dune init lib foo --public="some/invalid&name!" - dune init: option `--public': invalid component name - `some/invalid&name!' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--public': invalid component name `some/invalid&name!' + Library names must be non-empty and composed only of the + following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Usage: dune init library [OPTION]… NAME [PATH] + Try 'dune init library --help' or 'dune --help' for more information. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github3530.t b/duniverse/dune_/test/blackbox-tests/test-cases/github3530.t index 4aa6157a4..6583ab892 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/github3530.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github3530.t @@ -2,15 +2,15 @@ When an empty string is passed to `-p`, we get a nice error message. $ echo '(lang dune 2.0)' > dune-project $ dune build -p '' - dune build: option `--only-packages': Invalid package name: "" - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--only-packages': Invalid package name: "" + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] This can happen in a list as well: $ dune build -p 'a,b,' - dune build: option `--only-packages': Invalid package name: "" - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--only-packages': Invalid package name: "" + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github4345.t b/duniverse/dune_/test/blackbox-tests/test-cases/github4345.t new file mode 100644 index 000000000..ac93353a7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github4345.t @@ -0,0 +1,15 @@ +This is a reproduction case from issue #4345. +This was a bug where using (copy_files ...) to depend on files from a parent +directory would cause in internal error in dune due to a dependency cycle. The +bug is now fixed, so this project should build without error. + + $ DIR="gh4345" + $ mkdir $DIR && cd $DIR + $ echo "(lang dune 2.8)" > dune-project + $ mkdir lib + $ touch lib.opam file lib/lib.ml + $ cat >lib/dune < (library (name lib) (public_name lib)) + > (copy_files (files ../file)) + > EOF + $ dune build --root . diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github4401.t b/duniverse/dune_/test/blackbox-tests/test-cases/github4401.t index 80a49e293..f22327270 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/github4401.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github4401.t @@ -2,7 +2,7 @@ When --ignore-promoted-rules is passed, rules marked `(promote (until-clean))` are ignored. See #4401. $ cat > dune-project << EOF - > (lang dune 3.0) + > (lang dune 3.4) > EOF $ echo foobar > reference @@ -21,3 +21,12 @@ are ignored. See #4401. Error: No rule found for test -> required by alias runtest in dune:5 [1] + +This is correctly ignored if `dune-lang` is bumped to 3.5. + + $ cat > dune-project << EOF + > (lang dune 3.5) + > EOF + + $ dune clean + $ dune runtest --ignore-promoted-rules diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github5528.t b/duniverse/dune_/test/blackbox-tests/test-cases/github5528.t new file mode 100644 index 000000000..0b7eb8f30 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github5528.t @@ -0,0 +1,37 @@ + $ cat > dune-project < (lang dune 1.0) + > EOF + + $ cat > dune < (test + > (name t)) + > EOF + + $ cat > t.ml < type color = Normal | Cyan + > + > let int_of_color = function + > | Normal -> 0 + > | Cyan -> 6 + > + > let in_color c pp out x = + > let n = int_of_color c in + > Printf.fprintf out "\x1b[3%dm" n; + > pp out x; + > Printf.fprintf out "\x1b[0m" + > + > let reset_line = "\x1b[2K\r" + > + > let () = + > Printf.printf "%sVery Secret!\n%!" reset_line; + > Printf.printf "%s\n%!" (String.make 15 '-'); + > Printf.printf "%a\n%!" (in_color Cyan output_string) "Can you see it?" + > EOF + + $ dune runtest -f + Very Secret! + --------------- + Can you see it? + + $ dune exec ./t.exe + Can you see it? diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github5787.t b/duniverse/dune_/test/blackbox-tests/test-cases/github5787.t new file mode 100644 index 000000000..eaee91e3a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github5787.t @@ -0,0 +1,53 @@ +When (name) points to a module that is not part of (modules), a specific error +message is printed. + + $ cat > dune-project << EOF + > (lang dune 3.0) + > EOF + + $ touch a.ml b.ml + + $ cat > dune << EOF + > (executable + > (name a) + > (modules b)) + > EOF + + $ dune build + File "dune", line 2, characters 7-8: + 2 | (name a) + ^ + Error: The name "A" is not listed in the (modules) field of this stanza. + [1] + +This does not happen when (modules) is implicit. + + $ rm a.ml b.ml + + $ cat > dune << EOF + > (executable + > (name a)) + > EOF + + $ dune build + File "dune", line 2, characters 7-8: + 2 | (name a)) + ^ + Error: Module "A" doesn't exist. + [1] + +When the module is listed but the file does not exist, we get the "normal" +message. + + $ cat > dune << EOF + > (executable + > (name a) + > (modules a)) + > EOF + + $ dune build + File "dune", line 3, characters 10-11: + 3 | (modules a)) + ^ + Error: Module A doesn't exist. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/run.t deleted file mode 100644 index 81ce3c36b..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/run.t +++ /dev/null @@ -1,23 +0,0 @@ - $ echo 'let hello = "hello"' > explicit-interfaces/lib_sub.ml - $ echo 'let hello = "hello"' > no-interfaces/lib_sub.ml - -When there are explicit interfaces, modules must be rebuilt. - - $ dune runtest --root explicit-interfaces - Entering directory 'explicit-interfaces' - hello - $ echo 'let _x = 1' >> explicit-interfaces/lib_sub.ml - $ dune runtest --root explicit-interfaces - Entering directory 'explicit-interfaces' - hello - -When there are no interfaces, the situation is the same, but it is not possible -to rely on these. - - $ dune runtest --root no-interfaces - Entering directory 'no-interfaces' - hello - $ echo 'let _x = 1' >> no-interfaces/lib_sub.ml - $ dune runtest --root no-interfaces - Entering directory 'no-interfaces' - hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/dune b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib.mli b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib_sub.mli b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib_sub.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/lib_sub.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/lib_sub.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/main.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/main.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/explicit-interfaces/main.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/main.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/run.t new file mode 100644 index 000000000..2fc4cff44 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github660/explicit-interfaces.t/run.t @@ -0,0 +1,8 @@ +When there are explicit interfaces, modules must be rebuilt. + $ echo 'let hello = "hello"' > lib_sub.ml + + $ dune runtest + hello + $ echo 'let _x = 1' >> lib_sub.ml + $ dune runtest + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/dune b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/lib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/lib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/lib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/main.ml b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/main.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/github660.t/no-interfaces/main.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/main.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/run.t new file mode 100644 index 000000000..8843bfa95 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/github660/no-interfaces.t/run.t @@ -0,0 +1,10 @@ +When there are no interfaces, the situation is the same, but it +is not possible to rely on these. + + $ echo 'let hello = "hello"' > lib_sub.ml + + $ dune runtest + hello + $ echo 'let _x = 1' >> lib_sub.ml + $ dune runtest + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/glob-deps-outside-directory.t b/duniverse/dune_/test/blackbox-tests/test-cases/glob-deps-outside-directory.t new file mode 100644 index 000000000..865e5ed06 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/glob-deps-outside-directory.t @@ -0,0 +1,20 @@ +Glob deps in a subdirectory that refer to a path outside that subdirectory + + $ cat > dune-project < (lang dune 3.6) + > EOF + + $ mkdir -p foo bar + + $ cat > foo/dune < (rule + > (alias x) + > (deps (glob_files ../bar/*.txt)) + > (action (system "for i in %{deps}; do printf \"\$i\\n\"; done"))) + > EOF + + $ touch bar/a.txt bar/b.txt + + $ dune build @foo/x + ../bar/a.txt + ../bar/b.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/glob_files_rec.t b/duniverse/dune_/test/blackbox-tests/test-cases/glob_files_rec.t index f7e5f9cb8..3e51a6ef5 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/glob_files_rec.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/glob_files_rec.t @@ -82,3 +82,24 @@ Check that generated directories are ignored $ dune build @x +Check that we get a nice error message if we pass and absolute path to `glob_files_rec` +--------------------------------------------------------------------------------------- + +Put $PWD in a file that can be read with the %{read:...} pform, so the underline +in the error message is of consistent length on different systems. + $ printf $PWD > pwd + + $ cat > dune < (rule + > (alias x) + > (deps (glob_files_rec %{read:pwd}/*)) + > (action (echo %{deps}))) + > EOF + + $ dune build @x + File "dune", line 3, characters 23-36: + 3 | (deps (glob_files_rec %{read:pwd}/*)) + ^^^^^^^^^^^^^ + Error: Absolute paths in recursive globs are not supported. + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/run.t deleted file mode 100644 index 3ff9bb834..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/run.t +++ /dev/null @@ -1,12 +0,0 @@ - $ dune build --root pre-1.6 data/dune - Entering directory 'pre-1.6' - $ dune build --root pre-1.6 @all - Entering directory 'pre-1.6' - $ dune build --root 1.6 @runtest - Entering directory '1.6' - real dir - $ dune build --root glob @runtest - Entering directory 'glob' - real dir - $ dune build --root logical @runtest - Entering directory 'logical' diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/garbage1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/garbage1/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/garbage1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/garbage1/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/garbage2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/garbage2/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/garbage2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/garbage2/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/real/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/real/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/1.6/real/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/real/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/run.t new file mode 100644 index 000000000..808000fa2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/1.6.t/run.t @@ -0,0 +1,2 @@ + $ dune build @runtest + real dir diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/garbage1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/garbage1/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/garbage1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/garbage1/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/garbage2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/garbage2/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/garbage2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/garbage2/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/real/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/real/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/glob/real/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/real/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/run.t new file mode 100644 index 000000000..808000fa2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/glob.t/run.t @@ -0,0 +1,2 @@ + $ dune build @runtest + real dir diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/blarg/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/blarg/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/blarg/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/blarg/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/logical/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/run.t new file mode 100644 index 000000000..5684d6463 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/logical.t/run.t @@ -0,0 +1 @@ + $ dune build @runtest diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/data/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/data/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/data/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/data/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/garbage/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/garbage/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs.t/pre-1.6/garbage/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/garbage/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/run.t new file mode 100644 index 000000000..cbab4fdf0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ignored_subdirs/pre-1.6.t/run.t @@ -0,0 +1,2 @@ + $ dune build data/dune + $ dune build @all diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-chain.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-chain.t new file mode 100644 index 000000000..4b4e6faa3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-chain.t @@ -0,0 +1,29 @@ +---------------------------------------------------------------------------------- +Include a file with an `(include ...)` statement, which iteslf contains an +`(include ...`) statement. + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (library + > (name foo) + > (foreign_stubs + > (language c) + > (names bar) + > (include_dirs (include foo)))) + > EOF + + $ cat >bar.c < #include + > #include + > #include + > value bar(value unit) { return Val_int(A + B); } + > EOF + + $ mkdir -p inc_a inc_b + $ echo "#define A 40" > inc_a/a.h + $ echo "#define B 2" > inc_b/b.h + $ echo "((include baz))" > foo + $ echo "(inc_a inc_b)" > baz + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-lib.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-lib.t new file mode 100644 index 000000000..eeff9a411 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-lib.t @@ -0,0 +1,36 @@ +---------------------------------------------------------------------------------- +Test use of `(lib ...)` statements inside a file included with `(include ...)` + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (library + > (name foo) + > (foreign_stubs + > (language c) + > (names bar) + > (include_dirs (include foo)))) + > EOF + + $ echo "(inc_a inc_b (lib lib_a))" > foo + + $ mkdir -p inc_a inc_b + $ echo "#define A 40" > inc_a/a.h + $ echo "#define B 2" > inc_b/b.h + + $ mkdir -p lib_a + $ cat >lib_a/dune < (library (name lib_a)) + > EOF + + $ echo "#define C 2" > lib_a/c.h + + $ cat >bar.c < #include + > #include + > #include + > #include + > value bar(value unit) { return Val_int(A + B + C); } + > EOF + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-loop.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-loop.t new file mode 100644 index 000000000..c0e5d4497 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/include-dir-include-loop.t @@ -0,0 +1,30 @@ +---------------------------------------------------------------------------------- +Detect loops of `(include ...)` statements + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (library + > (name foo) + > (foreign_stubs + > (language c) + > (names bar) + > (include_dirs (include foo)))) + > EOF + + $ cat >bar.c < #include + > #include + > #include + > value bar(value unit) { return Val_int(A + B); } + > EOF + + $ echo "((include baz))" > foo + $ echo "((include foo))" > baz + + $ dune build + File "_build/default/baz", line 1, characters 10-13: + 1 | ((include foo)) + ^^^ + Error: Include loop detected via: _build/default/foo + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/multiple-include-dirs.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/multiple-include-dirs.t new file mode 100644 index 000000000..d0acdac0d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/multiple-include-dirs.t @@ -0,0 +1,28 @@ +---------------------------------------------------------------------------------- +Test where a multiple include directories are added via a `(include ...)` statement + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >dune < (library + > (name foo) + > (foreign_stubs + > (language c) + > (names bar) + > (include_dirs (include foo)))) + > EOF + + $ cat >bar.c < #include + > #include + > #include + > value bar(value unit) { return Val_int(A + B); } + > EOF + + $ mkdir -p inc_a inc_b + $ echo "#define A 40" > inc_a/a.h + $ echo "#define B 2" > inc_b/b.h + $ echo "(inc_a inc_b)" > foo + + $ dune build + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/single-include-dir.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/single-include-dir.t new file mode 100644 index 000000000..9aad447f9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-dirs-include/single-include-dir.t @@ -0,0 +1,50 @@ +---------------------------------------------------------------------------------- +Test where a single include directory is added via a `(include ...)` statement + +---------------------------------------------------------------------------------- +* Versions of dune before 3.5 do not support this feature + + $ echo "(lang dune 3.4)" > dune-project + $ cat >dune < (library + > (name foo) + > (foreign_stubs + > (language c) + > (names bar) + > (include_dirs (include foo)))) + > EOF + $ dune build + File "dune", line 6, characters 16-29: + 6 | (include_dirs (include foo)))) + ^^^^^^^^^^^^^ + Error: 'include' is only available since version 3.5 of the dune language. + Please update your dune-project file to have (lang dune 3.5). + [1] + +---------------------------------------------------------------------------------- +* Error if include file is missing + + $ echo "(lang dune 3.5)" > dune-project + + $ cat >bar.c < #include + > #include + > value bar(value unit) { return Val_int(A); } + > EOF + + $ dune build + File "dune", line 5, characters 9-12: + 5 | (names bar) + ^^^ + Error: No rule found for foo + [1] + +---------------------------------------------------------------------------------- +* Simple example + + $ mkdir -p inc_a + $ echo "#define A 42" > inc_a/a.h + $ echo inc_a > foo + + $ dune build + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune-project deleted file mode 100644 index ec8c49b51..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.9) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/exe/dune deleted file mode 100644 index 8f043f1c6..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/exe/dune +++ /dev/null @@ -1 +0,0 @@ -(executable (name test)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune-project deleted file mode 100644 index ec8c49b51..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.9) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/dune-project deleted file mode 100644 index ec8c49b51..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.9) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/dune-project deleted file mode 100644 index ec8c49b51..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.9) \ No newline at end of file diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/run.t deleted file mode 100644 index 5c0faf195..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/run.t +++ /dev/null @@ -1,44 +0,0 @@ -Basic test showcasing the feature. Every directory creates a new level of aliasing. - $ dune build --root basic - Entering directory 'basic' - File "lib/dune", line 1, characters 17-26: - 1 | (include_subdirs qualified) - ^^^^^^^^^ - Error: Unknown value qualified - Hint: did you mean unqualified? - [1] - -We are also allowed to write lib interface files at each level. - $ dune build --root nested-lib-interface - Entering directory 'nested-lib-interface' - File "lib/dune", line 1, characters 17-26: - 1 | (include_subdirs qualified) - ^^^^^^^^^ - Error: Unknown value qualified - Hint: did you mean unqualified? - [1] - -We can nested modules virtual - $ dune build @all --root nested-virtual - Entering directory 'nested-virtual' - File "impl/dune", line 1, characters 17-26: - 1 | (include_subdirs qualified) - ^^^^^^^^^ - Error: Unknown value qualified - Hint: did you mean unqualified? - File "vlib/dune", line 1, characters 17-26: - 1 | (include_subdirs qualified) - ^^^^^^^^^ - Error: Unknown value qualified - Hint: did you mean unqualified? - [1] - -We can set preprocessing options for nested modules - $ dune build @all --root pp - Entering directory 'pp' - File "dune", line 1, characters 17-26: - 1 | (include_subdirs qualified) - ^^^^^^^^^ - Error: Unknown value qualified - Hint: did you mean unqualified? - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune similarity index 58% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune index 102832ebc..97c764e49 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune @@ -1,3 +1,3 @@ -(alias - (name default) +(rule + (alias default) (action (run ./exe/test.exe))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune-project new file mode 100644 index 000000000..1863cf146 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/exe/dune new file mode 100644 index 000000000..f4d3dee65 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/exe/dune @@ -0,0 +1,3 @@ +(executable + (name test) + (libraries foolib)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/exe/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/exe/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/exe/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/exe/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/foo/a/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/foo/a/b.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/foo/a/b.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/foo/a/b.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/foo/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/foo/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/basic/lib/foo/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/lib/foo/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/run.t new file mode 100644 index 000000000..cfc667daf --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/basic.t/run.t @@ -0,0 +1,8 @@ +Basic test showcasing the feature. Every directory creates a new level of aliasing. + $ dune build + File "lib/dune", line 1, characters 17-26: + 1 | (include_subdirs qualified) + ^^^^^^^^^ + Error: Unknown value qualified + Hint: did you mean unqualified? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune similarity index 58% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune index 102832ebc..97c764e49 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune @@ -1,3 +1,3 @@ -(alias - (name default) +(rule + (alias default) (action (run ./exe/test.exe))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune-project new file mode 100644 index 000000000..1863cf146 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/exe/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/exe/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/exe/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/exe/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/bar/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/bar/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/bar/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/bar/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/bar/baz.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/bar/baz.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/bar/baz.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/bar/baz.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/foolib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/foolib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-lib-interface/lib/foolib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/foolib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/private.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/lib/private.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/run.t new file mode 100644 index 000000000..bc6f4d790 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-lib-interface.t/run.t @@ -0,0 +1,8 @@ +We are also allowed to write lib interface files at each level. + $ dune build + File "lib/dune", line 1, characters 17-26: + 1 | (include_subdirs qualified) + ^^^^^^^^^ + Error: Unknown value qualified + Hint: did you mean unqualified? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/dune-project new file mode 100644 index 000000000..1863cf146 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/impl/bar/virt.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/impl/bar/virt.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/impl/bar/virt.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/impl/bar/virt.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/impl/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/impl/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/impl/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/impl/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/run.t new file mode 100644 index 000000000..8afc3a625 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/run.t @@ -0,0 +1,13 @@ +We can nested modules virtual + $ dune build @all + File "impl/dune", line 1, characters 17-26: + 1 | (include_subdirs qualified) + ^^^^^^^^^ + Error: Unknown value qualified + Hint: did you mean unqualified? + File "vlib/dune", line 1, characters 17-26: + 1 | (include_subdirs qualified) + ^^^^^^^^^ + Error: Unknown value qualified + Hint: did you mean unqualified? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/vlib/bar/virt.mli b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/vlib/bar/virt.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/vlib/bar/virt.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/vlib/bar/virt.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/vlib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/vlib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/nested-virtual/vlib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/nested-virtual.t/vlib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/bar/ppme.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/bar/ppme.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/bar/ppme.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/bar/ppme.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/dune b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/dune-project new file mode 100644 index 000000000..1863cf146 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/dune-project @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/foolib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/foolib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/include-qualified.t/pp/foolib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/foolib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/run.t new file mode 100644 index 000000000..dc4e4e2d1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/include-qualified/pp.t/run.t @@ -0,0 +1,8 @@ +We can set preprocessing options for nested modules + $ dune build @all + File "dune", line 1, characters 17-26: + 1 | (include_subdirs qualified) + ^^^^^^^^^ + Error: Unknown value qualified + Hint: did you mean unqualified? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/inline_tests-byte.t b/duniverse/dune_/test/blackbox-tests/test-cases/inline_tests-byte.t new file mode 100644 index 000000000..f9ba0991c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/inline_tests-byte.t @@ -0,0 +1,29 @@ +Test running inline tests in bytecode mode + +Reproduction case for #5515 + + $ cat >dune-project < (lang dune 2.9) + > EOF + + $ cat >dune < (library + > (name test) + > (modules test) + > (inline_tests (modes byte)) + > (preprocess (pps ppx_inline_test))) + > EOF + + $ cat >test.ml < let be = + > match Sys.backend_type with + > | Native -> "native" + > | Bytecode -> "byte" + > | Other s -> s + > let%test "test1" = + > print_endline be; + > true + > EOF + + $ dune test + byte diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-absolute-path-error.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-absolute-path-error.t new file mode 100644 index 000000000..08728204d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-absolute-path-error.t @@ -0,0 +1,41 @@ +Report an error when absolute paths appear in the install stanza + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + +Put $PWD in a file that can be read with the %{read:...} pform, so the underline +in the error message is of consistent length on different systems. + $ printf $PWD > pwd + + $ touch foo.txt + + $ cat >dune < (install + > (files %{read:pwd}/foo.txt) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 8-27: + 2 | (files %{read:pwd}/foo.txt) + ^^^^^^^^^^^^^^^^^^^ + Error: Absolute paths are not allowed in the install stanza. + [1] + + $ mkdir -p bar + $ touch bar/bar.txt + + $ cat >dune < (install + > (dirs %{read:pwd}/bar) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 7-22: + 2 | (dirs %{read:pwd}/bar) + ^^^^^^^^^^^^^^^ + Error: Absolute paths are not allowed in the install stanza. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-dir/install-libdir.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/install-dir/install-libdir.t/dune index f5dd8eda7..3f8e65481 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/install-dir/install-libdir.t/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-dir/install-libdir.t/dune @@ -1,9 +1,7 @@ (library (name foo) - (public_name foo) -) + (public_name foo)) (install (section man) - (files a-man-page.1 another-man-page.3 a-man-page-with-no-ext) -) + (files a-man-page.1 another-man-page.3 a-man-page-with-no-ext)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-absolute-path.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-absolute-path.t new file mode 100644 index 000000000..dd99489de --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-absolute-path.t @@ -0,0 +1,41 @@ +Globs with absolute paths result in an error + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + +Put $PWD in a file that can be read with the %{read:...} pform, so that the underline +in the error message is of consisntent length on different systems. + $ printf $PWD > pwd + + $ touch foo.txt bar.txt + +Absolute paths work in non-recursive globs, but are not permitted in the install stanza. + $ cat >dune < (install + > (files (glob_files %{read:pwd}/*.txt)) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 20-37: + 2 | (files (glob_files %{read:pwd}/*.txt)) + ^^^^^^^^^^^^^^^^^ + Error: Absolute paths are not allowed in the install stanza. + [1] + +Absolute paths are not supported in recursive globs. + $ cat >dune < (install + > (files (glob_files_rec %{read:pwd}/*.txt)) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 24-41: + 2 | (files (glob_files_rec %{read:pwd}/*.txt)) + ^^^^^^^^^^^^^^^^^ + Error: Absolute paths in recursive globs are not supported. + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-files-only.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-files-only.t new file mode 100644 index 000000000..94e16a386 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-files-only.t @@ -0,0 +1,33 @@ +Test that the `glob_files` terms are only accepted in the `files` field and not in +the `dirs` field + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + + $ cat >dune < (install + > (dirs (glob_files *)) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 7-21: + 2 | (dirs (glob_files *)) + ^^^^^^^^^^^^^^ + Error: Invalid format, or ( as ) expected + [1] + + $ cat >dune < (install + > (dirs (glob_files_rec *)) + > (section share)) + > EOF + + $ dune build @install + File "dune", line 2, characters 7-25: + 2 | (dirs (glob_files_rec *)) + ^^^^^^^^^^^^^^^^^^ + Error: Invalid format, or ( as ) expected + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-recursive.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-recursive.t new file mode 100644 index 000000000..cb895851d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-recursive.t @@ -0,0 +1,69 @@ +Test that `glob_files_rec` can recursively find files + + $ cat >dune-project < (lang dune 3.5) + > (package (name foo)) + > EOF + + $ cat >dune < (install + > (files (glob_files_rec b/*.txt)) + > (section share)) + > EOF + +Make a file outside of the "b" directory. This file should be skipped. + $ touch a.txt + +Create a hierarchy of files and directories which should be included. + $ mkdir b + $ touch b/b.txt + $ mkdir b/c + $ touch b/c/c.txt + +Make sure we don't crash on empty directories. + $ mkdir b/c/empty-dir + +Add some files which don't match the glob. + $ touch b/b + $ touch b/txt + $ mkdir b/d + $ touch b/d/d + + $ dune build + File "dune", line 2, characters 8-32: + 2 | (files (glob_files_rec b/*.txt)) + ^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'glob_files_rec' is only available since version 3.6 of the dune + language. Please update your dune-project file to have (lang dune 3.6). + [1] + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + + $ dune build + + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + ] + share: [ + "_build/install/default/share/foo/b/b.txt" {"b/b.txt"} + "_build/install/default/share/foo/b/c/c.txt" {"b/c/c.txt"} + ] + + $ find _build/install | sort + _build/install + _build/install/default + _build/install/default/lib + _build/install/default/lib/foo + _build/install/default/lib/foo/META + _build/install/default/lib/foo/dune-package + _build/install/default/share + _build/install/default/share/foo + _build/install/default/share/foo/b + _build/install/default/share/foo/b/b.txt + _build/install/default/share/foo/b/c + _build/install/default/share/foo/b/c/c.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-sub-dir.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-sub-dir.t new file mode 100644 index 000000000..2a37aef31 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-sub-dir.t @@ -0,0 +1,32 @@ +Make sure we can handle globs in dune files inside subdirectories + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + + $ mkdir -p sub-dir/x/y/z + + $ cat >sub-dir/dune < (install + > (files a.txt (glob_files_rec x/*.txt)) + > (section share)) + > EOF + + $ touch sub-dir/a.txt + $ touch sub-dir/b.txt + $ touch sub-dir/x/foo.txt + $ touch sub-dir/x/y/foo.txt + $ touch sub-dir/x/y/z/foo.txt + + $ dune build @sub-dir/all + + $ find _build/default/sub-dir | sort + _build/default/sub-dir + _build/default/sub-dir/a.txt + _build/default/sub-dir/x + _build/default/sub-dir/x/foo.txt + _build/default/sub-dir/x/y + _build/default/sub-dir/x/y/foo.txt + _build/default/sub-dir/x/y/z + _build/default/sub-dir/x/y/z/foo.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/README.md similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/README.md diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/a.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/about.html similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/a.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/about.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/c.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/1.html similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/c.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/1.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/2.html similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/2.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/foo.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/3.html similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/foo.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/content/posts/3.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune new file mode 100644 index 000000000..fde966e54 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune @@ -0,0 +1,5 @@ +(install + (files + (glob_files style/*.css) + (glob_files_rec content/*.html)) + (section share)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune-project new file mode 100644 index 000000000..4370ca7ac --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.6) +(package (name blog)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/run.t new file mode 100644 index 000000000..a31fd43b5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/run.t @@ -0,0 +1,36 @@ +Simple example of installing website files + + $ dune build @install + + $ cat _build/default/blog.install + lib: [ + "_build/install/default/lib/blog/META" + "_build/install/default/lib/blog/dune-package" + ] + share: [ + "_build/install/default/share/blog/content/about.html" {"content/about.html"} + "_build/install/default/share/blog/content/posts/1.html" {"content/posts/1.html"} + "_build/install/default/share/blog/content/posts/2.html" {"content/posts/2.html"} + "_build/install/default/share/blog/content/posts/3.html" {"content/posts/3.html"} + "_build/install/default/share/blog/style/bar.css" {"style/bar.css"} + "_build/install/default/share/blog/style/foo.css" {"style/foo.css"} + ] + + $ find _build/install | sort + _build/install + _build/install/default + _build/install/default/lib + _build/install/default/lib/blog + _build/install/default/lib/blog/META + _build/install/default/lib/blog/dune-package + _build/install/default/share + _build/install/default/share/blog + _build/install/default/share/blog/content + _build/install/default/share/blog/content/about.html + _build/install/default/share/blog/content/posts + _build/install/default/share/blog/content/posts/1.html + _build/install/default/share/blog/content/posts/2.html + _build/install/default/share/blog/content/posts/3.html + _build/install/default/share/blog/style + _build/install/default/share/blog/style/bar.css + _build/install/default/share/blog/style/foo.css diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/myprivatelib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/README.md similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/myprivatelib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/README.md diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/mylib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/bar.css similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/mylib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/bar.css diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/mypackage.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/foo.css similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/mypackage.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob-web-example.t/style/foo.css diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob.t new file mode 100644 index 000000000..bd4b3fc55 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-glob/install-glob.t @@ -0,0 +1,53 @@ +Simple example of using a glob to specify files to install + + $ cat >dune-project < (lang dune 3.5) + > (package (name foo)) + > EOF + + $ cat >dune < (install + > (files (glob_files *.txt)) + > (section share)) + > EOF + + $ touch a.txt b.txt c.txt + + $ dune build @install + File "dune", line 2, characters 8-26: + 2 | (files (glob_files *.txt)) + ^^^^^^^^^^^^^^^^^^ + Error: 'glob_files' is only available since version 3.6 of the dune language. + Please update your dune-project file to have (lang dune 3.6). + [1] + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + + $ dune build @install + + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + ] + share: [ + "_build/install/default/share/foo/a.txt" + "_build/install/default/share/foo/b.txt" + "_build/install/default/share/foo/c.txt" + ] + + $ find _build/install | sort + _build/install + _build/install/default + _build/install/default/lib + _build/install/default/lib/foo + _build/install/default/lib/foo/META + _build/install/default/lib/foo/dune-package + _build/install/default/share + _build/install/default/share/foo + _build/install/default/share/foo/a.txt + _build/install/default/share/foo/b.txt + _build/install/default/share/foo/c.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-chain.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-chain.t new file mode 100644 index 000000000..dedb14864 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-chain.t @@ -0,0 +1,43 @@ +Including a file in the install stanza which includes another file + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((include bar.sexp)) + > EOF + + $ cat >bar.sexp < (a.txt) + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-dir.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-dir.t new file mode 100644 index 000000000..87678a939 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-dir.t @@ -0,0 +1,36 @@ +Example of including a file in the dirs field of the install stanza + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > (using directory-targets 0.1) + > EOF + + $ cat >dune < (install + > (dirs (include baz.sexp)) + > (section share)) + > EOF + + $ mkdir -p foo + + $ cat >foo/dune < (rule + > (target (dir bar)) + > (action (bash "mkdir %{target} && touch %{target}/a"))) + > EOF + + $ cat >baz.sexp < (foo/bar) + > EOF + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + share: [ + "_build/install/default/share/hello/bar/a" {"bar/a"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t new file mode 100644 index 000000000..795c385bb --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-foo-as-bar.t @@ -0,0 +1,39 @@ +Include a file which contains the (foo as bar) syntax for renaming a file + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((a.txt as b/c.txt)) + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/b/c.txt" {"b/c.txt"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t new file mode 100644 index 000000000..dca29fcc1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-generated-by-rule.t @@ -0,0 +1,40 @@ +Including a file in the install stanza which is generated by a rule + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (rule + > (target foo.sexp) + > (action + > (with-stdout-to foo.sexp (echo "(a.txt)")))) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ touch a.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-glob-files.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-glob-files.t new file mode 100644 index 000000000..f601068c4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-glob-files.t @@ -0,0 +1,36 @@ +Test that `(include ...)` composes with `(glob_files ...)` + + $ cat >dune-project < (lang dune 3.6) + > (package (name foo)) + > EOF + + $ cat >dune < (install + > (files + > (include foo.sexp)) + > (section share)) + > EOF + + $ cat >foo.sexp < ((glob_files dir1/*.txt) + > (glob_files_rec dir2/*.txt)) + > EOF + + $ mkdir -p dir1 dir2/foo/bar + $ touch dir1/a.txt dir1/b.txt dir2/c.txt dir2/foo/d.txt dir2/foo/bar/e.txt + + $ dune build @install + + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + ] + share: [ + "_build/install/default/share/foo/dir1/a.txt" {"dir1/a.txt"} + "_build/install/default/share/foo/dir1/b.txt" {"dir1/b.txt"} + "_build/install/default/share/foo/dir2/c.txt" {"dir2/c.txt"} + "_build/install/default/share/foo/dir2/foo/bar/e.txt" {"dir2/foo/bar/e.txt"} + "_build/install/default/share/foo/dir2/foo/d.txt" {"dir2/foo/d.txt"} + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t new file mode 100644 index 000000000..4e643cb6e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-invalid-file.t @@ -0,0 +1,32 @@ +Including a file in the install stanza which does not contain a sexp list + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < a.txt + > EOF + + $ dune build @install + File "_build/default/foo.sexp", line 1, characters 0-5: + 1 | a.txt + ^^^^^ + Error: Expected list, got: + a.txt + + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune new file mode 100644 index 000000000..5aff9637e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune @@ -0,0 +1,9 @@ +(install + (files (include resources.sexp)) + (section share)) + +(rule + (deps (source_tree resources) list_dir.ml) + (action + (with-stdout-to resources.sexp + (run ocaml list_dir.ml resources)))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project new file mode 100644 index 000000000..8f9dd0689 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) +(package (name foo)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml new file mode 100644 index 000000000..41c172346 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/list_dir.ml @@ -0,0 +1,19 @@ +(* Prints a sexp listing the contents of a given directory in the form: + + ((dir/foo as dir/foo) + (dir/bar as dir/bar) + (dir/baz as dir/baz) + ...) + + where foo, bar, baz, ... are files in the given directory. *) + +let list_dir dir = + Sys.readdir dir + |> Array.to_list + |> List.map (fun f -> String.concat "/" [dir; f]) + +let () = + list_dir (Sys.argv.(1)) + |> List.map (fun f -> Printf.sprintf "(%s as %s)" f f ) + |> String.concat " " + |> Printf.printf "(%s)" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/foo.mld b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/a.txt similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/foo.mld rename to duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/a.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/scope1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/b.txt similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/scope1.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/b.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/foo.mld b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/c.txt similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/foo.mld rename to duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/resources/c.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t new file mode 100644 index 000000000..8bca5cb78 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-list-files.t/run.t @@ -0,0 +1,21 @@ +Include a file generated by listing the contents of a directory. + + $ dune build @install + + $ cat _build/default/foo.install + lib: [ + "_build/install/default/lib/foo/META" + "_build/install/default/lib/foo/dune-package" + ] + share: [ + "_build/install/default/share/foo/resources/a.txt" {"resources/a.txt"} + "_build/install/default/share/foo/resources/b.txt" {"resources/b.txt"} + "_build/install/default/share/foo/resources/c.txt" {"resources/c.txt"} + ] + $ find _build/install/default/share | sort + _build/install/default/share + _build/install/default/share/foo + _build/install/default/share/foo/resources + _build/install/default/share/foo/resources/a.txt + _build/install/default/share/foo/resources/b.txt + _build/install/default/share/foo/resources/c.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-loop.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-loop.t new file mode 100644 index 000000000..263952d36 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include-loop.t @@ -0,0 +1,34 @@ +Detect include loops in files included in the install stanza + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ cat >foo.sexp < ((include bar.sexp)) + > EOF + + $ cat >bar.sexp < ((include foo.sexp)) + > EOF + + $ dune build @install + File "_build/default/bar.sexp", line 1, characters 10-18: + 1 | ((include foo.sexp)) + ^^^^^^^^ + Error: Include loop detected via: _build/default/foo.sexp + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include.t b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include.t new file mode 100644 index 000000000..613e11669 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/install-include/install-include.t @@ -0,0 +1,70 @@ +Simple example of including a file in the install stanza + + $ cat >dune-project < (lang dune 3.4) + > (package (name hello)) + > EOF + + $ cat >dune < (executable + > (public_name hello)) + > + > (install + > (files a.txt (include foo.sexp)) + > (section share)) + > EOF + + $ cat >hello.ml < let () = print_endline "Hello, World!" + > EOF + + $ touch a.txt + + $ dune build @install + File "dune", line 5, characters 14-32: + 5 | (files a.txt (include foo.sexp)) + ^^^^^^^^^^^^^^^^^^ + Error: 'include' is only available since version 3.5 of the dune language. + Please update your dune-project file to have (lang dune 3.5). + [1] + + $ cat >dune-project < (lang dune 3.5) + > (package (name hello)) + > EOF + + $ dune build @install + File "_unknown_", line 1, characters 0-0: + Error: No rule found for foo.sexp + [1] + + $ cat >foo.sexp < (b.txt c.txt) + > EOF + + $ touch b.txt + + $ dune build @install + File "_build/default/foo.sexp", line 1, characters 7-12: + 1 | (b.txt c.txt) + ^^^^^ + Error: No rule found for c.txt + [1] + + $ touch c.txt + + $ dune build @install + + $ cat _build/default/hello.install + lib: [ + "_build/install/default/lib/hello/META" + "_build/install/default/lib/hello/dune-package" + ] + bin: [ + "_build/install/default/bin/hello" + ] + share: [ + "_build/install/default/share/hello/a.txt" + "_build/install/default/share/hello/b.txt" + "_build/install/default/share/hello/c.txt" + ] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/internal/dump.t b/duniverse/dune_/test/blackbox-tests/test-cases/internal/dump.t index 259b5042b..ea4d939fc 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/internal/dump.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/internal/dump.t @@ -8,4 +8,4 @@ Test the "dune internal dump" command. > EOF $ dune build x $ dune internal dump _build/.to-delete-in-source-tree - set { In_source_tree "x" } + set { "x" } diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/run.t deleted file mode 100644 index 475e65d7e..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/run.t +++ /dev/null @@ -1,57 +0,0 @@ -Successes: - - $ dune build --display short --root foo --debug-dep - Entering directory 'foo' - ocamldep .foo.objs/foo.ml.d - ocamlc .foo.objs/byte/foo__.{cmi,cmo,cmt} - ocamldep .foo.objs/intf.mli.d - ocamlopt .foo.objs/native/foo__.{cmx,o} - ocamlc .foo.objs/byte/foo__Intf.{cmi,cmti} - ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} - ocamlc test/.bar.objs/byte/bar.{cmi,cmo,cmt} - ocamlopt .foo.objs/native/foo.{cmx,o} - ocamlc foo.cma - ocamlopt test/.bar.objs/native/bar.{cmx,o} - ocamlc test/bar.cma - ocamlopt foo.{a,cmxa} - ocamlopt test/bar.{a,cmxa} - ocamlopt foo.cmxs - ocamlopt test/bar.cmxs - -Errors: - - $ dune build --root a foo.cma - Entering directory 'a' - File "dune", line 1, characters 0-21: - 1 | (library - 2 | (name foo)) - Error: Some modules don't have an implementation. - You need to add the following field to this stanza: - - (modules_without_implementation x y) - [1] - $ dune build --root b foo.cma - Entering directory 'b' - File "dune", line 3, characters 33-34: - 3 | (modules_without_implementation x)) - ^ - Error: The following modules must be listed here as they don't have an - implementation: - - Y - [1] - $ dune build --root c foo.cma - Entering directory 'c' - File "dune", line 3, characters 33-34: - 3 | (modules_without_implementation x)) - ^ - Error: Module X doesn't exist. - [1] - $ dune build --root d foo.cma - Entering directory 'd' - File "dune", line 3, characters 33-34: - 3 | (modules_without_implementation x)) - ^ - Error: The following modules have an implementation, they cannot be listed as - modules_without_implementation: - - X - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/run.t new file mode 100644 index 000000000..6145c4383 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/run.t @@ -0,0 +1,11 @@ +Errors: + + $ dune build foo.cma + File "dune", line 1, characters 0-21: + 1 | (library + 2 | (name foo)) + Error: Some modules don't have an implementation. + You need to add the following field to this stanza: + + (modules_without_implementation x y) + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/x.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/x.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/x.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/x.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/y.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/y.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/a/y.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/a.t/y.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/run.t new file mode 100644 index 000000000..f928a8c2b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/run.t @@ -0,0 +1,10 @@ +Error: + + $ dune build foo.cma + File "dune", line 3, characters 33-34: + 3 | (modules_without_implementation x)) + ^ + Error: The following modules must be listed here as they don't have an + implementation: + - Y + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/x.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/x.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/x.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/x.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/y.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/y.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/b/y.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/b.t/y.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/c/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/c/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/c/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/c/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/run.t new file mode 100644 index 000000000..395d84a1b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/c.t/run.t @@ -0,0 +1,8 @@ +Error: + + $ dune build foo.cma + File "dune", line 3, characters 33-34: + 3 | (modules_without_implementation x)) + ^ + Error: Module X doesn't exist. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/run.t new file mode 100644 index 000000000..3030baf9d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/run.t @@ -0,0 +1,10 @@ +Error: + + $ dune build foo.cma + File "dune", line 3, characters 33-34: + 3 | (modules_without_implementation x)) + ^ + Error: The following modules have an implementation, they cannot be listed as + modules_without_implementation: + - X + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/x.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/x.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/x.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/x.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/x.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/d/x.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/d.t/x.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/scope2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/scope2.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/intf.mli b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/intf.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/intf.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/intf.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/run.t new file mode 100644 index 000000000..1459718cf --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/run.t @@ -0,0 +1,18 @@ +Successes: + + $ dune build --display short --debug-dep + ocamldep .foo.objs/foo.ml.d + ocamlc .foo.objs/byte/foo__.{cmi,cmo,cmt} + ocamldep .foo.objs/intf.mli.d + ocamlopt .foo.objs/native/foo__.{cmx,o} + ocamlc .foo.objs/byte/foo__Intf.{cmi,cmti} + ocamlc .foo.objs/byte/foo.{cmi,cmo,cmt} + ocamlc test/.bar.objs/byte/bar.{cmi,cmo,cmt} + ocamlopt .foo.objs/native/foo.{cmx,o} + ocamlc foo.cma + ocamlopt test/.bar.objs/native/bar.{cmx,o} + ocamlc test/bar.cma + ocamlopt foo.{a,cmxa} + ocamlopt test/bar.{a,cmxa} + ocamlopt foo.cmxs + ocamlopt test/bar.cmxs diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/test/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/test/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/test/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/test/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/test/dune b/duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/test/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/test/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/intf-only/foo.t/test/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/jsoo/simple.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/jsoo/simple.t/run.t index 0899ff046..f8b1e2c1f 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/jsoo/simple.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/jsoo/simple.t/run.t @@ -1,53 +1,11 @@ Compilation using jsoo - - $ dune build --display short bin/technologic.bc.js @install --profile dev 2>&1 | \ - > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g - js_of_ocaml bin/technologic.bc.runtime.js - ocamldep bin/.technologic.eobjs/technologic.ml.d - js_of_ocaml .js/stdlib/std_exit.cmo.js - C_COMPILER lib/stubs.o - ocamldep lib/.x.objs/x.ml.d - ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} - ocamldep lib/.x.objs/y.ml.d - ocamldep bin/.technologic.eobjs/z.ml.d - ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a - ocamlopt lib/.x.objs/native/x__.{cmx,o} - ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} - js_of_ocaml .js/js_of_ocaml-compiler.runtime/jsoo_runtime.cma.js - js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js - js_of_ocaml .js/stdlib/stdlib.cma.js - ocamlopt lib/.x.objs/native/x__Y.{cmx,o} - ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} - ocamlc lib/x.cma - ocamlopt lib/x.{a,cmxa} - ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} - js_of_ocaml bin/.technologic.eobjs/byte/z.cmo.js - js_of_ocaml lib/.x.objs/x.cma.js - ocamlopt lib/x.cmxs - js_of_ocaml bin/.technologic.eobjs/byte/technologic.cmo.js - js_of_ocaml bin/technologic.bc.js + $ dune build bin/technologic.bc.js @install --profile dev $ node ./_build/default/bin/technologic.bc.js buy it use it break it fix it - $ dune build --display short bin/technologic.bc.js @install --profile release 2>&1 | \ - > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g - ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} - ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x__.{cmx,o} - ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x__Y.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} - ocamlc lib/x.cma - ocamlopt lib/.x.objs/native/x.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} - ocamlopt lib/x.{a,cmxa} - ocamlc bin/technologic.bc-for-jsoo - ocamlopt lib/x.cmxs - js_of_ocaml bin/technologic.bc.js + $ dune build @install --profile release $ node ./_build/default/bin/technologic.bc.js buy it use it @@ -62,56 +20,18 @@ Compilation using jsoo with disable_dynamically_linked_foreign_archives = true > (default (disable_dynamically_linked_foreign_archives true))) > EOF $ dune clean - $ dune build --display short bin/technologic.bc.js @install --profile dev 2>&1 | \ - > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g - js_of_ocaml bin/technologic.bc.runtime.js - ocamldep bin/.technologic.eobjs/technologic.ml.d - js_of_ocaml .js/stdlib/std_exit.cmo.js - C_COMPILER lib/stubs.o - ocamldep lib/.x.objs/x.ml.d - ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} - ocamldep lib/.x.objs/y.ml.d - ocamldep bin/.technologic.eobjs/z.ml.d - ocamlmklib lib/libx_stubs.a - ocamlopt lib/.x.objs/native/x__.{cmx,o} - ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} - js_of_ocaml .js/js_of_ocaml-compiler.runtime/jsoo_runtime.cma.js - js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js - js_of_ocaml .js/stdlib/stdlib.cma.js - ocamlopt lib/.x.objs/native/x__Y.{cmx,o} - ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} - ocamlc lib/x.cma - ocamlopt lib/x.{a,cmxa} - ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} - js_of_ocaml bin/.technologic.eobjs/byte/z.cmo.js - js_of_ocaml lib/.x.objs/x.cma.js - ocamlopt lib/x.cmxs - js_of_ocaml bin/.technologic.eobjs/byte/technologic.cmo.js - js_of_ocaml bin/technologic.bc.js + $ dune build bin/technologic.bc.js @install --profile dev Js_of_ocaml whole program compilation doesn't work with disable_dynamically_linked_foreign_archives = true We would like the following to succeed: - $ dune build --display short bin/technologic.bc.js @install --profile release 2>&1 | \ - > sed s,^\ *$(ocamlc -config-var c_compiler),\ \ C_COMPILER,g - ocamlc lib/.x.objs/byte/x__.{cmi,cmo,cmt} - ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x__.{cmx,o} - ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt} - ocamlopt lib/.x.objs/native/x__Y.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt} - ocamlc lib/x.cma - ocamlopt lib/.x.objs/native/x.{cmx,o} - ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt} - ocamlopt lib/x.{a,cmxa} - ocamlopt lib/x.cmxs + $ dune build bin/technologic.bc.js @install --profile release File "bin/dune", line 2, characters 8-19: 2 | (names technologic) ^^^^^^^^^^^ Error: No rule found for lib/dllx_stubs.so + [1] Js_of_ocaml whole program compilation doesn't work with disable_dynamically_linked_foreign_archives = true diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/aliases.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/aliases.t new file mode 100644 index 000000000..e4368171b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/aliases.t @@ -0,0 +1,22 @@ +Test (preprocess) field on melange.emit stanza + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target output) + > (alias app) + > (module_system commonjs)) + > EOF + + $ cat > main.ml < let () = + > print_endline "hello" + > EOF + + $ dune build @app + $ node _build/default/output/melange__Main.js + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/dune new file mode 100644 index 000000000..9438e94e8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/dune @@ -0,0 +1,3 @@ +(cram + (deps %{bin:node} %{bin:melc}) + (alias runtest-melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/empty-entries.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/empty-entries.t new file mode 100644 index 000000000..ade92936c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/empty-entries.t @@ -0,0 +1,21 @@ +Test (entries) field can be left empty + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target output) + > (module_system commonjs)) + > EOF + + $ cat > hello.ml < let () = + > print_endline "hello" + > EOF + + $ dune build output/melange__Hello.js + $ node _build/default/output/melange__Hello.js + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/flags.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/flags.t new file mode 100644 index 000000000..88855e140 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/flags.t @@ -0,0 +1,28 @@ +Test (flags) field on melange.emit stanza + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target output) + > (entries main) + > (module_system commonjs) + > (flags -w -14-26)) + > EOF + +The code in main contains unused var (warning 26) and illegal backlash (warning 14) + + $ cat > main.ml < let t = "\e\n" in + > print_endline "hello" + > EOF + +Building should not fail as warnings are silenced + + $ dune build output/melange__Main.js + $ node _build/default/output/melange__Main.js + hello + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.ml new file mode 100644 index 000000000..09c070c7f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.ml @@ -0,0 +1 @@ +let buy_it = "buy " ^ A.it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.mli new file mode 100644 index 000000000..715e54b09 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/b.mli @@ -0,0 +1 @@ +val buy_it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/dune new file mode 100644 index 000000000..b8ebd08af --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/dune @@ -0,0 +1,4 @@ +(include_subdirs unqualified) +(library + (name lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.ml new file mode 100644 index 000000000..d11948ee5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.mli new file mode 100644 index 000000000..b05420237 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/app/lib/a.mli @@ -0,0 +1 @@ +val it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/c.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/c.ml new file mode 100644 index 000000000..8c8857df0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/c.ml @@ -0,0 +1 @@ +let () = Js.log Lib.B.buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/dune new file mode 100644 index 000000000..aa5cc793c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/inside/dune @@ -0,0 +1,5 @@ +(melange.emit + (target output) + (entries c) + (libraries lib) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/run.t new file mode 100644 index 000000000..998121686 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/include_subdirs.t/run.t @@ -0,0 +1,8 @@ +Test that libs using `(include_subdirs unqualified) work well with +`melange.emit` stanza + +Build js files + $ output=inside/output + $ dune build $output/inside/melange__C.js + $ node _build/default/$output/inside/melange__C.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/b.ml new file mode 100644 index 000000000..5243ff671 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/b.ml @@ -0,0 +1,3 @@ +let buy_it: Lib.A.t = "buy it" + +let () = Js.log buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune new file mode 100644 index 000000000..ad42df855 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune @@ -0,0 +1,4 @@ +(melange.emit + (target output) + (libraries lib) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/a.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/a.mli new file mode 100644 index 000000000..c6a8e288e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/a.mli @@ -0,0 +1 @@ +type t = string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/dune new file mode 100644 index 000000000..7c7cd9d21 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/lib/dune @@ -0,0 +1,4 @@ +(library + (name lib) + (modules_without_implementation a) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/run.t new file mode 100644 index 000000000..b98c10aba --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/intfonly.t/run.t @@ -0,0 +1,6 @@ +Test melange libs flow when using `modules_without_implementation` stanza + +Build js files + $ dune build output/melange__B.js + $ node _build/default/output/melange__B.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/merlin.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/merlin.t new file mode 100644 index 000000000..2842a3e55 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/merlin.t @@ -0,0 +1,26 @@ + Temporary special merlin support for melange only libs + + $ cat >dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ lib=foo + $ cat >dune < (library + > (name $lib) + > (private_modules bar) + > (modes melange)) + > EOF + + $ touch bar.ml $lib.ml + $ dune build @check + $ dune ocaml-merlin --dump-config="$(pwd)" | grep -i "$lib" + Foo + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ + Foo__ + $TESTCASE_ROOT/_build/default/.foo.objs/melange) + Foo__ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune new file mode 100644 index 000000000..13475e99e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune @@ -0,0 +1,5 @@ +(melange.emit + (target mli) + (entries x) + (libraries lib) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune-project new file mode 100644 index 000000000..b55e33ffe --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/dune-project @@ -0,0 +1,5 @@ +(lang dune 3.6) + +(using melange 0.1) + +(package (name x)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/dune new file mode 100644 index 000000000..9f14c4cd4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/dune @@ -0,0 +1,3 @@ +(library + (name lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.ml new file mode 100644 index 000000000..d11948ee5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.mli new file mode 100644 index 000000000..e3511eca6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/lib/y.mli @@ -0,0 +1 @@ +val it: string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/run.t new file mode 100644 index 000000000..61a756876 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/run.t @@ -0,0 +1,4 @@ +Compilation using melange, with interface files + $ dune build mli/melange__X.js + $ node ./_build/default/mli/melange__X.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/x.ml new file mode 100644 index 000000000..bf9a77028 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/mli.t/x.ml @@ -0,0 +1,3 @@ +let buy_it = "buy " ^ Lib.Y.it + +let () = print_endline buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/c.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/c.ml new file mode 100644 index 000000000..17bc5e268 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/c.ml @@ -0,0 +1 @@ +let () = X.M_2.print() diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune new file mode 100644 index 000000000..6638d9590 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune @@ -0,0 +1,5 @@ +(melange.emit + (target multilib) + (entries c) + (libraries x) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune-project new file mode 100644 index 000000000..b55e33ffe --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/dune-project @@ -0,0 +1,5 @@ +(lang dune 3.6) + +(using melange 0.1) + +(package (name x)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/dune new file mode 100644 index 000000000..3aa402d52 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/dune @@ -0,0 +1,4 @@ +(library + (name lib) + (wrapped false) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.ml new file mode 100644 index 000000000..befaa6c8f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.ml @@ -0,0 +1,2 @@ +let f() = + () diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.mli new file mode 100644 index 000000000..cccbba094 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/lib/m_1.mli @@ -0,0 +1 @@ +val f : unit -> unit diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/run.t new file mode 100644 index 000000000..9d8561305 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/run.t @@ -0,0 +1,15 @@ +Compilation using melange with a library +The rules should include cmjs of dependencies as well. + +Make sure no byte folders are included. + + $ dune rules multilib/x/x__M_2.js | tr -s '\n' ' ' | + > grep -ce "byte" + 0 + [1] + +Test resulting file + + $ dune build multilib/melange__C.js + $ node ./_build/default/multilib/melange__C.js + done diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/dune new file mode 100644 index 000000000..64b3dbb32 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/dune @@ -0,0 +1,4 @@ +(library + (name x) + (libraries lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.ml new file mode 100644 index 000000000..4001d0bc5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.ml @@ -0,0 +1,5 @@ +let () = + M_1.f(); + () + +let print () = Js.log "done" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.mli new file mode 100644 index 000000000..b848742e0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/multilib.t/x/m_2.mli @@ -0,0 +1 @@ +val print : unit -> unit diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/preprocess.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/preprocess.t new file mode 100644 index 000000000..8b9142778 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/preprocess.t @@ -0,0 +1,25 @@ +Test (preprocess) field on melange.emit stanza + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ cat > dune < (melange.emit + > (target output) + > (entries main) + > (module_system commonjs) + > (preprocess + > (action + > (run cat %{input-file})))) + > EOF + + $ cat > main.ml < let () = + > print_endline "hello" + > EOF + + $ dune build output/melange__Main.js + $ node _build/default/output/melange__Main.js + hello diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune new file mode 100644 index 000000000..f1a30f925 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune @@ -0,0 +1,5 @@ +(melange.emit + (target private-module) + (entries foo) + (libraries lib) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/foo.ml new file mode 100644 index 000000000..43b27c834 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/foo.ml @@ -0,0 +1 @@ +Lib.X.run ();; diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/run.t new file mode 100644 index 000000000..c6dfd77d3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/run.t @@ -0,0 +1,7 @@ +X is not accessible as it is private + $ dune build private-module/melange__Foo.js + File "foo.ml", line 1, characters 0-9: + 1 | Lib.X.run ();; + ^^^^^^^^^ + Error: The module Lib.X is an alias for module Lib__X, which is missing + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/dune new file mode 100644 index 000000000..d74c9cc58 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/dune @@ -0,0 +1,4 @@ +(library + (name lib) + (modes melange) + (private_modules x)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/with-private/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/x.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/with-private/x.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/x.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/y.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/y.ml new file mode 100644 index 000000000..129c95687 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private-module.t/with-private/y.ml @@ -0,0 +1 @@ +let run () = print_endline "private" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.ml new file mode 100644 index 000000000..fd228deab --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.ml @@ -0,0 +1 @@ +let buy_it = "buy " ^ Lib.A.it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.mli new file mode 100644 index 000000000..715e54b09 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/b.mli @@ -0,0 +1 @@ +val buy_it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/dune new file mode 100644 index 000000000..13ae685ab --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/app/dune @@ -0,0 +1,4 @@ +(library + (name app) + (libraries lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/c.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/c.ml new file mode 100644 index 000000000..09724ba2c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/c.ml @@ -0,0 +1 @@ +let () = Js.log App.B.buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/dune new file mode 100644 index 000000000..d0b3fc1c9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/dune @@ -0,0 +1,5 @@ +(melange.emit + (target output) + (entries c) + (libraries app) + (module_system es6)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.ml new file mode 100644 index 000000000..d11948ee5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.mli new file mode 100644 index 000000000..b05420237 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/a.mli @@ -0,0 +1 @@ +val it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/dune new file mode 100644 index 000000000..9f14c4cd4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/inside/lib/dune @@ -0,0 +1,3 @@ +(library + (name lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/package.json b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/package.json new file mode 100644 index 000000000..472002573 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/package.json @@ -0,0 +1,3 @@ +{ + "type": "module" +} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/run.t new file mode 100644 index 000000000..0f1eb9e7f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/private.t/run.t @@ -0,0 +1,26 @@ +Test the private libs flow when using `melange.emit` stanza + +Cmj rules should include --bs-package-output + $ dune rules inside/app/.app.objs/melange/app.cmj | + > grep -e "--bs-package-output" --after-context=1 + --bs-package-output + inside/app + +Cmj rules should not include --bs-package-name + $ dune rules inside/app/.app.objs/melange/app.cmj | + > grep -ce "--bs-package-name" + 0 + [1] + + $ output=inside/output + +Js rules should include module type + $ dune rules $output/inside/app/app__B.js | + > grep -e "--bs-module-type" --after-context=1 + --bs-module-type + es6 + +Build js files + $ dune build $output/inside/melange__C.js + $ node _build/default/$output/inside/melange__C.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/dune-project new file mode 100644 index 000000000..5c27793b2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/dune-project @@ -0,0 +1,6 @@ +(lang dune 3.6) + +(using melange 0.1) + +(package + (name pkg)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.ml new file mode 100644 index 000000000..74822cedb --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.ml @@ -0,0 +1,2 @@ +let buy_it = "buy " ^ Lib.A.it + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.mli new file mode 100644 index 000000000..715e54b09 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/b.mli @@ -0,0 +1 @@ +val buy_it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/dune new file mode 100644 index 000000000..72c07f59d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/app/dune @@ -0,0 +1,5 @@ +(library + (name app) + (public_name pkg.app) + (libraries lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/c.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/c.ml new file mode 100644 index 000000000..09724ba2c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/c.ml @@ -0,0 +1 @@ +let () = Js.log App.B.buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/dune new file mode 100644 index 000000000..9870409ff --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/dune @@ -0,0 +1,6 @@ +(melange.emit + (package pkg) + (target output) + (entries c) + (libraries app) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.ml new file mode 100644 index 000000000..d11948ee5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.mli new file mode 100644 index 000000000..b05420237 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/a.mli @@ -0,0 +1 @@ +val it : string diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/dune new file mode 100644 index 000000000..45ec72628 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/my_project/lib/dune @@ -0,0 +1,4 @@ +(library + (name lib) + (public_name pkg.lib) + (modes melange)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/run.t new file mode 100644 index 000000000..adaecb89a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/public.t/run.t @@ -0,0 +1,34 @@ +Test the public libs flow when using `melange.emit` stanza + +Cmj rules should include --bs-package-output + $ dune rules my_project/app/.app.objs/melange/app.cmj | + > grep -e "--bs-package-output" --after-context=1 + --bs-package-output + my_project/app + +Cmj rules should include --bs-package-name + $ dune rules my_project/app/.app.objs/melange/app.cmj | + > grep -e "--bs-package-name" --after-context=1 + --bs-package-name + pkg + + $ output=my_project/output + +Js rules should include --bs-module-type + $ dune rules $output/my_project/app/app__B.js | + > grep -e "--bs-module-type" --after-context=1 + --bs-module-type + commonjs + +Js rules should include --bs-package-name + $ dune rules $output/my_project/app/app__B.js | + > grep -e "--bs-package-name" --after-context=1 + --bs-package-name + pkg + +Build js files + $ dune build $output/my_project/melange__C.js + +Path to app_B is non-relative (broken) + $ node _build/default/$output/my_project/melange__C.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/reused-module.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/reused-module.t new file mode 100644 index 000000000..fe614d306 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/reused-module.t @@ -0,0 +1,31 @@ +Test error message for modules belonging to melange.emit and another stanza + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ cat > dune < (library + > (name lib) + > (modes melange)) + > (melange.emit + > (target output) + > (module_system commonjs)) + > EOF + + $ cat > main.ml < let () = + > print_endline "hello" + > EOF + + $ dune build output/melange__Main.js + File "dune", line 1, characters 0-0: + Error: Module "Main" is used in several stanzas: + - dune:1 + - dune:4 + To fix this error, you must specify an explicit "modules" field in every + library, executable, and executables stanzas in this dune file. Note that + each module cannot appear in more than one "modules" field - it must belong + to a single library or executable. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/root-module.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/root-module.t new file mode 100644 index 000000000..3f557a593 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/root-module.t @@ -0,0 +1,86 @@ +A library can be shadowed by an internal module name: + + $ cat >dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + + $ mkdir lib1 lib2 + + $ cat >lib1/dune < (library + > (name lib1) + > (modes melange)) + > EOF + $ cat >lib1/lib1.ml < let greeting = "Hello World" + > EOF + + $ cat >lib2/dune < (library + > (libraries lib1) + > (name lib2) + > (modes melange)) + > EOF + +Now we shadow lib1: + $ cat >lib2/lib1.ml < let greeting = () + > EOF + $ cat >lib2/lib2.ml < print_endline Lib1.greeting + > EOF + + $ dune build lib2/.lib2.objs/melange/lib2.cmj + File "lib2/lib2.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: This expression has type unit but an expression was expected of type + string + [1] + +We can use root_module to use lib1 with a different name: + + $ cat >lib2/dune < (library + > (libraries lib1) + > (root_module root) + > (name lib2) + > (modes melange)) + > EOF + $ cat >lib2/lib2.ml < let () = print_endline Root.Lib1.greeting + > EOF + $ dune build lib2/.lib2.objs/melange/lib2.cmj + +The same for melange.emit: + + $ cat > dune < (melange.emit + > (target output) + > (libraries lib1) + > (root_module root) + > (module_system commonjs)) + > EOF + $ cat > lib1.ml < let greeting = () + > EOF + $ cat >foo.ml < print_endline Lib1.greeting + > EOF + $ dune build output/melange__Foo.js + File "foo.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: This expression has type unit but an expression was expected of type + string + [1] + +Use root_module to fix: + + $ cat >foo.ml < print_endline Root.Lib1.greeting + > EOF + $ dune build output/melange__Foo.js + $ node _build/default/output/melange__Foo.js + Hello World diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/dune new file mode 100644 index 000000000..9dba25d27 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/dune @@ -0,0 +1,10 @@ +(library + (name lib) + (modules y) + (modes melange)) + +(melange.emit + (target simple) + (entries x) + (libraries lib) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/x.ml new file mode 100644 index 000000000..21be7f993 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/x.ml @@ -0,0 +1,3 @@ +let buy_it = "buy " ^ Lib.Y.it + +let () = Js.log buy_it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/y.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/y.ml new file mode 100644 index 000000000..d11948ee5 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/lib/y.ml @@ -0,0 +1 @@ +let it = "it" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/run.t new file mode 100644 index 000000000..c4d0d087f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/simple.t/run.t @@ -0,0 +1,6 @@ +Using `melange.emit` inside the same folder as the library works fine + + $ output=lib/simple + $ dune build $output/lib/melange__X.js + $ node _build/default/$output/lib/melange__X.js + buy it diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/target-validation.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/target-validation.t new file mode 100644 index 000000000..9a2f39b74 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/target-validation.t @@ -0,0 +1,77 @@ +Validation of target field in melange.emit stanzas + + $ cat > dune-project < (lang dune 3.6) + > (using melange 0.1) + > EOF + +Target should not be empty + + $ lib=foo + $ cat > dune < (library + > (name $lib) + > (modes melange)) + > (melange.emit + > (target "") + > (libraries $foo) + > (module_system es6)) + > EOF + + $ dune build + File "dune", line 5, characters 9-11: + 5 | (target "") + ^^ + Error: The field target can not be empty + [1] + +Target should not try to descend into subdirectories + + $ cat > dune < (library + > (name $lib) + > (modes melange)) + > (melange.emit + > (target foo/bar) + > (libraries $foo) + > (module_system es6)) + > EOF + + $ dune build + File "dune", line 5, characters 9-16: + 5 | (target foo/bar) + ^^^^^^^ + Error: The field target must use simple names and can not include paths to + other folders. To emit JavaScript files in another folder, move the + `melange.emit` stanza to that folder + [1] + +Target should not try to escape into parent directories + + $ rm dune + $ mkdir bar + $ mkdir foo + $ cat > bar/dune < (library + > (name bar) + > (modes melange)) + > EOF + + $ cat > foo/dune < (library + > (name $lib) + > (modes melange)) + > (melange.emit + > (target ../bar) + > (libraries $foo) + > (module_system es6)) + > EOF + + $ dune build + File "foo/dune", line 5, characters 9-15: + 5 | (target ../bar) + ^^^^^^ + Error: The field target must use simple names and can not include paths to + other folders. To emit JavaScript files in another folder, move the + `melange.emit` stanza to that folder + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/c.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/c.ml new file mode 100644 index 000000000..2ef42fdec --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/c.ml @@ -0,0 +1 @@ +let () = Vlib.run () diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune new file mode 100644 index 000000000..91b5e6303 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune @@ -0,0 +1,5 @@ +(melange.emit + (target output) + (entries c) + (libraries impl) + (module_system commonjs)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune-project new file mode 100644 index 000000000..1f00e4b26 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.6) + +(using melange 0.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/dune new file mode 100644 index 000000000..cab416451 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/dune @@ -0,0 +1,4 @@ +(library + (name impl) + (modes melange) + (implements vlib)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/vlib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/vlib.ml new file mode 100644 index 000000000..73a24b1f4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/impl/vlib.ml @@ -0,0 +1 @@ +let run () = Js.log "hello from melange" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/run.t new file mode 100644 index 000000000..c56aaad55 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/run.t @@ -0,0 +1,5 @@ +Virtual library with a single module are not yet supported for melange libs + + $ dune build output/melange__C.js + $ node _build/default/output/melange__C.js + hello from melange diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/vlib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/vlib/dune new file mode 100644 index 000000000..ad2e731d3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/vlib/dune @@ -0,0 +1,4 @@ +(library + (name vlib) + (modes melange) + (virtual_modules vlib)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/bar.mli b/duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/vlib/vlib.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/bar.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/melange/virtual_lib.t/vlib/vlib.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/merlin/dune b/duniverse/dune_/test/blackbox-tests/test-cases/merlin/dune index 65d15e451..feba37bed 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/merlin/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/merlin/dune @@ -5,3 +5,7 @@ (cram (applies_to merlin-tests) (deps %{bin:ocamlfind})) + +(cram + (applies_to github4125) + (deps %{bin:opam})) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/misc.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/misc.t/run.t index 55292e23b..fdc5fd94b 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/misc.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/misc.t/run.t @@ -6,39 +6,39 @@ Test that incompatible options are properly reported ---------------------------------------------------- $ dune build --verbose --display quiet - dune build: Cannot use --verbose and --display simultaneously - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: Cannot use --verbose and --display simultaneously + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build -p toto --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --for-release-of-packages toto --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --no-config --config x - dune build: Cannot use --config and --no-config simultaneously - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: Cannot use --config and --no-config simultaneously + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build -p toto --release - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --release --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] Allowed combinations diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/run.t deleted file mode 100644 index b3727f0df..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/run.t +++ /dev/null @@ -1,26 +0,0 @@ -Exact path provided by the user: - - $ dune runtest --root precise-path - Entering directory 'precise-path' - Error: No rule found for foo.exe - -> required by alias runtest in dune:1 - [1] - -Path that needs to be searched: - - $ dune runtest --root search-path - Entering directory 'search-path' - File "dune", line 3, characters 14-32: - 3 | (action (run foo-does-not-exist))) - ^^^^^^^^^^^^^^^^^^ - Error: Program foo-does-not-exist not found in the tree or in PATH - (context: default) - [1] - -Path in deps field of alias stanza - - $ dune runtest --root alias-deps-field - Entering directory 'alias-deps-field' - Error: No rule found for foobar - -> required by alias runtest in dune:1 - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/alias-deps-field/dune b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/alias-deps-field/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/alias-deps-field/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/alias-deps-field/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/run.t new file mode 100644 index 000000000..b35d84781 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/alias-deps-field.t/run.t @@ -0,0 +1,6 @@ +Path in deps field of alias stanza + + $ dune runtest + Error: No rule found for foobar + -> required by alias runtest in dune:1 + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/precise-path/dune b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/precise-path/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/precise-path/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/precise-path/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/run.t new file mode 100644 index 000000000..92f8b3eaf --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/precise-path.t/run.t @@ -0,0 +1,6 @@ +Exact path provided by the user: + + $ dune runtest + Error: No rule found for foo.exe + -> required by alias runtest in dune:1 + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/search-path/dune b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/search-path/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/search-path/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run.t/search-path/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/run.t new file mode 100644 index 000000000..80bb29ae8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/missing-loc-run/search-path.t/run.t @@ -0,0 +1,9 @@ +Path that needs to be searched: + + $ dune runtest + File "dune", line 3, characters 14-32: + 3 | (action (run foo-does-not-exist))) + ^^^^^^^^^^^^^^^^^^ + Error: Program foo-does-not-exist not found in the tree or in PATH + (context: default) + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/run.t deleted file mode 100644 index 00c582976..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/run.t +++ /dev/null @@ -1,125 +0,0 @@ -the name field can be omitted for libraries when public_name is present - $ dune build --root no-name-lib - Entering directory 'no-name-lib' - -this isn't possible for older syntax <= (1, 0) - $ dune build --root no-name-lib-syntax-1-0 - Entering directory 'no-name-lib-syntax-1-0' - File "dune", line 1, characters 22-25: - 1 | (library (public_name foo)) - ^^^ - Error: name field cannot be omitted before version 1.1 of the dune language - [1] - -executable(s) stanza works the same way - - $ dune build --root no-name-exes - Entering directory 'no-name-exes' - - $ dune build --root no-name-exes-syntax-1-0 - Entering directory 'no-name-exes-syntax-1-0' - File "dune", line 1, characters 0-36: - 1 | (executables (public_names foo bar)) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: names field may not be omitted before dune version 1.1 - [1] - -there's only a public name but it's invalid as a name - - $ dune build --root public-name-invalid-name - Entering directory 'public-name-invalid-name' - File "dune", line 1, characters 22-28: - 1 | (library (public_name c.find)) - ^^^^^^ - Error: Invalid library name. - Public library names don't have this restriction. You can either change this - public name to be a valid library name or add a "name" field with a valid - library name. - Hint: Library names must be non-empty and composed only of the following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Hint: c_find would be a correct library name - [1] - -there's only a public name which is invalid, and the library is unwrapped -this is an error since 2.0.0, it was only a warning before - - $ dune build --root public-name-invalid-wrapped-false - Entering directory 'public-name-invalid-wrapped-false' - File "dune", line 3, characters 14-21: - 3 | (public_name foo.bar)) - ^^^^^^^ - Error: Invalid library name. - Public library names don't have this restriction. You can either change this - public name to be a valid library name or add a "name" field with a valid - library name. - Hint: Library names must be non-empty and composed only of the following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Hint: foo_bar would be a correct library name - [1] - -lib: invalid name - $ dune exec ./bar.exe --root name-invalid-lib - Entering directory 'name-invalid-lib' - File "dune", line 3, characters 7-14: - 3 | (name foo.bar) - ^^^^^^^ - Error: "foo.bar" is an invalid library name. - Library names must be non-empty and composed only of the following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Hint: foo_bar would be a correct library name - [1] - - -exe: invalid name - $ dune build --root name-invalid-exe - Entering directory 'name-invalid-exe' - File "dune", line 2, characters 7-10: - 2 | (name a.b)) - ^^^ - Error: Module "A.b" doesn't exist. - [1] - -exe: invalid public-name - $ dune build --root public-name-invalid-exe - Entering directory 'public-name-invalid-exe' - File "dune", line 2, characters 14-17: - 2 | (public_name a.b)) - ^^^ - Error: Module "A.b" doesn't exist. - [1] - -exes: empty list of names/public names - $ mkdir -p empty-names-exes - $ cat >empty-names-exes/dune-project < (lang dune 2.0) - > EOF - $ cat >empty-names-exes/dune < (executables (names)) - > EOF - $ dune build --root empty-names-exes - Entering directory 'empty-names-exes' - File "dune", line 1, characters 13-20: - 1 | (executables (names)) - ^^^^^^^ - Error: Not enough arguments for names - [1] - $ cat >empty-names-exes/dune < (executables (public_names)) - > EOF - $ dune build --root empty-names-exes - Entering directory 'empty-names-exes' - File "dune", line 1, characters 13-27: - 1 | (executables (public_names)) - ^^^^^^^^^^^^^^ - Error: Not enough arguments for public_names - [1] - $ cat >empty-names-exes/dune < (tests (names)) - > EOF - $ dune build --root empty-names-exes - Entering directory 'empty-names-exes' - File "dune", line 1, characters 7-14: - 1 | (tests (names)) - ^^^^^^^ - Error: Not enough arguments for names - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/empty-names-exes.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/empty-names-exes.t new file mode 100644 index 000000000..97c556ebc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/empty-names-exes.t @@ -0,0 +1,31 @@ +exes: empty list of names/public names + $ cat >dune-project < (lang dune 2.0) + > EOF + $ cat >dune < (executables (names)) + > EOF + $ dune build + File "dune", line 1, characters 13-20: + 1 | (executables (names)) + ^^^^^^^ + Error: Not enough arguments for names + [1] + $ cat >dune < (executables (public_names)) + > EOF + $ dune build + File "dune", line 1, characters 13-27: + 1 | (executables (public_names)) + ^^^^^^^^^^^^^^ + Error: Not enough arguments for public_names + [1] + $ cat >dune < (tests (names)) + > EOF + $ dune build + File "dune", line 1, characters 7-14: + 1 | (tests (names)) + ^^^^^^^ + Error: Not enough arguments for names + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-exe/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/run.t new file mode 100644 index 000000000..f81e7207c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-exe.t/run.t @@ -0,0 +1,7 @@ +exe: invalid name + $ dune build + File "dune", line 2, characters 7-10: + 2 | (name a.b)) + ^^^ + Error: Module "A.b" doesn't exist. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/name-invalid-lib/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/run.t new file mode 100644 index 000000000..b44e0e18a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/name-invalid-lib.t/run.t @@ -0,0 +1,11 @@ +lib: invalid name + $ dune exec ./bar.exe + File "dune", line 3, characters 7-14: + 3 | (name foo.bar) + ^^^^^^^ + Error: "foo.bar" is an invalid library name. + Library names must be non-empty and composed only of the following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Hint: foo_bar would be a correct library name + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes-syntax-1-0/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib1/test.mld b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib1/test.mld rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/run.t new file mode 100644 index 000000000..9faf05afa --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes-syntax-1-0.t/run.t @@ -0,0 +1,7 @@ + $ dune build + File "dune", line 1, characters 0-36: + 1 | (executables (public_names foo bar)) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: names field may not be omitted before dune version 1.1 + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exe/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exe/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exe/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exe/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib2/test.mld b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib2/test.mld rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/root.opam b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/baz.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/root.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/baz.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-exes/exes/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/exes/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/lib.opam b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/lib.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/run.t new file mode 100644 index 000000000..171b93f50 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-exes.t/run.t @@ -0,0 +1,3 @@ +executable(s) stanza works the same way + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib-syntax-1-0/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/priv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/priv.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/run.t new file mode 100644 index 000000000..7edc94140 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib-syntax-1-0.t/run.t @@ -0,0 +1,7 @@ +this isn't possible for older syntax <= (1, 0) + $ dune build + File "dune", line 1, characters 22-25: + 1 | (library (public_name foo)) + ^^^ + Error: name field cannot be omitted before version 1.1 of the dune language + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/no-name-lib/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/priv2.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/priv2.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/aaa.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/aaa.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/run.t new file mode 100644 index 000000000..911ff7e6f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/no-name-lib.t/run.t @@ -0,0 +1,2 @@ +the name field can be omitted for libraries when public_name is present + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/bbb.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/a.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/bbb.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/a.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-exe/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/run.t new file mode 100644 index 000000000..b65f194b8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-exe.t/run.t @@ -0,0 +1,8 @@ +exe: invalid public-name + $ dune build + File "dune", line 2, characters 14-17: + 2 | (public_name a.b)) + ^^^ + Error: Module "A.b" doesn't exist. + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/ccc.ml b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/c.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/ccc.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/c.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-name/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/run.t new file mode 100644 index 000000000..8b99a5175 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-name.t/run.t @@ -0,0 +1,15 @@ +there's only a public name but it's invalid as a name + + $ dune build + File "dune", line 1, characters 22-28: + 1 | (library (public_name c.find)) + ^^^^^^ + Error: Invalid library name. + Public library names don't have this restriction. You can either change this + public name to be a valid library name or add a "name" field with a valid + library name. + Hint: Library names must be non-empty and composed only of the following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Hint: c_find would be a correct library name + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/dune b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation.t/public-name-invalid-wrapped-false/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/pkg1.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/foo.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/pkg2.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/foo.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/run.t new file mode 100644 index 000000000..d59e7fd83 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/name-field-validation/public-name-invalid-wrapped-false.t/run.t @@ -0,0 +1,15 @@ +there's only a public name which is invalid, and the library is unwrapped +this is an error since 2.0.0, it was only a warning before + + $ dune build + File "dune", line 3, characters 14-21: + 3 | (public_name foo.bar)) + ^^^^^^^ + Error: Invalid library name. + Public library names don't have this restriction. You can either change this + public name to be a valid library name or add a "name" field with a valid + library name. + Hint: Library names must be non-empty and composed only of the following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Hint: foo_bar would be a correct library name + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/dune-project deleted file mode 100644 index 43a1282a9..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.7) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/run.t deleted file mode 100644 index b608f68da..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/run.t +++ /dev/null @@ -1,25 +0,0 @@ -When a public executable is built in shared_object mode, a specific error -message is displayed: - - $ dune build --root=public --display=short - Entering directory 'public' - File "dune", line 1, characters 0-70: - 1 | (executable - 2 | (name mylib) - 3 | (public_name mylib) - 4 | (modes shared_object)) - Error: No installable mode found for this executable. - When public_name is set, one of the following modes is required: - - exe - - native - - byte - [1] - -However, it is possible to build a private one explicitly. - - $ dune build --root=private --display=short myprivatelib.so 2>&1 | dune_cmd sanitize - Entering directory 'private' - ocamldep .myprivatelib.eobjs/myprivatelib.ml.d - ocamlc .myprivatelib.eobjs/byte/myprivatelib.{cmi,cmo,cmt} - ocamlopt .myprivatelib.eobjs/native/myprivatelib.{cmx,o} - ocamlopt myprivatelib$ext_dll diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/byte-complete.t b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/byte-complete.t new file mode 100644 index 000000000..e897df5fa --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/byte-complete.t @@ -0,0 +1,27 @@ +Byte_complete is allowed to be installable since 3.6 + + $ pkg=foobarbaz + $ bin=testbin + $ cat >dune-project < (lang dune 3.5) + > EOF + $ touch $pkg.opam testbin.ml + $ cat >dune < (executable + > (name $bin) + > (public_name $bin) + > (modes byte_complete)) + > EOF + $ dune build @install + File "dune", line 4, characters 8-21: + 4 | (modes byte_complete)) + ^^^^^^^^^^^^^ + Error: byte_complete is only available since version 3.6 of the dune + language. Please update your dune-project file to have (lang dune 3.6). + [1] + $ cat >dune-project < (lang dune 3.6) + > EOF + $ dune build $pkg.install + $ grep $bin _build/default/$pkg.install + "_build/install/default/bin/testbin" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/dune b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/private/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/myprivatelib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/pkg1.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/myprivatelib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/run.t new file mode 100644 index 000000000..b9ca2f7c1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/private.t/run.t @@ -0,0 +1,7 @@ +However, it is possible to build a private one explicitly. + + $ dune build --display=short myprivatelib.so 2>&1 | dune_cmd sanitize + ocamldep .myprivatelib.eobjs/myprivatelib.ml.d + ocamlc .myprivatelib.eobjs/byte/myprivatelib.{cmi,cmo,cmt} + ocamlopt .myprivatelib.eobjs/native/myprivatelib.{cmx,o} + ocamlopt myprivatelib$ext_dll diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/dune b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode.t/public/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/mylib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/pkg2.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/mylib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/mypackage.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/pkg1.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/mypackage.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/run.t new file mode 100644 index 000000000..2ef6f7dc6 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/no-installable-mode/public.t/run.t @@ -0,0 +1,15 @@ +When a public executable is built in shared_object mode, a specific error +message is displayed: + + $ dune build --display=short + File "dune", line 1, characters 0-70: + 1 | (executable + 2 | (name mylib) + 3 | (public_name mylib) + 4 | (modes shared_object)) + Error: No installable mode found for this executable. + When public_name is set, one of the following modes is required: + - exe + - native + - byte + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/intf-only.t/foo/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/lib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/lib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/lib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/run.t index a496dd5af..affcbae69 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/run.t @@ -1,5 +1,4 @@ - $ dune exec ./test.exe --debug-dep --root dune - Entering directory 'dune' + $ dune exec ./test.exe --debug-dep File "dune", line 1, characters 0-0: Error: Module "Lib" is used in several stanzas: - dune:1 @@ -10,8 +9,7 @@ to a single library or executable. [1] - $ dune build src/a.cma --debug-dep --root dune - Entering directory 'dune' + $ dune build src/a.cma --debug-dep File "src/dune", line 1, characters 0-0: Error: Module "X" is used in several stanzas: - src/dune:1 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/src/dune b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/src/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/src/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/src/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/src/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/src/x.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/src/x.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/src/x.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/github1117.t b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/github1117.t new file mode 100644 index 000000000..a806924b9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/github1117.t @@ -0,0 +1,34 @@ +The rules that call odoc know that it is going to read the ODOC_SYNTAX +variable, and can rebuild as needed. + + $ cat > dune-project << EOF + > (lang dune 1.1) + > (package (name l)) + > EOF + + $ cat > dune << EOF + > (library + > (public_name l)) + > EOF + + $ cat > l.ml << EOF + > module type X = sig end + > EOF + + $ detect () { + > if grep -q '>sig<' $1 ; then + > echo it is ocaml + > elif grep -q '{ ... }' $1 ; then + > echo it is reason + > else + > echo it is unknown + > fi + > } + + $ dune build @doc + $ detect _build/default/_doc/_html/l/L/index.html + it is ocaml + + $ ODOC_SYNTAX=re dune build @doc + $ detect _build/default/_doc/_html/l/L/index.html + it is reason diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/run.t deleted file mode 100644 index 6c621ba8f..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/run.t +++ /dev/null @@ -1,35 +0,0 @@ -Duplicate mld's in the same scope - $ dune build @doc --display short --root ./same-scope - Entering directory 'same-scope' - odoc _doc/_html/highlight.pack.js,_doc/_html/odoc.css - odoc _doc/_odoc/pkg/root/page-index.odoc - ocamlc lib1/.root_lib1.objs/byte/root_lib1.{cmi,cmo,cmt} - ocamlc lib2/.root_lib2.objs/byte/root_lib2.{cmi,cmo,cmt} - odoc lib1/.root_lib1.objs/byte/root_lib1.odoc - odoc lib2/.root_lib2.objs/byte/root_lib2.odoc - odoc _doc/_odocls/root/root_lib1.odocl - odoc _doc/_odocls/root/root_lib2.odocl - odoc _doc/_odocls/root/page-index.odocl - odoc _doc/_html/root/Root_lib1/.dummy,_doc/_html/root/Root_lib1/index.html - odoc _doc/_html/root/Root_lib2/.dummy,_doc/_html/root/Root_lib2/index.html - odoc _doc/_html/root/index.html - -Duplicate mld's in different scope - $ rm -rf diff-scope/_build - $ dune build @doc --display short --root ./diff-scope - Entering directory 'diff-scope' - odoc _doc/_html/highlight.pack.js,_doc/_html/odoc.css - odoc _doc/_odoc/pkg/scope1/page-index.odoc - ocamlc scope1/.scope1.objs/byte/scope1.{cmi,cmo,cmt} - odoc _doc/_odoc/pkg/scope2/page-index.odoc - ocamlc scope2/.scope2.objs/byte/scope2.{cmi,cmo,cmt} - odoc scope1/.scope1.objs/byte/scope1.odoc - odoc scope2/.scope2.objs/byte/scope2.odoc - odoc _doc/_odocls/scope1/scope1.odocl - odoc _doc/_odocls/scope1/page-index.odocl - odoc _doc/_odocls/scope2/scope2.odocl - odoc _doc/_odocls/scope2/page-index.odocl - odoc _doc/_html/scope1/Scope1/.dummy,_doc/_html/scope1/Scope1/index.html - odoc _doc/_html/scope1/index.html - odoc _doc/_html/scope2/Scope2/.dummy,_doc/_html/scope2/Scope2/index.html - odoc _doc/_html/scope2/index.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/run.t new file mode 100644 index 000000000..42818864d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/run.t @@ -0,0 +1,17 @@ +Duplicate mld's in different scope + $ dune build @doc --display short + odoc _doc/_html/highlight.pack.js,_doc/_html/odoc.css + odoc _doc/_odoc/pkg/scope1/page-index.odoc + ocamlc scope1/.scope1.objs/byte/scope1.{cmi,cmo,cmt} + odoc _doc/_odoc/pkg/scope2/page-index.odoc + ocamlc scope2/.scope2.objs/byte/scope2.{cmi,cmo,cmt} + odoc scope1/.scope1.objs/byte/scope1.odoc + odoc scope2/.scope2.objs/byte/scope2.odoc + odoc _doc/_odocls/scope1/scope1.odocl + odoc _doc/_odocls/scope1/page-index.odocl + odoc _doc/_odocls/scope2/scope2.odocl + odoc _doc/_odocls/scope2/page-index.odocl + odoc _doc/_html/scope1/Scope1/.dummy,_doc/_html/scope1/Scope1/index.html + odoc _doc/_html/scope1/index.html + odoc _doc/_html/scope2/Scope2/.dummy,_doc/_html/scope2/Scope2/index.html + odoc _doc/_html/scope2/index.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/ocamldep-multi-stanzas.t/dune/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/foo.mld similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/pkg2.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/foo.mld diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/utop-script b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/scope1.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/utop-script rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope1/scope1.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope1/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/foo.mld similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/foo.mld diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/vendored.opam b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/scope2.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/vendored.opam rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/diff-scope.t/scope2/scope2.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/diff-scope/scope2/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib1/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib1/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib1/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib1/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/a.ml b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib1/test.mld similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/a.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib1/test.mld diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib2/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib2/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/lib2/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib2/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/b.ml b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib2/test.mld similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/b.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/lib2/test.mld diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/root.opam similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/root.opam diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/run.t new file mode 100644 index 000000000..e7bcb2e8c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds/same-scope.t/run.t @@ -0,0 +1,14 @@ +Duplicate mld's in the same scope + $ dune build @doc --display short + odoc _doc/_html/highlight.pack.js,_doc/_html/odoc.css + odoc _doc/_odoc/pkg/root/page-index.odoc + ocamlc lib1/.root_lib1.objs/byte/root_lib1.{cmi,cmo,cmt} + ocamlc lib2/.root_lib2.objs/byte/root_lib2.{cmi,cmo,cmt} + odoc lib1/.root_lib1.objs/byte/root_lib1.odoc + odoc lib2/.root_lib2.objs/byte/root_lib2.odoc + odoc _doc/_odocls/root/root_lib1.odocl + odoc _doc/_odocls/root/root_lib2.odocl + odoc _doc/_odocls/root/page-index.odocl + odoc _doc/_html/root/Root_lib1/.dummy,_doc/_html/root/Root_lib1/index.html + odoc _doc/_html/root/Root_lib2/.dummy,_doc/_html/root/Root_lib2/index.html + odoc _doc/_html/root/index.html diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune-invalid/dune b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune-invalid/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/odoc/odoc-unique-mlds.t/same-scope/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/run.t similarity index 65% rename from duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/run.t index ac07dcd76..22dca2fdc 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune-invalid.t/run.t @@ -1,22 +1,9 @@ -dune files -========== - -%{dep:string} -------------- - -In expands to a file name, and registers this as a dependency. - - $ dune build --root dune @test-dep - Entering directory 'dune' - dynamic-contents - %{path-no-dep:string} --------------------- This form does not exist, but displays an hint: - $ dune build --root dune-invalid @test-path-no-dep - Entering directory 'dune-invalid' + $ dune build @test-path-no-dep File "dune", line 7, characters 15-54: 7 | (echo "%{path-no-dep:file-that-does-not-exist}\n") ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune/dune b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune-invalid/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune-invalid/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/run.t new file mode 100644 index 000000000..12edcd3b9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/path-variables/dune.t/run.t @@ -0,0 +1,10 @@ +dune files +========== + +%{dep:string} +------------- + +In expands to a file name, and registers this as a dependency. + + $ dune build @test-dep + dynamic-contents diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/print-diff.t b/duniverse/dune_/test/blackbox-tests/test-cases/print-diff.t new file mode 100644 index 000000000..b7135a9b9 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/print-diff.t @@ -0,0 +1,137 @@ + $ cat > dune-project << EOF + > (lang dune 3.0) + > EOF + + $ cat > dune << EOF + > (rule + > (alias runtest) + > (action + > (diff a b))) + > + > (rule (write-file b b)) + > EOF + + $ cat > a << EOF + > a + > EOF + +--diff-command accepts a command name that is passed both files. + + $ dune runtest --diff-command echo + a b + File "a", line 1, characters 0-0: + Error: command reported no differences: cd _build/default && echo a b + [1] + +If the command succeeds (reports no diff), this is displayed. + + $ dune runtest --diff-command true + File "a", line 1, characters 0-0: + Error: command reported no differences: cd _build/default && true a b + [1] + +If the command fails, this is displayed too. + + $ dune runtest --diff-command false + File "a", line 1, characters 0-0: + Command exited with code 1. + [1] + +As a special case, - can be passed and just the fact that they differ is +printed. + + $ dune runtest --diff-command - + File "a", line 1, characters 0-0: + Error: Files _build/default/a and _build/default/b differ. + [1] + +The default behavior (when --diff-command is not passed) is equivalent to +`--diff-cmd` when testing dune. + + $ dune runtest + File "a", line 1, characters 0-0: + Error: Files _build/default/a and _build/default/b differ. + [1] + +Outside of dune, it is to first look for patdiff in PATH. + +To simulate what happens inside of dune, we'll need to setup a _path directory +with just the required binaries. _tools contains succeed (that prints its +arguments and succeeds) and fail (that prints its arguments and fails). In +addition to unsetting INSIDE_DUNE, we also need to pass +--always-show-command-line in order to have the same results locally and in CI. + + $ mkdir _tools + $ cat > _tools/succeed << 'EOF' + > #!/bin/sh + > echo Running "$0" "$@" + > EOF + $ chmod +x _tools/succeed + $ cat > _tools/fail << 'EOF' + > #!/bin/sh + > echo Running "$0" "$@" + > false + > EOF + $ chmod +x _tools/fail + $ mkdir _path + $ ln -s $(command -v dune) _path/ + $ ln -s $(command -v ocamlc) _path/ + + $ cp _tools/fail _path/patdiff + $ cp _tools/fail _path/diff + $ cp _tools/fail _path/git + + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + File "a", line 1, characters 0-0: + (cd _build/default && $TESTCASE_ROOT/_path/patdiff -keep-whitespace -location-style omake -ascii a b) + Running $TESTCASE_ROOT/_path/patdiff -keep-whitespace -location-style omake -ascii a b + [1] + +Otherwise, it will use git diff. + + $ rm _path/patdiff + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + File "a", line 1, characters 0-0: + $TESTCASE_ROOT/_path/git --no-pager diff --no-index --color=always -u _build/default/a _build/default/b + Running $TESTCASE_ROOT/_path/git --no-pager diff --no-index --color=always -u _build/default/a _build/default/b + [1] + +This also happens if patdiff returns no difference. + + $ cp _tools/succeed _path/patdiff + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + (cd _build/default && $TESTCASE_ROOT/_path/patdiff -keep-whitespace -location-style omake -ascii a b) + Running $TESTCASE_ROOT/_path/patdiff -keep-whitespace -location-style omake -ascii a b + File "a", line 1, characters 0-0: + $TESTCASE_ROOT/_path/git --no-pager diff --no-index --color=always -u _build/default/a _build/default/b + Running $TESTCASE_ROOT/_path/git --no-pager diff --no-index --color=always -u _build/default/a _build/default/b + [1] + +If patdiff or git are unavailable, it uses diff. + + $ rm _path/patdiff + $ rm _path/git + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + File "a", line 1, characters 0-0: + (cd _build/default && $TESTCASE_ROOT/_path/diff -u a b) + Running $TESTCASE_ROOT/_path/diff -u a b + [1] + +In this situation (when an automatically discovered command is used), if the +command succeeds, the "difference" message is still printed. + + $ cp _tools/succeed _path/diff + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + (cd _build/default && $TESTCASE_ROOT/_path/diff -u a b) + Running $TESTCASE_ROOT/_path/diff -u a b + File "a", line 1, characters 0-0: + Error: Files _build/default/a and _build/default/b differ. + [1] + +If diff is also not available, it just reports a difference. + + $ rm _path/diff + $ (unset INSIDE_DUNE; PATH=_path dune runtest --always-show-command-line --root .) + File "a", line 1, characters 0-0: + Error: Files _build/default/a and _build/default/b differ. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/vlib/bar.mli b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/bar.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/vlib/bar.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/bar.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/dune b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/foo.mli b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/foo.mli similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/foo.mli rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/foo.mli diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/run.t new file mode 100644 index 000000000..606716672 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/run.t @@ -0,0 +1,2 @@ + $ dune build + private module bar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/runfoo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/runfoo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/accessible-via-public/runfoo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/accessible-via-public.t/runfoo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/dune b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/run.t new file mode 100644 index 000000000..28984e48a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/run.t @@ -0,0 +1,6 @@ + $ dune build + File "foo.ml", line 1, characters 0-5: + 1 | X.run ();; + ^^^^^ + Error: Unbound module X + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/with-private/dune b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/with-private/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/inaccessible-in-deps/with-private/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/with-private/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/with-private/x.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/with-private/x.ml new file mode 100644 index 000000000..129c95687 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/inaccessible-in-deps.t/with-private/x.ml @@ -0,0 +1 @@ +let run () = print_endline "private" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/bar.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/private-subdir/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/foo.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/lib.opam b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/lib.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/priv.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/priv.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/priv2.ml b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/priv2.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/run.t similarity index 60% rename from duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/run.t index c4f4cf951..58ffe6534 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/private-modules.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/private-modules/private-subdir.t/run.t @@ -1,18 +1,7 @@ - $ dune build --root accessible-via-public - Entering directory 'accessible-via-public' - private module bar +Private modules are not excluded from the install file, but installed in the +.private subdir - $ dune build --root inaccessible-in-deps 2>&1 - Entering directory 'inaccessible-in-deps' - File "foo.ml", line 1, characters 0-5: - 1 | X.run ();; - ^^^^^ - Error: Unbound module X - [1] - -Private modules are not excluded from the install file, but installed in the .private subdir - $ dune build --root private-subdir | grep -i priv - Entering directory 'private-subdir' + $ dune build | grep -i priv "_build/install/default/lib/lib/.private/lib__Priv.cmi" {".private/lib__Priv.cmi"} "_build/install/default/lib/lib/.private/lib__Priv.cmt" {".private/lib__Priv.cmt"} "_build/install/default/lib/lib/foo/.private/priv2.cmi" {"foo/.private/priv2.cmi"} diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/private-package-lib/private-public-overlap.t b/duniverse/dune_/test/blackbox-tests/test-cases/private-package-lib/private-public-overlap.t new file mode 100644 index 000000000..cb8e1ba58 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/private-package-lib/private-public-overlap.t @@ -0,0 +1,26 @@ +We should forbid private libraries that belong to a package from depending on a +private library + + $ cat >dune-project < (lang dune 3.5) + > (package (name pkg)) + > EOF + + $ cat >dune < (library + > (name foo) + > (libraries bar) + > (package pkg) + > (modules)) + > (library + > (name bar) + > (modules)) + > EOF + + $ dune build @install + File "dune", line 3, characters 12-15: + 3 | (libraries bar) + ^^^ + Error: Library "bar" is private, it cannot be a dependency of a private + library attached to a package. You need to give "bar" a public name. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/promote/non-existent-subdir.t b/duniverse/dune_/test/blackbox-tests/test-cases/promote/non-existent-subdir.t new file mode 100644 index 000000000..8b5828fce --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/promote/non-existent-subdir.t @@ -0,0 +1,15 @@ +Test of a rule that tries to promote to a source directory that doesn't exist. + +Taken from #3502 + $ cat >dune-project < (lang dune 3.4) + > EOF + $ cat >dune < (subdir x + > (rule + > (mode (promote (until-clean))) + > (action (with-stdout-to y (echo "z"))))) + > EOF + $ dune build x/y + $ cat x/y + z diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-apply.t b/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-apply.t new file mode 100644 index 000000000..c2a074c65 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-apply.t @@ -0,0 +1,30 @@ +`dune promotion run` is equivalent to `dune promote`. + + $ cat > dune-project << EOF + > (lang dune 2.0) + > EOF + + $ cat > dune << EOF + > (rule + > (alias runtest) + > (action + > (diff a.expected a.actual))) + > + > (rule + > (write-file a.actual Actual)) + > EOF + + $ cat > a.expected << EOF + > Expected + > EOF + + $ dune runtest + File "a.expected", line 1, characters 0-0: + Error: Files _build/default/a.expected and _build/default/a.actual differ. + [1] + $ cat a.expected + Expected + $ dune promotion apply + Promoting _build/default/a.actual to a.expected. + $ cat a.expected + Actual diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-diff.t b/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-diff.t new file mode 100644 index 000000000..7157b11c0 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/promote/promotion-diff.t @@ -0,0 +1,64 @@ + $ cat > dune-project << EOF + > (lang dune 2.0) + > EOF + + $ cat > dune << EOF + > (rule + > (alias runtest) + > (action + > (diff a.expected a.actual))) + > + > (rule + > (with-stdout-to a.actual + > (echo "A actual\n"))) + > + > (rule + > (alias runtest) + > (action + > (progn + > (with-stdout-to b.actual + > (echo "B actual\n")) + > (diff? b.expected b.actual)))) + > EOF + + $ echo 'A expected' > a.expected + $ echo 'B expected' > b.expected + $ touch nothing-to-promote.txt + + $ dune runtest + File "a.expected", line 1, characters 0-0: + Error: Files _build/default/a.expected and _build/default/a.actual differ. + File "b.expected", line 1, characters 0-0: + Error: Files _build/default/b.expected and _build/default/b.actual differ. + [1] + + $ dune promotion diff --diff-command 'diff -u' 2>&1 | sed -e 's/\t.*$//' + File "a.expected", line 1, characters 0-0: + --- a.expected + +++ _build/default/a.actual + @@ -1 +1 @@ + -A expected + +A actual + File "b.expected", line 1, characters 0-0: + --- b.expected + +++ _build/.promotion-staging/b.expected + @@ -1 +1 @@ + -B expected + +B actual + + $ dune promotion diff b.expected --diff-command 'diff -u' 2>&1 | sed -e 's/\t.*$//' + File "b.expected", line 1, characters 0-0: + --- b.expected + +++ _build/.promotion-staging/b.expected + @@ -1 +1 @@ + -B expected + +B actual + + $ dune promotion diff a.expected nothing-to-promote.txt --diff-command 'diff -u' 2>&1 | sed -e 's/\t.*$//' + Warning: Nothing to promote for nothing-to-promote.txt. + File "a.expected", line 1, characters 0-0: + --- a.expected + +++ _build/default/a.actual + @@ -1 +1 @@ + -A expected + +A actual diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/dune-project deleted file mode 100644 index de4fc2092..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.0) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/run.t deleted file mode 100644 index bfa53dfb0..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/run.t +++ /dev/null @@ -1,48 +0,0 @@ -This behavior is surprising, we should get an error about the fact -that ${@} is not quoted and doesn't contain exactly 1 element - - $ dune build --root bad x - Entering directory 'bad' - File "dune", line 3, characters 25-35: - 3 | (action (with-stdout-to %{targets} (echo foo)))) - ^^^^^^^^^^ - Error: Variable %{targets} expands to 2 values, however a single value is - expected here. Please quote this atom. - [1] - -The targets should only be interpreted as a single path when quoted - - $ dune build --root good s - Entering directory 'good' - File "dune", line 1, characters 0-72: - 1 | (rule - 2 | (targets s t) - 3 | (action (with-stdout-to "%{targets}" (echo foo)))) - Error: Rule failed to generate the following targets: - - s - - t - [1] - - $ dune runtest --root quote-from-context - Entering directory 'quote-from-context' - Number of args: 3 - - $ dune runtest --root quotes-multi - Entering directory 'quotes-multi' - lines: foo bar baz - - $ dune build @quoted --root filename-space - Entering directory 'filename-space' - File "dune", line 4, characters 17-18: - 4 | (action (echo %{read:foo bar.txt}))) - ^ - Error: This character is not allowed inside %{...} forms - [1] - - $ dune build @unquoted --root filename-space - Entering directory 'filename-space' - File "dune", line 4, characters 17-18: - 4 | (action (echo %{read:foo bar.txt}))) - ^ - Error: This character is not allowed inside %{...} forms - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/bad/dune b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/bad/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/path-variables.t/dune/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/run.t new file mode 100644 index 000000000..88beff670 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/bad.t/run.t @@ -0,0 +1,10 @@ +This behavior is surprising, we should get an error about the fact +that ${@} is not quoted and doesn't contain exactly 1 element + + $ dune build x + File "dune", line 3, characters 25-35: + 3 | (action (with-stdout-to %{targets} (echo foo)))) + ^^^^^^^^^^ + Error: Variable %{targets} expands to 2 values, however a single value is + expected here. Please quote this atom. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/dune b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/bad/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/bad/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/foo bar.txt b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/foo bar.txt similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/foo bar.txt rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/foo bar.txt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/run.t new file mode 100644 index 000000000..4a97e97a2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/filename-space.t/run.t @@ -0,0 +1,6 @@ + $ dune build @quoted + File "dune", line 4, characters 17-18: + 4 | (action (echo %{read:foo bar.txt}))) + ^ + Error: This character is not allowed inside %{...} forms + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/good/dune b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/good/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/filename-space/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/run.t new file mode 100644 index 000000000..240e52508 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/good.t/run.t @@ -0,0 +1,11 @@ +The targets should only be interpreted as a single path when quoted + + $ dune build s + File "dune", line 1, characters 0-72: + 1 | (rule + 2 | (targets s t) + 3 | (action (with-stdout-to "%{targets}" (echo foo)))) + Error: Rule failed to generate the following targets: + - s + - t + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/args b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/args similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/args rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/args diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/count_args.ml b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/count_args.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/count_args.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/count_args.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/dune b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/good/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/good/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/run.t new file mode 100644 index 000000000..df55ccee3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quote-from-context.t/run.t @@ -0,0 +1,2 @@ + $ dune runtest + Number of args: 3 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/dune b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quote-from-context/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/foo b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/foo similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/quoting.t/quotes-multi/foo rename to duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/foo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/run.t new file mode 100644 index 000000000..e4346e79a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/quoting/quotes-multi.t/run.t @@ -0,0 +1,2 @@ + $ dune runtest + lines: foo bar baz diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/re-export-exe/dune b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/re-export-exe/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/re-export-exe/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/re-export-exe/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/run.t new file mode 100644 index 000000000..0eff12c1c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/re-export-exe.t/run.t @@ -0,0 +1,7 @@ +Re-exporting deps in executables isn't allowed + $ dune build @all + File "dune", line 7, characters 12-27: + 7 | (libraries (re_export foo))) + ^^^^^^^^^^^^^^^ + Error: re_export is not allowed here + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/aaa.ml b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/aaa.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/bbb.ml b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/bbb.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/ccc.ml b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/ccc.ml new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/dune b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/transitive/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/run.t similarity index 74% rename from duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/run.t index 7e8102c48..4c9580f07 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/re-exported-deps/transitive.t/run.t @@ -1,12 +1,10 @@ dependencies can be exported transitively: - $ dune exec ./foo.exe --root transitive - Entering directory 'transitive' + $ dune exec ./foo.exe transitive deps expressed in the dune-package - $ dune build @install --root transitive - Entering directory 'transitive' - $ dune_cmd cat transitive/_build/install/default/lib/pkg/dune-package | sed "s/(lang dune .*)/(lang dune )/" | dune_cmd sanitize + $ dune build @install + $ dune_cmd cat _build/install/default/lib/pkg/dune-package | sed "s/(lang dune .*)/(lang dune )/" | dune_cmd sanitize (lang dune ) (name pkg) (sections (lib .) (libexec .)) @@ -65,12 +63,3 @@ transitive deps expressed in the dune-package (main_module_name Ccc) (modes byte native) (modules (singleton (name Ccc) (obj_name ccc) (visibility public) (impl)))) - -Re-exporting deps in executables isn't allowed - $ dune build --root re-export-exe @all - Entering directory 're-export-exe' - File "dune", line 7, characters 12-27: - 7 | (libraries (re_export foo))) - ^^^^^^^^^^^^^^^ - Error: re_export is not allowed here - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t index e94b8e121..e630fee88 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t @@ -67,22 +67,3 @@ cryptic and can involve unrelated files: -> required by _build/default/indirect/a.exe -> required by alias indirect/indirect-deps in indirect/dune:6 [1] - -This is a reproduction case from issue #4345 - $ DIR="gh4345" - $ mkdir $DIR && cd $DIR - $ echo "(lang dune 2.8)" > dune-project - $ mkdir lib - $ touch lib.opam file lib/lib.ml - $ cat >lib/dune < (library (name lib) (public_name lib)) - > (copy_files (files ../file)) - > EOF - $ dune build --root . - Error: Dependency cycle between: - Computing installable artifacts for package lib - -> Evaluating predicate in directory _build/default - -> Computing directory contents of _build/default/lib - -> Computing installable artifacts for package lib - [1] - $ cd .. diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/root-module-duplicate.t b/duniverse/dune_/test/blackbox-tests/test-cases/root-module-duplicate.t new file mode 100644 index 000000000..9aed57cd8 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/root-module-duplicate.t @@ -0,0 +1,79 @@ +The following setup makes the `root_module` stanza export the `Logs` +modules twice, entailing the following error: + +``` +| File "root.ml-gen", line 15, characters 0-18: +| 15 | module Logs = Logs +| ^^^^^^^^^^^^^^^^^^ +| Error: Multiple definition of the module name Logs. +| Names must be unique in a given structure or signature. +| [1] +``` + + +Create a dummy library to depend on. The configuration is loosely +based on the logs package, which triggers the issue in real life. + + $ mkdir -p findlib-packages/logs + $ cat >findlib-packages/logs/META < description = "Logging infrastructure for OCaml" + > version = "0.7.0" + > requires = "" + > archive(byte) = "logs.cma" + > archive(native) = "logs.cmxa" + > plugin(byte) = "logs.cma" + > plugin(native) = "logs.cmxs" + > package "lwt" ( + > description = "Lwt support for Logs" + > version = "0.7.0" + > requires = "logs" + > archive(byte) = "logs_lwt.cma" + > archive(native) = "logs_lwt.cmxa" + > plugin(byte) = "logs_lwt.cma" + > plugin(native) = "logs_lwt.cmxs" + > ) + > EOF + + $ touch findlib-packages/logs/logs.ml + $ touch findlib-packages/logs/logs.mli + $ ocamlc -c findlib-packages/logs/logs.mli -o findlib-packages/logs/logs.cmi + $ ocamlc -c -I findlib-packages/logs findlib-packages/logs/logs.ml -o findlib-packages/logs/logs.cmo + $ ocamlc -a findlib-packages/logs/logs.cmo -o findlib-packages/logs/logs.cma + + $ touch findlib-packages/logs/logs_lwt.ml + $ touch findlib-packages/logs/logs_lwt.mli + $ ocamlc -c findlib-packages/logs/logs_lwt.mli -o findlib-packages/logs/logs_lwt.cmi + $ ocamlc -c -I findlib-packages/logs findlib-packages/logs/logs_lwt.ml -o findlib-packages/logs/logs_lwt.cmo + $ ocamlc -a findlib-packages/logs/logs_lwt.cmo -o findlib-packages/logs/logs_lwt.cma + + $ export OCAMLPATH="./findlib-packages" + +Setup the dune project. + + $ cat >dune-project < (lang dune 3.4) + > EOF + $ cat >dune < (library + > (name root_module) + > (root_module root) + > (libraries logs.lwt)) + > EOF + $ cat >root_module.ml < module Logs = Root.Logs + > EOF + +Trigger the error. + + $ dune build + File "root.ml-gen", line 3, characters 0-18: + 3 | module Logs = Logs + ^^^^^^^^^^^^^^^^^^ + Error: Multiple definition of the module name Logs. + Names must be unique in a given structure or signature. + [1] + $ cat _build/default/root.ml-gen + module Logs = Logs + module Logs_lwt = Logs_lwt + module Logs = Logs + module Logs_lwt = Logs_lwt diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/run.t deleted file mode 100644 index e271edb78..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/run.t +++ /dev/null @@ -1,33 +0,0 @@ -When a rule target can be be inferred from the rule action, the target or targets field can be omitted. -This works with the short form of the rule stanza: - - $ dune build @infer --root short-form - Entering directory 'short-form' - It worked! - -But should work with the long form as well: - - $ dune build @infer --root long-form - Entering directory 'long-form' - It should work as well! - -When an action has no targets, an helpful error message is displayed: - - $ dune build --root no-target - Entering directory 'no-target' - File "dune", line 1, characters 0-34: - 1 | (rule (action (echo "something"))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: Rule has no targets specified - [1] - -When the rule action targets cannot be inferred by dune, we should make it explicit -in the error message: - - $ dune build --root cannot-infer - Entering directory 'cannot-infer' - File "dune", line 1, characters 0-36: - 1 | (rule (action (system "something"))) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: Rule has no targets specified - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/cannot-infer/dune b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/cannot-infer/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/cannot-infer/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/cannot-infer/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/run.t new file mode 100644 index 000000000..87f37b956 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/cannot-infer.t/run.t @@ -0,0 +1,9 @@ +When the rule action targets cannot be inferred by dune, we should make it explicit +in the error message: + + $ dune build + File "dune", line 1, characters 0-36: + 1 | (rule (action (system "something"))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: Rule has no targets specified + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/long-form/dune b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/long-form/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/long-form/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/long-form/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/run.t new file mode 100644 index 000000000..3f8fdd2b3 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/long-form.t/run.t @@ -0,0 +1,4 @@ +But should work with the long form as well: + + $ dune build @infer + It should work as well! diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/no-target/dune b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/no-target/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/no-target/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/no-target/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/run.t new file mode 100644 index 000000000..cb03c5b93 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/no-target.t/run.t @@ -0,0 +1,8 @@ +When an action has no targets, an helpful error message is displayed: + + $ dune build + File "dune", line 1, characters 0-34: + 1 | (rule (action (echo "something"))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: Rule has no targets specified + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/short-form/dune b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/short-form/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/short-form/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence.t/short-form/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/run.t new file mode 100644 index 000000000..767fc4adc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule-target-inferrence/short-form.t/run.t @@ -0,0 +1,6 @@ +When a rule target can be be inferred from the rule action, the target or +targets field can be omitted. This works with the short form of the rule +stanza: + + $ dune build @infer + It worked! diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/pwd.ml b/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/pwd.ml new file mode 100644 index 000000000..0d62729df --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/pwd.ml @@ -0,0 +1,35 @@ +let () = Printexc.record_backtrace true + +let digest = + let raw = Sys.getcwd () |> Filename.dirname |> Filename.basename in + let idx = + let store_path = Sys.getenv "DUNE_PWD_STORE" in + match open_in store_path with + | exception Sys_error _ -> + let out = open_out_gen [ Open_append; Open_creat ] 0 store_path in + Printf.fprintf out "%s\n" raw; + close_out out; + 1 + | store -> + let rec loop i = + match input_line store with + | line -> if line = raw then i else loop (i + 1) + | exception End_of_file -> + close_in store; + let out = open_out_gen [ Open_append; Open_creat ] 0 store_path in + Printf.fprintf out "%s\n" raw; + close_out out; + i + in + let index = loop 1 in + close_in store; + index + in + Printf.sprintf "$%d" idx + +let () = + print_endline "running..."; + let out = open_out "target" in + output_string out "target"; + close_out out; + Printf.printf "digest: %s\n" digest diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/run.t new file mode 100644 index 000000000..b0cf36295 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/rule/digest.t/run.t @@ -0,0 +1,70 @@ +---------------------------------------------------------------------------------- +Test that rule digest doesn't depend on irrelevant details of the dune file + + $ export DUNE_PWD_STORE="$(mktemp)" + + $ echo "(lang dune 3.0)" > dune-project + + $ cat >dune < (rule + > (target target) + > (mode promote) + > (deps (sandbox always) pwd.ml) + > (action (run ocaml pwd.ml))) + > EOF + + $ dune build target + running... + digest: $1 + +Let's add a comment to the dune file. It shouldn't affect the rule digest. + + $ cat >dune < ; hello + > (rule + > (target target) + > (mode promote) + > (deps (sandbox always) pwd.ml) + > (action (run ocaml pwd.ml))) + > EOF + +... and it doesn't. + + $ rm _build/default/target target + $ dune build @default + running... + digest: $1 + +Now the same but with an alias. + + $ cat >dune < (rule + > (alias default) + > (deps (sandbox always) pwd.ml) + > (action (run ocaml pwd.ml))) + > EOF + + $ dune build @default + running... + digest: $2 + +Let's add a comment to the dune file. One might think that it doesn't affect +the rule digest, but it does because all the locations gets shifted. + + $ cat >dune < ; hello + > (rule + > (alias default) + > (deps (sandbox always) pwd.ml) + > (action (run ocaml pwd.ml))) + > EOF + +... but it does! It would be nice to encode the locations in a way that would +make them more resilient to non semantic changes. + +# CR-someday amokhov: Remove actual digests from this test so that we don't +# need to update it when rule digest version changes. + + $ dune build @default + running... + digest: $3 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/dune b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/dune deleted file mode 100644 index 05df03d38..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/dune +++ /dev/null @@ -1,3 +0,0 @@ -(executable - (public_name an_executable) -) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/run.t deleted file mode 100644 index 21ad9311d..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/run.t +++ /dev/null @@ -1,47 +0,0 @@ -If two packages are available and no (package) is present, an error message is -displayed. This can happen for: - -- (executable) - - $ dune build --root executable - Entering directory 'executable' - File "dune", line 1, characters 0-43: - 1 | (executable - 2 | (public_name an_executable) - 3 | ) - Error: I can't determine automatically which package this stanza is for. - I have the choice between these ones: - - pkg1 (because of pkg1.opam) - - pkg2 (because of pkg2.opam) - You need to add a (package ...) field to this (executable) stanza. - [1] - -- (documentation) - - $ dune build --root documentation - Entering directory 'documentation' - File "dune", line 1, characters 0-15: - 1 | (documentation) - ^^^^^^^^^^^^^^^ - Error: I can't determine automatically which package this stanza is for. - I have the choice between these ones: - - pkg1 (because of pkg1.opam) - - pkg2 (because of pkg2.opam) - You need to add a (package ...) field to this (documentation) stanza. - [1] - -- (install) - - $ dune build --root install - Entering directory 'install' - File "dune", line 1, characters 0-44: - 1 | (install - 2 | (section etc) - 3 | (files file.conf) - 4 | ) - Error: I can't determine automatically which package this stanza is for. - I have the choice between these ones: - - pkg1 (because of pkg1.opam) - - pkg2 (because of pkg2.opam) - You need to add a (package ...) field to this (install) stanza. - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/dune b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/documentation/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/pkg1.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/pkg2.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/run.t new file mode 100644 index 000000000..8226f8c07 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/documentation.t/run.t @@ -0,0 +1,15 @@ +If two packages are available and no (package) is present, an error message is +displayed. This can happen for: + +- (documentation) + + $ dune build + File "dune", line 1, characters 0-15: + 1 | (documentation) + ^^^^^^^^^^^^^^^ + Error: I can't determine automatically which package this stanza is for. + I have the choice between these ones: + - pkg1 (because of pkg1.opam) + - pkg2 (because of pkg2.opam) + You need to add a (package ...) field to this (documentation) stanza. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/dune new file mode 100644 index 000000000..a11a6cc9b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/dune @@ -0,0 +1,2 @@ +(executable + (public_name an_executable)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/pkg1.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/pkg2.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/run.t new file mode 100644 index 000000000..aa9208b39 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/executable.t/run.t @@ -0,0 +1,15 @@ +If two packages are available and no (package) is present, an error message is +displayed. This can happen for: + +- (executable) + + $ dune build + File "dune", line 1, characters 0-41: + 1 | (executable + 2 | (public_name an_executable)) + Error: I can't determine automatically which package this stanza is for. + I have the choice between these ones: + - pkg1 (because of pkg1.opam) + - pkg2 (because of pkg2.opam) + You need to add a (package ...) field to this (executable) stanza. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/dune b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/dune similarity index 53% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/dune index a44d3567d..d387b3beb 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/dune @@ -1,4 +1,3 @@ (install (section etc) - (files file.conf) -) + (files file.conf)) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/executable/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/pkg1.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/pkg1.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/pkg2.opam b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/pkg2.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/run.t new file mode 100644 index 000000000..bcc8ce68f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/several-packages/install-stanza.t/run.t @@ -0,0 +1,16 @@ +If two packages are available and no (package) is present, an error message is +displayed. This can happen for: + +- (install) + + $ dune build + File "dune", line 1, characters 0-43: + 1 | (install + 2 | (section etc) + 3 | (files file.conf)) + Error: I can't determine automatically which package this stanza is for. + I have the choice between these ones: + - pkg1 (because of pkg1.opam) + - pkg2 (because of pkg2.opam) + You need to add a (package ...) field to this (install) stanza. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/subst/project-name-restriction.t b/duniverse/dune_/test/blackbox-tests/test-cases/subst/project-name-restriction.t index e17fd67d4..cf0dcbe90 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/subst/project-name-restriction.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/subst/project-name-restriction.t @@ -31,4 +31,4 @@ doesn't verify that this is the case $ cat file.ml let name = "dune" let authors = "Jane Street Group, LLC " - let version = "3.4.1" + let version = "3.6.1" diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/target-outside-dir.t b/duniverse/dune_/test/blackbox-tests/test-cases/target-outside-dir.t new file mode 100644 index 000000000..39d269664 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/target-outside-dir.t @@ -0,0 +1,37 @@ +Generate rules in sub directories. There's two ways targets are specified: + +* Inferred from the action +* Specified by the user + +The restriction on generating targets should be the same on both. + + $ cat >dune-project < (lang dune 3.2) + > EOF + + $ cat >dune < (rule + > (with-stdout-to foo/bar.ml (echo "let foo = 42;;"))) + > EOF + + $ dune build foo/bar.ml + File "dune", line 2, characters 17-27: + 2 | (with-stdout-to foo/bar.ml (echo "let foo = 42;;"))) + ^^^^^^^^^^ + Error: This action has targets in a different directory than the current one, + this is not allowed by dune at the moment: + - foo/bar.ml + [1] + + $ cat >dune < (rule + > (targets foo/bar.ml) + > (action (with-stdout-to foo/bar.ml (echo "let foo = 42;;")))) + > EOF + + $ dune build foo/bar.ml + File "dune", line 2, characters 10-20: + 2 | (targets foo/bar.ml) + ^^^^^^^^^^ + Error: "foo/bar.ml" does not denote a file in the current directory. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/run.t deleted file mode 100644 index 1aca6b9ae..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/run.t +++ /dev/null @@ -1,14 +0,0 @@ - $ dune runtest --root singular - Entering directory 'singular' - singular test - - $ dune runtest --root plural - Entering directory 'plural' - regular test - regular test2 - $ dune runtest --root generated - Entering directory 'generated' - File "generated.expected", line 1, characters 0-0: - Error: Files _build/default/generated.expected and - _build/default/generated.output differ. - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/dune b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/generated.ml b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/generated.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/generated/generated.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/generated.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/run.t new file mode 100644 index 000000000..f041a30b2 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/generated.t/run.t @@ -0,0 +1,5 @@ + $ dune runtest + File "generated.expected", line 1, characters 0-0: + Error: Files _build/default/generated.expected and + _build/default/generated.output differ. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/dune b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/expect_test.expected b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/expect_test.expected similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/expect_test.expected rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/expect_test.expected diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/expect_test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/expect_test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/expect_test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/expect_test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/regular_test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/regular_test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/regular_test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/regular_test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/regular_test2.ml b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/regular_test2.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/plural/regular_test2.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/regular_test2.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/run.t new file mode 100644 index 000000000..3b9e9133e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/plural.t/run.t @@ -0,0 +1,3 @@ + $ dune runtest + regular test + regular test2 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/dune b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/run.t new file mode 100644 index 000000000..c377bfede --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/run.t @@ -0,0 +1,2 @@ + $ dune runtest + singular test diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/singular.ml b/duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/singular.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza.t/singular/singular.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/tests-stanza/singular.t/singular.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/top-module/dune b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/dune new file mode 100644 index 000000000..b48c8499a --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/dune @@ -0,0 +1,3 @@ +(cram + (applies_to load-with-pp) + (deps %{bin:dunepp})) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-exe.t b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-exe.t new file mode 100644 index 000000000..059d37f0d --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-exe.t @@ -0,0 +1,40 @@ +We try to load a module defined in an executable + + $ cat >dune-project < (lang dune 3.3) + > EOF + + $ cat >bar.ml < let v = 42 + > EOF + + $ cat >foo.ml < let foo = Bar.v + 42 + > EOF + + $ cat >dune < (executable + > (name foo)) + > EOF + + $ dune ocaml top-module foo.ml + #directory "$TESTCASE_ROOT/_build/default/.topmod/foo.ml";; + #load "$TESTCASE_ROOT/_build/default/.foo.eobjs/byte/dune__exe.cmo";; + #load "$TESTCASE_ROOT/_build/default/.foo.eobjs/byte/dune__exe__Bar.cmo";; + #load "$TESTCASE_ROOT/_build/default/.topmod/foo.ml/dune__exe__Foo.cmo";; + open Dune__exe + ;; + + $ ls _build/default/.topmod/foo.ml/ + dune__exe.cmi + dune__exe__Bar.cmi + dune__exe__Foo.cmi + dune__exe__Foo.cmo + + $ dir=_build/default/.foo.eobjs/byte/ + $ ls $dir/*.cmi + _build/default/.foo.eobjs/byte//dune__exe.cmi + _build/default/.foo.eobjs/byte//dune__exe__Bar.cmi + $ ls $dir/*.cmo + _build/default/.foo.eobjs/byte//dune__exe.cmo + _build/default/.foo.eobjs/byte//dune__exe__Bar.cmo diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-lib.t b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-lib.t new file mode 100644 index 000000000..d0b26b040 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-from-lib.t @@ -0,0 +1,58 @@ +We try to load a module defined in a library with a dependnecy + + $ cat >dune-project < (lang dune 3.3) + > EOF + + $ mkdir foo + $ cd foo + + $ cat >bar.ml < let v = 42 + > EOF + + $ cat >foo.ml < let foo = Bar.v + 42 + > EOF + + $ cat >dune < (library + > (libraries mydummylib) + > (name foo)) + > EOF + + $ cd .. + + $ mkdir mydummylib + $ cd mydummylib + $ cat >dune < (library (name mydummylib)) + > EOF + $ touch mydummylib.ml + $ touch blabla.ml + + $ cd .. + + $ dune ocaml top-module foo/foo.ml + #directory "$TESTCASE_ROOT/_build/default/.topmod/foo/foo.ml";; + #directory "$TESTCASE_ROOT/_build/default/mydummylib/.mydummylib.objs/byte";; + #load "$TESTCASE_ROOT/_build/default/mydummylib/mydummylib.cma";; + #load "$TESTCASE_ROOT/_build/default/foo/.foo.objs/byte/foo__.cmo";; + #load "$TESTCASE_ROOT/_build/default/foo/.foo.objs/byte/foo__Bar.cmo";; + #load "$TESTCASE_ROOT/_build/default/.topmod/foo/foo.ml/foo.cmo";; + open Foo__ + ;; + + $ ls _build/default/.topmod/foo/foo.ml + foo.cmi + foo.cmo + foo__.cmi + foo__Bar.cmi + + $ ls _build/default/mydummylib/.mydummylib.objs/byte/*.cmi + _build/default/mydummylib/.mydummylib.objs/byte/mydummylib.cmi + _build/default/mydummylib/.mydummylib.objs/byte/mydummylib__.cmi + _build/default/mydummylib/.mydummylib.objs/byte/mydummylib__Blabla.cmi + + $ ls _build/default/mydummylib/*.cma + _build/default/mydummylib/mydummylib.cma diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-pp.t b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-pp.t new file mode 100644 index 000000000..8b8a201d7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-pp.t @@ -0,0 +1,18 @@ + $ cat >dune-project < (lang dune 3.3) + > EOF + + $ cat >dune < (library + > (preprocess (action (run %{bin:dunepp} %{input-file}))) + > (name foo)) + > EOF + + $ cat >foo.ml < let foo = _STRING_ + > EOF + + $ dune ocaml top-module foo.ml | sed 's/"[^"]*dunepp"/$dunepp/g' + #directory "$TESTCASE_ROOT/_build/default/.topmod/foo.ml";; + #load "$TESTCASE_ROOT/_build/default/.topmod/foo.ml/foo.cmo";; + #pp $dunepp;; diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-ppx.t b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-ppx.t new file mode 100644 index 000000000..5f1078642 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/top-module/load-with-ppx.t @@ -0,0 +1,33 @@ +Load a module that requires ppx + + $ cat >dune-project < (lang dune 3.3) + > EOF + + $ cat >dune < (library + > (name driver_print_args) + > (kind ppx_rewriter) + > (modules ()) + > (ppx.driver (main "\| (fun () -> + > "\| let out = Sys.argv.(4) in + > "\| let out = open_out out in + > "\| let rec loop () = + > "\| match input_line stdin with + > "\| | s -> output_string out (s ^ "\n"); loop () + > "\| | exception End_of_file -> close_out out + > "\| in loop ()) + > ))) + > (library + > (name foo) + > (preprocess (pps driver_print_args))) + > EOF + $ cat >foo.ml < let () = () + > EOF + $ dune ocaml top-module foo.ml + #directory "$TESTCASE_ROOT/_build/default/.topmod/foo.ml";; + #load "$TESTCASE_ROOT/_build/default/.topmod/foo.ml/foo.cmo";; + #ppx "$TESTCASE_ROOT/_build/default/.ppx/d464a1bb671660981248d354c1722d5f/ppx.exe --as-ppx --cookie 'library-name=\"foo\"'";; + $ basename $(ls _build/default/.ppx/*/*.exe) + ppx.exe diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/run.t deleted file mode 100644 index 800a2d08f..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/run.t +++ /dev/null @@ -1,16 +0,0 @@ -Simple example to run toplevel - $ dune exec --root simple ./tt.exe -- -init simple/init.ml | sed -E 's/OCaml version .*$/OCaml version REDACTED/g' - Entering directory 'simple' - OCaml version REDACTED - Enter #help;; for help. - - Foo.x = 42 - - -Running toplevel with preprocessor - $ dune exec --root preprocessors ./tt.exe -- -init preprocessors/init.ml | sed -E 's/OCaml version .*$/Ocaml version REDACTED/g' - Entering directory 'preprocessors' - Ocaml version REDACTED - Enter #help;; for help. - - PPX extension: 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/dune b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/fooppx.ml b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/fooppx.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/fooppx.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/fooppx.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/init.ml b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/init.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/preprocessors/init.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/init.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/run.t new file mode 100644 index 000000000..f6ad3a113 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/preprocessors.t/run.t @@ -0,0 +1,6 @@ +Running toplevel with preprocessor + $ dune exec ./tt.exe -- -init init.ml | sed -E 's/OCaml version .*$/Ocaml version REDACTED/g' + Ocaml version REDACTED + Enter #help;; for help. + + PPX extension: 42 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/dune b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/init.ml b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/init.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza.t/simple/init.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/init.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/run.t new file mode 100644 index 000000000..d8ae57d54 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/toplevel-stanza/simple.t/run.t @@ -0,0 +1,8 @@ +Simple example to run toplevel + + $ dune exec ./tt.exe -- -init init.ml | sed -E 's/OCaml version .*$/OCaml version REDACTED/g' + OCaml version REDACTED + Enter #help;; for help. + + Foo.x = 42 + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/nothing-in-root/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/nothing-in-root/dune-project deleted file mode 100644 index 7655de077..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/nothing-in-root/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.1) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/run.t deleted file mode 100644 index f4872f167..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/run.t +++ /dev/null @@ -1,26 +0,0 @@ -By default, dune utop tries to make a toplevel for the current directory: - - $ echo 'exit 0;;' | dune utop --root lib-in-root . -- -init "" | grep -v 'version' - Entering directory 'lib-in-root' - Enter #help;; for help. - - Init file not found: "". - # - - -Utop will load libs recursively: - - $ echo 'exit 0;;' | dune utop --root nothing-in-root . -- -init "" | grep -v 'version' - Entering directory 'nothing-in-root' - Enter #help;; for help. - - Init file not found: "". - # - - -The message where the library path does not exist is different: - - $ dune utop --root nothing-in-root does-not-exist . -- -init "" - Entering directory 'nothing-in-root' - Error: cannot find directory: does-not-exist - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/dune b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/several-packages.t/install/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/run.t new file mode 100644 index 000000000..9c5cdcccc --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/run.t @@ -0,0 +1,7 @@ +By default, dune utop tries to make a toplevel for the current directory: + + $ echo 'exit 0;;' | dune utop . -- -init "" | grep -v 'version' + Enter #help;; for help. + + Init file not found: "". + # diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/utop-script b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/lib-in-root.t/utop-script new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/lib-in-root/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/nothing-in-root/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default.t/nothing-in-root/lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/run.t new file mode 100644 index 000000000..7b19bb66b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/utop/utop-default/nothing-in-root.t/run.t @@ -0,0 +1,14 @@ +Utop will load libs recursively: + + $ echo 'exit 0;;' | dune utop . -- -init "" | grep -v 'version' + Enter #help;; for help. + + Init file not found: "". + # + + +The message where the library path does not exist is different: + + $ dune utop does-not-exist . -- -init "" + Error: cannot find directory: does-not-exist + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dir/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dir/dune new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/conflicts-with-data-only/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/run.t new file mode 100644 index 000000000..237f5e33b --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/conflicts-with-data-only.t/run.t @@ -0,0 +1,6 @@ +The same directory cannot be marked as both vendored and data-only + + $ dune build + Error: Directory dir was marked as data_only and vendored, it can't be marked + as both. + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-dataonly/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-dataonly/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-dataonly/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-dataonly/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/run.t new file mode 100644 index 000000000..c53cca7f7 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-dataonly.t/run.t @@ -0,0 +1,9 @@ +Only direct subdirectories can be marked as data-only + + $ dune build + File "dune", line 1, characters 16-21: + 1 | (data_only_dirs a/b/c) + ^^^^^ + Error: only immediate sub-directories may be specified. + Hint: to ignore a/b/c, write "(data_only_dirs c)" in a/b/dune + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-vendor/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-vendor/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-vendor/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/deep-subfolder-vendor/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/run.t new file mode 100644 index 000000000..e7410f747 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/deep-subfolder-vendor.t/run.t @@ -0,0 +1,10 @@ +Only direct subdirectories can be marked as vendored + + $ dune build + File "dune", line 1, characters 15-18: + 1 | (vendored_dirs a/b) + ^^^ + Error: only immediate sub-directories may be specified. + Hint: to ignore a/b, write "(vendored_dirs b)" in a/dune + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/lib/vendored.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/lib/vendored.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/lib/vendored.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/lib/vendored.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/tests/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/tests/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/tests/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/tests/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/tests/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/tests/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/duniverse/vendored/tests/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/tests/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/vendored.opam b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/duniverse/vendored/vendored.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/lib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/lib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/lib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/lib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/lib/main.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/lib/main.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/lib/main.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/lib/main.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/main.opam b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/main.opam new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/run.t new file mode 100644 index 000000000..8ff07950e --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/run.t @@ -0,0 +1,9 @@ +Vendored directories should be traversed to find targets so that they are built +when they are depend upon + + $ dune build --debug-dependency-path + +Aliases should not be resolved in vendored sub directories + + $ dune runtest + Hello from main lib! diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/tests/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/tests/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/tests/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/tests/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/tests/test.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/tests/test.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/duniverse/tests/test.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/duniverse.t/tests/test.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/from-1-11/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/from-1-11/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/from-1-11/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/from-1-11/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/run.t new file mode 100644 index 000000000..289fee392 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/from-1-11.t/run.t @@ -0,0 +1,9 @@ +The vendored_dirs stanza is available from version 1.11 of the dune language + + $ dune build + File "dune", line 1, characters 0-17: + 1 | (vendored_dirs *) + ^^^^^^^^^^^^^^^^^ + Error: 'vendored_dirs' is only available since version 1.11 of the dune + language. Please update your dune-project file to have (lang dune 1.11). + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/dune deleted file mode 100644 index 67b077aef..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/dune +++ /dev/null @@ -1,6 +0,0 @@ -(alias - (name inaccurate-merlins-are-ok) - (deps vendored/a.ml) - (action (echo "There should be no inaccurate .merlin warning above!"))) - -(vendored_dirs vendored) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/dune deleted file mode 100644 index 134706f4c..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/vendored/dune +++ /dev/null @@ -1,9 +0,0 @@ -(library - (name a) - (modules a) - (preprocess (action (bash "some_command")))) - -(library - (name b) - (modules b) - (preprocess (action (bash "some_other_command")))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/run.t deleted file mode 100644 index a00062d91..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/run.t +++ /dev/null @@ -1,91 +0,0 @@ -Vendored directories should be traversed to find targets so that they are built when they are depend upon - - $ dune build --root duniverse --debug-dependency-path - Entering directory 'duniverse' - -Aliases should not be resolved in vendored sub directories - - $ dune runtest --root duniverse - Entering directory 'duniverse' - Hello from main lib! - -When compiling vendored code, all warnings should be disabled - - $ dune build --root warnings @no-warnings-please - Entering directory 'warnings' - There should be no OCaml warning! - -Dune will not warn about generating inaccurate .merlin files within vendored directories - - $ dune build --root inaccurate-merlin @inaccurate-merlins-are-ok - Entering directory 'inaccurate-merlin' - There should be no inaccurate .merlin warning above! - -The vendored_dirs stanza is available from version 1.11 of the dune language - - $ dune build --root from-1-11 - Entering directory 'from-1-11' - File "dune", line 1, characters 0-17: - 1 | (vendored_dirs *) - ^^^^^^^^^^^^^^^^^ - Error: 'vendored_dirs' is only available since version 1.11 of the dune - language. Please update your dune-project file to have (lang dune 1.11). - [1] - -The same directory cannot be marked as both vendored and data-only - - $ dune build --root conflicts-with-data-only - Entering directory 'conflicts-with-data-only' - Error: Directory dir was marked as data_only and vendored, it can't be marked - as both. - [1] - -The current directory cannot be marked as vendored - - $ dune build --root self-vendored - Entering directory 'self-vendored' - File "dune", line 1, characters 15-16: - 1 | (vendored_dirs .) - ^ - Error: invalid sub-directory name "." - Hint: did you mean (vendored_dirs *)? - [1] - -The current directory cannot be marked as data-only - - $ dune build --root self-data-only - Entering directory 'self-data-only' - File "dune", line 1, characters 16-17: - 1 | (data_only_dirs .) - ^ - Error: invalid sub-directory name "." - Hint: did you mean (data_only_dirs *)? - [1] - -Only direct subdirectories can be marked as vendored - - $ dune build --root deep-subfolder-vendor - Entering directory 'deep-subfolder-vendor' - File "dune", line 1, characters 15-18: - 1 | (vendored_dirs a/b) - ^^^ - Error: only immediate sub-directories may be specified. - Hint: to ignore a/b, write "(vendored_dirs b)" in a/dune - [1] - -Only direct subdirectories can be marked as data-only - - $ dune build --root deep-subfolder-dataonly - Entering directory 'deep-subfolder-dataonly' - File "dune", line 1, characters 16-21: - 1 | (data_only_dirs a/b/c) - ^^^^^ - Error: only immediate sub-directories may be specified. - Hint: to ignore a/b/c, write "(data_only_dirs c)" in a/b/dune - [1] - -Multiple direct subdirectories can be marked as data-only or vendored - - $ dune build --root multiple-dirs - Entering directory 'multiple-dirs' - diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/dune-project deleted file mode 100644 index 0636ab6ac..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 1.11) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/multiple-dirs/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/multiple-dirs/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/multiple-dirs/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/multiple-dirs/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/run.t new file mode 100644 index 000000000..5afc91246 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/multiple-dirs.t/run.t @@ -0,0 +1,3 @@ +Multiple direct subdirectories can be marked as data-only or vendored + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-data-only/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-data-only/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-data-only/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-data-only/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/run.t new file mode 100644 index 000000000..ed6607042 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-data-only.t/run.t @@ -0,0 +1,9 @@ +The current directory cannot be marked as data-only + + $ dune build + File "dune", line 1, characters 16-17: + 1 | (data_only_dirs .) + ^ + Error: invalid sub-directory name "." + Hint: did you mean (data_only_dirs *)? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-vendored/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-vendored/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-vendored/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/self-vendored/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/run.t new file mode 100644 index 000000000..b6efa8366 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/self-vendored.t/run.t @@ -0,0 +1,9 @@ +The current directory cannot be marked as vendored + + $ dune build + File "dune", line 1, characters 15-16: + 1 | (vendored_dirs .) + ^ + Error: invalid sub-directory name "." + Hint: did you mean (vendored_dirs *)? + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/inaccurate-merlin/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/run.t new file mode 100644 index 000000000..4fcead764 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/run.t @@ -0,0 +1,4 @@ +When compiling vendored code, all warnings should be disabled + + $ dune build @no-warnings-please + There should be no OCaml warning! diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored-two/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored-two/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored-two/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored-two/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored-two/lib2.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored-two/lib2.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored-two/lib2.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored-two/lib2.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored/dune b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored/lib.ml b/duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored/lib.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/vendor/main.t/warnings/vendored/lib.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/vendor/warnings.t/vendored/lib.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/unwrapped.t b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/unwrapped.t new file mode 100644 index 000000000..348c7d13c --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/unwrapped.t @@ -0,0 +1,21 @@ + $ cat >dune-project < (lang dune 3.3) + > EOF + + $ mkdir vlib impl + $ touch vlib/foo.mli + $ cat >vlib/dune < (library + > (name foo) + > (virtual_modules foo) + > (wrapped false)) + > EOF + + $ touch impl/foo.ml impl/new_public_module.ml + $ cat >impl/dune < (library + > (name bar) + > (implements foo)) + > EOF + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/bar.ml b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/bar.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/bar.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/bar.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/baz.ml b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/baz.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/baz.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/baz.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/dune b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/impl/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/impl/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/run.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/run.t diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/vlib/bar.mli b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/vlib/bar.mli new file mode 100644 index 000000000..733b2a323 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/vlib/bar.mli @@ -0,0 +1 @@ +val run : unit -> unit diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/vlib/dune b/duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/vlib/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules.t/vlib/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/virtual-libraries/impl-public-modules/wrapped.t/vlib/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/basic.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/basic.t index e313ea2a3..3cc3a2f18 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/basic.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/basic.t @@ -15,7 +15,7 @@ Basic tests for the file-watching mode. > (rule > (target y) > (deps x) - > (action (bash "cat x > y"))) + > (action (system "cat x > y"))) > EOF $ start_dune @@ -62,18 +62,18 @@ Basic tests for the file-watching mode. Success, waiting for filesystem changes... Success, waiting for filesystem changes... Success, waiting for filesystem changes... - File "dune", line 1, characters 0-57: + File "dune", line 1, characters 0-59: 1 | (rule 2 | (target y) 3 | (deps x) - 4 | (action (bash "cat x > y"))) + 4 | (action (system "cat x > y"))) Error: No rule found for x Had errors, waiting for filesystem changes... - File "dune", line 1, characters 0-57: + File "dune", line 1, characters 0-59: 1 | (rule 2 | (target y) 3 | (deps x) - 4 | (action (bash "cat x > y"))) + 4 | (action (system "cat x > y"))) Error: No rule found for x Had errors, waiting for filesystem changes... Success, waiting for filesystem changes... diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/copy-rules.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/copy-rules.t index 6a47c1bba..fa41d3aea 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/copy-rules.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/copy-rules.t @@ -7,7 +7,7 @@ Test rules that copy source files in file-watching mode. > (rule > (deps (glob_files *.txt)) > (target summary) - > (action (bash "cat %{deps} > %{target}"))) + > (action (system "cat %{deps} > %{target}"))) > EOF $ echo a > a.txt @@ -35,7 +35,7 @@ consequence of using a glob in this directory, which forces all *.txt rules. > (rule > (deps (glob_files *.txt)) > (target summary) - > (action (bash "cat %{deps} > %{target}"))) + > (action (system "cat %{deps} > %{target}"))) > (rule > (target c.txt) > (action (write-file %{target} "c\n"))) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/dir-target-promotion.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/dir-target-promotion.t index cf40ccaad..4a3f8ee81 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/dir-target-promotion.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/dir-target-promotion.t @@ -10,10 +10,10 @@ Test directory target promotion in file-watching mode. > EOF $ cat > dune < (rule - > (mode promote) - > (deps src (sandbox always)) - > (targets (dir d1)) - > (action (bash "mkdir -p d1/d2; cp src d1/a; cp src d1/b; cp src d1/d2/c"))) + > (mode promote) + > (deps src (sandbox always)) + > (targets (dir d1)) + > (action (system "mkdir -p d1/d2; cp src d1/a; cp src d1/b; cp src d1/d2/c"))) > EOF $ echo -n "*" > src diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/dune b/duniverse/dune_/test/blackbox-tests/test-cases/watching/dune index b56b1d9f4..ca4fdc57c 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/dune +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/dune @@ -3,3 +3,7 @@ (enabled_if (<> "macosx" %{ocaml-config:system})) (deps helpers.sh)) + +(cram + (applies_to what-dune-watches) + (deps %{bin:strace})) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/fs-memo.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/fs-memo.t index 3fd9cbbb5..b3c44f9ff 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/fs-memo.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/fs-memo.t @@ -28,11 +28,11 @@ when necessary. > (rule > (alias default) > (deps dep - > (glob_files file-?) - > (glob_files dir/file-?) - > (glob_files dir/subdir/file-?)) + > (glob_files file-?) + > (glob_files dir/file-?) + > (glob_files dir/subdir/file-?)) > (target result) - > (action (bash "\| echo Executing rule... + > (action (system "\| echo Executing rule... > "\| echo %{deps} | > "\| tr ' ' '\n' | > "\| xargs -n 1 | diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/helpers.sh b/duniverse/dune_/test/blackbox-tests/test-cases/watching/helpers.sh index e80446811..7aff73977 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/helpers.sh +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/helpers.sh @@ -13,7 +13,8 @@ with_timeout () { exit_code=$? if [ "$exit_code" = 124 ] then - printf "Timed out" + echo Timed out + cat .#dune-output else return "$exit_code" fi diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/retriggering.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/retriggering.t index 48c22e795..5c803c238 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/retriggering.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/retriggering.t @@ -10,10 +10,10 @@ Bad rule! You are not supposed to modify the source tree. No ice-cream for you! $ echo '(lang dune 3.0)' > dune-project $ cat > dune < (rule - > (deps (glob_files *.txt) (sandbox none)) - > (alias default) - > (action (bash "\| echo "I'm seeing: %{deps}" >> ../../../output - > "\| touch ../../new-source.txt + > (deps (glob_files *.txt) (sandbox none)) + > (alias default) + > (action (system "\| echo "I'm seeing: %{deps}" >> ../../../output + > "\| touch ../../new-source.txt > ))) > EOF diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/sandbox-mkdir.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/sandbox-mkdir.t index 79200262c..479f62bdf 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/sandbox-mkdir.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/sandbox-mkdir.t @@ -13,7 +13,7 @@ Test that Dune mkdirs the right set of directories in the sandbox. > (target target) > (mode promote) > (deps (sandbox always)) - > (action (chdir subdir (bash "echo hello > ../target; pwd")))) + > (action (chdir subdir (system "echo hello > ../target; pwd")))) > EOF $ start_dune @@ -23,7 +23,7 @@ Test that Dune mkdirs the right set of directories in the sandbox. $ cat test/target hello -Now force a rebuild. This suceeds (in the past it could fail due to [mkdir] +Now force a rebuild. This succeeds (in the past it could fail due to [mkdir] memoization). $ rm _build/default/test/target test/target diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/watching/target-promotion.t b/duniverse/dune_/test/blackbox-tests/test-cases/watching/target-promotion.t index d252eca66..dbe10ca7d 100644 --- a/duniverse/dune_/test/blackbox-tests/test-cases/watching/target-promotion.t +++ b/duniverse/dune_/test/blackbox-tests/test-cases/watching/target-promotion.t @@ -5,14 +5,14 @@ Test target promotion in file-watching mode. $ echo '(lang dune 3.0)' > dune-project $ cat > dune < (rule - > (mode promote) - > (deps original) - > (target promoted) - > (action (copy %{deps} %{target}))) + > (mode promote) + > (deps original) + > (target promoted) + > (action (copy %{deps} %{target}))) > (rule - > (deps promoted) - > (target result) - > (action (bash "cat promoted promoted > result"))) + > (deps promoted) + > (target result) + > (action (system "cat promoted promoted > result"))) > EOF $ echo hi > original @@ -64,14 +64,14 @@ Now switch the mode to standard. Dune reports an error about multiple rules for $ cat > dune < (rule - > (mode standard) - > (deps original) - > (target promoted) - > (action (copy %{deps} %{target}))) + > (mode standard) + > (deps original) + > (target promoted) + > (action (copy %{deps} %{target}))) > (rule - > (deps promoted) - > (target result) - > (action (bash "cat promoted promoted > result"))) + > (deps promoted) + > (target result) + > (action (system "cat promoted promoted > result"))) > EOF $ build result @@ -95,14 +95,14 @@ Now use [fallback] to override the rule that generates [promoted]. $ cat > dune < (rule - > (mode fallback) - > (deps original) - > (target promoted) - > (action (copy %{deps} %{target}))) + > (mode fallback) + > (deps original) + > (target promoted) + > (action (copy %{deps} %{target}))) > (rule - > (deps promoted) - > (target result) - > (action (bash "cat promoted promoted > result"))) + > (deps promoted) + > (target result) + > (action (system "cat promoted promoted > result"))) > EOF At first, we don't have the source, so the rule is used. @@ -151,14 +151,14 @@ Now test file-system events generated during target promotion. $ cat > dune < (rule - > (mode promote) - > (deps original) - > (target promoted) - > (action (copy %{deps} %{target}))) + > (mode promote) + > (deps original) + > (target promoted) + > (action (copy %{deps} %{target}))) > (rule - > (deps promoted) - > (target result) - > (action (bash "cat promoted promoted > result"))) + > (deps promoted) + > (target result) + > (action (system "cat promoted promoted > result"))) > EOF $ cat promoted diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/run.t deleted file mode 100644 index fdd447e92..000000000 --- a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/run.t +++ /dev/null @@ -1,67 +0,0 @@ -dune ignores jbuild-workspace files: - - $ dune build --root jbuilder-default-name - Entering directory 'jbuilder-default-name' - -dune uses a versioned file. If the version is missing, then we get an error. - - $ dune build --root dune-no-version - Entering directory 'dune-no-version' - File "dune-workspace", line 1, characters 0-19: - 1 | (context (default)) - ^^^^^^^^^^^^^^^^^^^ - Error: Invalid first line, expected: (lang ) - [1] - -specifying the workspace file is possible: - - $ dune build --root custom-workspace --workspace custom-workspace/dune-workspace.dev - Entering directory 'custom-workspace' - -Workspaces let you set custom profiles - - $ dune runtest --root custom-profile - Entering directory 'custom-profile' - build profile: foobar - -A workspace context can be defined using an opam switch. This test is disabled -because we don't really have a way to mock an opam switch. - -# $ dune build --root opam --display quiet 2>&1 - -Workspaces also allow you to set "target" for cross compilation. This feature is -a bit hard to test since it requires mocking more than one context. But we can -see how we can set a "native" target. Which is the default. - - $ dune exec ./foo.exe --root targets-native - Entering directory 'targets-native' - message from targets-native test - -Workspaces also allow you to set the env for a context: - - $ dune printenv --root workspace-env --profile default - Entering directory 'workspace-env' - (flags - (-w -40 -machin)) - (ocamlc_flags - (-g -verbose)) - (ocamlopt_flags (-g)) - (c_flags ()) - (cxx_flags ()) - (link_flags ()) - (menhir_flags ()) - (coq_flags (-q)) - (js_of_ocaml_flags ()) - (js_of_ocaml_build_runtime_flags ()) - (js_of_ocaml_link_flags ()) - - $ dune build --root multiple-merlin-contexts - Entering directory 'multiple-merlin-contexts' - File "dune-workspace", line 8, characters 1-82: - 8 | (opam - 9 | (switch foo-switch) - 10 | (name foo-name) - 11 | (profile foo-profile) - 12 | (merlin))) - Error: you can only have one context for merlin - [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-profile/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/run.t new file mode 100644 index 000000000..8ab0c3bce --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-profile.t/run.t @@ -0,0 +1,4 @@ +Workspaces let you set custom profiles + + $ dune runtest + build profile: foobar diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-workspace/dune-workspace.dev b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-workspace.t/dune-workspace.dev similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/custom-workspace/dune-workspace.dev rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-workspace.t/dune-workspace.dev diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-workspace.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-workspace.t/run.t new file mode 100644 index 000000000..d6e62e432 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/custom-workspace.t/run.t @@ -0,0 +1,3 @@ +specifying the workspace file is possible: + + $ dune build --workspace dune-workspace.dev diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune new file mode 100644 index 000000000..03925a195 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune @@ -0,0 +1,3 @@ +(cram + (applies_to multiple-merlin-contexts opam) + (deps %{bin:opam})) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/dune-no-version/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune-no-version.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/dune-no-version/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune-no-version.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune-no-version.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune-no-version.t/run.t new file mode 100644 index 000000000..6460ef633 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/dune-no-version.t/run.t @@ -0,0 +1,9 @@ +dune uses a versioned file. If the version is missing, then we get an error. + + $ dune build + File "dune-workspace", line 1, characters 0-19: + 1 | (context (default)) + ^^^^^^^^^^^^^^^^^^^ + Error: Invalid first line, expected: (lang ) + [1] + diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/jbuilder-default-name/jbuild-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name.t/jbuild-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/jbuilder-default-name/jbuild-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name.t/jbuild-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name.t/run.t new file mode 100644 index 000000000..1d6b3a6d1 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/jbuilder-default-name.t/run.t @@ -0,0 +1,3 @@ +dune ignores jbuild-workspace files: + + $ dune build diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/multiple-merlin-contexts/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/multiple-merlin-contexts.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/multiple-merlin-contexts/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/multiple-merlin-contexts.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/multiple-merlin-contexts.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/multiple-merlin-contexts.t/run.t new file mode 100644 index 000000000..cdd7098c4 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/multiple-merlin-contexts.t/run.t @@ -0,0 +1,11 @@ +Only a single context may be marked for merlin + + $ dune build + File "dune-workspace", line 8, characters 1-82: + 8 | (opam + 9 | (switch foo-switch) + 10 | (name foo-name) + 11 | (profile foo-profile) + 12 | (merlin))) + Error: you can only have one context for merlin + [1] diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/opam/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/opam.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/opam/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/opam.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/opam.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/opam.t/run.t new file mode 100644 index 000000000..a93316d1f --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/opam.t/run.t @@ -0,0 +1,4 @@ +A workspace context can be defined using an opam switch. This test is disabled +because we don't really have a way to mock an opam switch. + +# $ dune build --display quiet 2>&1 diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/foo.ml b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/foo.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/targets-native/foo.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/foo.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/run.t new file mode 100644 index 000000000..9a26ae468 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/targets-native.t/run.t @@ -0,0 +1,6 @@ +Workspaces also allow you to set "target" for cross compilation. This feature is +a bit hard to test since it requires mocking more than one context. But we can +see how we can set a "native" target. Which is the default. + + $ dune exec ./foo.exe + message from targets-native test diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune new file mode 100644 index 000000000..e69de29bb diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspaces.t/workspace-env/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t new file mode 100644 index 000000000..ba7868b23 --- /dev/null +++ b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-env.t/run.t @@ -0,0 +1,16 @@ +Workspaces also allow you to set the env for a context: + + $ dune printenv --profile default + (flags + (-w -40 -machin)) + (ocamlc_flags + (-g -verbose)) + (ocamlopt_flags (-g)) + (c_flags ()) + (cxx_flags ()) + (link_flags ()) + (menhir_flags ()) + (coq_flags (-q)) + (js_of_ocaml_flags ()) + (js_of_ocaml_build_runtime_flags ()) + (js_of_ocaml_link_flags ()) diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/hello.exe.source b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/hello.exe.source similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/hello.exe.source rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/hello.exe.source diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/hello.ml b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/hello.ml similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/bin/hello.ml rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/bin/hello.ml diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune-project b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune-project similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune-project rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune-project diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune-workspace b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune-workspace similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/dune-workspace rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/dune-workspace diff --git a/duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/run.t b/duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/run.t similarity index 100% rename from duniverse/dune_/test/blackbox-tests/test-cases/workspace-paths.t/run.t rename to duniverse/dune_/test/blackbox-tests/test-cases/workspaces/workspace-paths.t/run.t diff --git a/duniverse/dune_/test/blackbox-tests/utils/dunepp.mll b/duniverse/dune_/test/blackbox-tests/utils/dunepp.mll index 26acc0d8e..eff2684c6 100644 --- a/duniverse/dune_/test/blackbox-tests/utils/dunepp.mll +++ b/duniverse/dune_/test/blackbox-tests/utils/dunepp.mll @@ -6,16 +6,24 @@ rule main = parse { let () = set_binary_mode_out stdout true; - Printf.eprintf "running preprocessor in %s\n" (Sys.getcwd ()); let (input, pp_cwd, deps) = match Array.to_list Sys.argv with - | _ :: input :: pp_cwd :: deps -> (input, pp_cwd, deps) + | _ :: input :: pp_cwd :: deps -> (input, Some pp_cwd, deps) + | _ :: [input] -> (input, None, []) | _ -> assert false in + begin match pp_cwd with + | None -> () + | Some _ -> Printf.eprintf "running preprocessor in %s\n" (Sys.getcwd ()) + end; ListLabels.iter deps ~f:(fun f -> Printf.eprintf "dep %s exists = %b\n" f (Sys.file_exists f); - let f = Filename.concat pp_cwd f in - Printf.eprintf "dep %s exists = %b\n" f (Sys.file_exists f) + begin match pp_cwd with + | None -> () + | Some pp_cwd -> + let f = Filename.concat pp_cwd f in + Printf.eprintf "dep %s exists = %b\n" f (Sys.file_exists f) + end ); main (Lexing.from_channel (open_in_bin input)) } diff --git a/duniverse/dune_/test/bulk-update.sh b/duniverse/dune_/test/bulk-update.sh deleted file mode 100644 index da4add3cf..000000000 --- a/duniverse/dune_/test/bulk-update.sh +++ /dev/null @@ -1,39 +0,0 @@ -#!/bin/bash - -# This scripts aims to make it easier to do a bulk update of all the -# tests. Simply run it in a terminal and fix the test that's currently -# failing. The script will automatically switch to the next test when -# the current test succeeds. It uses inotifywait to detect changes to -# the test. - -DUNE=_build/default/bin/main_dune.exe - -LIST=$(mktemp) -trap "rm -f $LIST" EXIT - -echo "Computing the list of failing tests..." -$DUNE runtest test/blackbox-tests \ - --diff-command "echo >> $LIST" &> /dev/null -TESTS=$(cat $LIST |cut -d/ -f4 |sed 's/^//') -rm -f $LIST - -count=0 -for t in $TESTS; do - let count++ -done - -i=1 -for t in $TESTS; do - n=0 - while true; do - clear - let n++ - title="[$i/$count] $t (run $n)" - echo "$title" - echo "${title//?/=}" - echo - $DUNE build @test/blackbox-tests/$t && break - inotifywait $(find test/blackbox-tests/test-cases/$t -type d) \ - -e modify,attrib,close_write,move,create,delete - done -done diff --git a/duniverse/dune_/test/expect-tests/common/dune b/duniverse/dune_/test/expect-tests/common/dune index f5ef932ed..d55c5971a 100644 --- a/duniverse/dune_/test/expect-tests/common/dune +++ b/duniverse/dune_/test/expect-tests/common/dune @@ -1,4 +1,4 @@ (library (name dune_tests_common) (modules dune_tests_common) - (libraries stdune dune_util)) + (libraries stdune dune_console dune_util)) diff --git a/duniverse/dune_/test/expect-tests/common/dune_tests_common.ml b/duniverse/dune_/test/expect-tests/common/dune_tests_common.ml index 437d95c89..8d5341514 100644 --- a/duniverse/dune_/test/expect-tests/common/dune_tests_common.ml +++ b/duniverse/dune_/test/expect-tests/common/dune_tests_common.ml @@ -1,4 +1,5 @@ open Stdune +module Console = Dune_console let print pp = Format.printf "%a@." Pp.to_fmt pp @@ -9,7 +10,7 @@ let init = lazy (Printexc.record_backtrace false; Path.set_root (Path.External.cwd ()); - Path.Build.set_build_dir (Path.Build.Kind.of_string "_build"); + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build"); Console.Backend.(set dumb); Dune_util.Log.init ()) in diff --git a/duniverse/dune_/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml b/duniverse/dune_/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml index 3de933da1..6f6332e3d 100644 --- a/duniverse/dune_/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml +++ b/duniverse/dune_/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml @@ -9,7 +9,16 @@ type event = | Fill of Fiber.fill | Abort -let server where = Server.create where ~backlog:10 +let server (where : Unix.sockaddr) = + (match where with + | ADDR_UNIX p -> + let p = Path.of_string p in + Path.unlink_no_err p; + Path.mkdir_p (Path.parent_exn p) + | _ -> ()); + match Server.create where ~backlog:10 with + | Ok t -> t + | Error `Already_in_use -> assert false let client where = Csexp_rpc.Client.create where diff --git a/duniverse/dune_/test/expect-tests/stdune/digest_tests.ml b/duniverse/dune_/test/expect-tests/digest/digest_tests.ml similarity index 76% rename from duniverse/dune_/test/expect-tests/stdune/digest_tests.ml rename to duniverse/dune_/test/expect-tests/digest/digest_tests.ml index f2d9a831b..7c6bae2e3 100644 --- a/duniverse/dune_/test/expect-tests/stdune/digest_tests.ml +++ b/duniverse/dune_/test/expect-tests/digest/digest_tests.ml @@ -1,10 +1,11 @@ open Stdune +module Digest = Dune_digest let%expect_test "directory digest version" = (* If this test fails with a new digest value, make sure to update to update [directory_digest_version] in digest.ml. - The expected value is kept ouside of the expect block on purpose so that it + The expected value is kept outside of the expect block on purpose so that it must be modified manually. *) let expected = "a743ec66ce913ff6587a3816a8acc6ea" in let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in @@ -21,12 +22,15 @@ let%expect_test "directory digest version" = print_endline "[FAIL] unable to calculate digest"); [%expect {| [PASS] |}] -let%expect_test "reject directories with symlinks (for now)" = +let%expect_test "directories with symlinks" = let dir = Temp.create Dir ~prefix:"digest-tests" ~suffix:"" in let stats = { Digest.Stats_for_digest.st_kind = S_DIR; st_perm = 1 } in + let sub = Path.relative dir "sub" in + Path.mkdir_p sub; Unix.symlink "bar" (Path.to_string (Path.relative dir "foo")); + Unix.symlink "bar" (Path.to_string (Path.relative sub "foo")); (match Digest.path_with_stats ~allow_dirs:true dir stats with - | Ok _ -> print_endline "[FAIL] failure expected" - | Unexpected_kind -> print_endline "[PASS]" + | Ok _ -> print_endline "[PASS]" + | Unexpected_kind -> print_endline "[FAIL] unexpected kind" | Unix_error _ -> print_endline "[FAIL] unable to calculate digest"); [%expect {| [PASS] |}] diff --git a/duniverse/dune_/test/expect-tests/digest/dune b/duniverse/dune_/test/expect-tests/digest/dune new file mode 100644 index 000000000..02d1cdd1a --- /dev/null +++ b/duniverse/dune_/test/expect-tests/digest/dune @@ -0,0 +1,15 @@ +(library + (name digest_unit_tests) + (inline_tests) + (libraries + stdune + dune_digest + ;; This is because of the (implicit_transitive_deps false) + ;; in dune-project + ppx_expect.config + ppx_expect.config_types + ppx_expect.common + base + ppx_inline_test.config) + (preprocess + (pps ppx_expect))) diff --git a/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml b/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml index 460404e49..a3ad7a868 100644 --- a/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml +++ b/duniverse/dune_/test/expect-tests/dune_file_watcher/dune_file_watcher_tests_lib.ml @@ -12,7 +12,7 @@ let init () = let () = try Unix.mkdir tmp_dir 0o777 with _ -> () in Unix.chdir tmp_dir; Path.set_root (Path.External.of_string tmp_dir); - Path.Build.set_build_dir (Path.Build.Kind.of_string "_build") + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build") let now () = Unix.gettimeofday () diff --git a/duniverse/dune_/test/expect-tests/dune_util/dune b/duniverse/dune_/test/expect-tests/dune_util/dune new file mode 100644 index 000000000..2a30b8bf1 --- /dev/null +++ b/duniverse/dune_/test/expect-tests/dune_util/dune @@ -0,0 +1,20 @@ +(library + (name flock_tests) + (inline_tests + (enabled_if + (<> %{system} win)) + (deps + (sandbox always))) + (libraries + dune_util + dyn + stdune + ;; This is because of the (implicit_transitive_deps false) + ;; in dune-project + ppx_expect.config + ppx_expect.config_types + ppx_expect.common + base + ppx_inline_test.config) + (preprocess + (pps ppx_expect))) diff --git a/duniverse/dune_/test/expect-tests/dune_util/flock_tests.ml b/duniverse/dune_/test/expect-tests/dune_util/flock_tests.ml new file mode 100644 index 000000000..de9f6c62f --- /dev/null +++ b/duniverse/dune_/test/expect-tests/dune_util/flock_tests.ml @@ -0,0 +1,63 @@ +open Stdune +module Flock = Dune_util.Flock + +let%expect_test "blocking lock" = + let fd = Unix.openfile "tlc1" [ Unix.O_CREAT ] 0o777 in + let lock = Flock.create fd in + print_endline "acquiring lock"; + (match Flock.lock_block lock Exclusive with + | Ok () -> print_endline "acquired lock" + | Error _ -> assert false); + (match Flock.unlock lock with + | Ok () -> print_endline "released lock" + | Error _ -> assert false); + Unix.close fd; + [%expect {| + acquiring lock + acquired lock + released lock |}] + +let%expect_test "nonblocking lock" = + let fd flag = Unix.openfile "tlc2" [ flag ] 0o777 in + let fd1 = fd Unix.O_CREAT in + let lock1 = Flock.create fd1 in + print_endline "acquiring lock"; + (match Flock.lock_non_block lock1 Exclusive with + | Ok `Success -> print_endline "acquired lock" + | Ok `Failure | Error _ -> assert false); + let fd2 = fd Unix.O_RDONLY in + let lock2 = Flock.create fd2 in + (match Flock.lock_non_block lock2 Exclusive with + | Ok `Failure -> print_endline "verified that we can't lock again" + | Ok `Success -> Code_error.raise "acquired lock again" [] + | Error err -> + Code_error.raise "err" [ ("message", Dyn.string @@ Unix.error_message err) ]); + (match Flock.unlock lock1 with + | Ok () -> print_endline "released lock" + | Error _ -> assert false); + let lock2 = Flock.create fd2 in + (match Flock.lock_non_block lock2 Exclusive with + | Ok `Success -> print_endline "managed to lock after unlock" + | Ok `Failure | Error _ -> assert false); + Unix.close fd1; + Unix.close fd2; + [%expect + {| + acquiring lock + acquired lock + verified that we can't lock again + released lock + managed to lock after unlock |}] + +let%expect_test "double lock" = + let fd = Unix.openfile "tlc3" [ Unix.O_CREAT ] 0o600 in + let lock = Flock.create fd in + (match Flock.lock_non_block lock Exclusive with + | Ok `Success -> print_endline "lock 1 worked" + | _ -> assert false); + (match Flock.lock_non_block lock Exclusive with + | Ok `Success -> print_endline "lock 2 worked" + | _ -> assert false); + [%expect {| + lock 1 worked + lock 2 worked |}] diff --git a/duniverse/dune_/test/expect-tests/fiber/fiber_tests.ml b/duniverse/dune_/test/expect-tests/fiber/fiber_tests.ml index d37c65012..ff84ce64c 100644 --- a/duniverse/dune_/test/expect-tests/fiber/fiber_tests.ml +++ b/duniverse/dune_/test/expect-tests/fiber/fiber_tests.ml @@ -271,7 +271,7 @@ let%expect_test "nested with_error_handler" = let fiber = Fiber.with_error_handler ~on_error:(fun exn -> - print_endline "outter handler"; + print_endline "outer handler"; Exn_with_backtrace.reraise exn) (fun () -> Fiber.with_error_handler @@ -283,7 +283,7 @@ let%expect_test "nested with_error_handler" = (try test unit fiber with Exit -> print_endline "[PASS] got Exit"); [%expect {| inner handler - outter handler + outer handler [PASS] got Exit |}] let must_set_flag f = @@ -324,7 +324,7 @@ let%expect_test "finalize" = let%expect_test "nested finalize" = let fiber = Fiber.finalize - ~finally:(fun () -> Fiber.return (print_endline "outter finally")) + ~finally:(fun () -> Fiber.return (print_endline "outer finally")) (fun () -> Fiber.finalize ~finally:(fun () -> Fiber.return (print_endline "inner finally")) @@ -333,7 +333,7 @@ let%expect_test "nested finalize" = (try test unit fiber with Exit -> print_endline "[PASS] got Exit"); [%expect {| inner finally - outter finally + outer finally [PASS] got Exit |}] let%expect_test "context switch and raise inside finalize" = diff --git a/duniverse/dune_/test/expect-tests/scheduler_tests.ml b/duniverse/dune_/test/expect-tests/scheduler_tests.ml index 68f9830bc..e18546f80 100644 --- a/duniverse/dune_/test/expect-tests/scheduler_tests.ml +++ b/duniverse/dune_/test/expect-tests/scheduler_tests.ml @@ -53,7 +53,7 @@ let%expect_test "cancelling a build" = [%expect {| PASS: build was cancelled |}] (* CR-soon jeremiedimino: currently cancelling a build cancels not only this - build but also all runing fibers, including ones that are unrelated. *) + build but also all running fibers, including ones that are unrelated. *) let%expect_test "cancelling a build: effect on other fibers" = let build_started = Fiber.Ivar.create () in go (fun () -> diff --git a/duniverse/dune_/test/expect-tests/stdune/ansi_color_tests.ml b/duniverse/dune_/test/expect-tests/stdune/ansi_color_tests.ml index d603d9d85..503c3c871 100644 --- a/duniverse/dune_/test/expect-tests/stdune/ansi_color_tests.ml +++ b/duniverse/dune_/test/expect-tests/stdune/ansi_color_tests.ml @@ -107,3 +107,19 @@ let%expect_test "reproduce #2664" = [ "34" ], Verbatim "20" |}] + +let%expect_test "Ansi_color.strip" = + print_string + (String.concat ~sep:"\n" + (List.map ~f:Ansi_color.strip + [ "\027[34mthe lazy fox\027[39m jumps over the brown dog\027[0m" + ; "the lazy fox \027[34mjumps over\027[39m the brown dog\027[0m" + ; "\027[34mthe lazy fox\027[39m jumps over \027[0mthe brown dog" + ; "\027[34mthe lazy fox \027[39mjumps over\027[0thebrown dog" + ])); + [%expect + {| +the lazy fox jumps over the brown dog +the lazy fox jumps over the brown dog +the lazy fox jumps over the brown dog +the lazy fox jumps over|}] diff --git a/duniverse/dune_/test/expect-tests/stdune/bytes_unit_tests.ml b/duniverse/dune_/test/expect-tests/stdune/bytes_unit_tests.ml new file mode 100644 index 000000000..a23a508ce --- /dev/null +++ b/duniverse/dune_/test/expect-tests/stdune/bytes_unit_tests.ml @@ -0,0 +1,51 @@ +open Stdune + +let () = + (* We assert some properties of the conversion table here. It should be sorted + by the values in the second component and the suffix list must be + non-empty. *) + let rec loop = function + | [] -> () + | [ (units, _) ] -> assert (List.length units >= 1) + | (units, value) :: ((_, value') :: _ as l) -> + assert (List.length units >= 1); + assert (value <= value'); + loop l + in + loop Bytes_unit.conversion_table + +let%expect_test _ = + let bytes = + [ 0L + ; 1L + ; 12L + ; 123L + ; 1234L + ; 12345L + ; 123456L + ; 1234567L + ; 12345678L + ; 123456789L + ; 1234567890L + ; 12345678901L + ; 123456789012L + ; 1234567890123L + ] + in + List.iter ~f:(fun x -> Bytes_unit.pp x |> print_endline) bytes; + [%expect + {| + 0B + 1B + 12B + 123B + 1.23kB + 12.35kB + 123.46kB + 1.23MB + 12.35MB + 123.46MB + 1.23GB + 12.35GB + 123.46GB + 1.23TB |}] diff --git a/duniverse/dune_/test/expect-tests/stdune/string_tests.ml b/duniverse/dune_/test/expect-tests/stdune/string_tests.ml index 32b9cd2f0..7cdfc8dd5 100644 --- a/duniverse/dune_/test/expect-tests/stdune/string_tests.ml +++ b/duniverse/dune_/test/expect-tests/stdune/string_tests.ml @@ -105,3 +105,27 @@ let%expect_test _ = [%expect {| "foo" |}] + +let%expect_test _ = + String.drop_suffix "foobar" ~suffix:"bar" |> option string |> print_dyn; + [%expect {| +Some "foo" +|}] + +let%expect_test _ = + String.drop_suffix "foobar" ~suffix:"foobar" |> option string |> print_dyn; + [%expect {| +Some "" +|}] + +let%expect_test _ = + String.drop_suffix "foobar" ~suffix:"" |> option string |> print_dyn; + [%expect {| +Some "foobar" +|}] + +let%expect_test _ = + String.drop_suffix "foobar" ~suffix:"foo" |> option string |> print_dyn; + [%expect {| +None +|}] diff --git a/duniverse/dune_/test/unit-tests/artifact_substitution/artifact_substitution.ml b/duniverse/dune_/test/unit-tests/artifact_substitution/artifact_substitution.ml index 9b48f4236..d21aaba51 100644 --- a/duniverse/dune_/test/unit-tests/artifact_substitution/artifact_substitution.ml +++ b/duniverse/dune_/test/unit-tests/artifact_substitution/artifact_substitution.ml @@ -4,7 +4,7 @@ module Re = Dune_re let () = Path.set_root (Path.External.cwd ()); - Path.Build.set_build_dir (Path.Build.Kind.of_string "_build") + Path.Build.set_build_dir (Path.Outside_build_dir.of_string "_build") let fail fmt = Printf.ksprintf @@ -136,6 +136,7 @@ let test input = Fiber.run ~iter:(fun () -> assert false) (let ofs = ref 0 in + let open Fiber.O in let input buf pos len = let to_copy = min len (String.length input - !ofs) in Bytes.blit_string ~src:input ~dst:buf ~src_pos:!ofs ~dst_pos:pos @@ -144,9 +145,12 @@ let test input = to_copy in let output = Buffer.add_subbytes buf in - Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy - ~input_file:(Path.of_string "") - ~input ~output); + let+ (_ : Artifact_substitution.status) = + Artifact_substitution.copy ~conf:Artifact_substitution.conf_dummy + ~input_file:(Path.of_string "") + ~input ~output + in + ()); let result = Buffer.contents buf in if result <> expected then fail diff --git a/duniverse/dune_/vendor/cmdliner/LICENSE.md b/duniverse/dune_/vendor/cmdliner/LICENSE.md index 90fca24d7..c4cd256d5 100644 --- a/duniverse/dune_/vendor/cmdliner/LICENSE.md +++ b/duniverse/dune_/vendor/cmdliner/LICENSE.md @@ -1,4 +1,4 @@ -Copyright (c) 2011 Daniel C. Bünzli +Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner.ml index 4bf33a0b0..b5b1f11fb 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner.ml @@ -1,406 +1,23 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) module Manpage = Cmdliner_manpage -module Arg = Cmdliner_arg module Term = struct - type ('a, 'b) stdlib_result = ('a, 'b) result - include Cmdliner_term - - (* Deprecated *) - - let man_format = Cmdliner_arg.man_format - let pure = const - - (* Terms *) - - let ( $ ) = app - - type 'a ret = [ `Ok of 'a | term_escape ] - - let ret (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (`Ok v) -> Ok v - | Ok (`Error _ as err) -> Error err - | Ok (`Help _ as help) -> Error help - | Error _ as e -> e - - let term_result ?(usage = false) (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (Ok _ as ok) -> ok - | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) - | Error _ as e -> e - - let cli_parse_result (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (Ok _ as ok) -> ok - | Ok (Error (`Msg e)) -> Error (`Parse e) - | Error _ as e -> e - - let main_name = - Cmdliner_info.Args.empty, - (fun ei _ -> Ok (Cmdliner_info.(term_name @@ eval_main ei))) - - let choice_names = - let choice_name t = Cmdliner_info.term_name t in - Cmdliner_info.Args.empty, - (fun ei _ -> Ok (List.rev_map choice_name (Cmdliner_info.eval_choices ei))) - - let with_used_args (al, v) : (_ * string list) t = - al, fun ei cl -> - match v ei cl with - | Ok x -> - let actual_args arg_info acc = - let args = Cmdliner_cline.actual_args cl arg_info in - List.rev_append args acc - in - let used = List.rev (Cmdliner_info.Args.fold actual_args al []) in - Ok (x, used) - | Error _ as e -> e - - (* Term information *) - - type exit_info = Cmdliner_info.exit - let exit_info = Cmdliner_info.exit - - let exit_status_success = 0 - let exit_status_cli_error = 124 - let exit_status_internal_error = 125 - let default_error_exits = - [ exit_info exit_status_cli_error ~doc:"on command line parsing errors."; - exit_info exit_status_internal_error - ~doc:"on unexpected internal errors (bugs)."; ] - - let default_exits = - (exit_info exit_status_success ~doc:"on success.") :: default_error_exits - - type env_info = Cmdliner_info.env - let env_info = Cmdliner_info.env - - type info = Cmdliner_info.term - let info = Cmdliner_info.term ~args:Cmdliner_info.Args.empty - let name ti = Cmdliner_info.term_name ti - - (* Evaluation *) - - let err_help s = "Term error, help requested for unknown command " ^ s - let err_argv = "argv array must have at least one element" - let err_multi_cmd_def name (a, _) (a', _) = - Cmdliner_base.err_multi_def ~kind:"command" name Cmdliner_info.term_doc a a' - - type 'a result = - [ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] - - let add_stdopts ei = - let docs = Cmdliner_info.(term_stdopts_docs @@ eval_term ei) in - let vargs, vers = match Cmdliner_info.(term_version @@ eval_main ei) with - | None -> Cmdliner_info.Args.empty, None - | Some _ -> - let args, _ as vers = Cmdliner_arg.stdopt_version ~docs in - args, Some vers - in - let help = Cmdliner_arg.stdopt_help ~docs in - let args = Cmdliner_info.Args.union vargs (fst help) in - let term = Cmdliner_info.(term_add_args (eval_term ei) args) in - help, vers, Cmdliner_info.eval_with_term ei term - - type 'a eval_result = - ('a, [ term_escape - | `Exn of exn * Printexc.raw_backtrace - | `Parse of string - | `Std_help of Manpage.format | `Std_version ]) stdlib_result - - let run ~catch ei cl f = try (f ei cl :> 'a eval_result) with - | exn when catch -> - let bt = Printexc.get_raw_backtrace () in - Error (`Exn (exn, bt)) - - let try_eval_stdopts ~catch ei cl help version = - match run ~catch ei cl (snd help) with - | Ok (Some fmt) -> Some (Error (`Std_help fmt)) - | Error _ as err -> Some err - | Ok None -> - match version with - | None -> None - | Some version -> - match run ~catch ei cl (snd version) with - | Ok false -> None - | Ok true -> Some (Error (`Std_version)) - | Error _ as err -> Some err - - let term_eval ~catch ei f args = - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let res = match Cmdliner_cline.create term_args args with - | Error (e, cl) -> - begin match try_eval_stdopts ~catch ei cl help version with - | Some e -> e - | None -> Error (`Error (true, e)) - end - | Ok cl -> - match try_eval_stdopts ~catch ei cl help version with - | Some e -> e - | None -> run ~catch ei cl f - in - ei, res - - let term_eval_peek_opts ei f args = - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let v, ret = match Cmdliner_cline.create ~peek_opts:true term_args args with - | Error (e, cl) -> - begin match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> None, e - | None -> None, Error (`Error (true, e)) - end - | Ok cl -> - let ret = run ~catch:true ei cl f in - let v = match ret with Ok v -> Some v | Error _ -> None in - match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> v, e - | None -> v, ret - in - let ret = match ret with - | Ok v -> `Ok v - | Error `Std_help _ -> `Help - | Error `Std_version -> `Version - | Error `Parse _ -> `Error `Parse - | Error `Help _ -> `Help - | Error `Exn _ -> `Error `Exn - | Error `Error _ -> `Error `Term - in - v, ret - - let do_help help_ppf err_ppf ei fmt cmd = - let ei = match cmd with - | None -> Cmdliner_info.(eval_with_term ei @@ eval_main ei) - | Some cmd -> - try - let is_cmd t = Cmdliner_info.term_name t = cmd in - let cmd = List.find is_cmd (Cmdliner_info.eval_choices ei) in - Cmdliner_info.eval_with_term ei cmd - with Not_found -> invalid_arg (err_help cmd) - in - let _, _, ei = add_stdopts ei (* may not be the originally eval'd term *) in - Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei - - let do_result help_ppf err_ppf ei = function - | Ok v -> `Ok v - | Error res -> - match res with - | `Std_help fmt -> Cmdliner_docgen.pp_man err_ppf fmt help_ppf ei; `Help - | `Std_version -> Cmdliner_msg.pp_version help_ppf ei; `Version - | `Parse err -> - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; `Help - | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; `Error `Exn - | `Error (usage, err) -> - (if usage - then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err - else Cmdliner_msg.pp_err err_ppf ei ~err); - `Error `Term - - (* API *) - - let env_default v = try Some (Sys.getenv v) with Not_found -> None - let remove_exec argv = - try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv - - let eval - ?help:(help_ppf = Format.std_formatter) - ?err:(err_ppf = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) ((al, f), ti) = - let term = Cmdliner_info.term_add_args ti al in - let ei = Cmdliner_info.eval ~env (Simple term) in - let args = remove_exec argv in - let ei, res = term_eval ~catch ei f args in - do_result help_ppf err_ppf ei res - - let choose_term main choices = function - | [] -> Ok (main, [], [fst main]) - | maybe :: args' as args -> - if String.length maybe > 1 && maybe.[0] = '-' then Ok (main, args, [fst main]) else - let index = - let add acc (choice, _ as c) = - let name = Cmdliner_info.term_name choice in - match Cmdliner_trie.add acc name c with - | `New t -> t - | `Replaced (c', _) -> invalid_arg (err_multi_cmd_def name c c') - in - List.fold_left add Cmdliner_trie.empty choices - in - match Cmdliner_trie.find index maybe with - | `Ok choice -> Ok (choice, args', [fst choice ; fst main]) - | `Not_found -> - let all = Cmdliner_trie.ambiguities index "" in - let hints = Cmdliner_suggest.value maybe all in - Error (Cmdliner_base.err_unknown ~kind:"command" maybe ~hints) - | `Ambiguous -> - let ambs = Cmdliner_trie.ambiguities index maybe in - let ambs = List.sort compare ambs in - Error (Cmdliner_base.err_ambiguous ~kind:"command" maybe ~ambs) - - module Group = struct - type 'a node = - | Term of 'a Cmdliner_term.t - | Group of 'a t list - - and 'a t = 'a node * info - - let term_add_args (al, f) info = - Cmdliner_info.term_add_args info al - - let rec add_args (node, info) = - match node with - | Term (al, f) -> (Term (al, f), term_add_args (al, f) info) - | Group subs -> (Group (List.map add_args subs), info) - - let (>>=) res f = - match res with - | Error e -> Error e - | Ok x -> f x - - let parse_arg_cmd = function - | [] -> Error `No_args - | cmd :: args -> - if String.length cmd >= 1 && cmd.[0] = '-' then - Error `No_args - else - Ok (cmd, args) - - let cmd_name (_, info) = Cmdliner_info.term_name info - - let one_of (cmd, (choices : _ t list), path, args) = - let index = - let add acc c = - let name = cmd_name c in - match Cmdliner_trie.add acc name c with - | `New t -> t - | `Replaced (c', _) -> - let flip (x, y) = (y, x) in - invalid_arg (err_multi_cmd_def name (flip c) (flip c')) - in - List.fold_left add Cmdliner_trie.empty choices - in - match Cmdliner_trie.find index cmd with - | `Ok (choice, info) -> Ok ((choice, info), choices, info :: path, args) - | `Not_found -> - let all = Cmdliner_trie.ambiguities index "" in - let hints = Cmdliner_suggest.value cmd all in - Error (`Invalid_command (cmd, path, choices, hints)) - | `Ambiguous -> - let ambs = Cmdliner_trie.ambiguities index cmd in - let ambs = List.sort compare ambs in - Error (`Ambiguous (cmd, path, ambs)) - - let try_one_of choices path args = - match parse_arg_cmd args with - | Ok (cmd, args) -> one_of (cmd, choices, path, args) - | Error `No_args -> Error (`No_args (path, choices)) - - let rec try_choose_term choices path args = - try_one_of choices path args >>= choose_term - - and choose_term ((t, info), choices, path, args) = - match t with - | Term t -> Ok ((t, info), choices, path, args) - | Group subs -> try_choose_term subs path args - - let choose_term main choices args = - let path = [snd main] in - match parse_arg_cmd args with - | Error `No_args -> Ok (main, choices, path, args) - | Ok (cmd, args) -> one_of (cmd, choices, path, args) >>= choose_term - - let eval - ?help:(help_ppf = Format.std_formatter) - ?err:(err_ppf = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) main choices = - let choices_f = List.map add_args choices in - let to_term_f ((al, f), ti) = Cmdliner_info.term_add_args ti al, f in - let main_args = fst main in - let main_f = to_term_f main in - let main = fst main_f in - match choose_term (main_args, (fst main_f)) choices_f (remove_exec argv) with - | Error (`No_args (path, choices)) -> - let err = Cmdliner_base.err_no_sub_command in - let sibling_terms = List.map snd choices in - let ei = Cmdliner_info.eval ~env - (Sub_command { path ; main ; sibling_terms}) in - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let args = remove_exec argv in - begin match Cmdliner_cline.create ~peek_opts:true term_args args with - | Ok cl - | Error (_, cl) -> - begin match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> do_result help_ppf err_ppf ei e - | None -> - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - end - end - | Error (`Invalid_command (maybe, path, choices, hints)) -> - let err = Cmdliner_base.err_unknown ~kind:"command" maybe ~hints in - let sibling_terms = List.map snd choices in - let ei = - Cmdliner_info.eval ~env (Sub_command { path ; main ; sibling_terms}) - in - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | Error (`Ambiguous (cmd, path, ambs)) -> - let err = Cmdliner_base.err_ambiguous ~kind:"command" cmd ~ambs in - let sibling_terms = List.map snd choices in - let ei = - Cmdliner_info.eval ~env (Sub_command { path ; main ; sibling_terms}) in - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | Ok (((_, f), info), sibling_terms, path, args) -> - let sibling_terms = List.map snd sibling_terms in - let ei = Cmdliner_info.eval ~env - (Sub_command { main ; path ; sibling_terms }) in - let ei, res = term_eval ~catch ei f args in - do_result help_ppf err_ppf ei res - end - - let eval_choice ?help ?err ?catch ?env ?argv main choices = - let choices = List.map (fun (c, nfo) -> Group.Term c, nfo) choices in - Group.eval ?help ?err ?catch ?env ?argv main choices - - let eval_peek_opts - ?(version_opt = false) ?(env = env_default) ?(argv = Sys.argv) - ((args, f) : 'a t) = - let version = if version_opt then Some "dummy" else None in - let term = Cmdliner_info.term ~args ?version "dummy" in - let ei = Cmdliner_info.eval ~env (Simple term) in - (term_eval_peek_opts ei f (remove_exec argv) :> 'a option * 'a result) - - (* Exits *) - - let exit_status_of_result ?(term_err = 1) = function - | `Ok _ | `Help | `Version -> exit_status_success - | `Error `Term -> term_err - | `Error `Exn -> exit_status_internal_error - | `Error `Parse -> exit_status_cli_error - - let exit_status_of_status_result ?term_err = function - | `Ok n -> n - | r -> exit_status_of_result ?term_err r - - let stdlib_exit = exit - let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r) - let exit_status ?term_err r = - stdlib_exit (exit_status_of_status_result ?term_err r) - + include Cmdliner_term_deprecated +end +module Cmd = struct + module Exit = Cmdliner_info.Exit + module Env = Cmdliner_info.Env + include Cmdliner_cmd + include Cmdliner_eval end +module Arg = Cmdliner_arg (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner.mli index 62620726a..c6d179a97 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner.mli @@ -1,39 +1,25 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Declarative definition of command line interfaces. - [Cmdliner] provides a simple and compositional mechanism - to convert command line arguments to OCaml values and pass them to - your functions. The module automatically handles syntax errors, - help messages and UNIX man page generation. It supports programs - with single or multiple commands - (like [darcs] or [git]) and respect most of the - {{:http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html} - POSIX} and - {{:http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html} - GNU} conventions. + Consult the {{!page-tutorial}tutorial}, details about the supported + {{!page-cli}command line syntax} and {{!page-examples}examples} of + use. - Consult the {{!basics}basics}, details about the supported - {{!cmdline}command line syntax} and {{!examples} examples} of - use. Open the module to use it, it defines only three modules in - your scope. - - {e v1.0.4-31-gb5d6161 — {{:http://erratique.ch/software/cmdliner }homepage}} *) - -(** {1:top Interface} *) + Open the module to use it, it defines only three modules in your + scope. *) (** Man page specification. Man page generation is automatically handled by [Cmdliner], - consult the {{!manual}details}. + consult the {{!page-tool_man.manual}details}. - The {!block} type is used to define a man page's content. It's a - good idea to follow the {{!standard_sections}standard} manual page - structure. + The {!Manpage.block} type is used to define a man page's + content. It's a good idea to follow the + {{!Manpage.standard_sections}standard} manual page structure. {b References.} {ul @@ -60,11 +46,11 @@ module Manpage : sig Except in [`Pre], whitespace and newlines are not significant and are all collapsed to a single space. All block strings - support the {{!doclang}documentation markup language}.*) + support the {{!page-tool_man.doclang}documentation markup language}.*) val escape : string -> string (** [escape s] escapes [s] so that it doesn't get interpreted by the - {{!doclang}documentation markup language}. *) + {{!page-tool_man.doclang}documentation markup language}. *) type title = string * int * string * string * string (** The type for man page titles. Describes the man page @@ -112,12 +98,13 @@ module Manpage : sig listed here. *) val s_options : string - (** The [OPTIONS] section. By default options and flag arguments get + (** The [OPTIONS] section. By default optional arguments get listed here. *) val s_common_options : string - (** The [COMMON OPTIONS] section. For programs with multiple commands - a section that can be used to gather options common to all commands. *) + (** The [COMMON OPTIONS] section. By default help and version options get + listed here. For programs with multiple commands, optional arguments + common to all commands can be added here. *) val s_exit_status : string (** The [EXIT STATUS] section. By default term status exit codes @@ -146,6 +133,10 @@ module Manpage : sig val s_see_also : string (** The [SEE ALSO] section. *) + val s_none : string + (** [s_none] is a special section named ["cmdliner-none"] that can be used + whenever you do not want something to be listed. *) + (** {1:output Output} The {!print} function can be useful if the client wants to define @@ -172,8 +163,8 @@ end (** Terms. - A term is evaluated by a program to produce a {{!result}result}, - which can be turned into an {{!exits}exit status}. A term made of terms + A term is evaluated by a program to produce a {{!Term.result}result}, + which can be turned into an {{!Term.exits}exit status}. A term made of terms referring to {{!Arg}command line arguments} implicitly defines a command line syntax. *) module Term : sig @@ -186,14 +177,6 @@ module Term : sig val const : 'a -> 'a t (** [const v] is a term that evaluates to [v]. *) - (**/**) - val pure : 'a -> 'a t - (** @deprecated use {!const} instead. *) - - val man_format : Manpage.format t - (** @deprecated Use {!Arg.man_format} instead. *) - (**/**) - val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t (** [f $ v] is a term that evaluates to the result of applying the evaluation of [v] to the one of [f]. *) @@ -203,105 +186,137 @@ module Term : sig (** {1 Interacting with Cmdliner's evaluation} *) - type 'a ret = - [ `Help of Manpage.format * string option - | `Error of (bool * string) - | `Ok of 'a ] - (** The type for command return values. See {!ret}. *) - - val ret : 'a ret t -> 'a t - (** [ret v] is a term whose evaluation depends on the case - to which [v] evaluates. With : - {ul - {- [`Ok v], it evaluates to [v].} - {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints - the error [e] and the term's usage if [usage] is [true].} - {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints the - term's man page in the given [format] (or the man page for a - specific [name] term in case of multiple term evaluation).}} *) - val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t (** [term_result ~usage t] evaluates to {ul {- [`Ok v] if [t] evaluates to [Ok v]} {- [`Error `Term] with the error message [e] and usage shown according to [usage] (defaults to [false]), if [t] evaluates to - [Error (`Msg e)].}} *) + [Error (`Msg e)].}} + + See also {!term_result'}. *) + + val term_result' : ?usage:bool -> ('a, string) result t -> 'a t + (** [term_result'] is like {!term_result} but with a [string] + error case. *) val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t (** [cli_parse_result t] is a term that evaluates to: {ul {- [`Ok v] if [t] evaluates to [Ok v].} {- [`Error `Parse] with the error message [e] - if [t] evaluates to [Error (`Msg e)].}} *) + if [t] evaluates to [Error (`Msg e)].}} + + See also {!cli_parse_result'}. *) + + val cli_parse_result' : ('a, string) result t -> 'a t + (** [cli_parse_result'] is like {!cli_parse_result} but with a [string] + error case. *) val main_name : string t - (** [main_name] is a term that evaluates to the "main" term's name. *) + (** [main_name] is a term that evaluates to the main command name; + that is the name of the tool. *) val choice_names : string list t - (** [choice_names] is a term that evaluates to the names of the terms - to choose from. *) + (** [choice_names] is a term that evaluates to the names of the commands + that are children of the main command. *) val with_used_args : 'a t -> ('a * string list) t (** [with_used_args t] is a term that evaluates to [t] tupled with the arguments from the command line that where used to evaluate [t]. *) - (** {1:tinfo Term information} + type 'a ret = + [ `Help of Manpage.format * string option + | `Error of (bool * string) + | `Ok of 'a ] + (** The type for command return values. See {!val-ret}. *) + + val ret : 'a ret t -> 'a t + (** [ret v] is a term whose evaluation depends on the case + to which [v] evaluates. With : + {ul + {- [`Ok v], it evaluates to [v].} + {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints + the error [e] and the term's usage if [usage] is [true].} + {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints + a manpage in format [format]. If [name] is [None] this is the + the main command's manpage. If [name] is [Some c] this is + the man page of the sub command [c] of the main command.}} + + {b Note.} While not deprecated you are encouraged not use this API. *) + + (** {1:deprecated Deprecated Term evaluation interface} + + This interface is deprecated in favor of {!Cmdliner.Cmd}. Follow + the compiler deprecation warning hints to transition. *) + + (** {2:tinfo Term information} Term information defines the name and man page of a term. For simple evaluation this is the name of the program and its man page. For multiple term evaluation, this is the name of a command and its man page. *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + type exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] (** The type for exit status information. *) val exit_info : ?docs:string -> ?doc:string -> ?max:int -> int -> exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] (** [exit_info ~docs ~doc min ~max] describe the range of exit statuses from [min] to [max] (defaults to [min]). [doc] is the man page information for the statuses, defaults to ["undocumented"]. [docs] is the title of the man page section in which the statuses will be listed, it defaults to {!Manpage.s_exit_status}. - In [doc] the {{!doclang}documentation markup language} can be - used with following variables: + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: {ul {- [$(status)], the value of [min].} {- [$(status_max)], the value of [max].} - {- The variables mentioned in {!info}}} *) + {- The variables mentioned in {!val-info}}} *) val default_exits : exit_info list + [@@ocaml.deprecated + "Use Cmd.Exit.defaults or Cmd.info's defaults ~exits value instead."] (** [default_exits] is information for exit status {!exit_status_success} added to {!default_error_exits}. *) val default_error_exits : exit_info list + [@@ocaml.deprecated "List.filter the Cmd.Exit.defaults value instead."] (** [default_error_exits] is information for exit statuses {!exit_status_cli_error} and {!exit_status_internal_error}. *) type env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] (** The type for environment variable information. *) val env_info : ?docs:string -> ?doc:string -> string -> env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] (** [env_info ~docs ~doc var] describes an environment variable [var]. [doc] is the man page information of the environment variable, defaults to ["undocumented"]. [docs] is the title of the man page section in which the environment variable will be - listed, it defaults to {!Manpage.s_environment}. + listed, it defaults to {!Cmdliner.Manpage.s_environment}. - In [doc] the {{!doclang}documentation markup language} can be - used with following variables: + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: {ul {- [$(env)], the value of [var].} - {- The variables mentioned in {!info}}} *) + {- The variables mentioned in {!val-info}}} *) type info + [@@ocaml.deprecated "Use Cmd.info instead."] (** The type for term information. *) val info : ?man_xrefs:Manpage.xref list -> ?man:Manpage.block list -> ?envs:env_info list -> ?exits:exit_info list -> ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> string -> info + [@@ocaml.deprecated "Use Cmd.info instead."] (** [info sdocs man docs doc version name] is a term information such that: {ul @@ -325,16 +340,17 @@ module Term : sig {- [man] is the text of the man page for the term.} {- [man_xrefs] are cross-references to other manual pages. These are used to generate a {!Manpage.s_see_also} section.}} - [doc], [man], [envs] support the {{!doclang}documentation markup - language} in which the following variables are recognized: + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: {ul {- [$(tname)] the term's name.} {- [$(mname)] the main term's name.}} *) val name : info -> string + [@@ocaml.deprecated "Use Cmd.info_name instead."] (** [name ti] is the name of the term information. *) - (** {1:evaluation Evaluation} *) + (** {2:evaluation Evaluation} *) type 'a result = [ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] @@ -347,7 +363,7 @@ module Term : sig {- [`Error `Parse], a command line parse error occurred and was reported on the error formatter.} {- [`Error `Term], a term evaluation error occurred and was reported - on the error formatter (see {!Term.ret}).} + on the error formatter (see {!Term.val-ret}').} {- [`Error `Exn], an exception [e] was caught and reported on the error formatter (see the [~catch] parameter of {!eval}).}} *) @@ -355,6 +371,7 @@ module Term : sig ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> ?env:(string -> string option) -> ?argv:string array -> ('a t * info) -> 'a result + [@@ocaml.deprecated "Use Cmd.v and one of Cmd.eval* instead."] (** [eval help err catch argv (t,i)] is the evaluation result of [t] with command line arguments [argv] (defaults to {!Sys.argv}). @@ -373,6 +390,7 @@ module Term : sig ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> ?env:(string -> string option) -> ?argv:string array -> 'a t * info -> ('a t * info) list -> 'a result + [@@ocaml.deprecated "Use Cmd.group and one of Cmd.eval* instead."] (** [eval_choice help err catch argv (t,i) choices] is like {!eval} except that if the first argument on the command line is not an option name it will look in [choices] for a term whose information has this @@ -382,34 +400,10 @@ module Term : sig is unspecified the "main" term [t] is evaluated. [i] defines the name and man page of the program. *) - module Group : sig - type 'a term - - type 'a node = - | Term of 'a term - | Group of 'a t list - (** The type for an individual command or a command group. - {ul - {- [Term], individual command term.} - {- [Group], a list of command terms in the same group.}} *) - - and 'a t = 'a node * info - (** An individual command or a command group annotated with an [info] *) - - val eval : - ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> - ?env:(string -> string option) -> ?argv:string array -> - 'a term * info -> 'a t list -> 'a result - (** [eval help err catch argv (t, i) choices] is like {!eval_choice} - except that it will search for term inside the command group [choices] - - If a command group is selected without a sub command, the program will - exit with an error message. *) - end with type 'a term := 'a t - val eval_peek_opts : ?version_opt:bool -> ?env:(string -> string option) -> ?argv:string array -> 'a t -> 'a option * 'a result + [@@ocaml.deprecated "Use Cmd.eval_peek_opts instead."] (** [eval_peek_opts version_opt argv t] evaluates [t], a term made of optional arguments only, with the command line [argv] (defaults to {!Sys.argv}). In this evaluation, unknown optional @@ -437,11 +431,11 @@ module Term : sig positional argument from the value of an unknown optional argument. *) - (** {1:exits Turning evaluation results into exit codes} + (** {2:exits Turning evaluation results into exit codes} {b Note.} If you are using the following functions to handle the evaluation result of a term you should add {!default_exits} to - the term's information {{!info}[~exits]} argument. + the term's information {{!val-info}[~exits]} argument. {b WARNING.} You should avoid status codes strictly greater than 125 as those may be used by @@ -449,36 +443,336 @@ module Term : sig some} shells. *) val exit_status_success : int + [@@ocaml.deprecated "Use Cmd.Exit.ok instead."] (** [exit_status_success] is 0, the exit status for success. *) val exit_status_cli_error : int + [@@ocaml.deprecated "Use Cmd.Exit.cli_error instead."] (** [exit_status_cli_error] is 124, an exit status for command line parsing errors. *) val exit_status_internal_error : int + [@@ocaml.deprecated "Use Cmd.Exit.internal_error instead."] (** [exit_status_internal_error] is 125, an exit status for unexpected internal errors. *) - val exit_status_of_result : ?term_err:int -> 'a result -> int + val exit_status_of_result : ?term_err:int -> unit result -> int + [@@ocaml.deprecated "Use Cmd.eval instead."] (** [exit_status_of_result ~term_err r] is an [exit(3)] status code determined from [r] as follows: {ul - {- {!exit_status_success} if [r] is one of [`Ok _], [`Version], [`Help]} + {- {!exit_status_success} if [r] is one of [`Ok ()], [`Version], [`Help]} {- [term_err] if [r] is [`Error `Term], [term_err] defaults to [1].} {- {!exit_status_cli_error} if [r] is [`Error `Parse]} {- {!exit_status_internal_error} if [r] is [`Error `Exn]}} *) val exit_status_of_status_result : ?term_err:int -> int result -> int + [@@ocaml.deprecated "Use Cmd.eval' instead."] (** [exit_status_of_status_result] is like {!exit_status_of_result} except for [`Ok n] where [n] is used as the status exit code. *) - val exit : ?term_err:int -> 'a result -> unit + val exit : ?term_err:int -> unit result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval instead."] (** [exit ~term_err r] is [Stdlib.exit @@ exit_status_of_result ~term_err r] *) val exit_status : ?term_err:int -> int result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval' instead."] (** [exit_status ~term_err r] is [Stdlib.exit @@ exit_status_of_status_result ~term_err r] *) + + (**/**) + val pure : 'a -> 'a t + [@@ocaml.deprecated "Use Term.const instead."] + (** @deprecated use {!const} instead. *) + + val man_format : Manpage.format t + [@@ocaml.deprecated "Use Arg.man_format instead."] + (** @deprecated Use {!Arg.man_format} instead. *) + (**/**) +end + +(** Commands. + + Command line syntaxes are implicitely defined by {!Term}s. A command + value binds a syntax and its documentation to a command name. + + A command can group a list of sub commands (and recursively). In this + case your tool defines a tree of commands, each with its own command + line syntax. The root of that tree is called the {e main command}; + it represents your tool and its name. *) +module Cmd : sig + + (** {1:info Command information} + + Command information defines the name and documentation of a command. *) + + (** Exit codes and their information. *) + module Exit : sig + + (** {1:codes Exit codes} *) + + type code = int + (** The type for exit codes. + + {b Warning.} You should avoid status codes strictly greater than 125 + as those may be used by + {{:https://www.gnu.org/software/bash/manual/html_node/Exit-Status.html} + some} shells. *) + + val ok : code + (** [ok] is [0], the exit status for success. *) + + val some_error : code + (** [some_error] is [123], an exit status for indisciminate errors + reported on stderr. *) + + val cli_error : code + (** [cli_error] is [124], an exit status for command line parsing + errors. *) + + val internal_error : code + (** [internal_error] is [125], an exit status for unexpected internal + errors. *) + + (** {1:info Exit code information} *) + + type info + (** The type for exit code information. *) + + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + (** [exit_info ~docs ~doc min ~max] describe the range of exit + statuses from [min] to [max] (defaults to [min]). [doc] is the + man page information for the statuses, defaults to ["undocumented"]. + [docs] is the title of the man page section in which the statuses + will be listed, it defaults to {!Manpage.s_exit_status}. + + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(status)], the value of [min].} + {- [$(status_max)], the value of [max].} + {- The variables mentioned in the {!Cmd.val-info}}} *) + + val info_code : info -> code + (** [info_code i] is the minimal code of [i]. *) + + val defaults : info list + (** [defaults] are exit code information for {!ok}, {!some_error} + {!cli_error} and {!internal_error}. *) + end + + (** Environment variable and their information. *) + module Env : sig + + (** {1:envvars Environment variables} *) + + type var = string + (** The type for environment names. *) + + (** {1:info Environment variable information} *) + + [@@@alert "-deprecated"] + + type info = Term.env_info (* because of Arg. *) + (** The type for environment variable information. *) + + [@@@alert "+deprecated"] + + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + (** [info ~docs ~doc var] describes an environment variable + [var] such that: + {ul + {- [doc] is the man page information of the environment + variable, defaults to ["undocumented"].} + {- [docs] is the title of the man page section in which the environment + variable will be listed, it defaults to + {!Cmdliner.Manpage.s_environment}.} + {- [deprecated], if specified the environment is deprecated and the + string is a message output on standard error when the environment + variable gets used to lookup the default value of an argument.}} + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(env)], the value of [var].} + {- The variables mentioned in {!val-info}.}} *) + end + + type info + (** The type for information about commands. *) + + val info : + ?deprecated:string -> ?man_xrefs:Manpage.xref list -> + ?man:Manpage.block list -> ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + (** [info name ?sdocs ?man ?docs ?doc ?version] is a term information + such that: + {ul + {- [name] is the name of the command.} + {- [version] is the version string of the command line tool, this + is only relevant for the main command and ignored otherwise.} + {- [deprecated], if specified the command is deprecated and the + string is a message output on standard error when the command + is used.} + {- [doc] is a one line description of the command used + for the [NAME] section of the command's man page and in command + group listings.} + {- [docs], for commands that are part of a group, the title of the + section of the parent's command man page where it should be listed + (defaults to {!Manpage.s_commands}).} + {- [sdocs] defines the title of the section in which the + standard [--help] and [--version] arguments are listed + (defaults to {!Manpage.s_common_options}).} + {- [exits] is a list of exit statuses that the command evaluation + may produce, defaults to {!Exit.defaults}.} + {- [envs] is a list of environment variables that influence + the command's evaluation.} + {- [man] is the text of the man page for the command.} + {- [man_xrefs] are cross-references to other manual pages. These + are used to generate a {!Manpage.s_see_also} section.}} + + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: + {ul + {- [$(tname)] the (term's) command's name.} + {- [$(mname)] the main command name.}} *) + + (** {1:cmds Commands} *) + + type 'a t + (** The type for commands whose evaluation result in a value of + type ['a]. *) + + val v : info -> 'a Term.t -> 'a t + (** [v i t] is a command with information [i] and command line syntax + parsed by [t]. *) + + val group : ?default:'a Term.t -> info -> 'a t list -> 'a t + (** [group i ?default cmds] is a command with information [i] that + groups sub commands [cmds]. [default] is the command line syntax + to parse if no sub command is specified on the command line. If + [default] is [None] (default), the tool errors when no sub + command is specified. *) + + val name : 'a t -> string + (** [name c] is the name of [c]. *) + + (** {1:eval Evaluation} + + These functions are meant to be composed with {!Stdlib.exit}. + The following exit codes may be returned by all these functions: + {ul + {- {!Exit.cli_error} if a parse error occurs.} + {- {!Exit.internal_error} if the [~catch] argument is [true] (default) + and an uncaught exception is raised.} + {- The value of [~term_err] (defaults to {!Exit.cli_error}) if + a term error occurs.}} + + These exit codes are described in {!Exit.defaults} which is the + default value of the [?exits] argument of function {!val-info}. *) + + val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> unit t -> Exit.code + (** [eval cmd] is {!Exit.ok} if [cmd] evaluates to [()]. + See {!eval_value} for other arguments. *) + + val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> Exit.code t -> Exit.code + (** [eval' cmd] is [c] if [cmd] evaluates to the exit code [c]. + See {!eval_value} for other arguments. *) + + val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (unit, string) result t -> Exit.code + (** [eval_result cmd] is: + {ul + {- {!Exit.ok} if [cmd] evaluates to [Ok ()].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (Exit.code, string) result t -> Exit.code + (** [eval_result' cmd] is: + {ul + {- [c] if [cmd] evaluates to [Ok c].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + (** {2:eval_low Low level evaluation} + + This interface gives more information on command evaluation results + and lets you choose how to map evaluation results to exit codes. *) + + type 'a eval_ok = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Version (** The version of the main cmd was requested. *) + | `Help (** Help was requested. *) ] + (** The type for successful evaluation results. *) + + type eval_error = + [ `Parse (** A parse error occured. *) + | `Term (** A term evaluation error occured. *) + | `Exn (** An uncaught exception occured. *) ] + (** The type for erroring evaluation results. *) + + val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a t -> + ('a eval_ok, eval_error) result + (** [eval ~help ~err ~catch ~env ~argv cmd] is the evaluation result + of [cmd] with: + {ul + {- [argv] the command line arguments to parse (defaults to {!Sys.argv})} + {- [env] the function used for environment variable lookup (defaults + to {!Sys.getenv}.} + {- [catch] if [true] (default) uncaught exceptions + are intercepted and their stack trace is written to the [err] + formatter} + {- [help] is the formatter used to print help or version messages + (defaults to {!Format.std_formatter})} + {- [err] is the formatter used to print error messages + (defaults to {!Format.err_formatter}.}} *) + + val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Term.t -> + 'a option * ('a eval_ok, eval_error) result + (** [eval_peek_opts version_opt argv t] evaluates [t], a term made + of optional arguments only, with the command line [argv] + (defaults to {!Sys.argv}). In this evaluation, unknown optional + arguments and positional arguments are ignored. + + The evaluation returns a pair. The first component is + the result of parsing the command line [argv] stripped from + any help and version option if [version_opt] is [true] (defaults + to [false]). It results in: + {ul + {- [Some _] if the command line would be parsed correctly given the + {e partial} knowledge in [t].} + {- [None] if a parse error would occur on the options of [t]}} + + The second component is the result of parsing the command line + [argv] without stripping the help and version options. It + indicates what the evaluation would result in on [argv] given + the partial knowledge in [t] (for example it would return + [`Help] if there's a help option in [argv]). However in + contrasts to {!val-eval_value} no side effects like error + reporting or help output occurs. + + {b Note.} Positional arguments can't be peeked without the full + specification of the command line: we can't tell apart a + positional argument from the value of an unknown optional + argument. *) end (** Terms for command line arguments. @@ -487,8 +781,8 @@ end to the arguments provided on the command line. Basic constraints, like the argument type or repeatability, are - specified by defining a value of type {!t}. Further constraints can - be specified during the {{!argterms}conversion} to a term. *) + specified by defining a value of type {!Arg.t}. Further constraints can + be specified during the {{!Arg.argterms}conversion} to a term. *) module Arg : sig (** {1:argconv Argument converters} @@ -498,50 +792,50 @@ module Arg : sig are provided for many types of the standard library. *) type 'a parser = string -> [ `Ok of 'a | `Error of string ] + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' instead."] (** The type for argument parsers. - @deprecated Use a parser with [('a, [ `Msg of string]) result] results - and {!conv}. *) + {b Deprecated.} Use parser signatures of {!val-conv} or {!val-conv'}. *) type 'a printer = Format.formatter -> 'a -> unit (** The type for converted argument printers. *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + type 'a conv = 'a parser * 'a printer (** The type for argument converters. - {b WARNING.} This type will become abstract in the next - major version of cmdliner, use {!val:conv} or {!pconv} - to construct values of this type. *) + {b Warning.} Do not use directly, use {!val-conv} or {!val-conv'}. + This type will become abstract in the next major version of cmdliner. *) - type 'a converter = 'a conv - (** @deprecated Use the {!type:conv} type via the {!val:conv} and {!pconv} - functions. *) + [@@@alert "+deprecated"] (* Need to be able to mention them ! *) val conv : ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> 'a conv - (** [converter ~docv (parse, print)] is an argument converter + (** [conv ~docv (parse, print)] is an argument converter parsing values with [parse] and printing them with [print]. [docv] is a documentation meta-variable used in the documentation to stand for the argument value, defaults to ["VALUE"]. *) - val pconv : - ?docv:string -> 'a parser * 'a printer -> 'a conv - (** [pconv] is like {!converter}, but uses a deprecated {!parser} - signature. *) + val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> + 'a conv + (** [conv'] is like {!val-conv} but the [Error] case has an unlabelled + string. *) val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) - (** [conv_parser c] 's [c]'s parser. *) + (** [conv_parser c] is the parser of [c]. *) val conv_printer : 'a conv -> 'a printer - (** [conv_printer c] is [c]'s printer. *) + (** [conv_printer c] is the printer of [c]. *) val conv_docv : 'a conv -> string (** [conv_docv c] is [c]'s documentation meta-variable. - {b WARNING.} Currently always returns ["VALUE"] in the future - will return the value given to {!conv} or {!pconv}. *) + {b Warning.} Currently always returns ["VALUE"] in the future + will return the value given to {!val-conv} or {!val-conv'}. *) val parser_of_kind_of_string : kind:string -> (string -> 'a option) -> @@ -550,11 +844,16 @@ module Arg : sig parser using the [kind_of_string] function for parsing and [kind] to report errors (e.g. could be ["an integer"] for an [int] parser.). *) + val some' : ?none:'a -> 'a conv -> 'a option conv + (** [some' ?none c] is like the converter [c] except it returns + [Some] value. It is used for command line arguments that default + to [None] when absent. If provided, [none] is used with [conv]'s + printer to document the value taken on absence; to document + a more complex behaviour use the [absent] argument of {!val-info}. *) + val some : ?none:string -> 'a conv -> 'a option conv - (** [some none c] is like the converter [c] except it returns - [Some] value. It is used for command line arguments - that default to [None] when absent. [none] is what to print to - document the absence (defaults to [""]). *) + (** [some ?none c] is like [some'] but [none] is described as a + string that will be rendered in bold. *) (** {1:arginfo Arguments and their information} @@ -564,18 +863,6 @@ module Arg : sig if the argument is absent from the command line and the variable is defined. *) - type env = Term.env_info - (** The type for environment variables and their documentation. *) - - val env_var : ?docs:string -> ?doc:string -> string -> env - (** [env_var docs doc var] is an environment variables [var]. [doc] - is the man page information of the environment variable, the - {{!doclang}documentation markup language} with the variables - mentioned in {!info} be used; it defaults to ["See option - $(opt)."]. [docs] is the title of the man page section in which - the environment variable will be listed, it defaults to - {!Manpage.s_environment}. *) - type 'a t (** The type for arguments holding data of type ['a]. *) @@ -583,8 +870,8 @@ module Arg : sig (** The type for information about command line arguments. *) val info : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> string list -> - info + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Cmd.Env.info -> string list -> info (** [info docs docv doc env names] defines information for an argument. {ul @@ -595,10 +882,10 @@ module Arg : sig for positional arguments.} {- [env] defines the name of an environment variable which is looked up for defining the argument if it is absent from the - command line. See {{!envlookup}environment variables} for + command line. See {{!page-cli.envlookup}environment variables} for details.} {- [doc] is the man page information of the argument. - The {{!doclang}documentation language} can be used and + The {{!page-tool_man.doclang}documentation language} can be used and the following variables are recognized: {ul {- ["$(docv)"] the value of [docv] (see below).} @@ -613,7 +900,14 @@ module Arg : sig will be listed. For optional arguments this defaults to {!Manpage.s_options}. For positional arguments this defaults to {!Manpage.s_arguments}. However a positional argument is only - listed if it has both a [doc] and [docv] specified.}} *) + listed if it has both a [doc] and [docv] specified.} + {- [deprecated], if specified the argument is deprecated and the + string is a message output on standard error when the argument + is used.} + {- [absent], if specified a documentation string that indicates + what happens when the argument is absent. The document language + can be used like in [doc]. This overrides the automatic default + value rendering that is performed by the combinators.}} *) val ( & ) : ('a -> 'b) -> 'a -> 'b (** [f & v] is [f v], a right associative composition operator for @@ -637,7 +931,7 @@ module Arg : sig is absent from the command line. *) val vflag : 'a -> ('a * info) list -> 'a t - (** [vflag v \[v]{_0}[,i]{_0}[;...\]] is an ['a] argument defined + (** [vflag v \[v]{_0}[,i]{_0}[;…\]] is an ['a] argument defined by an optional flag that may appear {e at most} once on the command line under one of the names specified in the [i]{_k} values. The argument holds [v] if the flag is absent from the @@ -657,7 +951,6 @@ module Arg : sig {b Note.} Environment variable lookup is unsupported for for these arguments. *) - val alias : string list -> info -> bool t (** [alias l i] is a [flag i] except the arguments [l] are also parsed as if they appeared in place of the option. *) @@ -785,7 +1078,7 @@ module Arg : sig (** [enum l p] converts values such that unambiguous prefixes of string names in [l] map to the corresponding value of type ['a]. - {b Warning.} The type ['a] must be comparable with {!Pervasives.compare}. + {b Warning.} The type ['a] must be comparable with {!Stdlib.compare}. @raise Invalid_argument if [l] is empty. *) @@ -837,812 +1130,49 @@ module Arg : sig (** [doc_quote s] quotes the string [s]. *) val doc_alts : ?quoted:bool -> string list -> string - (** [doc_alts alts] documents the alternative tokens [alts] according - the number of alternatives. If [quoted] is [true] (default) - the tokens are quoted. The resulting string can be used in - sentences of the form ["$(docv) must be %s"]. + (** [doc_alts alts] documents the alternative tokens [alts] + according the number of alternatives. If [quoted] is: + {ul + {- [None], the tokens are enclosed in manpage markup directives + to render them in bold (manpage convention).} + {- [Some true], the tokens are quoted with {!doc_quote}.} + {- [Some false], the tokens are written as is}} + The resulting string can be used in sentences of + the form ["$(docv) must be %s"]. - @raise Invalid_argument if [alts] is the empty string. *) + @raise Invalid_argument if [alts] is the empty list. *) val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string (** [doc_alts_enum quoted alts] is [doc_alts quoted (List.map fst alts)]. *) -end - -(** {1:basics Basics} - - With [Cmdliner] your program evaluates a term. A {e term} is a value - of type {!Term.t}. The type parameter indicates the type of the - result of the evaluation. - -One way to create terms is by lifting regular OCaml values with -{!Term.const}. Terms can be applied to terms evaluating to functional -values with {!Term.( $ )}. For example for the function: -{[ -let revolt () = print_endline "Revolt!" -]} + (** {1:deprecated Deprecated} *) -the term : + [@@@alert "-deprecated"] -{[ -open Cmdliner - -let revolt_t = Term.(const revolt $ const ()) -]} - -is a term that evaluates to the result (and effect) of the [revolt] -function. Terms are evaluated with {!Term.eval}: - -{[ -let () = Term.exit @@ Term.eval (revolt_t, Term.info "revolt") -]} - -This defines a command line program named ["revolt"], without command -line arguments, that just prints ["Revolt!"] on [stdout]. - -{[ -> ./revolt -Revolt! -]} - -The combinators in the {!Arg} module allow to extract command line -argument data as terms. These terms can then be applied to lifted -OCaml functions to be evaluated by the program. - -Terms corresponding to command line argument data that are part of a -term evaluation implicitly define a command line syntax. We show this -on an concrete example. - -Consider the [chorus] function that prints repeatedly a given message : - -{[ -let chorus count msg = - for i = 1 to count do print_endline msg done -]} - -we want to make it available from the command line with the synopsis: - -{[ -chorus [-c COUNT | --count=COUNT] [MSG] -]} - -where [COUNT] defaults to [10] and [MSG] defaults to ["Revolt!"]. We -first define a term corresponding to the [--count] option: - -{[ -let count = - let doc = "Repeat the message $(docv) times." in - Arg.(value & opt int 10 & info ["c"; "count"] ~docv:"COUNT" ~doc) -]} - -This says that [count] is a term that evaluates to the value of an -optional argument of type [int] that defaults to [10] if unspecified -and whose option name is either [-c] or [--count]. The arguments [doc] -and [docv] are used to generate the option's man page information. - -The term for the positional argument [MSG] is: - -{[ -let msg = - let doc = "Overrides the default message to print." in - let env = Arg.env_var "CHORUS_MSG" ~doc in - let doc = "The message to print." in - Arg.(value & pos 0 string "Revolt!" & info [] ~env ~docv:"MSG" ~doc) -]} - -which says that [msg] is a term whose value is the positional argument -at index [0] of type [string] and defaults to ["Revolt!"] or the -value of the environment variable [CHORUS_MSG] if the argument is -unspecified on the command line. Here again [doc] and [docv] are used -for the man page information. - -The term for executing [chorus] with these command line arguments is : - -{[ -let chorus_t = Term.(const chorus $ count $ msg) -]} - -and we are now ready to define our program: - -{[ -let info = - let doc = "print a customizable message repeatedly" in - let man = [ - `S Manpage.s_bugs; - `P "Email bug reports to ." ] - in - Term.info "chorus" ~version:"%‌%VERSION%%" ~doc ~exits:Term.default_exits ~man + type 'a converter = 'a conv + [@@ocaml.deprecated "Use Arg.conv' function instead."] + (** See {!Arg.conv'}. *) -let () = Term.exit @@ Term.eval (chorus_t, info)) -]} + val pconv : + ?docv:string -> 'a parser * 'a printer -> 'a conv + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' function instead."] + (** [pconv] is like {!val-conv} or {!val-conv'}, but uses a + deprecated {!parser} signature. *) -The [info] value created with {!Term.info} gives more information -about the term we execute and is used to generate the program's man -page. Since we provided a [~version] string, the program will -automatically respond to the [--version] option by printing this -string. -A program using {!Term.eval} always responds to the [--help] option by -showing the man page about the program generated using the information -you provided with {!Term.info} and {!Arg.info}. Here is the output -generated by our example : + type env = Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.type-info} *) -{v -> ./chorus --help -NAME - chorus - print a customizable message repeatedly - -SYNOPSIS - chorus [OPTION]... [MSG] - -ARGUMENTS - MSG (absent=Revolt! or CHORUS_MSG env) - The message to print. - -OPTIONS - -c COUNT, --count=COUNT (absent=10) - Repeat the message COUNT times. - - --help[=FMT] (default=auto) - Show this help in format FMT. The value FMT must be one of `auto', - `pager', `groff' or `plain'. With `auto', the format is `pager` or - `plain' whenever the TERM env var is `dumb' or undefined. - - --version - Show version information. - -EXIT STATUS - chorus exits with the following status: - - 0 on success. - - 124 on command line parsing errors. - - 125 on unexpected internal errors (bugs). - -ENVIRONMENT - These environment variables affect the execution of chorus: - - CHORUS_MSG - Overrides the default message to print. - -BUGS - Email bug reports to . -v} - -If a pager is available, this output is written to a pager. This help -is also available in plain text or in the -{{:http://www.gnu.org/software/groff/groff.html}groff} man page format -by invoking the program with the option [--help=plain] or -[--help=groff]. - -For examples of more complex command line definitions look and run -the {{!examples}examples}. - -{2:multiterms Multiple terms} - -[Cmdliner] also provides support for programs like [darcs] or [git] -that have multiple commands each with their own syntax: - -{[prog COMMAND [OPTION]... ARG...]} - -A command is defined by coupling a term with {{!Term.tinfo}term -information}. The term information defines the command name and its -man page. Given a list of commands the function {!Term.eval_choice} -will execute the term corresponding to the [COMMAND] argument or a -specific "main" term if there is no [COMMAND] argument. - -{2:doclang Documentation markup language} - -Manpage {{!Manpage.block}blocks} and doc strings support the following -markup language. - -{ul -{- Markup directives [$(i,text)] and [$(b,text)], where [text] is raw - text respectively rendered in italics and bold.} -{- Outside markup directives, context dependent variables of the form - [$(var)] are substituted by marked up data. For example in a term's - man page [$(tname)] is substituted by the term name in bold.} -{- Characters $, (, ) and \ can respectively be escaped by \$, \(, \) - and \\ (in OCaml strings this will be ["\\$"], ["\\("], ["\\)"], - ["\\\\"]). Escaping $ and \ is mandatory everywhere. Escaping ) is - mandatory only in markup directives. Escaping ( is only here for - your symmetric pleasure. Any other sequence of characters starting - with a \ is an illegal character sequence.} -{- Refering to unknown markup directives or variables will generate - errors on standard error during documentation generation.}} - -{2:manual Manual} - -Man page sections for a term are printed in the order specified by the -term manual as given to {!Term.info}. Unless specified explicitely in -the term's manual the following sections are automaticaly created and -populated for you: - -{ul -{- {{!Manpage.s_name}[NAME]} section.} -{- {{!Manpage.s_synopsis}[SYNOPSIS]} section.}} - -The various [doc] documentation strings specified by the term's -subterms and additional metadata get inserted at the end of the -documentation section name [docs] they respectively mention, in the -following order: - -{ol -{- Commands, see {!Term.info}.} -{- Positional arguments, see {!Arg.info}. Those are listed iff - both the [docv] and [doc] string is specified by {!Arg.info}.} -{- Optional arguments, see {!Arg.info}.} -{- Exit statuses, see {!Term.exit_info}.} -{- Environment variables, see {!Arg.env_var} and {!Term.env_info}.}} - -If a [docs] section name is mentioned and does not exist in the term's -manual, an empty section is created for it, after which the [doc] strings -are inserted, possibly prefixed by boilerplate text (e.g. for -{!Manpage.s_environment} and {!Manpage.s_exit_status}). - -If the created section is: -{ul -{- {{!Manpage.standard_sections}standard}, it - is inserted at the right place in the order specified - {{!Manpage.standard_sections}here}, but after a possible non-standard - section explicitely specified by the term since the latter get the - order number of the last previously specified standard section - or the order of {!Manpage.s_synopsis} if there is no such section.} -{- non-standard, it is inserted before the {!Manpage.s_commands} - section or the first subsequent existing standard section if it - doesn't exist. Taking advantage of this behaviour is discouraged, - you should declare manually your non standard section in the term's - manual.}} - -Ideally all manual strings should be UTF-8 encoded. However at the -moment macOS (until at least 10.12) is stuck with [groff 1.19.2] which -doesn't support `preconv(1)`. Regarding UTF-8 output, generating the -man page with [-Tutf8] maps the hyphen-minus [U+002D] to the minus -sign [U+2212] which makes it difficult to search it in the pager, so -[-Tascii] is used for now. Conclusion is that it is better to stick -to the ASCII set for now. Please contact the author if something seems -wrong in this reasoning or if you know a work around this. - -{2:misc Miscellaneous} - -{ul -{- The option name [--cmdliner] is reserved by the library.} -{- The option name [--help], (and [--version] if you specify a version - string) is reserved by the library. Using it as a term or option - name may result in undefined behaviour.} -{- Defining the same option or command name via two different - arguments or terms is illegal and raises [Invalid_argument].}} - -{1:cmdline Command line syntax} - -For programs evaluating a single term the most general form of invocation is: - -{[ -prog [OPTION]... [ARG]... -]} - -The program automatically reponds to the [--help] option by printing -the help. If a version string is provided in the {{!Term.tinfo}term -information}, it also automatically responds to the [--version] option -by printing this string. - -Command line arguments are either {{!optargs}{e optional}} or -{{!posargs}{e positional}}. Both can be freely interleaved but since -[Cmdliner] accepts many optional forms this may result in -ambiguities. The special {{!posargs} token [--]} can be used to -resolve them. - -Programs evaluating multiple terms also add this form of invocation: - -{[ -prog COMMAND [OPTION]... [ARG]... -]} - -Commands automatically respond to the [--help] option by printing -their help. The [COMMAND] string must be the first string following -the program name and may be specified by a prefix as long as it is not -ambiguous. - -{2:optargs Optional arguments} - -An optional argument is specified on the command line by a {e name} -possibly followed by a {e value}. - -The name of an option can be short or long. - -{ul -{- A {e short} name is a dash followed by a single alphanumeric - character: ["-h"], ["-q"], ["-I"].} -{- A {e long} name is two dashes followed by alphanumeric - characters and dashes: ["--help"], ["--silent"], ["--ignore-case"].}} - -More than one name may refer to the same optional argument. For -example in a given program the names ["-q"], ["--quiet"] and -["--silent"] may all stand for the same boolean argument indicating -the program to be quiet. Long names can be specified by any non -ambiguous prefix. - -The value of an option can be specified in three different ways. - -{ul -{- As the next token on the command line: ["-o a.out"], ["--output a.out"].} -{- Glued to a short name: ["-oa.out"].} -{- Glued to a long name after an equal character: ["--output=a.out"].}} - -Glued forms are especially useful if the value itself starts with a -dash as is the case for negative numbers, ["--min=-10"]. - -An optional argument without a value is either a {e flag} (see -{!Arg.flag}, {!Arg.vflag}) or an optional argument with an optional -value (see the [~vopt] argument of {!Arg.opt}). - -Short flags can be grouped together to share a single dash and the -group can end with a short option. For example assuming ["-v"] and -["-x"] are flags and ["-f"] is a short option: - -{ul -{- ["-vx"] will be parsed as ["-v -x"].} -{- ["-vxfopt"] will be parsed as ["-v -x -fopt"].} -{- ["-vxf opt"] will be parsed as ["-v -x -fopt"].} -{- ["-fvx"] will be parsed as ["-f=vx"].}} - -{2:posargs Positional arguments} - -Positional arguments are tokens on the command line that are not -option names and are not the value of an optional argument. They are -numbered from left to right starting with zero. - -Since positional arguments may be mistaken as the optional value of an -optional argument or they may need to look like option names, anything -that follows the special token ["--"] on the command line is -considered to be a positional argument. - -{2:envlookup Environment variables} - -Non-required command line arguments can be backed up by an environment -variable. If the argument is absent from the command line and that -the environment variable is defined, its value is parsed using the -argument converter and defines the value of the argument. - -For {!Arg.flag} and {!Arg.flag_all} that do not have an argument converter a -boolean is parsed from the lowercased variable value as follows: - - -{ul -{- [""], ["false"], ["no"], ["n"] or ["0"] is [false].} -{- ["true"], ["yes"], ["y"] or ["1"] is [true].} -{- Any other string is an error.}} - -Note that environment variables are not supported for {!Arg.vflag} and -{!Arg.vflag_all}. - -{1:examples Examples} - -These examples are in the [test] directory of the distribution. - -{2:exrm A [rm] command} - -We define the command line interface of a [rm] command with the synopsis: - -{[ -rm [OPTION]... FILE... -]} - -The [-f], [-i] and [-I] flags define the prompt behaviour of [rm], -represented in our program by the [prompt] type. If more than one of -these flags is present on the command line the last one takes -precedence. - -To implement this behaviour we map the presence of these flags to -values of the [prompt] type by using {!Arg.vflag_all}. This argument -will contain all occurrences of the flag on the command line and we -just take the {!Arg.last} one to define our term value (if there's no -occurrence the last value of the default list [[Always]] is taken, -i.e. the default is [Always]). - -{[ -(* Implementation of the command, we just print the args. *) - -type prompt = Always | Once | Never -let prompt_str = function -| Always -> "always" | Once -> "once" | Never -> "never" - -let rm prompt recurse files = - Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n" - (prompt_str prompt) recurse (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner - -let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE") -let prompt = - let doc = "Prompt before every removal." in - let always = Always, Arg.info ["i"] ~doc in - let doc = "Ignore nonexistent files and never prompt." in - let never = Never, Arg.info ["f"; "force"] ~doc in - let doc = "Prompt once before removing more than three files, or when - removing recursively. Less intrusive than $(b,-i), while - still giving protection against most mistakes." - in - let once = Once, Arg.info ["I"] ~doc in - Arg.(last & vflag_all [Always] [always; never; once]) - -let recursive = - let doc = "Remove directories and their contents recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let cmd = - let doc = "remove files or directories" in - let man = [ - `S Manpage.s_description; - `P "$(tname) removes each specified $(i,FILE). By default it does not - remove directories, to also remove them and their contents, use the - option $(b,--recursive) ($(b,-r) or $(b,-R))."; - `P "To remove a file whose name starts with a `-', for example - `-foo', use one of these commands:"; - `P "rm -- -foo"; `Noblank; - `P "rm ./-foo"; - `P "$(tname) removes symbolic links, not the files referenced by the - links."; - `S Manpage.s_bugs; `P "Report bugs to ."; - `S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ] - in - Term.(const rm $ prompt $ recursive $ files), - Term.info "rm" ~version:"v1.0.4-31-gb5d6161" ~doc ~exits:Term.default_exits ~man - -let () = Term.(exit @@ eval cmd) -]} - -{2:excp A [cp] command} - -We define the command line interface of a [cp] command with the synopsis: -{[ -cp [OPTION]... SOURCE... DEST -]} - -The [DEST] argument must be a directory if there is more than one -[SOURCE]. This constraint is too complex to be expressed by the -combinators of {!Arg}. Hence we just give it the {!Arg.string} type -and verify the constraint at the beginning of the [cp] -implementation. If unsatisfied we return an [`Error] and by using -{!Term.ret} on the lifted result [cp_t] of [cp], [Cmdliner] handles -the error reporting. - -{[ -(* Implementation, we check the dest argument and print the args *) - -let cp verbose recurse force srcs dest = - if List.length srcs > 1 && - (not (Sys.file_exists dest) || not (Sys.is_directory dest)) - then - `Error (false, dest ^ " is not a directory") - else - `Ok (Printf.printf - "verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n" - verbose recurse force (String.concat ", " srcs) dest) - -(* Command line interface *) - -open Cmdliner - -let verbose = - let doc = "Print file names as they are copied." in - Arg.(value & flag & info ["v"; "verbose"] ~doc) - -let recurse = - let doc = "Copy directories recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let force = - let doc = "If a destination file cannot be opened, remove it and try again."in - Arg.(value & flag & info ["f"; "force"] ~doc) - -let srcs = - let doc = "Source file(s) to copy." in - Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) - -let dest = - let doc = "Destination of the copy. Must be a directory if there is more - than one $(i,SOURCE)." in - Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"DEST" - ~doc) - -let cmd = - let doc = "copy files" in - let man_xrefs = - [ `Tool "mv"; `Tool "scp"; `Page (2, "umask"); `Page (7, "symlink") ] - in - let exits = Term.default_exits in - let man = - [ `S Manpage.s_bugs; - `P "Email them to ."; ] - in - Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest)), - Term.info "cp" ~version:"v1.0.4-31-gb5d6161" ~doc ~exits ~man ~man_xrefs - -let () = Term.(exit @@ eval cmd) -]} - -{2:extail A [tail] command} - -We define the command line interface of a [tail] command with the -synopsis: - -{[ -tail [OPTION]... [FILE]... -]} - -The [--lines] option whose value specifies the number of last lines to -print has a special syntax where a [+] prefix indicates to start -printing from that line number. In the program this is represented by -the [loc] type. We define a custom [loc] {{!Arg.argconv}argument -converter} for this option. - -The [--follow] option has an optional enumerated value. The argument -converter [follow], created with {!Arg.enum} parses the option value -into the enumeration. By using {!Arg.some} and the [~vopt] argument of -{!Arg.opt}, the term corresponding to the option [--follow] evaluates -to [None] if [--follow] is absent from the command line, to [Some -Descriptor] if present but without a value and to [Some v] if present -with a value [v] specified. - -{[ -(* Implementation of the command, we just print the args. *) - -type loc = bool * int -type verb = Verbose | Quiet -type follow = Name | Descriptor - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k -let follow_str = function Name -> "name" | Descriptor -> "descriptor" -let verb_str = function Verbose -> "verbose" | Quiet -> "quiet" - -let tail lines follow verb pid files = - Printf.printf "lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n" - (loc_str lines) (opt_str follow_str follow) (verb_str verb) - (opt_str string_of_int pid) (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner - -let lines = - let loc = - let parse s = - try - if s <> "" && s.[0] <> '+' then Ok (true, int_of_string s) else - Ok (false, int_of_string (String.sub s 1 (String.length s - 1))) - with Failure _ -> Error (`Msg "unable to parse integer") - in - let print ppf p = Format.fprintf ppf "%s" (loc_str p) in - Arg.conv ~docv:"N" (parse, print) - in - Arg.(value & opt loc (true, 10) & info ["n"; "lines"] ~docv:"N" - ~doc:"Output the last $(docv) lines or use $(i,+)$(docv) to start - output after the $(i,N)-1th line.") - -let follow = - let doc = "Output appended data as the file grows. $(docv) specifies how the - file should be tracked, by its `name' or by its `descriptor'." in - let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in - Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None & - info ["f"; "follow"] ~docv:"ID" ~doc) - -let verb = - let doc = "Never output headers giving file names." in - let quiet = Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc in - let doc = "Always output headers giving file names." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~doc in - Arg.(last & vflag_all [Quiet] [quiet; verbose]) - -let pid = - let doc = "With -f, terminate after process $(docv) dies." in - Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc) - -let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE") - -let cmd = - let doc = "display the last part of a file" in - let man = [ - `S Manpage.s_description; - `P "$(tname) prints the last lines of each $(i,FILE) to standard output. If - no file is specified reads standard input. The number of printed - lines can be specified with the $(b,-n) option."; - `S Manpage.s_bugs; - `P "Report them to ."; - `S Manpage.s_see_also; - `P "$(b,cat)(1), $(b,head)(1)" ] - in - Term.(const tail $ lines $ follow $ verb $ pid $ files), - Term.info "tail" ~version:"%‌%VERSION%%" ~doc ~exits:Term.default_exits ~man - -let () = Term.(exit @@ eval cmd) -]} - -{2:exdarcs A [darcs] command} - -We define the command line interface of a [darcs] command with the -synopsis: - -{[ -darcs [COMMAND] ... -]} - -The [--debug], [-q], [-v] and [--prehook] options are available in -each command. To avoid having to pass them individually to each -command we gather them in a record of type [copts]. By lifting the -record constructor [copts] into the term [copts_t] we now have a term -that we can pass to the commands to stand for an argument of type -[copts]. These options are documented in a section called [COMMON -OPTIONS], since we also want to put [--help] and [--version] in this -section, the term information of commands makes a judicious use of the -[sdocs] parameter of {!Term.info}. - -The [help] command shows help about commands or other topics. The help -shown for commands is generated by [Cmdliner] by making an appropriate -use of {!Term.ret} on the lifted [help] function. - -If the program is invoked without a command we just want to show the -help of the program as printed by [Cmdliner] with [--help]. This is -done by the [default_cmd] term. - -{[ -(* Implementations, just print the args. *) - -type verb = Normal | Quiet | Verbose -type copts = { debug : bool; verb : verb; prehook : string option } - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let opt_str_str = opt_str (fun s -> s) -let verb_str = function - | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose" - -let pr_copts oc copts = Printf.fprintf oc - "debug = %B\nverbosity = %s\nprehook = %s\n" - copts.debug (verb_str copts.verb) (opt_str_str copts.prehook) - -let initialize copts repodir = Printf.printf - "%arepodir = %s\n" pr_copts copts repodir - -let record copts name email all ask_deps files = Printf.printf - "%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n" - pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps - (String.concat ", " files) - -let help copts man_format cmds topic = match topic with -| None -> `Help (`Pager, None) (* help about the program. *) -| Some topic -> - let topics = "topics" :: "patterns" :: "environment" :: cmds in - let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in - match conv topic with - | `Error e -> `Error (false, e) - | `Ok t when t = "topics" -> List.iter print_endline topics; `Ok () - | `Ok t when List.mem t cmds -> `Help (man_format, Some t) - | `Ok t -> - let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in - `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page) - -open Cmdliner - -(* Help sections common to all commands *) - -let help_secs = [ - `S Manpage.s_common_options; - `P "These options are common to all commands."; - `S "MORE HELP"; - `P "Use `$(mname) $(i,COMMAND) --help' for help on a single command.";`Noblank; - `P "Use `$(mname) help patterns' for help on patch matching."; `Noblank; - `P "Use `$(mname) help environment' for help on environment variables."; - `S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";] - -(* Options common to all commands *) - -let copts debug verb prehook = { debug; verb; prehook } -let copts_t = - let docs = Manpage.s_common_options in - let debug = - let doc = "Give only debug output." in - Arg.(value & flag & info ["debug"] ~docs ~doc) - in - let verb = - let doc = "Suppress informational output." in - let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in - let doc = "Give verbose output." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in - Arg.(last & vflag_all [Normal] [quiet; verbose]) - in - let prehook = - let doc = "Specify command to run before this $(mname) command." in - Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc) - in - Term.(const copts $ debug $ verb $ prehook) - -(* Commands *) - -let initialize_cmd = - let repodir = - let doc = "Run the program in repository directory $(docv)." in - Arg.(value & opt file Filename.current_dir_name & info ["repodir"] - ~docv:"DIR" ~doc) - in - let doc = "make the current directory a repository" in - let exits = Term.default_exits in - let man = [ - `S Manpage.s_description; - `P "Turns the current directory into a Darcs repository. Any - existing files and subdirectories become ..."; - `Blocks help_secs; ] - in - Term.(const initialize $ copts_t $ repodir), - Term.info "initialize" ~doc ~sdocs:Manpage.s_common_options ~exits ~man - -let record_cmd = - let pname = - let doc = "Name of the patch." in - Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME" - ~doc) - in - let author = - let doc = "Specifies the author's identity." in - Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL" - ~doc) - in - let all = - let doc = "Answer yes to all patches." in - Arg.(value & flag & info ["a"; "all"] ~doc) - in - let ask_deps = - let doc = "Ask for extra dependencies." in - Arg.(value & flag & info ["ask-deps"] ~doc) - in - let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in - let doc = "create a patch from unrecorded changes" in - let exits = Term.default_exits in - let man = - [`S Manpage.s_description; - `P "Creates a patch from changes in the working tree. If you specify - a set of files ..."; - `Blocks help_secs; ] - in - Term.(const record $ copts_t $ pname $ author $ all $ ask_deps $ files), - Term.info "record" ~doc ~sdocs:Manpage.s_common_options ~exits ~man - -let help_cmd = - let topic = - let doc = "The topic to get help on. `topics' lists the topics." in - Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) - in - let doc = "display help about darcs and darcs commands" in - let man = - [`S Manpage.s_description; - `P "Prints help about darcs commands and other subjects..."; - `Blocks help_secs; ] - in - Term.(ret - (const help $ copts_t $ Arg.man_format $ Term.choice_names $topic)), - Term.info "help" ~doc ~exits:Term.default_exits ~man - -let default_cmd = - let doc = "a revision control system" in - let sdocs = Manpage.s_common_options in - let exits = Term.default_exits in - let man = help_secs in - Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)), - Term.info "darcs" ~version:"v1.0.4-31-gb5d6161" ~doc ~sdocs ~exits ~man - -let cmds = [initialize_cmd; record_cmd; help_cmd] - -let () = Term.(exit @@ eval_choice default_cmd cmds) -]} -*) + val env_var : + ?deprecated:string -> ?docs:string -> ?doc:string -> Cmd.Env.var -> + Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.val-info}. *) +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.ml index 284f9e994..f32a36d97 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let rev_compare n0 n1 = compare n1 n0 @@ -33,6 +32,10 @@ let conv ?docv (parse, print) = let parse s = match parse s with Ok v -> `Ok v | Error (`Msg e) -> `Error e in parse, print +let conv' ?docv (parse, print) = + let parse s = match parse s with Ok v -> `Ok v | Error e -> `Error e in + parse, print + let pconv ?docv conv = conv let conv_parser (parse, _) = @@ -48,15 +51,16 @@ let parser_of_kind_of_string ~kind k_of_string = | Some v -> Ok v let some = Cmdliner_base.some +let some' = Cmdliner_base.some' (* Argument information *) -type env = Cmdliner_info.env -let env_var = Cmdliner_info.env +type env = Cmdliner_info.Env.info +let env_var = Cmdliner_info.Env.info type 'a t = 'a Cmdliner_term.t -type info = Cmdliner_info.arg -let info = Cmdliner_info.arg +type info = Cmdliner_info.Arg.t +let info = Cmdliner_info.Arg.v (* Arguments *) @@ -68,29 +72,37 @@ let parse_to_list parser s = match parser s with | `Ok v -> `Ok [v] | `Error _ as e -> e -let try_env ei a parse ~absent = match Cmdliner_info.arg_env a with +let report_deprecated_env ei e = match Cmdliner_info.Env.info_deprecated e with +| None -> () +| Some msg -> + let var = Cmdliner_info.Env.info_var e in + let msg = String.concat "" ["environment variable "; var; ": "; msg ] in + let err_fmt = Cmdliner_info.Eval.err_ppf ei in + Cmdliner_msg.pp_err err_fmt ei ~err:msg + +let try_env ei a parse ~absent = match Cmdliner_info.Arg.env a with | None -> Ok absent | Some env -> - let var = Cmdliner_info.env_var env in - match Cmdliner_info.(eval_env_var ei var) with + let var = Cmdliner_info.Env.info_var env in + match Cmdliner_info.Eval.env_var ei var with | None -> Ok absent | Some v -> match parse v with - | `Ok v -> Ok v | `Error e -> err (Cmdliner_msg.err_env_parse env ~err:e) + | `Ok v -> report_deprecated_env ei env; Ok v -let arg_to_args = Cmdliner_info.Args.singleton +let arg_to_args = Cmdliner_info.Arg.Set.singleton let list_to_args f l = - let add acc v = Cmdliner_info.Args.add (f v) acc in - List.fold_left add Cmdliner_info.Args.empty l + let add acc v = Cmdliner_info.Arg.Set.add (f v) acc in + List.fold_left add Cmdliner_info.Arg.Set.empty l let alias_opt aliases a = - let a = Cmdliner_info.arg_make_opt ~absent:Err ~kind:Opt a in + let a = Cmdliner_info.Arg.make_opt ~absent:Err ~kind:Opt a in let aliases = (fun f -> function | None -> Error (Cmdliner_msg.err_opt_value_missing f) | Some o -> Ok (aliases o)) in - let a = Cmdliner_info.arg_aliases ~aliases a in - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.aliases ~aliases a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -103,8 +115,8 @@ let alias aliases a = let aliases = (fun f -> function | Some v -> Error (Cmdliner_msg.err_flag_value f v) | None -> Ok aliases) in - let a = Cmdliner_info.arg_aliases ~aliases a in - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.aliases ~aliases a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -114,7 +126,7 @@ let alias aliases a = arg_to_args a, convert let flag a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -124,8 +136,8 @@ let flag a = arg_to_args a, convert let flag_all a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let a = Cmdliner_info.arg_make_all_opts a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.make_all_opts a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a (parse_to_list Cmdliner_base.env_bool_parse) ~absent:[] @@ -160,7 +172,7 @@ let vflag v l = try Ok (aux None l) with Failure e -> err e in let flag (_, a) = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else a + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else a in list_to_args flag l, convert @@ -183,23 +195,26 @@ let vflag_all v l = try Ok (aux [] l) with Failure e -> err e in let flag (_, a) = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - Cmdliner_info.arg_make_all_opts a + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + Cmdliner_info.Arg.make_all_opts a in list_to_args flag l, convert let parse_opt_value parse f v = match parse v with | `Ok v -> v -| `Error e -> failwith (Cmdliner_msg.err_opt_parse f e) +| `Error err -> failwith (Cmdliner_msg.err_opt_parse f ~err) let opt ?vopt (parse, print) v a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let absent = Cmdliner_info.Val (lazy (str_of_pp print v)) in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in let kind = match vopt with - | None -> Cmdliner_info.Opt - | Some dv -> Cmdliner_info.Opt_vopt (str_of_pp print dv) + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) in - let a = Cmdliner_info.arg_make_opt ~absent ~kind a in + let a = Cmdliner_info.Arg.make_opt ~absent ~kind a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a parse ~absent:v | [_, f, Some v] -> @@ -214,13 +229,16 @@ let opt ?vopt (parse, print) v a = arg_to_args a, convert let opt_all ?vopt (parse, print) v a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let absent = Cmdliner_info.Val (lazy "") in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy "") + in let kind = match vopt with - | None -> Cmdliner_info.Opt - | Some dv -> Cmdliner_info.Opt_vopt (str_of_pp print dv) + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) in - let a = Cmdliner_info.arg_make_opt_all ~absent ~kind a in + let a = Cmdliner_info.Arg.make_opt_all ~absent ~kind a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a (parse_to_list parse) ~absent:v | l -> @@ -240,13 +258,16 @@ let opt_all ?vopt (parse, print) v a = let parse_pos_value parse a v = match parse v with | `Ok v -> v -| `Error e -> failwith (Cmdliner_msg.err_pos_parse a e) +| `Error err -> failwith (Cmdliner_msg.err_pos_parse a ~err) let pos ?(rev = false) k (parse, print) v a = - if Cmdliner_info.arg_is_opt a then invalid_arg err_not_pos else - let absent = Cmdliner_info.Val (lazy (str_of_pp print v)) in - let pos = Cmdliner_info.pos ~rev ~start:k ~len:(Some 1) in - let a = Cmdliner_info.arg_make_pos_abs ~absent ~pos a in + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in + let pos = Cmdliner_info.Arg.pos ~rev ~start:k ~len:(Some 1) in + let a = Cmdliner_info.Arg.make_pos_abs ~absent ~pos a in let convert ei cl = match Cmdliner_cline.pos_arg cl a with | [] -> try_env ei a parse ~absent:v | [v] -> @@ -256,8 +277,8 @@ let pos ?(rev = false) k (parse, print) v a = arg_to_args a, convert let pos_list pos (parse, _) v a = - if Cmdliner_info.arg_is_opt a then invalid_arg err_not_pos else - let a = Cmdliner_info.arg_make_pos pos a in + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let a = Cmdliner_info.Arg.make_pos ~pos a in let convert ei cl = match Cmdliner_cline.pos_arg cl a with | [] -> try_env ei a (parse_to_list parse) ~absent:v | l -> @@ -266,32 +287,32 @@ let pos_list pos (parse, _) v a = in arg_to_args a, convert -let all = Cmdliner_info.pos ~rev:false ~start:0 ~len:None +let all = Cmdliner_info.Arg.pos ~rev:false ~start:0 ~len:None let pos_all c v a = pos_list all c v a let pos_left ?(rev = false) k = let start = if rev then k + 1 else 0 in let len = if rev then None else Some k in - pos_list (Cmdliner_info.pos ~rev ~start ~len) + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) let pos_right ?(rev = false) k = let start = if rev then 0 else k + 1 in let len = if rev then Some k else None in - pos_list (Cmdliner_info.pos ~rev ~start ~len) + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) (* Arguments as terms *) let absent_error args = let make_req a acc = - let req_a = Cmdliner_info.arg_make_req a in - Cmdliner_info.Args.add req_a acc + let req_a = Cmdliner_info.Arg.make_req a in + Cmdliner_info.Arg.Set.add req_a acc in - Cmdliner_info.Args.fold make_req args Cmdliner_info.Args.empty + Cmdliner_info.Arg.Set.fold make_req args Cmdliner_info.Arg.Set.empty let value a = a let err_arg_missing args = - err @@ Cmdliner_msg.err_arg_missing (Cmdliner_info.Args.choose args) + err @@ Cmdliner_msg.err_arg_missing (Cmdliner_info.Arg.Set.choose args) let required (args, convert) = let args = absent_error args in @@ -319,14 +340,6 @@ let last (args, convert) = in args, convert -let last_or_none (args, convert) = - let convert ei cl = match convert ei cl with - | Ok [] -> Ok None - | Ok l -> Ok (Some (List.hd (List.rev l))) - | Error _ as e -> e - in - args, convert - (* Predefined arguments *) let man_fmts = @@ -336,9 +349,9 @@ let man_fmt_docv = "FMT" let man_fmts_enum = Cmdliner_base.enum man_fmts let man_fmts_alts = doc_alts_enum man_fmts let man_fmts_doc kind = - strf "Show %s in format $(docv). The value $(docv) must be %s. With `auto', - the format is `pager` or `plain' whenever the $(b,TERM) env var is - `dumb' or undefined." + strf "Show %s in format $(docv). The value $(docv) must be %s. \ + With $(b,auto), the format is $(b,pager) or $(b,plain) whenever \ + the $(b,TERM) env var is $(b,dumb) or undefined." kind man_fmts_alts let man_format = @@ -377,7 +390,7 @@ let t3 = Cmdliner_base.t3 let t4 = Cmdliner_base.t4 (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.mli index dbd2f0cfd..4375b41aa 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_arg.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Command line arguments as terms. *) @@ -15,6 +14,9 @@ val conv : ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> 'a conv +val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> 'a conv + val pconv : ?docv:string -> 'a parser * 'a printer -> 'a conv val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) val conv_printer : 'a conv -> 'a printer @@ -25,15 +27,17 @@ val parser_of_kind_of_string : (string -> ('a, [`Msg of string]) result) val some : ?none:string -> 'a converter -> 'a option converter +val some' : ?none:'a -> 'a converter -> 'a option converter -type env = Cmdliner_info.env -val env_var : ?docs:string -> ?doc:string -> string -> env +type env = Cmdliner_info.Env.info +val env_var : ?deprecated:string -> ?docs:string -> ?doc:string -> string -> env type 'a t = 'a Cmdliner_term.t type info val info : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> string list -> info + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:env -> string list -> info val ( & ) : ('a -> 'b) -> 'a -> 'b @@ -97,7 +101,7 @@ val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.ml index 5e84dfc25..c1a4d217a 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.ml @@ -1,17 +1,58 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) +let strf = Printf.sprintf + +(* Unique ids *) + +let uid = + (* Thread-safe UIDs, Oo.id (object end) was used before. + Note this won't be thread-safe in multicore, we should use + Atomic but this is >= 4.12 and we have 4.08 for now. *) + let c = ref 0 in + fun () -> + let id = !c in + incr c; if id > !c then assert false (* too many ids *) else id + +(* Edit distance *) + +let edit_distance s0 s1 = + let minimum (a : int) (b : int) (c : int) : int = min a (min b c) in + let s0,s1 = if String.length s0 <= String.length s1 then s0,s1 else s1,s0 in + let m = String.length s0 and n = String.length s1 in + let rec rows row0 row i = match i > n with + | true -> row0.(m) + | false -> + row.(0) <- i; + for j = 1 to m do + if s0.[j - 1] = s1.[i - 1] then row.(j) <- row0.(j - 1) else + row.(j) <- minimum (row0.(j - 1) + 1) (row0.(j) + 1) (row.(j - 1) + 1) + done; + rows row row0 (i + 1) + in + rows (Array.init (m + 1) (fun x -> x)) (Array.make (m + 1) 0) 1 + +let suggest s candidates = + let add (min, acc) name = + let d = edit_distance s name in + if d = min then min, (name :: acc) else + if d < min then d, [name] else + min, acc + in + let dist, suggs = List.fold_left add (max_int, []) candidates in + if dist < 3 (* suggest only if not too far *) then suggs else [] + (* Invalid argument strings *) let err_empty_list = "empty list" -let err_incomplete_enum = "Incomplete enumeration for the type" +let err_incomplete_enum ss = + strf "Arg.enum: missing printable string for a value, other strings are: %s" + (String.concat ", " ss) (* Formatting tools *) -let strf = Printf.sprintf let pp = Format.fprintf let pp_sp = Format.pp_print_space let pp_str = Format.pp_print_string @@ -58,9 +99,12 @@ let pp_tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *) (* Converter (end-user) error messages *) -let quote s = strf "`%s'" s -let alts_str ?(quoted = true) alts = - let quote = if quoted then quote else (fun s -> s) in +let quote s = strf "'%s'" s +let alts_str ?quoted alts = + let quote = match quoted with + | None -> strf "$(b,%s)" + | Some quoted -> if quoted then quote else (fun s -> s) + in match alts with | [] -> invalid_arg err_empty_list | [a] -> (quote a) @@ -76,26 +120,27 @@ let err_multi_def ~kind name doc v v' = kind name (doc v) (doc v') let err_ambiguous ~kind s ~ambs = - strf "%s %s ambiguous and could be %s" kind (quote s) (alts_str ambs) - -let err_unknown ?(hints = []) ~kind v = - let did_you_mean s = strf ", did you mean %s ?" s in - let hints = match hints with [] -> "." | hs -> did_you_mean (alts_str hs) in + strf "%s %s ambiguous and could be %s" kind (quote s) + (alts_str ~quoted:true ambs) + +let err_unknown ?(dom = []) ?(hints = []) ~kind v = + let hints = match hints, dom with + | [], [] -> "." + | [], dom -> strf ", must be %s." (alts_str ~quoted:true dom) + | hints, _ -> strf ", did you mean %s?" (alts_str ~quoted:true hints) + in strf "unknown %s %s%s" kind (quote v) hints -let err_no_sub_command = - "is a command group and requires a command argument." - let err_no kind s = strf "no %s %s" (quote s) kind let err_not_dir s = strf "%s is not a directory" (quote s) let err_is_dir s = strf "%s is a directory" (quote s) let err_element kind s exp = - strf "invalid element in %s (`%s'): %s" kind s exp + strf "invalid element in %s ('%s'): %s" kind s exp let err_invalid kind s exp = strf "invalid %s %s, %s" kind (quote s) exp let err_invalid_val = err_invalid "value" let err_sep_miss sep s = - err_invalid_val s (strf "missing a `%c' separator" sep) + err_invalid_val s (strf "missing a '%c' separator" sep) (* Converters *) @@ -104,20 +149,25 @@ type 'a printer = Format.formatter -> 'a -> unit type 'a conv = 'a parser * 'a printer let some ?(none = "") (parse, print) = - let parse s = match parse s with - | `Ok v -> `Ok (Some v) - | `Error _ as e -> e - in + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in let print ppf v = match v with | None -> Format.pp_print_string ppf none | Some v -> print ppf v in parse, print +let some' ?none (parse, print) = + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in + let print ppf = function + | None -> (match none with None -> () | Some v -> print ppf v) + | Some v -> print ppf v + in + parse, print + let bool = let parse s = try `Ok (bool_of_string s) with | Invalid_argument _ -> - `Error (err_invalid_val s (alts_str ["true"; "false"])) + `Error (err_invalid_val s (alts_str ~quoted:true ["true"; "false"])) in parse, Format.pp_print_bool @@ -158,15 +208,15 @@ let enum sl = | `Ok _ as r -> r | `Ambiguous -> let ambs = List.sort compare (Cmdliner_trie.ambiguities t s) in - `Error (err_ambiguous "enum value" s ambs) + `Error (err_ambiguous ~kind:"enum value" s ~ambs) | `Not_found -> let alts = List.rev (List.rev_map (fun (s, _) -> s) sl) in - `Error (err_invalid_val s ("expected " ^ (alts_str alts))) + `Error (err_invalid_val s ("expected " ^ (alts_str ~quoted:true alts))) in let print ppf v = let sl_inv = List.rev_map (fun (s,v) -> (v,s)) sl in try pp_str ppf (List.assoc v sl_inv) - with Not_found -> invalid_arg err_incomplete_enum + with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl)) in parse, print @@ -286,10 +336,12 @@ let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) = let env_bool_parse s = match String.lowercase_ascii s with | "" | "false" | "no" | "n" | "0" -> `Ok false | "true" | "yes" | "y" | "1" -> `Ok true -| s -> `Error (err_invalid_val s (alts_str ["true"; "yes"; "false"; "no" ])) +| s -> + let alts = alts_str ~quoted:true ["true"; "yes"; "false"; "no" ] in + `Error (err_invalid_val s alts) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.mli index 039b3f94d..2c3f3d94e 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_base.mli @@ -1,11 +1,17 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** A few helpful base definitions. *) +val uid : unit -> int +(** [uid ()] is new unique for the program run. *) + +val suggest : string -> string list -> string list +(** [suggest near candidates] suggest values from [candidates] + not too far from [near]. *) + (** {1:fmt Formatting helpers} *) val pp_text : Format.formatter -> string -> unit @@ -17,10 +23,10 @@ val pp_tokens : spaces:bool -> Format.formatter -> string -> unit val quote : string -> string val alts_str : ?quoted:bool -> string list -> string val err_ambiguous : kind:string -> string -> ambs:string list -> string -val err_unknown : ?hints:string list -> kind:string -> string -> string +val err_unknown : + ?dom:string list -> ?hints:string list -> kind:string -> string -> string val err_multi_def : kind:string -> string -> ('b -> string) -> 'b -> 'b -> string - val err_no_sub_command : string (** {1:conv Textual OCaml value converters} *) @@ -29,6 +35,7 @@ type 'a printer = Format.formatter -> 'a -> unit type 'a conv = 'a parser * 'a printer val some : ?none:string -> 'a conv -> 'a option conv +val some' : ?none:'a -> 'a conv -> 'a option conv val bool : bool conv val char : char conv val int : int conv @@ -53,7 +60,7 @@ val t4 : val env_bool_parse : bool parser (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.ml index c2f00bd3f..2b8108c68 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (* A command line stores pre-parsed information about the command @@ -14,7 +13,7 @@ let err_multi_opt_name_def name a a' = Cmdliner_base.err_multi_def - ~kind:"option name" name Cmdliner_info.arg_doc a a' + ~kind:"option name" name Cmdliner_info.Arg.doc a a' module Amap = Map.Make (Cmdliner_info.Arg) @@ -42,18 +41,18 @@ let arg_info_indexes args = let rec loop optidx posidx cl = function | [] -> optidx, posidx, cl | a :: l -> - match Cmdliner_info.arg_is_pos a with + match Cmdliner_info.Arg.is_pos a with | true -> loop optidx (a :: posidx) (Amap.add a (P []) cl) l | false -> let add t name = match Cmdliner_trie.add t name a with | `New t -> t | `Replaced (a', _) -> invalid_arg (err_multi_opt_name_def name a a') in - let names = Cmdliner_info.arg_opt_names a in + let names = Cmdliner_info.Arg.opt_names a in let optidx = List.fold_left add optidx names in loop optidx posidx (Amap.add a (O []) cl) l in - loop Cmdliner_trie.empty [] Amap.empty (Cmdliner_info.Args.elements args) + loop Cmdliner_trie.empty [] Amap.empty (Cmdliner_info.Arg.Set.elements args) (* Optional argument parsing *) @@ -82,7 +81,7 @@ let hint_matching_opt optidx s = let short_opt, _ = parse_opt_arg short_opt in let long_opt, _ = parse_opt_arg long_opt in let all = Cmdliner_trie.ambiguities optidx "-" in - match List.mem short_opt all, Cmdliner_suggest.value long_opt all with + match List.mem short_opt all, Cmdliner_base.suggest long_opt all with | false, [] -> [] | false, l -> l | true, [] -> [short_opt] @@ -100,11 +99,11 @@ let parse_opt_args ~peek_opts optidx cl args = let name, value = parse_opt_arg s in match Cmdliner_trie.find optidx name with | `Ok a -> - let value, args = match value, Cmdliner_info.arg_opt_kind a with - | Some v, (Cmdliner_info.Flag) when is_short_opt name -> - None, ("-" ^ v) :: args + let value, args = match value, Cmdliner_info.Arg.opt_kind a with + | Some v, Cmdliner_info.Arg.Flag when is_short_opt name -> + None, ("-" ^ v) :: args | Some _, _ -> value, args - | None, Cmdliner_info.Flag -> value, args + | None, Cmdliner_info.Arg.Flag -> value, args | None, _ -> match args with | [] -> None, args @@ -112,7 +111,7 @@ let parse_opt_args ~peek_opts optidx cl args = in let arg = O ((k, name, value) :: opt_arg cl a) in let errs,args = - match Cmdliner_info.arg_alias a name value with + match Cmdliner_info.Arg.alias a name value with | Ok l -> errs,l@args | Error err -> err::errs,args in @@ -125,7 +124,7 @@ let parse_opt_args ~peek_opts optidx cl args = | `Ambiguous -> let ambs = Cmdliner_trie.ambiguities optidx name in let ambs = List.sort compare ambs in - let err = Cmdliner_base.err_ambiguous "option" name ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"option" name ~ambs in loop (err :: errs) (k + 1) cl pargs args in let errs, cl, pargs = loop [] 0 cl [] args in @@ -148,7 +147,7 @@ let process_pos_args posidx cl pargs = in the list index posidx, is given a value according the list of positional arguments values [pargs]. *) if pargs = [] then - let misses = List.filter Cmdliner_info.arg_is_req posidx in + let misses = List.filter Cmdliner_info.Arg.is_req posidx in if misses = [] then Ok cl else Error (Cmdliner_msg.err_pos_misses misses, cl) else @@ -157,18 +156,18 @@ let process_pos_args posidx cl pargs = let rec loop misses cl max_spec = function | [] -> misses, cl, max_spec | a :: al -> - let apos = Cmdliner_info.arg_pos a in - let rev = Cmdliner_info.pos_rev apos in - let start = pos rev (Cmdliner_info.pos_start apos) in - let stop = match Cmdliner_info.pos_len apos with + let apos = Cmdliner_info.Arg.pos_kind a in + let rev = Cmdliner_info.Arg.pos_rev apos in + let start = pos rev (Cmdliner_info.Arg.pos_start apos) in + let stop = match Cmdliner_info.Arg.pos_len apos with | None -> pos rev last - | Some n -> pos rev (Cmdliner_info.pos_start apos + n - 1) + | Some n -> pos rev (Cmdliner_info.Arg.pos_start apos + n - 1) in let start, stop = if rev then stop, start else start, stop in let args = take_range start stop pargs in let max_spec = max stop max_spec in let cl = Amap.add a (P args) cl in - let misses = match Cmdliner_info.arg_is_req a && args = [] with + let misses = match Cmdliner_info.Arg.is_req a && args = [] with | true -> a :: misses | false -> misses in @@ -187,8 +186,29 @@ let create ?(peek_opts = false) al args = | Ok (cl, pargs) -> process_pos_args posidx cl pargs | Error (errs, cl, _) -> Error (errs, cl) +let deprecated_msgs cl = + let add i arg acc = match Cmdliner_info.Arg.deprecated i with + | None -> acc + | Some msg -> + let plural l = if List.length l > 1 then "s " else " " in + match arg with + | O [] | P [] -> acc (* Should not happen *) + | O os -> + let plural = plural os in + let names = List.map (fun (_, n, _) -> n) os in + let names = String.concat " " (List.map Cmdliner_base.quote names) in + let msg = "option" :: plural :: names :: ": " :: msg :: [] in + String.concat "" msg :: acc + | P args -> + let plural = plural args in + let args = String.concat " " (List.map Cmdliner_base.quote args) in + let msg = "argument" :: plural :: args :: ": " :: msg :: [] in + String.concat "" msg :: acc + in + Amap.fold add cl [] + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.mli index f4f976d23..5651bda2d 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cline.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Command lines. *) @@ -9,16 +8,19 @@ type t val create : - ?peek_opts:bool -> Cmdliner_info.args -> string list -> + ?peek_opts:bool -> Cmdliner_info.Arg.Set.t -> string list -> (t, string * t) result -val opt_arg : t -> Cmdliner_info.arg -> (int * string * (string option)) list -val pos_arg : t -> Cmdliner_info.arg -> string list -val actual_args : t -> Cmdliner_info.arg -> string list +val opt_arg : t -> Cmdliner_info.Arg.t -> (int * string * (string option)) list +val pos_arg : t -> Cmdliner_info.Arg.t -> string list +val actual_args : t -> Cmdliner_info.Arg.t -> string list (** Actual command line arguments from the command line *) +val is_opt : string -> bool +val deprecated_msgs : t -> string list + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.ml new file mode 100644 index 000000000..5a156f3fd --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.ml @@ -0,0 +1,46 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Commands *) + +(* Command info *) + +type info = Cmdliner_info.Cmd.t +let info = Cmdliner_info.Cmd.v + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +let get_info = function Cmd (i, _) | Group (i, _) -> i +let children_infos = function +| Cmd _ -> [] | Group (_, (_, cs)) -> List.map get_info cs + +let v i (args, p) = Cmd (Cmdliner_info.Cmd.add_args i args, p) +let group ?default i cmds = + let args, parser = match default with + | None -> None, None | Some (args, p) -> Some args, Some p + in + let children = List.map get_info cmds in + let i = Cmdliner_info.Cmd.with_children i ~args ~children in + Group (i, (parser, cmds)) + +let name c = Cmdliner_info.Cmd.name (get_info c) + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.mli new file mode 100644 index 000000000..54da1535d --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_cmd.mli @@ -0,0 +1,40 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Commands and their information. *) + +type info = Cmdliner_info.Cmd.t + +val info : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Cmdliner_info.Env.info list -> ?exits:Cmdliner_info.Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +val v : info -> 'a Cmdliner_term.t -> 'a t +val group : ?default:'a Cmdliner_term.t -> info -> 'a t list -> 'a t +val name : 'a t -> string +val get_info : 'a t -> info + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.ml index 80cf9f075..d452ae830 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.ml @@ -1,14 +1,31 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let rev_compare n0 n1 = compare n1 n0 let strf = Printf.sprintf +let order_args a0 a1 = + match Cmdliner_info.Arg.is_opt a0, Cmdliner_info.Arg.is_opt a1 with + | true, true -> (* optional by name *) + let key names = + let k = List.hd (List.sort rev_compare names) in + let k = String.lowercase_ascii k in + if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k + in + compare + (key @@ Cmdliner_info.Arg.opt_names a0) + (key @@ Cmdliner_info.Arg.opt_names a1) + | false, false -> (* positional by variable *) + compare + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a0) + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a1) + | true, false -> -1 (* positional first *) + | false, true -> 1 (* optional after *) + let esc = Cmdliner_manpage.escape -let term_name t = esc @@ Cmdliner_info.term_name t +let cmd_name t = esc @@ Cmdliner_info.Cmd.name t let sorted_items_to_blocks ~boilerplate:b items = (* Items are sorted by section and then rev. sorted by appearance. @@ -31,87 +48,117 @@ let sorted_items_to_blocks ~boilerplate:b items = (* Doc string variables substitutions. *) let env_info_subst ~subst e = function -| "env" -> Some (strf "$(b,%s)" @@ esc (Cmdliner_info.env_var e)) +| "env" -> Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e)) | id -> subst id let exit_info_subst ~subst e = function -| "status" -> Some (strf "%d" (fst @@ Cmdliner_info.exit_statuses e)) -| "status_max" -> Some (strf "%d" (snd @@ Cmdliner_info.exit_statuses e)) +| "status" -> Some (strf "%d" (fst @@ Cmdliner_info.Exit.info_codes e)) +| "status_max" -> Some (strf "%d" (snd @@ Cmdliner_info.Exit.info_codes e)) | id -> subst id let arg_info_subst ~subst a = function | "docv" -> - Some (strf "$(i,%s)" @@ esc (Cmdliner_info.arg_docv a)) -| "opt" when Cmdliner_info.arg_is_opt a -> - Some (strf "$(b,%s)" @@ esc (Cmdliner_info.arg_opt_name_sample a)) + Some (strf "$(i,%s)" @@ esc (Cmdliner_info.Arg.docv a)) +| "opt" when Cmdliner_info.Arg.is_opt a -> + Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Arg.opt_name_sample a)) | "env" as id -> - begin match Cmdliner_info.arg_env a with + begin match Cmdliner_info.Arg.env a with | Some e -> env_info_subst ~subst e id | None -> subst id end | id -> subst id -let term_info_subst ei = function -| "tname" -> Some (strf "$(b,%s)" @@ term_name (Cmdliner_info.eval_term ei)) -| "mname" -> Some (strf "$(b,%s)" @@ term_name (Cmdliner_info.eval_main ei)) +let cmd_info_subst ei = function +| "tname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.cmd ei)) +| "mname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.main ei)) | _ -> None (* Command docs *) -let invocation ?(sep = ' ') ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_main -> term_name (Cmdliner_info.eval_main ei) -| `Multiple_group -| `Multiple_sub -> - let sep = String.make 1 sep in - Cmdliner_info.eval_terms_rev ei - |> List.rev_map Cmdliner_info.term_name - |> String.concat sep - |> strf "%s" - -let plain_invocation ei = invocation ei -let invocation ?sep ei = esc @@ invocation ?sep ei +let invocation ?(sep = " ") ?(parents = []) cmd = + let names = List.rev_map Cmdliner_info.Cmd.name (cmd :: parents) in + esc @@ String.concat sep names let synopsis_pos_arg a = - let v = match Cmdliner_info.arg_docv a with "" -> "ARG" | v -> v in + let v = match Cmdliner_info.Arg.docv a with "" -> "ARG" | v -> v in let v = strf "$(i,%s)" (esc v) in - let v = (if Cmdliner_info.arg_is_req a then strf "%s" else strf "[%s]") v in - match Cmdliner_info.(pos_len @@ arg_pos a) with - | None -> v ^ "..." + let v = (if Cmdliner_info.Arg.is_req a then strf "%s" else strf "[%s]") v in + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with + | None -> v ^ "…" | Some 1 -> v | Some n -> let rec loop n acc = if n <= 0 then acc else loop (n - 1) (v :: acc) in String.concat " " (loop n []) -let synopsis ei = match Cmdliner_info.eval_kind ei with -| `Multiple_main -> strf "$(b,%s) $(i,COMMAND) ..." @@ invocation ei -| `Multiple_group -| `Simple | `Multiple_sub -> +let synopsis_opt_arg a n = + let var = match Cmdliner_info.Arg.docv a with "" -> "VAL" | v -> v in + match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Flag -> strf "$(b,%s)" (esc n) + | Cmdliner_info.Arg.Opt -> + if String.length n > 2 + then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) + else strf "$(b,%s) $(i,%s)" (esc n) (esc var) + | Cmdliner_info.Arg.Opt_vopt _ -> + if String.length n > 2 + then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) + else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + +let deprecated cmd = match Cmdliner_info.Cmd.deprecated cmd with +| None -> "" | Some _ -> "(Deprecated) " + +let synopsis ?parents cmd = match Cmdliner_info.Cmd.children cmd with +| [] -> let rev_cli_order (a0, _) (a1, _) = - Cmdliner_info.rev_arg_pos_cli_order a0 a1 + Cmdliner_info.Arg.rev_pos_cli_order a0 a1 + in + let args = Cmdliner_info.Cmd.args cmd in + let oargs, pargs = Cmdliner_info.Arg.(Set.partition is_opt args) in + let oargs = + (* Keep only those that are listed in the s_options section and + that are not [--version] or [--help]. * *) + let keep a = + let drop_names n = n = "--help" || n = "--version" in + Cmdliner_info.Arg.docs a = Cmdliner_manpage.s_options && + not (List.exists drop_names (Cmdliner_info.Arg.opt_names a)) + in + let oargs = Cmdliner_info.Arg.Set.(elements (filter keep oargs)) in + let count = List.length oargs in + let any_option = "[$(i,OPTION)]…" in + if count = 0 || count > 3 then any_option else + let syn a = + strf "[%s]" (synopsis_opt_arg a (Cmdliner_info.Arg.opt_name_sample a)) + in + let oargs = List.sort order_args oargs in + let oargs = String.concat " " (List.map syn oargs) in + String.concat " " [oargs; any_option] + in + let pargs = + let pargs = Cmdliner_info.Arg.Set.elements pargs in + if pargs = [] then "" else + let pargs = List.map (fun a -> a, synopsis_pos_arg a) pargs in + let pargs = List.sort rev_cli_order pargs in + String.concat " " ("" (* add a space *) :: List.rev_map snd pargs) in - let add_pos a acc = match Cmdliner_info.arg_is_opt a with - | true -> acc - | false -> (a, synopsis_pos_arg a) :: acc + strf "%s$(b,%s) %s%s" + (deprecated cmd) (invocation ?parents cmd) oargs pargs +| _cmds -> + let subcmd = match Cmdliner_info.Cmd.has_args cmd with + | false -> "$(i,COMMAND)" | true -> "[$(i,COMMAND)]" in - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let pargs = Cmdliner_info.Args.fold add_pos args [] in - let pargs = List.sort rev_cli_order pargs in - let pargs = String.concat " " (List.rev_map snd pargs) in - strf "$(b,%s) [$(i,OPTION)]... %s" (invocation ei) pargs - -let cmd_docs ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_sub -> [] -| `Multiple_group -| `Multiple_main -> - let add_cmd acc t = - let cmd = strf "$(b,%s)" @@ term_name t in - (Cmdliner_info.term_docs t, `I (cmd, Cmdliner_info.term_doc t)) :: acc + strf "%s$(b,%s) %s …" (deprecated cmd) (invocation ?parents cmd) subcmd + +let cmd_docs ei = match Cmdliner_info.(Cmd.children (Eval.cmd ei)) with +| [] -> [] +| cmds -> + let add_cmd acc cmd = + let syn = synopsis cmd in + (Cmdliner_info.Cmd.docs cmd, `I (syn, Cmdliner_info.Cmd.doc cmd)) :: acc in let by_sec_by_rev_name (s0, `I (c0, _)) (s1, `I (c1, _)) = let c = compare s0 s1 in if c <> 0 then c else compare c1 c0 (* N.B. reverse *) in - let cmds = List.fold_left add_cmd [] (Cmdliner_info.eval_choices ei) in + let cmds = List.fold_left add_cmd [] cmds in let cmds = List.sort by_sec_by_rev_name cmds in let cmds = (cmds :> (string * Cmdliner_manpage.block) list) in sorted_items_to_blocks ~boilerplate:None cmds @@ -119,42 +166,36 @@ let cmd_docs ei = match Cmdliner_info.eval_kind ei with (* Argument docs *) let arg_man_item_label a = - if Cmdliner_info.arg_is_pos a - then strf "$(i,%s)" (esc @@ Cmdliner_info.arg_docv a) else - let fmt_name var = match Cmdliner_info.arg_opt_kind a with - | Cmdliner_info.Flag -> fun n -> strf "$(b,%s)" (esc n) - | Cmdliner_info.Opt -> - fun n -> - if String.length n > 2 - then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) - else strf "$(b,%s) $(i,%s)" (esc n) (esc var) - | Cmdliner_info.Opt_vopt _ -> - fun n -> - if String.length n > 2 - then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) - else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + let s = match Cmdliner_info.Arg.is_pos a with + | true -> strf "$(i,%s)" (esc @@ Cmdliner_info.Arg.docv a) + | false -> + let names = List.sort compare (Cmdliner_info.Arg.opt_names a) in + String.concat ", " (List.rev_map (synopsis_opt_arg a) names) in - let var = match Cmdliner_info.arg_docv a with "" -> "VAL" | v -> v in - let names = List.sort compare (Cmdliner_info.arg_opt_names a) in - let s = String.concat ", " (List.rev_map (fmt_name var) names) in - s + match Cmdliner_info.Arg.deprecated a with + | None -> s | Some _ -> "(Deprecated) " ^ s let arg_to_man_item ~errs ~subst ~buf a = - let or_env ~value a = match Cmdliner_info.arg_env a with + let subst = arg_info_subst ~subst a in + let or_env ~value a = match Cmdliner_info.Arg.env a with | None -> "" | Some e -> let value = if value then " or" else "absent " in - strf "%s $(b,%s) env" value (esc @@ Cmdliner_info.env_var e) + strf "%s $(b,%s) env" value (esc @@ Cmdliner_info.Env.info_var e) in - let absent = match Cmdliner_info.arg_absent a with - | Cmdliner_info.Err -> "required" - | Cmdliner_info.Val v -> + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Err -> "required" + | Cmdliner_info.Arg.Doc "" -> strf "%s" (or_env ~value:false a) + | Cmdliner_info.Arg.Doc s -> + let s = Cmdliner_manpage.subst_vars ~errs ~subst buf s in + strf "absent=%s%s" s (or_env ~value:true a) + | Cmdliner_info.Arg.Val v -> match Lazy.force v with | "" -> strf "%s" (or_env ~value:false a) - | v -> strf "absent=%s%s" (esc v) (or_env ~value:true a) + | v -> strf "absent=$(b,%s)%s" (esc v) (or_env ~value:true a) in - let optvopt = match Cmdliner_info.arg_opt_kind a with - | Cmdliner_info.Opt_vopt v -> strf "default=%s" v + let optvopt = match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Opt_vopt v -> strf "default=$(b,%s)" (esc v) | _ -> "" in let argvdoc = match optvopt, absent with @@ -162,38 +203,28 @@ let arg_to_man_item ~errs ~subst ~buf a = | s, "" | "", s -> strf " (%s)" s | s, s' -> strf " (%s) (%s)" s s' in - let subst = arg_info_subst ~subst a in - let doc = Cmdliner_info.arg_doc a in + let doc = Cmdliner_info.Arg.doc a in let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in - (Cmdliner_info.arg_docs a, `I (arg_man_item_label a ^ argvdoc, doc)) + (Cmdliner_info.Arg.docs a, `I (arg_man_item_label a ^ argvdoc, doc)) let arg_docs ~errs ~subst ~buf ei = let by_sec_by_arg a0 a1 = - let c = compare (Cmdliner_info.arg_docs a0) (Cmdliner_info.arg_docs a1) in + let c = compare (Cmdliner_info.Arg.docs a0) (Cmdliner_info.Arg.docs a1) in if c <> 0 then c else - match Cmdliner_info.arg_is_opt a0, Cmdliner_info.arg_is_opt a1 with - | true, true -> (* optional by name *) - let key names = - let k = List.hd (List.sort rev_compare names) in - let k = String.lowercase_ascii k in - if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k - in - compare - (key @@ Cmdliner_info.arg_opt_names a0) - (key @@ Cmdliner_info.arg_opt_names a1) - | false, false -> (* positional by variable *) - compare - (String.lowercase_ascii @@ Cmdliner_info.arg_docv a0) - (String.lowercase_ascii @@ Cmdliner_info.arg_docv a1) - | true, false -> -1 (* positional first *) - | false, true -> 1 (* optional after *) + let c = + match Cmdliner_info.Arg.deprecated a0, Cmdliner_info.Arg.deprecated a1 + with + | None, None | Some _, Some _ -> 0 + | None, Some _ -> -1 | Some _, None -> 1 + in + if c <> 0 then c else order_args a0 a1 in let keep_arg a acc = - if not Cmdliner_info.(arg_is_pos a && (arg_docv a = "" || arg_doc a = "")) + if not Cmdliner_info.Arg.(is_pos a && (docv a = "" || doc a = "")) then (a :: acc) else acc in - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let args = Cmdliner_info.Args.fold keep_arg args [] in + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let args = Cmdliner_info.Arg.Set.fold keep_arg args [] in let args = List.sort by_sec_by_arg args in let args = List.rev_map (arg_to_man_item ~errs ~subst ~buf) args in sorted_items_to_blocks ~boilerplate:None args @@ -208,14 +239,14 @@ let exit_docs ~errs ~subst ~buf ~has_sexit ei = let by_sec (s0, _) (s1, _) = compare s0 s1 in let add_exit_item acc e = let subst = exit_info_subst ~subst e in - let min, max = Cmdliner_info.exit_statuses e in - let doc = Cmdliner_info.exit_doc e in + let min, max = Cmdliner_info.Exit.info_codes e in + let doc = Cmdliner_info.Exit.info_doc e in let label = if min = max then strf "%d" min else strf "%d-%d" min max in let item = `I (label, Cmdliner_manpage.subst_vars ~errs ~subst buf doc) in - Cmdliner_info.(exit_docs e, item) :: acc + (Cmdliner_info.Exit.info_docs e, item) :: acc in - let exits = Cmdliner_info.(term_exits @@ eval_term ei) in - let exits = List.sort Cmdliner_info.exit_order exits in + let exits = Cmdliner_info.Cmd.exits @@ Cmdliner_info.Eval.cmd ei in + let exits = List.sort Cmdliner_info.Exit.info_order exits in let exits = List.fold_left add_exit_item [] exits in let exits = List.stable_sort by_sec (* sort by section *) exits in let boilerplate = if has_sexit then None else Some exit_boilerplate in @@ -229,15 +260,17 @@ let env_boilerplate sec = match sec = Cmdliner_manpage.s_environment with let env_docs ~errs ~subst ~buf ~has_senv ei = let add_env_item ~subst (seen, envs as acc) e = - if Cmdliner_info.Envs.mem e seen then acc else - let seen = Cmdliner_info.Envs.add e seen in - let var = strf "$(b,%s)" @@ esc (Cmdliner_info.env_var e) in - let doc = Cmdliner_info.env_doc e in + if Cmdliner_info.Env.Set.mem e seen then acc else + let seen = Cmdliner_info.Env.Set.add e seen in + let var = strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e) in + let var = match Cmdliner_info.Env.info_deprecated e with + | None -> var | Some _ -> "(Deprecated) " ^ var in + let doc = Cmdliner_info.Env.info_doc e in let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in - let envs = (Cmdliner_info.env_docs e, `I (var, doc)) :: envs in + let envs = (Cmdliner_info.Env.info_docs e, `I (var, doc)) :: envs in seen, envs in - let add_arg_env a acc = match Cmdliner_info.arg_env a with + let add_arg_env a acc = match Cmdliner_info.Arg.env a with | None -> acc | Some e -> add_env_item ~subst:(arg_info_subst ~subst a) acc e in @@ -248,10 +281,10 @@ let env_docs ~errs ~subst ~buf ~has_senv ei = in (* Arg envs before term envs is important here: if the same is mentioned both in an arg and in a term the substs of the arg are allowed. *) - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let tenvs = Cmdliner_info.(term_envs @@ eval_term ei) in - let init = Cmdliner_info.Envs.empty, [] in - let acc = Cmdliner_info.Args.fold add_arg_env args init in + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let tenvs = Cmdliner_info.Cmd.envs @@ Cmdliner_info.Eval.cmd ei in + let init = Cmdliner_info.Env.Set.empty, [] in + let acc = Cmdliner_info.Arg.Set.fold add_arg_env args init in let _, envs = List.fold_left add_env acc tenvs in let envs = List.sort by_sec_by_rev_name envs in let envs = (envs :> (string * Cmdliner_manpage.block) list) in @@ -261,17 +294,25 @@ let env_docs ~errs ~subst ~buf ~has_senv ei = (* xref doc *) let xref_docs ~errs ei = - let main = Cmdliner_info.(term_name @@ eval_main ei) in + let main = Cmdliner_info.Eval.main ei in let to_xref = function - | `Main -> main, 1 + | `Main -> Cmdliner_info.Cmd.name main, 1 | `Tool tool -> tool, 1 | `Page (name, sec) -> name, sec | `Cmd c -> - if Cmdliner_info.eval_has_choice ei c then strf "%s-%s" main c, 1 else - (Format.fprintf errs "xref %s: no such term name@." c; "doc-err", 0) + (* N.B. we are handling only the first subcommand level here *) + let cmds = Cmdliner_info.Cmd.children main in + let mname = Cmdliner_info.Cmd.name main in + let is_cmd cmd = Cmdliner_info.Cmd.name cmd = c in + if List.exists is_cmd cmds then strf "%s-%s" mname c, 1 else + (Format.fprintf errs "xref %s: no such command name@." c; "doc-err", 0) in let xref_str (name, sec) = strf "%s(%d)" (esc name) sec in - let xrefs = Cmdliner_info.(term_man_xrefs @@ eval_term ei) in + let xrefs = Cmdliner_info.Cmd.man_xrefs @@ Cmdliner_info.Eval.cmd ei in + let xrefs = match main == Cmdliner_info.Eval.cmd ei with + | true -> List.filter (fun x -> x <> `Main) xrefs (* filter out default *) + | false -> xrefs + in let xrefs = List.fold_left (fun acc x -> to_xref x :: acc) [] xrefs in let xrefs = List.(rev_map xref_str (sort rev_compare xrefs)) in if xrefs = [] then [] else @@ -280,24 +321,28 @@ let xref_docs ~errs ei = (* Man page construction *) let ensure_s_name ei sm = - if Cmdliner_manpage.(smap_has_section sm s_name) then sm else - let tname = invocation ~sep:'-' ei in - let tdoc = Cmdliner_info.(term_doc @@ eval_term ei) in + if Cmdliner_manpage.(smap_has_section sm ~sec:s_name) then sm else + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let tname = (deprecated cmd) ^ invocation ~sep:"-" ~parents cmd in + let tdoc = Cmdliner_info.Cmd.doc cmd in let tagline = if tdoc = "" then "" else strf " - %s" tdoc in let tagline = `P (strf "%s%s" tname tagline) in Cmdliner_manpage.(smap_append_block sm ~sec:s_name tagline) let ensure_s_synopsis ei sm = if Cmdliner_manpage.(smap_has_section sm ~sec:s_synopsis) then sm else - let synopsis = `P (synopsis ei) in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = `P (synopsis ~parents cmd) in Cmdliner_manpage.(smap_append_block sm ~sec:s_synopsis synopsis) -let insert_term_man_docs ~errs ei sm = +let insert_cmd_man_docs ~errs ei sm = let buf = Buffer.create 200 in - let subst = term_info_subst ei in - let ins sm (s, b) = Cmdliner_manpage.smap_append_block sm s b in - let has_senv = Cmdliner_manpage.(smap_has_section sm s_environment) in - let has_sexit = Cmdliner_manpage.(smap_has_section sm s_exit_status) in + let subst = cmd_info_subst ei in + let ins sm (sec, b) = Cmdliner_manpage.smap_append_block sm ~sec b in + let has_senv = Cmdliner_manpage.(smap_has_section sm ~sec:s_environment) in + let has_sexit = Cmdliner_manpage.(smap_has_section sm ~sec:s_exit_status) in let sm = List.fold_left ins sm (cmd_docs ei) in let sm = List.fold_left ins sm (arg_docs ~errs ~subst ~buf ei) in let sm = List.fold_left ins sm (exit_docs ~errs ~subst ~buf ~has_sexit ei)in @@ -306,20 +351,22 @@ let insert_term_man_docs ~errs ei sm = sm let text ~errs ei = - let man = Cmdliner_info.(term_man @@ eval_term ei) in + let man = Cmdliner_info.Cmd.man @@ Cmdliner_info.Eval.cmd ei in let sm = Cmdliner_manpage.smap_of_blocks man in let sm = ensure_s_name ei sm in let sm = ensure_s_synopsis ei sm in - let sm = insert_term_man_docs ei ~errs sm in + let sm = insert_cmd_man_docs ei ~errs sm in Cmdliner_manpage.smap_to_blocks sm let title ei = - let main = Cmdliner_info.eval_main ei in - let exec = String.capitalize_ascii (Cmdliner_info.term_name main) in - let name = String.uppercase_ascii (invocation ~sep:'-' ei) in + let main = Cmdliner_info.Eval.main ei in + let exec = String.capitalize_ascii (Cmdliner_info.Cmd.name main) in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let name = String.uppercase_ascii (invocation ~sep:"-" ~parents cmd) in let center_header = esc @@ strf "%s Manual" exec in let left_footer = - let version = match Cmdliner_info.term_version main with + let version = match Cmdliner_info.Cmd.version main with | None -> "" | Some v -> " " ^ v in esc @@ strf "%s%s" exec version @@ -330,18 +377,21 @@ let man ~errs ei = title ei, text ~errs ei let pp_man ~errs fmt ppf ei = Cmdliner_manpage.print - ~errs ~subst:(term_info_subst ei) fmt ppf (man ~errs ei) + ~errs ~subst:(cmd_info_subst ei) fmt ppf (man ~errs ei) (* Plain synopsis for usage *) let pp_plain_synopsis ~errs ppf ei = let buf = Buffer.create 100 in - let subst = term_info_subst ei in - let syn = Cmdliner_manpage.doc_to_plain ~errs ~subst buf (synopsis ei) in + let subst = cmd_info_subst ei in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = synopsis ~parents cmd in + let syn = Cmdliner_manpage.doc_to_plain ~errs ~subst buf synopsis in Format.fprintf ppf "@[%s@]" syn (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.mli index 59d473fe4..826bfacae 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_docgen.mli @@ -1,20 +1,17 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -val plain_invocation : Cmdliner_info.eval -> string - val pp_man : errs:Format.formatter -> Cmdliner_manpage.format -> Format.formatter -> - Cmdliner_info.eval -> unit + Cmdliner_info.Eval.t -> unit val pp_plain_synopsis : - errs:Format.formatter -> Format.formatter -> Cmdliner_info.eval -> unit + errs:Format.formatter -> Format.formatter -> Cmdliner_info.Eval.t -> unit (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.ml new file mode 100644 index 000000000..c3747bf8c --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.ml @@ -0,0 +1,292 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] + +let err_help s = "Term error, help requested for unknown command " ^ s +let err_argv = "argv array must have at least one element" + +let add_stdopts ei = + let docs = Cmdliner_info.Cmd.stdopts_docs @@ Cmdliner_info.Eval.cmd ei in + let vargs, vers = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> Cmdliner_info.Arg.Set.empty, None + | Some _ -> + let args, _ as vers = Cmdliner_arg.stdopt_version ~docs in + args, Some vers + in + let help = Cmdliner_arg.stdopt_help ~docs in + let args = Cmdliner_info.Arg.Set.union vargs (fst help) in + let cmd = Cmdliner_info.Cmd.add_args (Cmdliner_info.Eval.cmd ei) args in + help, vers, Cmdliner_info.Eval.with_cmd ei cmd + +let parse_error_term err ei cl = Error (`Parse err) + +type 'a eval_result = + ('a, [ Cmdliner_term.term_escape + | `Exn of exn * Printexc.raw_backtrace + | `Parse of string + | `Std_help of Cmdliner_manpage.format | `Std_version ]) result + +let run_parser ~catch ei cl f = try (f ei cl :> 'a eval_result) with +| exn when catch -> + let bt = Printexc.get_raw_backtrace () in + Error (`Exn (exn, bt)) + +let try_eval_stdopts ~catch ei cl help version = + match run_parser ~catch ei cl (snd help) with + | Ok (Some fmt) -> Some (Error (`Std_help fmt)) + | Error _ as err -> Some err + | Ok None -> + match version with + | None -> None + | Some version -> + match run_parser ~catch ei cl (snd version) with + | Ok false -> None + | Ok true -> Some (Error (`Std_version)) + | Error _ as err -> Some err + +let do_help help_ppf err_ppf ei fmt cmd = + let ei = match cmd with + | None (* help of main command requested *) -> + let env _ = assert false in + let cmd = Cmdliner_info.Eval.main ei in + let ei' = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf in + begin match Cmdliner_info.Eval.parents ei with + | [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) ei' + | _ -> let _, _, ei = add_stdopts ei' in ei + end + | Some cmd -> + try + (* For now we simply keep backward compat. [cmd] should be + a name from main's children. *) + let main = Cmdliner_info.Eval.main ei in + let is_cmd t = Cmdliner_info.Cmd.name t = cmd in + let children = Cmdliner_info.Cmd.children main in + let cmd = List.find is_cmd children in + let _, _, ei = add_stdopts (Cmdliner_info.Eval.with_cmd ei cmd) in + ei + with Not_found -> invalid_arg (err_help cmd) + in + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei + +let do_result help_ppf err_ppf ei = function +| Ok v -> Ok (`Ok v) +| Error res -> + match res with + | `Std_help fmt -> + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei; Ok `Help + | `Std_version -> + Cmdliner_msg.pp_version help_ppf ei; Ok `Version + | `Parse err -> + Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; + Error `Parse + | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; Ok `Help + | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; (Error `Exn) + | `Error (usage, err) -> + (if usage + then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err + else Cmdliner_msg.pp_err err_ppf ei ~err); + (Error `Term) + +let cmd_name_trie cmds = + let add acc cmd = + let i = Cmdliner_cmd.get_info cmd in + let name = Cmdliner_info.Cmd.name i in + match Cmdliner_trie.add acc name cmd with + | `New t -> t + | `Replaced (cmd', _) -> + let i' = Cmdliner_cmd.get_info cmd' and kind = "command" in + invalid_arg @@ + Cmdliner_base.err_multi_def ~kind name Cmdliner_info.Cmd.doc i i' + in + List.fold_left add Cmdliner_trie.empty cmds + +let cmd_name_dom cmds = + let cmd_name c = Cmdliner_info.Cmd.name (Cmdliner_cmd.get_info c) in + List.sort String.compare (List.rev_map cmd_name cmds) + +let find_term args cmd = + let never_term _ _ = assert false in + let stop args_rest args_rev parents cmd = + let args = List.rev_append args_rev args_rest in + match (cmd : 'a Cmdliner_cmd.t) with + | Cmd (i, t) -> + args, t, i, parents, Ok () + | Group (i, (Some t, children)) -> + args, t, i, parents, Ok () + | Group (i, (None, children)) -> + let dom = cmd_name_dom children in + let err = Cmdliner_msg.err_cmd_missing ~dom in + args, never_term, i, parents, Error err + in + let rec loop args_rev parents cmd = function + | ("--" :: _ | [] as rest) -> stop rest args_rev parents cmd + | (arg :: _ as rest) when Cmdliner_cline.is_opt arg -> + stop rest args_rev parents cmd + | arg :: args -> + match cmd with + | Cmd (i, t) -> + let args = List.rev_append args_rev (arg :: args) in + args, t, i, parents, Ok () + | Group (i, (t, children)) -> + let index = cmd_name_trie children in + match Cmdliner_trie.find index arg with + | `Ok cmd -> loop args_rev (i :: parents) cmd args + | `Not_found -> + let args = List.rev_append args_rev (arg :: args) in + let all = Cmdliner_trie.ambiguities index "" in + let hints = Cmdliner_base.suggest arg all in + let dom = cmd_name_dom children in + let kind = "command" in + let err = Cmdliner_base.err_unknown ~kind ~dom ~hints arg in + args, never_term, i, parents, Error err + | `Ambiguous -> + let args = List.rev_append args_rev (arg :: args) in + let ambs = Cmdliner_trie.ambiguities index arg in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"command" arg ~ambs in + args, never_term, i, parents, Error err + in + loop [] [] cmd args + +let env_default v = try Some (Sys.getenv v) with Not_found -> None +let remove_exec argv = + try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv + +let do_deprecated_msgs err_ppf cl ei = + let cmd = Cmdliner_info.Eval.cmd ei in + let msgs = Cmdliner_cline.deprecated_msgs cl in + let msgs = match Cmdliner_info.Cmd.deprecated cmd with + | None -> msgs + | Some msg -> + let name = Cmdliner_base.quote (Cmdliner_info.Cmd.name cmd) in + String.concat "" ("command " :: name :: ": " :: msg :: []) :: msgs + in + if msgs <> [] + then Cmdliner_msg.pp_err err_ppf ei ~err:(String.concat "\n" msgs) + +let eval_value + ?help:(help_ppf = Format.std_formatter) + ?err:(err_ppf = Format.err_formatter) + ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) cmd + = + let args, f, cmd, parents, res = find_term (remove_exec argv) cmd in + let ei = Cmdliner_info.Eval.v ~cmd ~parents ~env ~err_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let res = match res with + | Error msg -> (* Command lookup error, we still prioritize stdargs *) + let cl = match Cmdliner_cline.create term_args args with + | Error (_, cl) -> cl | Ok cl -> cl + in + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, msg)) + end + | Ok () -> + match Cmdliner_cline.create term_args args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, e)) + end + | Ok cl -> + match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> + do_deprecated_msgs err_ppf cl ei; + run_parser ~catch ei cl f + in + do_result help_ppf err_ppf ei res + +let eval_peek_opts + ?(version_opt = false) ?(env = env_default) ?(argv = Sys.argv) t + : 'a option * ('a eval_ok, eval_error) result + = + let args, f = t in + let version = if version_opt then Some "dummy" else None in + let cmd = Cmdliner_info.Cmd.v ?version "dummy" in + let cmd = Cmdliner_info.Cmd.add_args cmd args in + let null_ppf = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) in + let ei = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf:null_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let cli_args = remove_exec argv in + let v, ret = + match Cmdliner_cline.create ~peek_opts:true term_args cli_args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> None, e + | None -> None, Error (`Error (true, e)) + end + | Ok cl -> + let ret = run_parser ~catch:true ei cl f in + let v = match ret with Ok v -> Some v | Error _ -> None in + match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> v, e + | None -> v, ret + in + let ret = match ret with + | Ok v -> Ok (`Ok v) + | Error `Std_help _ -> Ok `Help + | Error `Std_version -> Ok `Version + | Error `Parse _ -> Error `Parse + | Error `Help _ -> Ok `Help + | Error `Exn _ -> Error `Exn + | Error `Error _ -> Error `Term + in + (v, ret) + +let exit_status_of_result ?(term_err = Cmdliner_info.Exit.cli_error) = function +| Ok (`Ok _ | `Help | `Version) -> Cmdliner_info.Exit.ok +| Error `Term -> term_err +| Error `Parse -> Cmdliner_info.Exit.cli_error +| Error `Exn -> Cmdliner_info.Exit.internal_error + +let eval ?help ?err ?catch ?env ?argv ?term_err cmd = + exit_status_of_result ?term_err @@ + eval_value ?help ?err ?catch ?env ?argv cmd + +let eval' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok c) -> c + | r -> exit_status_of_result ?term_err r + +let pp_err ppf cmd ~msg = (* FIXME move that to Cmdliner_msgs *) + let name = Cmdliner_cmd.name cmd in + Format.fprintf ppf "%s: @[%a@]@." name Cmdliner_base.pp_lines msg + +let eval_result + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r + +let eval_result' + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Ok c)) -> c + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.mli new file mode 100644 index 000000000..18746d96f --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_eval.mli @@ -0,0 +1,60 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Command evaluation *) + +(** {1:eval Evaluating commands} *) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] + +val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a Cmdliner_cmd.t -> + ('a eval_ok, eval_error) result + +val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Cmdliner_term.t -> + 'a option * ('a eval_ok, eval_error) result + +val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> unit Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> int Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> (unit, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code + +val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> + (Cmdliner_info.Exit.code, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.ml similarity index 80% rename from duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.mli rename to duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.ml index 189bc94c0..5a9fe7928 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.ml @@ -1,15 +1,11 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -val value : string -> string list -> string list -(** [value near candidates] suggests values from [candidates] - not to far from near. *) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.mli new file mode 100644 index 000000000..5a9fe7928 --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_exit.mli @@ -0,0 +1,21 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.ml index 64b8fb28b..87dec769f 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.ml @@ -1,258 +1,237 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) +(* Exit codes *) + +module Exit = struct + type code = int + + let ok = 0 + let some_error = 123 + let cli_error = 124 + let internal_error = 125 + + type info = + { codes : code * code; (* min, max *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?(docs = Cmdliner_manpage.s_exit_status) ?(doc = "undocumented") ?max min + = + let max = match max with None -> min | Some max -> max in + { codes = (min, max); doc; docs } + + let info_codes i = i.codes + let info_code i = fst i.codes + let info_doc i = i.doc + let info_docs i = i.docs + let info_order i0 i1 = compare i0.codes i1.codes + let defaults = + [ info ok ~doc:"on success."; + info some_error + ~doc:"on indiscriminate errors reported on standard error."; + info cli_error ~doc:"on command line parsing errors."; + info internal_error ~doc:"on unexpected internal errors (bugs)."; ] +end -let new_id = (* thread-safe UIDs, Oo.id (object end) was used before. *) - let c = ref 0 in - fun () -> - let id = !c in - incr c; if id > !c then assert false (* too many ids *) else id - -(* Environments *) - -type env = (* information about an environment variable. *) - { env_id : int; (* unique id for the env var. *) - env_var : string; (* the variable. *) - env_doc : string; (* help. *) - env_docs : string; } (* title of help section where listed. *) - -let env - ?docs:(env_docs = Cmdliner_manpage.s_environment) - ?doc:(env_doc = "See option $(opt).") env_var = - { env_id = new_id (); env_var; env_doc; env_docs } - -let env_var e = e.env_var -let env_doc e = e.env_doc -let env_docs e = e.env_docs - +(* Environment variables *) module Env = struct - type t = env - let compare a0 a1 = (compare : int -> int -> int) a0.env_id a1.env_id + type var = string + type info = (* information about an environment variable. *) + { id : int; (* unique id for the env var. *) + deprecated : string option; + var : string; (* the variable. *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?deprecated + ?(docs = Cmdliner_manpage.s_environment) ?(doc = "See option $(opt).") var + = + { id = Cmdliner_base.uid (); deprecated; var; doc; docs } + + let info_deprecated i = i.deprecated + let info_var i = i.var + let info_doc i = i.doc + let info_docs i = i.docs + let info_compare i0 i1 = Int.compare i0.id i1.id + + module Set = Set.Make (struct type t = info let compare = info_compare end) end -module Envs = Set.Make (Env) -type envs = Envs.t - (* Arguments *) -type arg_absence = Err | Val of string Lazy.t -type opt_kind = Flag | Opt | Opt_vopt of string - -type pos_kind = (* information about a positional argument. *) - { pos_rev : bool; (* if [true] positions are counted from the end. *) - pos_start : int; (* start positional argument. *) - pos_len : int option } (* number of arguments or [None] if unbounded. *) - -let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = - { pos_rev; pos_start; pos_len} - -let pos_rev p = p.pos_rev -let pos_start p = p.pos_start -let pos_len p = p.pos_len - -type arg = (* information about a command line argument. *) - { id : int; (* unique id for the argument. *) - absent : arg_absence; (* behaviour if absent. *) - env : env option; (* environment variable. *) - doc : string; (* help. *) - docv : string; (* variable name for the argument in help. *) - docs : string; (* title of help section where listed. *) - pos : pos_kind; (* positional arg kind. *) - opt_kind : opt_kind; (* optional arg kind. *) - opt_names : string list; (* names (for opt args). *) - opt_all : bool; (* repeatable (for opt args). *) - opt_alias: string -> string option -> (string list, string) Result.t; - (* [opt_alias arg value], [arg] is the name of the argument, +module Arg = struct + type absence = Err | Val of string Lazy.t | Doc of string + type opt_kind = Flag | Opt | Opt_vopt of string + + type pos_kind = (* information about a positional argument. *) + { pos_rev : bool; (* if [true] positions are counted from the end. *) + pos_start : int; (* start positional argument. *) + pos_len : int option } (* number of arguments or [None] if unbounded. *) + + let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = + { pos_rev; pos_start; pos_len} + + let pos_rev p = p.pos_rev + let pos_start p = p.pos_start + let pos_len p = p.pos_len + + type t = (* information about a command line argument. *) + { id : int; (* unique id for the argument. *) + deprecated : string option; (* deprecation message *) + absent : absence; (* behaviour if absent. *) + env : Env.info option; (* environment variable for default value. *) + doc : string; (* help. *) + docv : string; (* variable name for the argument in help. *) + docs : string; (* title of help section where listed. *) + pos : pos_kind; (* positional arg kind. *) + opt_kind : opt_kind; (* optional arg kind. *) + opt_names : string list; (* names (for opt args). *) + opt_all : bool; (* repeatable (for opt args). *) + opt_alias: string -> string option -> (string list, string) Result.t; (* [opt_alias arg value], [arg] is the name of the argument, and [value] is the possible value *) - } - -let dumb_pos = pos ~rev:false ~start:(-1) ~len:None - -let arg ?docs ?(docv = "") ?(doc = "") ?env names = - let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in - let opt_names = List.map dash names in - let docs = match docs with - | Some s -> s - | None -> - match names with - | [] -> Cmdliner_manpage.s_arguments - | _ -> Cmdliner_manpage.s_options - in - { id = new_id (); absent = Val (lazy ""); env; doc; docv; docs; - pos = dumb_pos; opt_kind = Flag; opt_names; opt_all = false; + } + + let dumb_pos = pos ~rev:false ~start:(-1) ~len:None + + let v ?deprecated ?(absent = "") ?docs ?(docv = "") ?(doc = "") ?env names = + let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in + let opt_names = List.map dash names in + let docs = match docs with + | Some s -> s + | None -> + match names with + | [] -> Cmdliner_manpage.s_arguments + | _ -> Cmdliner_manpage.s_options + in + { id = Cmdliner_base.uid (); deprecated; absent = Doc absent; + env; doc; docv; docs; pos = dumb_pos; opt_kind = Flag; opt_names; + opt_all = false; opt_alias = fun _ _ -> Ok [] } -let arg_id a = a.id -let arg_absent a = a.absent -let arg_env a = a.env -let arg_doc a = a.doc -let arg_docv a = a.docv -let arg_docs a = a.docs -let arg_pos a = a.pos -let arg_opt_kind a = a.opt_kind -let arg_opt_names a = a.opt_names -let arg_opt_all a = a.opt_all -let arg_opt_name_sample a = - (* First long or short name (in that order) in the list; this - allows the client to control which name is shown *) - let rec find = function - | [] -> List.hd a.opt_names - | n :: ns -> if (String.length n) > 2 then n else find ns - in - find a.opt_names -let arg_alias a = a.opt_alias - -let arg_make_req a = { a with absent = Err } -let arg_make_all_opts a = { a with opt_all = true } -let arg_make_opt ~absent ~kind:opt_kind a = { a with absent; opt_kind } -let arg_make_opt_all ~absent ~kind:opt_kind a = - { a with absent; opt_kind; opt_all = true } - -let arg_make_pos ~pos a = { a with pos } -let arg_make_pos_abs ~absent ~pos a = { a with absent; pos } -let arg_aliases ~aliases a = { a with opt_alias = aliases } - -let arg_is_opt a = a.opt_names <> [] -let arg_is_pos a = a.opt_names = [] -let arg_is_req a = a.absent = Err - -let arg_pos_cli_order a0 a1 = (* best-effort order on the cli. *) - let c = compare (a0.pos.pos_rev) (a1.pos.pos_rev) in - if c <> 0 then c else - if a0.pos.pos_rev - then compare a1.pos.pos_start a0.pos.pos_start - else compare a0.pos.pos_start a1.pos.pos_start - -let rev_arg_pos_cli_order a0 a1 = arg_pos_cli_order a1 a0 + let id a = a.id + let deprecated a = a.deprecated + let absent a = a.absent + let env a = a.env + let doc a = a.doc + let docv a = a.docv + let docs a = a.docs + let pos_kind a = a.pos + let opt_kind a = a.opt_kind + let opt_names a = a.opt_names + let opt_all a = a.opt_all + let opt_name_sample a = + (* First long or short name (in that order) in the list; this + allows the client to control which name is shown *) + let rec find = function + | [] -> List.hd a.opt_names + | n :: ns -> if (String.length n) > 2 then n else find ns + in + find a.opt_names + let alias a = a.opt_alias + + let make_req a = { a with absent = Err } + let make_all_opts a = { a with opt_all = true } + let make_opt ~absent ~kind:opt_kind a = { a with absent; opt_kind } + let make_opt_all ~absent ~kind:opt_kind a = + { a with absent; opt_kind; opt_all = true } + + let make_pos ~pos a = { a with pos } + let make_pos_abs ~absent ~pos a = { a with absent; pos } + let aliases ~aliases a = { a with opt_alias = aliases } + + let is_opt a = a.opt_names <> [] + let is_pos a = a.opt_names = [] + let is_req a = a.absent = Err + + let pos_cli_order a0 a1 = (* best-effort order on the cli. *) + let c = compare (a0.pos.pos_rev) (a1.pos.pos_rev) in + if c <> 0 then c else + if a0.pos.pos_rev + then compare a1.pos.pos_start a0.pos.pos_start + else compare a0.pos.pos_start a1.pos.pos_start + + let rev_pos_cli_order a0 a1 = pos_cli_order a1 a0 + + let compare a0 a1 = Int.compare a0.id a1.id + module Set = Set.Make (struct type nonrec t = t let compare = compare end) +end -module Arg = struct - type t = arg - let compare a0 a1 = (compare : int -> int -> int) a0.id a1.id +(* Commands *) + +module Cmd = struct + type t = + { name : string; (* name of the cmd. *) + version : string option; (* version (for --version). *) + deprecated : string option; (* deprecation message *) + doc : string; (* one line description of cmd. *) + docs : string; (* title of man section where listed (commands). *) + sdocs : string; (* standard options, title of section where listed. *) + exits : Exit.info list; (* exit codes for the cmd. *) + envs : Env.info list; (* env vars that influence the cmd. *) + man : Cmdliner_manpage.block list; (* man page text. *) + man_xrefs : Cmdliner_manpage.xref list; (* man cross-refs. *) + args : Arg.Set.t; (* Command arguments. *) + has_args : bool; (* [true] if has own parsing term. *) + children : t list; } (* Children, if any. *) + + let v + ?deprecated ?(man_xrefs = [`Main]) ?(man = []) ?(envs = []) + ?(exits = Exit.defaults) ?(sdocs = Cmdliner_manpage.s_common_options) + ?(docs = Cmdliner_manpage.s_commands) ?(doc = "") ?version name + = + { name; version; deprecated; doc; docs; sdocs; exits; + envs; man; man_xrefs; args = Arg.Set.empty; + has_args = true; children = [] } + + let name t = t.name + let version t = t.version + let deprecated t = t.deprecated + let doc t = t.doc + let docs t = t.docs + let stdopts_docs t = t.sdocs + let exits t = t.exits + let envs t = t.envs + let man t = t.man + let man_xrefs t = t.man_xrefs + let args t = t.args + let has_args t = t.has_args + let children t = t.children + let add_args t args = { t with args = Arg.Set.union args t.args } + let with_children cmd ~args ~children = + let has_args, args = match args with + | None -> false, cmd.args + | Some args -> true, Arg.Set.union args cmd.args + in + { cmd with has_args; args; children } end -module Args = Set.Make (Arg) -type args = Args.t - -(* Exit info *) - -type exit = - { exit_statuses : int * int; - exit_doc : string; - exit_docs : string; } - -let exit - ?docs:(exit_docs = Cmdliner_manpage.s_exit_status) - ?doc:(exit_doc = "undocumented") ?max min = - let max = match max with None -> min | Some max -> max in - { exit_statuses = (min, max); exit_doc; exit_docs } - -let exit_statuses e = e.exit_statuses -let exit_doc e = e.exit_doc -let exit_docs e = e.exit_docs -let exit_order e0 e1 = compare e0.exit_statuses e1.exit_statuses - -(* Term info *) - -type term_info = - { term_name : string; (* name of the term. *) - term_version : string option; (* version (for --version). *) - term_doc : string; (* one line description of term. *) - term_docs : string; (* title of man section where listed (commands). *) - term_sdocs : string; (* standard options, title of section where listed. *) - term_exits : exit list; (* exit codes for the term. *) - term_envs : env list; (* env vars that influence the term. *) - term_man : Cmdliner_manpage.block list; (* man page text. *) - term_man_xrefs : Cmdliner_manpage.xref list; } (* man cross-refs. *) - -type term = - { term_info : term_info; - term_args : args; } - -let term - ?args:(term_args = Args.empty) ?man_xrefs:(term_man_xrefs = []) - ?man:(term_man = []) ?envs:(term_envs = []) ?exits:(term_exits = []) - ?sdocs:(term_sdocs = Cmdliner_manpage.s_options) - ?docs:(term_docs = "COMMANDS") ?doc:(term_doc = "") ?version:term_version - term_name = - let term_info = - { term_name; term_version; term_doc; term_docs; term_sdocs; term_exits; - term_envs; term_man; term_man_xrefs } - in - { term_info; term_args } - -let term_name t = t.term_info.term_name -let term_version t = t.term_info.term_version -let term_doc t = t.term_info.term_doc -let term_docs t = t.term_info.term_docs -let term_stdopts_docs t = t.term_info.term_sdocs -let term_exits t = t.term_info.term_exits -let term_envs t = t.term_info.term_envs -let term_man t = t.term_info.term_man -let term_man_xrefs t = t.term_info.term_man_xrefs -let term_args t = t.term_args - -let term_add_args t args = - { t with term_args = Args.union args t.term_args } - -type eval_kind = -| Simple of term -| Main of { term : term ; choices : term list } -| Sub_command of { path : term list; - main : term; - sibling_terms : term list } - -(* Eval info *) - -type eval = (* information about the evaluation context. *) - { term : term; (* term being evaluated. *) - main : term; (* main term. *) - path : term list; - choices : term list; (* all term choices. *) - env : string -> string option } (* environment variable lookup. *) - -let eval ~env kind = - let (main, term, path, choices) = - match kind with - | Simple term -> (term, term, [term], []) - | Main { term ; choices } -> (term, term, [term], choices) - | Sub_command { main ; path ; sibling_terms } -> - let term = List.hd path in - (main, term, path, sibling_terms) - in - { term; main; choices; env; path } - -let eval_term e = e.term -let eval_main e = e.main -let eval_term_path e = e.path -let eval_choices e = e.choices -let eval_env_var e v = e.env v - -let eval_kind ei = - (* subgroup *) - if ei.choices = [] then `Simple else - if (ei.term.term_info.term_name == ei.main.term_info.term_name) - then - match ei.path with - | [] -> assert false - | [_] -> `Multiple_main - | _ :: _ :: _ -> `Multiple_group - else `Multiple_sub - -let eval_terms_rev ei = ei.path - -let eval_with_term ei term = { ei with term } - -let eval_has_choice e cmd = - (* handle subgroup *) - let is_cmd t = t.term_info.term_name = cmd in - List.exists is_cmd e.choices +(* Evaluation *) + +module Eval = struct + type t = (* information about the evaluation context. *) + { cmd : Cmd.t; (* cmd being evaluated. *) + parents : Cmd.t list; (* parents of cmd, root is last. *) + env : string -> string option; (* environment variable lookup. *) + err_ppf : Format.formatter (* error formatter *) } + + let v ~cmd ~parents ~env ~err_ppf = { cmd; parents; env; err_ppf } + + let cmd e = e.cmd + let parents e = e.parents + let env_var e v = e.env v + let err_ppf e = e.err_ppf + let main e = match List.rev e.parents with [] -> e.cmd | m :: _ -> m + let with_cmd ei cmd = { ei with cmd } +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.mli index 5a6668b0c..2b995a2f6 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_info.mli @@ -1,138 +1,147 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -(** Terms, argument, env vars information. - - The following types keep untyped information about arguments and - terms. This data is used to parse the command line, report errors - and format man pages. *) - -(** {1:env Environment variables} *) - -type env -val env : ?docs:string -> ?doc:string -> string -> env -val env_var : env -> string -val env_doc : env -> string -val env_docs : env -> string - -module Env : Set.OrderedType with type t = env -module Envs : Set.S with type elt = env -type envs = Envs.t - -(** {1:arg Arguments} *) - -type arg_absence = -| Err (** an error is reported. *) -| Val of string Lazy.t (** if <> "", takes the given default value. *) -(** The type for what happens if the argument is absent from the cli. *) - -type opt_kind = -| Flag (** without value, just a flag. *) -| Opt (** with required value. *) -| Opt_vopt of string (** with optional value, takes given default. *) -(** The type for optional argument kinds. *) - -type pos_kind -val pos : rev:bool -> start:int -> len:int option -> pos_kind -val pos_rev : pos_kind -> bool -val pos_start : pos_kind -> int -val pos_len : pos_kind -> int option - -type arg -val arg : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> - string list -> arg - -val arg_id : arg -> int -val arg_absent : arg -> arg_absence -val arg_env : arg -> env option -val arg_doc : arg -> string -val arg_docv : arg -> string -val arg_docs : arg -> string -val arg_opt_names : arg -> string list (* has dashes *) -val arg_opt_name_sample : arg -> string (* warning must be an opt arg *) -val arg_opt_kind : arg -> opt_kind -val arg_pos : arg -> pos_kind -val arg_alias : arg -> string -> string option -> (string list, string) Result.t - -val arg_make_req : arg -> arg -val arg_make_all_opts : arg -> arg -val arg_make_opt : absent:arg_absence -> kind:opt_kind -> arg -> arg -val arg_make_opt_all : absent:arg_absence -> kind:opt_kind -> arg -> arg -val arg_make_pos : pos:pos_kind -> arg -> arg -val arg_make_pos_abs : absent:arg_absence -> pos:pos_kind -> arg -> arg -val arg_aliases : aliases:(string -> string option -> (string list, string) Result.t) -> arg -> arg - -val arg_is_opt : arg -> bool -val arg_is_pos : arg -> bool -val arg_is_req : arg -> bool - -val arg_pos_cli_order : arg -> arg -> int -val rev_arg_pos_cli_order : arg -> arg -> int - -module Arg : Set.OrderedType with type t = arg -module Args : Set.S with type elt = arg -type args = Args.t - -(** {1:exit Exit status} *) - -type exit -val exit : ?docs:string -> ?doc:string -> ?max:int -> int -> exit -val exit_statuses : exit -> int * int -val exit_doc : exit -> string -val exit_docs : exit -> string -val exit_order : exit -> exit -> int - -(** {1:term Term information} *) - -type term - -val term : - ?args:args -> ?man_xrefs:Cmdliner_manpage.xref list -> - ?man:Cmdliner_manpage.block list -> ?envs:env list -> ?exits:exit list -> - ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> - string -> term - -val term_name : term -> string -val term_version : term -> string option -val term_doc : term -> string -val term_docs : term -> string -val term_stdopts_docs : term -> string -val term_exits : term -> exit list -val term_envs : term -> env list -val term_man : term -> Cmdliner_manpage.block list -val term_man_xrefs : term -> Cmdliner_manpage.xref list -val term_args : term -> args - -val term_add_args : term -> args -> term - -(** {1:eval Evaluation information} *) - -type eval - -type eval_kind = -| Simple of term -| Main of { term : term ; choices : term list } -| Sub_command of { path : term list; - main : term; - sibling_terms : term list } - -val eval : env:(string -> string option) -> eval_kind -> eval - -val eval_term : eval -> term -val eval_main : eval -> term -val eval_choices : eval -> term list -val eval_env_var : eval -> string -> string option -val eval_kind : eval -> [> `Multiple_main | `Multiple_group | `Multiple_sub | `Simple ] -val eval_with_term : eval -> term -> eval -val eval_has_choice : eval -> string -> bool -val eval_terms_rev : eval -> term list +(** Exit codes, environment variabes, arguments, commands and eval information. + + These information types gathers untyped data used to parse command + lines report errors and format man pages. *) + +(** Exit codes. *) +module Exit : sig + type code = int + val ok : code + val some_error : code + val cli_error : code + val internal_error : code + + type info + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + val info_code : info -> code + val info_codes : info -> code * code + val info_doc : info -> string + val info_docs : info -> string + val info_order : info -> info -> int + val defaults : info list +end + +(** Environment variables. *) +module Env : sig + type var = string + type info + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + val info_var : info -> string + val info_doc : info -> string + val info_docs : info -> string + val info_deprecated : info -> string option + + module Set : Set.S with type elt = info +end + +(** Arguments *) +module Arg : sig + + type absence = + | Err (** an error is reported. *) + | Val of string Lazy.t (** if <> "", takes the given default value. *) + | Doc of string + (** if <> "", a doc string interpreted in the doc markup language. *) + (** The type for what happens if the argument is absent from the cli. *) + + type opt_kind = + | Flag (** without value, just a flag. *) + | Opt (** with required value. *) + | Opt_vopt of string (** with optional value, takes given default. *) + (** The type for optional argument kinds. *) + + type pos_kind + val pos : rev:bool -> start:int -> len:int option -> pos_kind + val pos_rev : pos_kind -> bool + val pos_start : pos_kind -> int + val pos_len : pos_kind -> int option + + type t + val v : + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Env.info -> string list -> t + + val id : t -> int + val deprecated : t -> string option + val absent : t -> absence + val env : t -> Env.info option + val doc : t -> string + val docv : t -> string + val docs : t -> string + val opt_names : t -> string list (* has dashes *) + val opt_name_sample : t -> string (* warning must be an opt arg *) + val opt_kind : t -> opt_kind + val pos_kind : t -> pos_kind + val alias : t -> string -> string option -> (string list, string) Result.t + + val make_req : t -> t + val make_all_opts : t -> t + val make_opt : absent:absence -> kind:opt_kind -> t -> t + val make_opt_all : absent:absence -> kind:opt_kind -> t -> t + val make_pos : pos:pos_kind -> t -> t + val make_pos_abs : absent:absence -> pos:pos_kind -> t -> t + val aliases : aliases:(string -> string option -> (string list, string) Result.t) -> t -> t + + val is_opt : t -> bool + val is_pos : t -> bool + val is_req : t -> bool + + val pos_cli_order : t -> t -> int + val rev_pos_cli_order : t -> t -> int + + val compare : t -> t -> int + module Set : Set.S with type elt = t +end + +(** Commands. *) +module Cmd : sig + type t + val v : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> t + + val name : t -> string + val version : t -> string option + val deprecated : t -> string option + val doc : t -> string + val docs : t -> string + val stdopts_docs : t -> string + val exits : t -> Exit.info list + val envs : t -> Env.info list + val man : t -> Cmdliner_manpage.block list + val man_xrefs : t -> Cmdliner_manpage.xref list + val args : t -> Arg.Set.t + val has_args : t -> bool + val children : t -> t list + val add_args : t -> Arg.Set.t -> t + val with_children : t -> args:Arg.Set.t option -> children:t list -> t +end + +(** Evaluation. *) +module Eval : sig + type t + val v : + cmd:Cmd.t -> parents:Cmd.t list -> env:(string -> string option) -> + err_ppf:Format.formatter -> t + + val cmd : t -> Cmd.t + val main : t -> Cmd.t + val parents : t -> Cmd.t list + val env_var : t -> string -> string option + val err_ppf : t -> Format.formatter + val with_cmd : t -> Cmd.t -> t +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.ml index 19160fcf6..699564cd2 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (* Manpages *) @@ -40,14 +39,16 @@ let s_examples = "EXAMPLES" let s_bugs = "BUGS" let s_authors = "AUTHORS" let s_see_also = "SEE ALSO" +let s_none = "cmdliner-none" (* Section order *) let s_created = "" let order = [| s_name; s_synopsis; s_description; s_created; s_commands; - s_command_aliases; s_arguments; s_options; s_common_options; s_exit_status; - s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; |] + s_arguments; s_options; s_common_options; s_exit_status; + s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; + s_none; |] let order_synopsis = 1 let order_created = 3 @@ -95,14 +96,16 @@ let smap_to_blocks smap = (* N.B. this leaves `Blocks content untouched. *) let rec loop acc smap s = function | b :: rbs -> loop (b :: acc) smap s rbs | [] -> - let acc = if s = "" then acc else `S s :: acc in + let acc = if s = "" then acc else `S s :: acc in match smap with - | (s, (_, rbs)) :: smap -> loop acc smap s rbs | [] -> acc + | (_, (_, [])) :: smap -> loop acc smap "" [] (* skip empty section *) + | (s, (_, rbs)) :: smap -> + if s = s_none + then loop acc smap "" [] (* skip *) + else loop acc smap s rbs in - match smap with - | [] -> [] - | (s, (_, rbs)) :: smap -> loop [] smap s rbs + loop [] smap "" [] let smap_has_section smap ~sec = List.exists (fun (s, _) -> sec = s) smap let smap_append_block smap ~sec b = @@ -145,12 +148,12 @@ let pp_tokens = Cmdliner_base.pp_tokens let err e fmt = pf e ("cmdliner error: " ^^ fmt ^^ "@.") let err_unescaped ~errs c s = err errs "unescaped %C in %S" c s -let err_malformed ~errs s = err errs "Malformed $(...) in %S" s -let err_unclosed ~errs s = err errs "Unclosed $(...) in %S" s +let err_malformed ~errs s = err errs "Malformed $(…) in %S" s +let err_unclosed ~errs s = err errs "Unclosed $(…) in %S" s let err_undef ~errs id s = err errs "Undefined variable $(%s) in %S" id s let err_illegal_esc ~errs c s = err errs "Illegal escape char %C in %S" c s let err_markup ~errs dir s = - err errs "Unknown cmdliner markup $(%c,...) in %S" dir s + err errs "Unknown cmdliner markup $(%c,…) in %S" dir s let is_markup_dir = function 'i' | 'b' -> true | _ -> false let is_markup_esc = function '$' | '\\' | '(' | ')' -> true | _ -> false @@ -411,7 +414,7 @@ let pp_groff_blocks ~errs subst ppf text = List.iter pp_block text let pp_groff_page ~errs subst ppf ((n, s, a1, a2, a3), t) = - pf ppf ".\\\" Pipe this output to groff -Tutf8 | less@\n\ + pf ppf ".\\\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R@\n\ .\\\"@\n\ .mso an.tmac@\n\ .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\ @@ -436,34 +439,42 @@ let pp_to_temp_file pp_v v = let find_cmd cmds = let test, null = match Sys.os_type with | "Win32" -> "where", " NUL" - | _ -> "type", "/dev/null" + | _ -> "command -v", "/dev/null" in - let cmd c = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in + let cmd (c, _) = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in try Some (List.find cmd cmds) with Not_found -> None let pp_to_pager print ppf v = let pager = - let cmds = ["less"; "more"] in - let cmds = try (Sys.getenv "PAGER") :: cmds with Not_found -> cmds in - let cmds = try (Sys.getenv "MANPAGER") :: cmds with Not_found -> cmds in + let cmds = ["less"," -R"; "more", ""] in + (* Fundamentally env var lookups should try to cut the exec name. *) + let cmds = try (Sys.getenv "PAGER", "") :: cmds with Not_found -> cmds in + let cmds = try (Sys.getenv "MANPAGER", "") :: cmds with Not_found -> cmds in find_cmd cmds in match pager with | None -> print `Plain ppf v - | Some pager -> - let cmd = match (find_cmd ["groff"; "nroff"]) with + | Some (pager, opts) -> + let pager = pager ^ opts in + let groffer = + let cmds = + ["mandoc", " -m man -K utf-8 -T utf8"; + "groff", " -m man -K utf8 -T utf8"; + "nroff", ""] + in + find_cmd cmds + in + let cmd = match groffer with | None -> begin match pp_to_temp_file (print `Plain) v with | None -> None | Some f -> Some (strf "%s < %s" pager f) end - | Some c -> + | Some (groffer, opts) -> + let groffer = groffer ^ opts in begin match pp_to_temp_file (print `Groff) v with | None -> None - | Some f -> - (* TODO use -Tutf8, but annoyingly maps U+002D to U+2212. *) - let xroff = if c = "groff" then c ^ " -Tascii -P-c" else c in - Some (strf "%s < %s | %s" xroff f pager) + | Some f -> Some (strf "%s < %s | %s" groffer f pager) end in match cmd with @@ -487,7 +498,7 @@ let rec print | Some _ -> print ~errs ~subst `Pager ppf page (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.mli index 809f19bc5..5d43a5bfd 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_manpage.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Manpages. @@ -38,6 +37,7 @@ val s_bugs : string val s_examples : string val s_authors : string val s_see_also : string +val s_none : string (** {1 Section maps} @@ -70,7 +70,7 @@ val subst_vars : string -> string (** [subst b ~subst s], using [b], substitutes in [s] variables of the form "$(doc)" by their [subst] definition. This leaves escapes and markup - directives $(markup,...) intact. + directives $(markup,…) intact. @raise Invalid_argument in case of illegal syntax. *) @@ -84,7 +84,7 @@ val doc_to_plain : @raise Invalid_argument in case of illegal syntax. *) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.ml index dae67561d..a61c81596 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let strf = Printf.sprintf @@ -14,7 +13,7 @@ let pp_lines = Cmdliner_base.pp_lines (* Environment variable errors *) let err_env_parse env ~err = - let var = Cmdliner_info.env_var env in + let var = Cmdliner_info.Env.info_var env in strf "environment variable %s: %s" (quote var) err (* Positional argument errors *) @@ -23,7 +22,7 @@ let err_pos_excess excess = strf "too many arguments, don't know what to do with %s" (String.concat ", " (List.map quote excess)) -let err_pos_miss a = match Cmdliner_info.arg_docv a with +let err_pos_miss a = match Cmdliner_info.Arg.docv a with | "" -> "a required argument is missing" | v -> strf "required argument %s is missing" v @@ -31,21 +30,21 @@ let err_pos_misses = function | [] -> assert false | [a] -> err_pos_miss a | args -> - let add_arg acc a = match Cmdliner_info.arg_docv a with + let add_arg acc a = match Cmdliner_info.Arg.docv a with | "" -> "ARG" :: acc | argv -> argv :: acc in - let rev_args = List.sort Cmdliner_info.rev_arg_pos_cli_order args in + let rev_args = List.sort Cmdliner_info.Arg.rev_pos_cli_order args in let args = List.fold_left add_arg [] rev_args in let args = String.concat ", " args in strf "required arguments %s are missing" args -let err_pos_parse a ~err = match Cmdliner_info.arg_docv a with +let err_pos_parse a ~err = match Cmdliner_info.Arg.docv a with | "" -> err | argv -> - match Cmdliner_info.(pos_len @@ arg_pos a) with + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with | Some 1 -> strf "%s argument: %s" argv err - | None | Some _ -> strf "%s... arguments: %s" argv err + | None | Some _ -> strf "%s… arguments: %s" argv err (* Optional argument errors *) @@ -63,32 +62,31 @@ let err_opt_repeated f f' = (* Argument errors *) let err_arg_missing a = - if Cmdliner_info.arg_is_pos a then err_pos_miss a else - strf "required option %s is missing" (Cmdliner_info.arg_opt_name_sample a) + if Cmdliner_info.Arg.is_pos a then err_pos_miss a else + strf "required option %s is missing" (Cmdliner_info.Arg.opt_name_sample a) + +let err_cmd_missing ~dom = + strf "required COMMAND name is missing, must be %s." + (Cmdliner_base.alts_str ~quoted:true dom) (* Other messages *) -let exec_name_terms terms = - String.concat " " (List.rev_map Cmdliner_info.term_name terms) -let exec_name ei = exec_name_terms (Cmdliner_info.eval_terms_rev ei) - -let pp_version ppf ei = match Cmdliner_info.(term_version @@ eval_main ei) with -| None -> assert false -| Some v -> pp ppf "@[%a@]@." Cmdliner_base.pp_text v - -let pp_try_help ppf ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_main -> - pp ppf "@[<2>Try `%s --help' for more information.@]" (exec_name ei) -| `Multiple_group -| `Multiple_sub -> - let exec_cmd = Cmdliner_docgen.plain_invocation ei in - let parent = - Cmdliner_info.eval_terms_rev ei - |> List.tl - |> exec_name_terms - in - pp ppf "@[<2>Try `%s --help' or `%s --help' for more information.@]" - exec_cmd parent +let exec_name ei = Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei + +let pp_version ppf ei = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> assert false + | Some v -> pp ppf "@[%a@]@." Cmdliner_base.pp_text v + +let pp_try_help ppf ei = + let rcmds = Cmdliner_info.Eval.(cmd ei :: parents ei) in + match List.rev_map Cmdliner_info.Cmd.name rcmds with + | [] -> assert false + | [n] -> pp ppf "@[<2>Try '%s --help' for more information.@]" n + | n :: _ as cmds -> + let cmds = String.concat " " cmds in + pp ppf "@[<2>Try '%s --help' or '%s --help' for more information.@]" + cmds n let pp_err ppf ei ~err = pp ppf "%s: @[%a@]@." (exec_name ei) pp_lines err @@ -108,7 +106,7 @@ let pp_backtrace ppf ei e bt = (exec_name ei) pp_lines (strf "%s\n%s" (Printexc.to_string e) bt) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.mli index f645080f1..125e17519 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_msg.mli @@ -1,20 +1,19 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Messages for the end-user. *) (** {1:env_err Environment variable errors} *) -val err_env_parse : Cmdliner_info.env -> err:string -> string +val err_env_parse : Cmdliner_info.Env.info -> err:string -> string (** {1:pos_err Positional argument errors} *) val err_pos_excess : string list -> string -val err_pos_misses : Cmdliner_info.arg list -> string -val err_pos_parse : Cmdliner_info.arg -> err:string -> string +val err_pos_misses : Cmdliner_info.Arg.t list -> string +val err_pos_parse : Cmdliner_info.Arg.t -> err:string -> string (** {1:opt_err Optional argument errors} *) @@ -25,22 +24,23 @@ val err_opt_repeated : string -> string -> string (** {1:arg_err Argument errors} *) -val err_arg_missing : Cmdliner_info.arg -> string +val err_arg_missing : Cmdliner_info.Arg.t -> string +val err_cmd_missing : dom:string list -> string (** {1:msgs Other messages} *) -val pp_version : Format.formatter -> Cmdliner_info.eval -> unit -val pp_try_help : Format.formatter -> Cmdliner_info.eval -> unit -val pp_err : Format.formatter -> Cmdliner_info.eval -> err:string -> unit +val pp_version : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_try_help : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_err : Format.formatter -> Cmdliner_info.Eval.t -> err:string -> unit val pp_err_usage : - Format.formatter -> Cmdliner_info.eval -> err_lines:bool -> err:string -> unit + Format.formatter -> Cmdliner_info.Eval.t -> err_lines:bool -> err:string -> unit val pp_backtrace : Format.formatter -> - Cmdliner_info.eval -> exn -> Printexc.raw_backtrace -> unit + Cmdliner_info.Eval.t -> exn -> Printexc.raw_backtrace -> unit (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.ml deleted file mode 100644 index ea1fce2c8..000000000 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_suggest.ml +++ /dev/null @@ -1,54 +0,0 @@ -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. - Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 - ---------------------------------------------------------------------------*) - -let levenshtein_distance s t = - (* As found here http://rosettacode.org/wiki/Levenshtein_distance#OCaml *) - let minimum a b c = min a (min b c) in - let m = String.length s in - let n = String.length t in - (* for all i and j, d.(i).(j) will hold the Levenshtein distance between - the first i characters of s and the first j characters of t *) - let d = Array.make_matrix (m+1) (n+1) 0 in - for i = 0 to m do d.(i).(0) <- i done; - for j = 0 to n do d.(0).(j) <- j done; - for j = 1 to n do - for i = 1 to m do - if s.[i-1] = t.[j-1] then - d.(i).(j) <- d.(i-1).(j-1) (* no operation required *) - else - d.(i).(j) <- minimum - (d.(i-1).(j) + 1) (* a deletion *) - (d.(i).(j-1) + 1) (* an insertion *) - (d.(i-1).(j-1) + 1) (* a substitution *) - done; - done; - d.(m).(n) - -let value s candidates = - let add (min, acc) name = - let d = levenshtein_distance s name in - if d = min then min, (name :: acc) else - if d < min then d, [name] else - min, acc - in - let dist, suggs = List.fold_left add (max_int, []) candidates in - if dist < 3 (* suggest only if not too far *) then suggs else [] - -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli - - Permission to use, copy, modify, and/or distribute this software for any - purpose with or without fee is hereby granted, provided that the above - copyright notice and this permission notice appear in all copies. - - THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.ml index 7d274d6d8..13220cfbb 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) type term_escape = @@ -9,14 +8,14 @@ type term_escape = | `Help of Cmdliner_manpage.format * string option ] type 'a parser = - Cmdliner_info.eval -> Cmdliner_cline.t -> + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> ('a, [ `Parse of string | term_escape ]) result -type 'a t = Cmdliner_info.args * 'a parser +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser -let const v = Cmdliner_info.Args.empty, (fun _ _ -> Ok v) +let const v = Cmdliner_info.Arg.Set.empty, (fun _ _ -> Ok v) let app (args_f, f) (args_v, v) = - Cmdliner_info.Args.union args_f args_v, + Cmdliner_info.Arg.Set.union args_f args_v, fun ei cl -> match (f ei cl) with | Error _ as e -> e | Ok f -> @@ -24,8 +23,66 @@ let app (args_f, f) (args_v, v) = | Error _ as e -> e | Ok v -> Ok (f v) +(* Terms *) + +let ( $ ) = app + +type 'a ret = [ `Ok of 'a | term_escape ] + +let ret (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (`Ok v) -> Ok v + | Ok (`Error _ as err) -> Error err + | Ok (`Help _ as help) -> Error help + | Error _ as e -> e + +let term_result ?(usage = false) (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) + | Error _ as e -> e + +let term_result' ?usage t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + term_result ?usage wrap + +let cli_parse_result (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Parse e) + | Error _ as e -> e + +let cli_parse_result' t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + cli_parse_result wrap + +let main_name = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> Ok (Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei)) + +let choice_names = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> + (* N.B. this keeps everything backward compatible. We return the command + names of main's children *) + let name t = Cmdliner_info.Cmd.name t in + let choices = Cmdliner_info.Cmd.children (Cmdliner_info.Eval.main ei) in + Ok (List.rev_map name choices)) + +let with_used_args (al, v) : (_ * string list) t = + al, fun ei cl -> + match v ei cl with + | Ok x -> + let actual_args arg_info acc = + let args = Cmdliner_cline.actual_args cl arg_info in + List.rev_append args acc + in + let used = List.rev (Cmdliner_info.Arg.Set.fold actual_args al []) in + Ok (x, used) + | Error _ as e -> e + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.mli index 8db40106d..c9b280ecb 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Terms *) @@ -11,20 +10,32 @@ type term_escape = | `Help of Cmdliner_manpage.format * string option ] type 'a parser = - Cmdliner_info.eval -> Cmdliner_cline.t -> + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> ('a, [ `Parse of string | term_escape ]) result (** Type type for command line parser. given static information about the command line and a command line to parse returns an OCaml value. *) -type 'a t = Cmdliner_info.args * 'a parser +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser (** The type for terms. The list of arguments it can parse and the parsing function that does so. *) val const : 'a -> 'a t val app : ('a -> 'b) t -> 'a t -> 'b t +val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t + +type 'a ret = [ `Ok of 'a | term_escape ] + +val ret : 'a ret t -> 'a t +val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t +val term_result' : ?usage:bool -> ('a, string) result t -> 'a t +val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t +val cli_parse_result' : ('a, string) result t -> 'a t +val main_name : string t +val choice_names : string list t +val with_used_args : 'a t -> ('a * string list) t (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_term_deprecated.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term_deprecated.ml new file mode 100644 index 000000000..a156d3bc4 --- /dev/null +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_term_deprecated.ml @@ -0,0 +1,93 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Term combinators *) + +let man_format = Cmdliner_arg.man_format +let pure = Cmdliner_term.const + +(* Term information *) + +type exit_info = Cmdliner_info.Exit.info +let exit_info = Cmdliner_info.Exit.info + +let exit_status_success = Cmdliner_info.Exit.ok +let exit_status_cli_error = Cmdliner_info.Exit.cli_error +let exit_status_internal_error = Cmdliner_info.Exit.internal_error +let default_error_exits = + [ exit_info exit_status_cli_error ~doc:"on command line parsing errors."; + exit_info exit_status_internal_error + ~doc:"on unexpected internal errors (bugs)."; ] + +let default_exits = + (exit_info exit_status_success ~doc:"on success.") :: default_error_exits + +type env_info = Cmdliner_info.Env.info +let env_info = Cmdliner_info.Env.info ?deprecated:None + +type info = Cmdliner_info.Cmd.t +let info + ?(man_xrefs = []) ?man ?envs ?(exits = []) + ?(sdocs = Cmdliner_manpage.s_options) ?docs ?doc ?version name + = + Cmdliner_info.Cmd.v + ~man_xrefs ?man ?envs ~exits ~sdocs ?docs ?doc ?version name + +let name ti = Cmdliner_info.Cmd.name ti + +(* Evaluation *) + +type 'a result = +[ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] + +let to_legacy_result = function +| Ok (#Cmdliner_eval.eval_ok as r) -> (r : 'a result) +| Error e -> `Error e + +let eval ?help ?err ?catch ?env ?argv (t, i) = + let cmd = Cmdliner_cmd.v i t in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_choice ?help ?err ?catch ?env ?argv (t, i) choices = + let sub (t, i) = Cmdliner_cmd.v i t in + let cmd = Cmdliner_cmd.group i ~default:t (List.map sub choices) in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_peek_opts ?version_opt ?env ?argv t = + let o, r = Cmdliner_eval.eval_peek_opts ?version_opt ?env ?argv t in + o, to_legacy_result r + +(* Exits *) + +let exit_status_of_result ?(term_err = 1) = function +| `Ok () | `Help | `Version -> exit_status_success +| `Error `Term -> term_err +| `Error `Exn -> exit_status_internal_error +| `Error `Parse -> exit_status_cli_error + +let exit_status_of_status_result ?term_err = function +| `Ok n -> n +| `Help | `Version | `Error _ as r -> exit_status_of_result ?term_err r + +let stdlib_exit = exit +let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r) +let exit_status ?term_err r = + stdlib_exit (exit_status_of_status_result ?term_err r) + +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.ml b/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.ml index 1147a7176..e7e6a7acd 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.ml +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) module Cmap = Map.Make (Char) (* character maps. *) @@ -81,7 +80,7 @@ let of_list l = List.fold_left add empty l (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.mli b/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.mli index b3e629f60..4b77a7f16 100644 --- a/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.mli +++ b/duniverse/dune_/vendor/cmdliner/src/cmdliner_trie.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Tries. @@ -19,7 +18,7 @@ val ambiguities : 'a t -> string -> string list val of_list : (string * 'a) list -> 'a t (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/duniverse/dune_/vendor/update-cmdliner.sh b/duniverse/dune_/vendor/update-cmdliner.sh index b7cb83b96..d97b3ad59 100755 --- a/duniverse/dune_/vendor/update-cmdliner.sh +++ b/duniverse/dune_/vendor/update-cmdliner.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=b5d61616851bfb0f0c2ed64302dd5cccd39413c8 +version=c7f97d02cedc3d7e267704b987f3c1403e8152a9 set -e -o pipefail diff --git a/duniverse/dune_/xdg.opam b/duniverse/dune_/xdg.opam index c5cceb32b..9ff301440 100644 --- a/duniverse/dune_/xdg.opam +++ b/duniverse/dune_/xdg.opam @@ -1,4 +1,4 @@ -version: "3.4.1" +version: "3.6.1" # This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "XDG Base Directory Specification" @@ -11,7 +11,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.3"} + "dune" {>= "3.5"} "ocaml" {>= "4.08"} "odoc" {with-doc} ] diff --git a/duniverse/duration/CHANGES.md b/duniverse/duration/CHANGES.md index e7764d03a..6f8596c1c 100644 --- a/duniverse/duration/CHANGES.md +++ b/duniverse/duration/CHANGES.md @@ -1,3 +1,7 @@ +## v0.2.1 (2022-10-11) + +* Duration.pp: microseconds suffix is now "μs" instead of "us" (#8 by @MisterDA) + ## 0.2.0 (2021-08-04) * 32 bit compatibility: diff --git a/duniverse/duration/README.md b/duniverse/duration/README.md index b7bfdd6c2..612ec2d93 100644 --- a/duniverse/duration/README.md +++ b/duniverse/duration/README.md @@ -1,6 +1,6 @@ ## Duration - conversions to various time units -0.2.0 +v0.2.1 A duration is represented in nanoseconds as an unsigned 64 bit integer. This has a range of up to 584 years. Functions provided check the input and raise diff --git a/duniverse/duration/dune-project b/duniverse/duration/dune-project index 33e9488d3..f901daf44 100644 --- a/duniverse/duration/dune-project +++ b/duniverse/duration/dune-project @@ -1,3 +1,3 @@ (lang dune 1.0) (name duration) -(version 0.2.0) +(version v0.2.1) diff --git a/duniverse/duration/duration.ml b/duniverse/duration/duration.ml index 4aed1e113..a3929631e 100644 --- a/duniverse/duration/duration.ml +++ b/duniverse/duration/duration.ml @@ -1,4 +1,3 @@ - type t = int64 let of_us_64 m = @@ -157,4 +156,4 @@ let pp ppf t = else if ms > 0L then Format.fprintf ppf "%Ld.%03Ldms" ms us else (* if us > 0 then *) - Format.fprintf ppf "%Ld.%03Ldus" us ns + Format.fprintf ppf "%Ld.%03Ldμs" us ns diff --git a/duniverse/duration/duration.mli b/duniverse/duration/duration.mli index b6f2fbfa4..9ce5fe88e 100644 --- a/duniverse/duration/duration.mli +++ b/duniverse/duration/duration.mli @@ -8,7 +8,7 @@ All functions converting to [t] raise [Invalid_argument] on out of bound or negative input. - {e 0.2.0 - {{:https://github.com/hannesm/duration }homepage}} + {e v0.2.1 - {{:https://github.com/hannesm/duration }homepage}} *) (** The type for a duration, exposed as an int64 to provide interoperability. *) diff --git a/duniverse/duration/duration.opam b/duniverse/duration/duration.opam index 3edffd251..0754494fe 100644 --- a/duniverse/duration/duration.opam +++ b/duniverse/duration/duration.opam @@ -1,4 +1,4 @@ -version: "0.2.0" +version: "0.2.1" opam-version: "2.0" maintainer: "Hannes Mehnert " authors: "Hannes Mehnert " diff --git a/duniverse/mirage-crypto/.cirrus.yml b/duniverse/mirage-crypto/.cirrus.yml index e5311b053..125424f52 100644 --- a/duniverse/mirage-crypto/.cirrus.yml +++ b/duniverse/mirage-crypto/.cirrus.yml @@ -6,9 +6,38 @@ freebsd_task: matrix: - OCAML_VERSION: 4.11.1 - OCAML_VERSION: 4.12.0 + + pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash + + ocaml_script: + - opam init -a --comp=$OCAML_VERSION + - opam env + + pin_packages_script: + - opam install -y solo5-bindings-hvt zarith-freestanding opam-depext + - opam pin add mirage-crypto . -y --with-version=0.10.6 --with-test + - opam pin add mirage-crypto-rng . -y --with-version=0.10.6 --with-test + - opam pin add mirage-crypto-rng-mirage . -y --with-version=0.10.6 --with-test + - opam pin add mirage-crypto-pk . -y --with-version=0.10.6 --with-test + - opam pin add mirage-crypto-ec . -y --with-version=0.10.6 --with-test + - opam pin add mirage-crypto-rng-async . -y --with-version=0.10.6 --with-test + + test_script: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec,mirage-crypto-rng-async + + test_mirage_script: eval `opam env` && ./.test-mirage.sh + +freebsd_eio_task: pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash - ocaml_script: opam init -a --comp=$OCAML_VERSION - dependencies_script: eval `opam env` && opam install -y --deps-only . - build_script: eval `opam env` && dune build @install - test_script: eval `opam env` && opam install -y -t --deps-only . && dune build @runtest - test_mirage_script: eval `opam env` && opam install -y solo5-bindings-hvt zarith-freestanding opam-depext && opam pin add -y . && ./.test-mirage.sh + + ocaml_script: + - opam init -a --bare + - opam update + - opam switch create 5.0.0~alpha0 --repositories=default,alpha=git+https://github.com/kit-ty-kate/opam-alpha-repository.git + - opam env + + pin_packages_script: + - opam pin add mirage-crypto . -y --with-version=dev + - opam pin add mirage-crypto-rng . -y --with-version=dev + - opam pin add mirage-crypto-rng-eio . -y --with-version=dev --with-test + + test_script: opam exec -- dune runtest -p mirage-crypto-rng-eio diff --git a/duniverse/mirage-crypto/.github/workflows/esy.yml b/duniverse/mirage-crypto/.github/workflows/esy.yml deleted file mode 100644 index b70c71a18..000000000 --- a/duniverse/mirage-crypto/.github/workflows/esy.yml +++ /dev/null @@ -1,69 +0,0 @@ -name: Crypto - -on: [push, pull_request] - -jobs: - cross_compile: - name: Cross compile - - strategy: - fail-fast: false - matrix: - system: [ubuntu, macos] - target: [android.arm64, linux.musl.arm64, macos.arm64] - exclude: - - system: ubuntu - target: macos.arm64 - - system: macos - target: linux.musl.arm64 - - runs-on: ${{ matrix.system }}-latest - - steps: - - name: Checkout code - uses: actions/checkout@v2 - - - name: Create esy wrapper - run: | - echo '{ - "name": "cross-compile", - "dependencies": { - "@opam/mirage-crypto": "*", - "@opam/mirage-crypto-ec": "*", - "@opam/mirage-crypto-pk": "*", - "@opam/mirage-crypto-rng": "*", - "@opam/mirage-crypto-rng-mirage": "*", - "generate": "EduardoRFS/reason-mobile:generate.json" - }, - "resolutions": { - "@opam/mirage-crypto": "./mirage-crypto.opam", - "@opam/mirage-crypto-ec": "./mirage-crypto-ec.opam", - "@opam/mirage-crypto-pk": "./mirage-crypto-pk.opam", - "@opam/mirage-crypto-rng": "./mirage-crypto-rng.opam", - "@opam/mirage-crypto-rng-mirage": "./mirage-crypto-rng-mirage.opam", - "@opam/mtime": "github:dune-universe/mtime:mtime.opam#9584b66cecc891208b31cec4628dd412b8cffe75", - "@opam/zarith": "github:dune-universe/Zarith:zarith.opam#c62b045106fafa407874053bdd79273a8f591352", - "@opam/num": "github:dune-universe/num:num.opam#bdb2d7653e927e142b701b51d89f393471279713", - "esy-gmp": "github:EduardoRFS/esy-gmp:package.json#336668546d995962806520b913218414dd0ff83f" - } - }' > esy.json - - - uses: actions/setup-node@v1 - with: - node-version: 14 - - name: Install esy - run: npm install -g esy - - name: Create cross compile toolchain lock - run: esy solve - - uses: esy/github-action@v1 - with: - cache-key: ${{ matrix.target }}-${{ hashFiles('esy.lock/index.json') }} - - - name: Create ${{ matrix.target }} wrapper - run: esy generate ${{ matrix.target }} - - - name: Install ${{ matrix.target }} dependencies - run: esy @${{ matrix.target }} install - - - name: Build ${{ matrix.target }} - run: esy @${{ matrix.target }} build diff --git a/duniverse/mirage-crypto/.github/workflows/test.yml b/duniverse/mirage-crypto/.github/workflows/test.yml index e525d3497..037113b0e 100644 --- a/duniverse/mirage-crypto/.github/workflows/test.yml +++ b/duniverse/mirage-crypto/.github/workflows/test.yml @@ -21,4 +21,52 @@ jobs: - name: Use OCaml ${{ matrix.ocaml-version }} uses: ocaml/setup-ocaml@v2 with: + opam-local-packages: | + *.opam + !mirage-crypto-rng-eio.opam ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Install dependencies + run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-mirage mirage-crypto-pk mirage-crypto-ec mirage-crypto-rng-async + + - name: Build + run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec,mirage-crypto-rng-async + + - name: Test + run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec,mirage-crypto-rng-async + + build-test-unix-eio: + name : Unix (eio) + + strategy: + fail-fast: false + matrix: + ocaml-version: [ocaml-variants.5.0.0+trunk] + operating-system: [macos-latest, ubuntu-latest] + + runs-on: ${{ matrix.operating-system }} + + steps: + - name: Checkout code + uses: actions/checkout@v2 + + - name: Use OCaml ${{ matrix.ocaml-version }} + uses: ocaml/setup-ocaml@v2 + with: + opam-local-packages: | + mirage-crypto.opam + mirage-crypto-rng.opam + mirage-crypto-rng-eio.opam + ocaml-compiler: ${{ matrix.ocaml-version }} + opam-repositories: | + default: https://github.com/ocaml/opam-repository.git + alpha: https://github.com/kit-ty-kate/opam-alpha-repository.git + + - name: Install dependencies + run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-eio + + - name: Build + run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-eio + + - name: Test + run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-eio diff --git a/duniverse/mirage-crypto/.github/workflows/windows.yml b/duniverse/mirage-crypto/.github/workflows/windows.yml index 0d85db632..d24853c85 100644 --- a/duniverse/mirage-crypto/.github/workflows/windows.yml +++ b/duniverse/mirage-crypto/.github/workflows/windows.yml @@ -9,7 +9,7 @@ jobs: strategy: fail-fast: false matrix: - ocaml-compiler: ["4.12.0", "4.11.2", "4.10.2", "4.09.1", "4.08.1"] + ocaml-version: ["4.12.0", "4.11.2", "4.10.2", "4.09.1", "4.08.1"] operating-system: [windows-latest] runs-on: ${{ matrix.operating-system }} @@ -18,10 +18,20 @@ jobs: - name: Checkout code uses: actions/checkout@v2 - - name: Use OCaml ${{ matrix.ocaml-version }} + - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 with: opam-local-packages: | *.opam !mirage-crypto-rng-async.opam + !mirage-crypto-rng-eio.opam ocaml-compiler: ${{ matrix.ocaml-version }} + + - name: Install dependencies + run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-mirage mirage-crypto-pk mirage-crypto-ec + + - name: Build + run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec + + - name: Test + run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec diff --git a/duniverse/mirage-crypto/CHANGES.md b/duniverse/mirage-crypto/CHANGES.md index d0741d8ab..892aac31c 100644 --- a/duniverse/mirage-crypto/CHANGES.md +++ b/duniverse/mirage-crypto/CHANGES.md @@ -1,3 +1,16 @@ +## v0.10.7 (2022-09-13) + +- mirage-crypto-rng-eio: new package for seeding and feeding entropy to the + rng with eio (#155 @bikallem, @talex5, @hannesm) +- mirage-crypto-ec: expose Dsa.byte_length (#164 @hannesm) +- CI: various fixes (#154 #164 @hannesm) +- mirage-crypto-rng-mirage: use 'a generator type alias +- mirage-crypto-rng: improve setup_rng message (add async, revise lwt) (#161 + @hannesm) +- mirage-crypto-rng-mirage: always feed the default generator (as done in + a8c7bbd2552a9d2177450e95f280342f80fba01d for the lwt feeding) (#161 @hannesm) +- ec: update generated code to recent fiat-crypto (#156 @hannesm) + ## v0.10.6 (2022-03-29) - Use _WIN32 instead of __WIN32__, as proposed by @jonahbeckford in #137 diff --git a/duniverse/mirage-crypto/README.md b/duniverse/mirage-crypto/README.md index 631a3f6b2..27e8b3bb8 100644 --- a/duniverse/mirage-crypto/README.md +++ b/duniverse/mirage-crypto/README.md @@ -1,6 +1,6 @@ # mirage-crypto - Cryptographic primitives for MirageOS -v0.10.6 +v0.10.7 mirage-crypto is a small cryptographic library that puts emphasis on the applicative style and ease of use. It includes basic ciphers (AES, 3DES, RC4, diff --git a/duniverse/mirage-crypto/dune-project b/duniverse/mirage-crypto/dune-project index d9cb1b424..94b114d71 100644 --- a/duniverse/mirage-crypto/dune-project +++ b/duniverse/mirage-crypto/dune-project @@ -1,4 +1,4 @@ (lang dune 2.6) (name mirage-crypto) -(version v0.10.6) +(version v0.10.7) (formatting disabled) diff --git a/duniverse/mirage-crypto/ec/mirage_crypto_ec.ml b/duniverse/mirage-crypto/ec/mirage_crypto_ec.ml index 91a30c708..dbd04abb3 100644 --- a/duniverse/mirage-crypto/ec/mirage_crypto_ec.ml +++ b/duniverse/mirage-crypto/ec/mirage_crypto_ec.ml @@ -43,6 +43,8 @@ module type Dsa = sig type pub + val byte_length : int + val priv_of_cstruct : Cstruct.t -> (priv, error) result val priv_to_cstruct : priv -> Cstruct.t @@ -502,6 +504,8 @@ module Make_dsa (Param : Parameters) (F : Foreign_n) (P : Point) (S : Scalar) (H type priv = scalar + let byte_length = Param.byte_length + let priv_of_cstruct = S.of_cstruct let priv_to_cstruct = S.to_cstruct diff --git a/duniverse/mirage-crypto/ec/mirage_crypto_ec.mli b/duniverse/mirage-crypto/ec/mirage_crypto_ec.mli index 22c830a83..045a3b564 100644 --- a/duniverse/mirage-crypto/ec/mirage_crypto_ec.mli +++ b/duniverse/mirage-crypto/ec/mirage_crypto_ec.mli @@ -72,6 +72,9 @@ module type Dsa = sig type pub (** The type for public keys. *) + val byte_length : int + (** [byte_length] is the size of a ECDSA signature in bytes. *) + (** {2 Serialisation} *) val priv_of_cstruct : Cstruct.t -> (priv, error) result diff --git a/duniverse/mirage-crypto/ec/native/GNUmakefile b/duniverse/mirage-crypto/ec/native/GNUmakefile index 41e7b05a6..97d9e46a0 100644 --- a/duniverse/mirage-crypto/ec/native/GNUmakefile +++ b/duniverse/mirage-crypto/ec/native/GNUmakefile @@ -4,6 +4,7 @@ # The lowest bound of fiat-crypto is git commit # dabaf4b3132e8bb4a3f5fcd8366eec6ac9bb4232 (July 16th 2021) # Generated on FreeBSD 12.2p2 with coq 8.13.1 (OCaml 4.12.0) +# with fiat-crypto 2a07751f37af74edeac47b19bd51810bc99b91a1 (May 29th 2022) WBW_MONT ?= ../../../fiat-crypto/src/ExtractionOCaml/word_by_word_montgomery --static --use-value-barrier --inline-internal UNSAT_SOLINAS ?= ../../../fiat-crypto/src/ExtractionOCaml/unsaturated_solinas --static --use-value-barrier --inline-internal diff --git a/duniverse/mirage-crypto/ec/native/curve25519_32.h b/duniverse/mirage-crypto/ec/native/curve25519_32.h index a3e0db5fb..4b23be184 100644 --- a/duniverse/mirage-crypto/ec/native/curve25519_32.h +++ b/duniverse/mirage-crypto/ec/native/curve25519_32.h @@ -15,7 +15,7 @@ #include typedef unsigned char fiat_25519_uint1; typedef signed char fiat_25519_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_25519_FIAT_INLINE __inline__ #else # define FIAT_25519_FIAT_INLINE @@ -932,7 +932,7 @@ static void fiat_25519_opp(fiat_25519_loose_field_element out1, const fiat_25519 * The function fiat_25519_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/curve25519_64.h b/duniverse/mirage-crypto/ec/native/curve25519_64.h index c509a1406..957e7a2ad 100644 --- a/duniverse/mirage-crypto/ec/native/curve25519_64.h +++ b/duniverse/mirage-crypto/ec/native/curve25519_64.h @@ -15,7 +15,7 @@ #include typedef unsigned char fiat_25519_uint1; typedef signed char fiat_25519_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_25519_FIAT_EXTENSION __extension__ # define FIAT_25519_FIAT_INLINE __inline__ #else @@ -475,7 +475,7 @@ static void fiat_25519_opp(fiat_25519_loose_field_element out1, const fiat_25519 * The function fiat_25519_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np224_32.h b/duniverse/mirage-crypto/ec/native/np224_32.h index afb75c3e4..7bede2b58 100644 --- a/duniverse/mirage-crypto/ec/native/np224_32.h +++ b/duniverse/mirage-crypto/ec/native/np224_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np224_uint1; typedef signed char fiat_np224_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP224_FIAT_INLINE __inline__ #else # define FIAT_NP224_FIAT_INLINE @@ -3601,7 +3601,7 @@ static void fiat_np224_from_bytes(uint32_t out1[7], const uint8_t arg1[28]) { * The function fiat_np224_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np224_64.h b/duniverse/mirage-crypto/ec/native/np224_64.h index 3f72f96d9..6dfe9dc93 100644 --- a/duniverse/mirage-crypto/ec/native/np224_64.h +++ b/duniverse/mirage-crypto/ec/native/np224_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np224_uint1; typedef signed char fiat_np224_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP224_FIAT_EXTENSION __extension__ # define FIAT_NP224_FIAT_INLINE __inline__ #else @@ -1726,7 +1726,7 @@ static void fiat_np224_from_bytes(uint64_t out1[4], const uint8_t arg1[28]) { * The function fiat_np224_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np256_32.h b/duniverse/mirage-crypto/ec/native/np256_32.h index 4e0d34291..abddb1526 100644 --- a/duniverse/mirage-crypto/ec/native/np256_32.h +++ b/duniverse/mirage-crypto/ec/native/np256_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np256_uint1; typedef signed char fiat_np256_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP256_FIAT_INLINE __inline__ #else # define FIAT_NP256_FIAT_INLINE @@ -4227,7 +4227,7 @@ static void fiat_np256_from_bytes(uint32_t out1[8], const uint8_t arg1[32]) { * The function fiat_np256_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np256_64.h b/duniverse/mirage-crypto/ec/native/np256_64.h index 8429d4401..c55af589d 100644 --- a/duniverse/mirage-crypto/ec/native/np256_64.h +++ b/duniverse/mirage-crypto/ec/native/np256_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np256_uint1; typedef signed char fiat_np256_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP256_FIAT_EXTENSION __extension__ # define FIAT_NP256_FIAT_INLINE __inline__ #else @@ -1772,7 +1772,7 @@ static void fiat_np256_from_bytes(uint64_t out1[4], const uint8_t arg1[32]) { * The function fiat_np256_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np384_32.h b/duniverse/mirage-crypto/ec/native/np384_32.h index 5264642da..a7581964d 100644 --- a/duniverse/mirage-crypto/ec/native/np384_32.h +++ b/duniverse/mirage-crypto/ec/native/np384_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np384_uint1; typedef signed char fiat_np384_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP384_FIAT_INLINE __inline__ #else # define FIAT_NP384_FIAT_INLINE @@ -8786,7 +8786,7 @@ static void fiat_np384_from_bytes(uint32_t out1[12], const uint8_t arg1[48]) { * The function fiat_np384_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np384_64.h b/duniverse/mirage-crypto/ec/native/np384_64.h index 681522e24..6fb471a9b 100644 --- a/duniverse/mirage-crypto/ec/native/np384_64.h +++ b/duniverse/mirage-crypto/ec/native/np384_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np384_uint1; typedef signed char fiat_np384_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP384_FIAT_EXTENSION __extension__ # define FIAT_NP384_FIAT_INLINE __inline__ #else @@ -3073,7 +3073,7 @@ static void fiat_np384_from_bytes(uint64_t out1[6], const uint8_t arg1[48]) { * The function fiat_np384_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np521_32.h b/duniverse/mirage-crypto/ec/native/np521_32.h index c3ad4769d..c47a0c35f 100644 --- a/duniverse/mirage-crypto/ec/native/np521_32.h +++ b/duniverse/mirage-crypto/ec/native/np521_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np521_uint1; typedef signed char fiat_np521_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP521_FIAT_INLINE __inline__ #else # define FIAT_NP521_FIAT_INLINE @@ -16207,7 +16207,7 @@ static void fiat_np521_from_bytes(uint32_t out1[17], const uint8_t arg1[66]) { * The function fiat_np521_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/np521_64.h b/duniverse/mirage-crypto/ec/native/np521_64.h index 7ab86ec7b..960e4e7d0 100644 --- a/duniverse/mirage-crypto/ec/native/np521_64.h +++ b/duniverse/mirage-crypto/ec/native/np521_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_np521_uint1; typedef signed char fiat_np521_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_NP521_FIAT_EXTENSION __extension__ # define FIAT_NP521_FIAT_INLINE __inline__ #else @@ -5588,7 +5588,7 @@ static void fiat_np521_from_bytes(uint64_t out1[9], const uint8_t arg1[66]) { * The function fiat_np521_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p224_32.h b/duniverse/mirage-crypto/ec/native/p224_32.h index 8ec008028..d5777bdac 100644 --- a/duniverse/mirage-crypto/ec/native/p224_32.h +++ b/duniverse/mirage-crypto/ec/native/p224_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p224_uint1; typedef signed char fiat_p224_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P224_FIAT_INLINE __inline__ #else # define FIAT_P224_FIAT_INLINE @@ -3209,7 +3209,7 @@ static void fiat_p224_nonzero(uint32_t* out1, const uint32_t arg1[7]) { * The function fiat_p224_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p224_64.h b/duniverse/mirage-crypto/ec/native/p224_64.h index d46761df9..76b0d84d6 100644 --- a/duniverse/mirage-crypto/ec/native/p224_64.h +++ b/duniverse/mirage-crypto/ec/native/p224_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p224_uint1; typedef signed char fiat_p224_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P224_FIAT_EXTENSION __extension__ # define FIAT_P224_FIAT_INLINE __inline__ #else @@ -1460,7 +1460,7 @@ static void fiat_p224_nonzero(uint64_t* out1, const uint64_t arg1[4]) { * The function fiat_p224_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p256_32.h b/duniverse/mirage-crypto/ec/native/p256_32.h index 7eda4c3d9..24aea2d7a 100644 --- a/duniverse/mirage-crypto/ec/native/p256_32.h +++ b/duniverse/mirage-crypto/ec/native/p256_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p256_uint1; typedef signed char fiat_p256_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P256_FIAT_INLINE __inline__ #else # define FIAT_P256_FIAT_INLINE @@ -3907,7 +3907,7 @@ static void fiat_p256_nonzero(uint32_t* out1, const uint32_t arg1[8]) { * The function fiat_p256_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p256_64.h b/duniverse/mirage-crypto/ec/native/p256_64.h index 2400fd5a6..622b8a4a2 100644 --- a/duniverse/mirage-crypto/ec/native/p256_64.h +++ b/duniverse/mirage-crypto/ec/native/p256_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p256_uint1; typedef signed char fiat_p256_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P256_FIAT_EXTENSION __extension__ # define FIAT_P256_FIAT_INLINE __inline__ #else @@ -1362,7 +1362,7 @@ static void fiat_p256_nonzero(uint64_t* out1, const uint64_t arg1[4]) { * The function fiat_p256_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p384_32.h b/duniverse/mirage-crypto/ec/native/p384_32.h index e9c365834..18a936a09 100644 --- a/duniverse/mirage-crypto/ec/native/p384_32.h +++ b/duniverse/mirage-crypto/ec/native/p384_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p384_uint1; typedef signed char fiat_p384_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P384_FIAT_INLINE __inline__ #else # define FIAT_P384_FIAT_INLINE @@ -8940,7 +8940,7 @@ static void fiat_p384_nonzero(uint32_t* out1, const uint32_t arg1[12]) { * The function fiat_p384_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p384_64.h b/duniverse/mirage-crypto/ec/native/p384_64.h index 6651d679f..020beea2f 100644 --- a/duniverse/mirage-crypto/ec/native/p384_64.h +++ b/duniverse/mirage-crypto/ec/native/p384_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p384_uint1; typedef signed char fiat_p384_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P384_FIAT_EXTENSION __extension__ # define FIAT_P384_FIAT_INLINE __inline__ #else @@ -2975,7 +2975,7 @@ static void fiat_p384_nonzero(uint64_t* out1, const uint64_t arg1[6]) { * The function fiat_p384_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p521_32.h b/duniverse/mirage-crypto/ec/native/p521_32.h index 90fe7b667..b25a79b2d 100644 --- a/duniverse/mirage-crypto/ec/native/p521_32.h +++ b/duniverse/mirage-crypto/ec/native/p521_32.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p521_uint1; typedef signed char fiat_p521_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P521_FIAT_INLINE __inline__ #else # define FIAT_P521_FIAT_INLINE @@ -18100,7 +18100,7 @@ static void fiat_p521_nonzero(uint32_t* out1, const uint32_t arg1[17]) { * The function fiat_p521_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/ec/native/p521_64.h b/duniverse/mirage-crypto/ec/native/p521_64.h index aa824e787..3322d7873 100644 --- a/duniverse/mirage-crypto/ec/native/p521_64.h +++ b/duniverse/mirage-crypto/ec/native/p521_64.h @@ -20,7 +20,7 @@ #include typedef unsigned char fiat_p521_uint1; typedef signed char fiat_p521_int1; -#ifdef __GNUC__ +#if defined(__GNUC__) || defined(__clang__) # define FIAT_P521_FIAT_EXTENSION __extension__ # define FIAT_P521_FIAT_INLINE __inline__ #else @@ -5409,7 +5409,7 @@ static void fiat_p521_nonzero(uint64_t* out1, const uint64_t arg1[9]) { * The function fiat_p521_selectznz is a multi-limb conditional select. * * Postconditions: - * eval out1 = (if arg1 = 0 then eval arg2 else eval arg3) + * out1 = (if arg1 = 0 then arg2 else arg3) * * Input Bounds: * arg1: [0x0 ~> 0x1] diff --git a/duniverse/mirage-crypto/mirage-crypto-ec.opam b/duniverse/mirage-crypto/mirage-crypto-ec.opam index bfc43f9fd..b5310ed2a 100644 --- a/duniverse/mirage-crypto/mirage-crypto-ec.opam +++ b/duniverse/mirage-crypto/mirage-crypto-ec.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" synopsis: "Elliptic Curve Cryptography with primitives taken from Fiat" description: """ diff --git a/duniverse/mirage-crypto/mirage-crypto-pk.opam b/duniverse/mirage-crypto/mirage-crypto-pk.opam index c30ff9a6b..619f4edb2 100644 --- a/duniverse/mirage-crypto/mirage-crypto-pk.opam +++ b/duniverse/mirage-crypto/mirage-crypto-pk.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" homepage: "https://github.com/mirage/mirage-crypto" dev-repo: "git+https://github.com/mirage/mirage-crypto.git" diff --git a/duniverse/mirage-crypto/mirage-crypto-rng-async.opam b/duniverse/mirage-crypto/mirage-crypto-rng-async.opam index 2a2d0f9d9..d9866d190 100644 --- a/duniverse/mirage-crypto/mirage-crypto-rng-async.opam +++ b/duniverse/mirage-crypto/mirage-crypto-rng-async.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" homepage: "https://github.com/mirage/mirage-crypto" dev-repo: "git+https://github.com/mirage/mirage-crypto.git" diff --git a/duniverse/mirage-crypto/mirage-crypto-rng-eio.opam b/duniverse/mirage-crypto/mirage-crypto-rng-eio.opam new file mode 100644 index 000000000..bb2427d9a --- /dev/null +++ b/duniverse/mirage-crypto/mirage-crypto-rng-eio.opam @@ -0,0 +1,30 @@ +version: "0.10.7" +opam-version: "2.0" +homepage: "https://github.com/mirage/mirage-crypto" +dev-repo: "git+https://github.com/mirage/mirage-crypto.git" +bug-reports: "https://github.com/mirage/mirage-crypto/issues" +doc: "https://mirage.github.io/mirage-crypto/doc" +authors: ["Bikal Gurung " ] +maintainer: "Bikal Gurung " +license: "ISC" +synopsis: "Feed the entropy source in an eio-friendly way" + +build: [ ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs ] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] + +depends: [ + "base-domains" + "dune" {>= "3.0"} + "eio" {>= "0.3"} + "cstruct" {>= "6.0.0"} + "logs" + "mirage-crypto-rng" {=version} + "duration" + "mtime" + "eio_main" {with-test} +] +description: """ +Mirage-crypto-rng-eio feeds the entropy source for Mirage_crypto_rng-based +random number genreator implementations, in an eio-friendly way. +""" \ No newline at end of file diff --git a/duniverse/mirage-crypto/mirage-crypto-rng-mirage.opam b/duniverse/mirage-crypto/mirage-crypto-rng-mirage.opam index a49c0c4ee..30051a2b5 100644 --- a/duniverse/mirage-crypto/mirage-crypto-rng-mirage.opam +++ b/duniverse/mirage-crypto/mirage-crypto-rng-mirage.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" homepage: "https://github.com/mirage/mirage-crypto" dev-repo: "git+https://github.com/mirage/mirage-crypto.git" diff --git a/duniverse/mirage-crypto/mirage-crypto-rng.opam b/duniverse/mirage-crypto/mirage-crypto-rng.opam index 658061be2..70f16b288 100644 --- a/duniverse/mirage-crypto/mirage-crypto-rng.opam +++ b/duniverse/mirage-crypto/mirage-crypto-rng.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" homepage: "https://github.com/mirage/mirage-crypto" dev-repo: "git+https://github.com/mirage/mirage-crypto.git" diff --git a/duniverse/mirage-crypto/mirage-crypto.opam b/duniverse/mirage-crypto/mirage-crypto.opam index def508f04..0e25d61db 100644 --- a/duniverse/mirage-crypto/mirage-crypto.opam +++ b/duniverse/mirage-crypto/mirage-crypto.opam @@ -1,4 +1,4 @@ -version: "0.10.6" +version: "0.10.7" opam-version: "2.0" homepage: "https://github.com/mirage/mirage-crypto" dev-repo: "git+https://github.com/mirage/mirage-crypto.git" diff --git a/duniverse/mirage-crypto/rng/async/mirage_crypto_rng_async.ml b/duniverse/mirage-crypto/rng/async/mirage_crypto_rng_async.ml index 97ae3fa3b..495462bf4 100644 --- a/duniverse/mirage-crypto/rng/async/mirage_crypto_rng_async.ml +++ b/duniverse/mirage-crypto/rng/async/mirage_crypto_rng_async.ml @@ -72,13 +72,13 @@ let initialize ?g ?time_source ?(sleep = Time_ns.Span.of_int_sec 1) generator = in List.mapi ~f:(fun i f -> f i) init |> Cstruct.concat in - let rng = + let rng = create ?g ~seed ~time:(ns_since_epoch time_source) generator in set_default_generator rng; periodically_collect_cpu_entropy time_source sleep; - periodically_collect_getrandom_entropy - time_source + periodically_collect_getrandom_entropy + time_source (Time_ns.Span.scale_int sleep 10); read_cpu_counter_at_the_start_of_every_cycle (); end diff --git a/duniverse/mirage-crypto/rng/eio/dune b/duniverse/mirage-crypto/rng/eio/dune new file mode 100644 index 000000000..379f2270a --- /dev/null +++ b/duniverse/mirage-crypto/rng/eio/dune @@ -0,0 +1,4 @@ +(library + (name mirage_crypto_rng_eio) + (public_name mirage-crypto-rng-eio) + (libraries eio cstruct logs mirage-crypto-rng duration mtime.clock.os)) diff --git a/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.ml b/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.ml new file mode 100644 index 000000000..f0e78ba6f --- /dev/null +++ b/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.ml @@ -0,0 +1,83 @@ + +open Mirage_crypto_rng + +type env = < + clock: Eio.Time.clock; + secure_random: Eio.Flow.source; +> + +let src = Logs.Src.create "mirage-crypto-rng-eio" ~doc:"Mirage crypto RNG Eio" +module Log = (val Logs.src_log src: Logs.LOG) + +let getrandom env i = + let buf = Cstruct.create i in + Eio.Flow.read_exact env#secure_random buf; + buf + +let getrandom_init env i = + let data = getrandom env 128 in + Entropy.header i data + +let rec periodic env f delta = + f (); + Eio.Time.sleep env#clock (Duration.to_f delta); + periodic env f delta + +let periodically_feed_entropy env delta source = + let task () = + let per_pool = 8 in + let size = per_pool * pools None in + let random = getrandom env size in + let idx = ref 0 in + let f () = + incr idx; + Cstruct.sub random (per_pool * (pred !idx)) per_pool + in + Entropy.feed_pools None source f + in + periodic env task delta + +let rdrand_task env delta = + match Entropy.cpu_rng with + | Error `Not_supported -> [] + | Ok cpu_rng -> [ fun () -> periodic env (cpu_rng None) delta ] + +let running = ref false + +let run + ?g + ?(sleep = Duration.of_sec 1) + generator + env + fn + = + if !running then begin + Log.debug + (fun m -> m "Mirage_crypto_rng_eio.initialize has already been called, \ + ignoring this call."); + fn () + end + else begin + running := true; + Fun.protect + ~finally:(fun () -> + running := false; + unset_default_generator ()) + (fun () -> + (try + let _ = default_generator () in + Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \ + been set, check that this call is intentional"); + with + No_default_generator -> ()); + let seed = + let init = + Entropy.[ bootstrap ; whirlwind_bootstrap ; bootstrap ; getrandom_init env ] in + List.mapi (fun i f -> f i) init |> Cstruct.concat + in + let rng = create ?g ~seed ~time:Mtime_clock.elapsed_ns generator in + set_default_generator rng; + let source = Entropy.register_source "getrandom" in + let feed_entropy () = periodically_feed_entropy env (Int64.mul sleep 10L) source in + Eio.Fiber.any (rdrand_task env sleep @ [feed_entropy ; fn])) + end diff --git a/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.mli b/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.mli new file mode 100644 index 000000000..6f95cfa5e --- /dev/null +++ b/duniverse/mirage-crypto/rng/eio/mirage_crypto_rng_eio.mli @@ -0,0 +1,39 @@ +(** {b RNG} seeding on {b Eio backends}. + + This module initializes a given random number generator with [getrandom()] and a CPU RNG. + [Eio.Stdenv.secure_random] is used as the [getrandom()] implementation. +*) + +type env = < + clock: Eio.Time.clock; + secure_random: Eio.Flow.source; + > + +(** [run ~g ~sleep gen env fn] will bring the RNG into a working state. The argument + [sleep] is measured in ns (default 1s), and is used to sleep between collection + of entropy from the CPU RNG. Every [10 * sleep] getrandom is used to collect + entropy. + + {b Note} In a multi-domain setting [run] ensures that entropy collection, feeding + and RNG setup are limited to one domain. + + [fn] is the main function that will have access to a running RNG. + + [g] [gen] denotes random number generator scheme to be used, eg [Mirage_crypto_rng.Fortuna]. + + [[ + open Mirage_crypto_rng + + let () = + Eio_main.run @@ fun env -> + Mirage_crypto_rng_eio.run (module Fortuna) env @@ fun () -> + let random_num = Mirage_crypto_rng.generate 32 in + Printf.printf "Random number: %S%!" (Cstruct.to_string random_num) + ]] +*) +val run + : ?g:'a + -> ?sleep:int64 + -> 'a Mirage_crypto_rng.generator + -> + -> (unit -> 'b) -> 'b diff --git a/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml b/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml index f725effde..f363b3d03 100644 --- a/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml +++ b/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml @@ -33,12 +33,12 @@ module Log = (val Logs.src_log src : Logs.LOG) module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) = struct include Mirage_crypto_rng - let rdrand_task g delta = + let rdrand_task delta = match Entropy.cpu_rng with | Error `Not_supported -> () | Ok cpu_rng -> let open Lwt.Infix in - let rdrand = cpu_rng g in + let rdrand = cpu_rng None in Lwt.async (fun () -> let rec one () = rdrand (); @@ -69,8 +69,8 @@ module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) = struct in let rng = create ?g ~seed ~time:M.elapsed_ns rng in set_default_generator rng; - rdrand_task (Some rng) sleep; - Mirage_runtime.at_enter_iter (Entropy.timer_accumulator (Some rng)); + rdrand_task sleep; + Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None); Lwt.return_unit end end diff --git a/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli b/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli index 3c97627f3..baec6afd2 100644 --- a/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli +++ b/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli @@ -20,12 +20,27 @@ generation suite. For proper operation, they need to be seeded with a high-quality entropy source. - Suitable generators are provided by sub-libraries + Suitable entropy feeding of generators are provided by sub-libraries {{!Mirage_crypto_rng_lwt}mirage-crypto-rng.lwt} (for Lwt), - {{!Mirage_crypto_rng_mirage}mirage-crypto-rng.mirage} (for MirageOS), - and {{!Mirage_crypto_rng_unix}mirage-crypto-rng.unix}. - Although this module exposes a more fine-grained interface, allowing manual - seeding of generators, this is intended either for implementing + {{!Mirage_crypto_rng_async}mirage-crypto-rng-async} (for Async), + {{!Mirage_crypto_rng_mirage}mirage-crypto-rng-mirage} (for MirageOS), + {{!Mirage_crypto_rng_unix}mirage-crypto-rng.unix}, + and {{!Mirage_crypto_rng_eio}mirage-crypto-rng-eio} (for Eio). + + The intention is that "initialize" in the respective sub-library is called + once, which sets the default generator and registers entropy + harvesting asynchronous tasks. The semantics is that the entropy is always + fed to the {{!default_generator}default generator}, which is not necessarily + the one set by "initialize". The reasoning behind this is that the default + generator should be used in most setting, and that should be fed a constant + stream of entropy. + + [mirage-crypto-rng-eio] package differs slightly from other rng packages. + Instead of the [initilize] function a [run] function is provided with + similar behaviour, i.e. RNG setup, entropy collection and periodic reseeding. + + Although this module exposes a more fine-grained interface, e.g. allowing + manual seeding of generators, this is intended either for implementing entropy-harvesting modules, or very specialized purposes. Users of this library should almost certainly use one of the above entropy libraries, and avoid manually managing the generator seeding. @@ -33,8 +48,9 @@ Similarly, although it is possible to swap the default generator and gain control over the random stream, this is also intended for specialized applications such as testing or similar scenarios where the RNG needs to be - fully deterministic, or as a component of deterministic algorithms which - internally rely on pseudorandom streams. + fully deterministic (RFC 6979, deterministic usage of DSA), or as a + component of deterministic algorithms which internally rely on pseudorandom + streams. In the general case, users should not maintain their local instances of {{!g}g}. All of the generators in a process have to compete for entropy, and @@ -179,7 +195,7 @@ module Fortuna : Generator module Hmac_drbg (H : Mirage_crypto.Hash.S) : Generator val create : ?g:'a -> ?seed:Cstruct.t -> ?strict:bool -> - ?time:(unit -> int64) -> (module Generator with type g = 'a) -> g + ?time:(unit -> int64) -> 'a generator -> g (** [create ~g ~seed ~strict ~time module] uses a module conforming to the {{!Generator}Generator} signature to instantiate the generic generator {{!g}g}. @@ -204,6 +220,13 @@ val set_default_generator : g -> unit (** [set_default_generator g] sets the default generator to [g]. This function must be called once. *) +(**/**) +(* This function is only used by eio to set the default generator to None when + the entropy harvesting tasks are finished. *) +val unset_default_generator : unit -> unit +(** [unset_default_generator ()] sets the default generator to [None]. *) +(**/**) + val generate : ?g:g -> int -> Cstruct.t (** Invoke {{!Generator.generate}generate} on [g] or {{!generator}default generator}. *) diff --git a/duniverse/mirage-crypto/rng/rng.ml b/duniverse/mirage-crypto/rng/rng.ml index 9b67994b1..12a46f63e 100644 --- a/duniverse/mirage-crypto/rng/rng.ml +++ b/duniverse/mirage-crypto/rng/rng.ml @@ -14,11 +14,14 @@ let setup_rng = `let main = Mirage.foreign \"Unikernel.Main\" (random @-> job)`, \ and `let () = register \"my_unikernel\" [main $ default_random]`. \ \n If you are using Lwt, execute \ - `Mirage_crypto_rng_lwt.initialize ()` at the beginning of \ - your event loop (`Lwt_main.run`) execution. \ - \n If you're using neither MirageOS nor lwt, there is no periodic \ - reseeding. For an initial seed from getrandom(), execute \ - `Mirage_crypto_rng_unix.initialize ()`. You can use \ + `Mirage_crypto_rng_lwt.initialize ()` at startup. \ + \n If you are using Async, execute \ + `Mirage_crypto_eng_async.initialize (module Mirage_crypto_rng.Fortuna)` \ + at startup. \ + \n If you are using Eio, execute in one of the fibers \ + `Mirage_crypto_rng_eio.run (module Fortuna) env` (`env` from `Eio_main.run`). + \n Otherwise, there is no periodic reseeding. For an initial seed from \ + getrandom(), execute `Mirage_crypto_rng_unix.initialize ()`. You can use \ `Mirage_crypto_rng.accumulate` and `Mirage_crypto_rng.reseed` to \ reseed the RNG manually." @@ -53,6 +56,8 @@ let _default_generator = ref None let set_default_generator g = _default_generator := Some g +let unset_default_generator () = _default_generator := None + let default_generator () = match !_default_generator with | None -> raise No_default_generator diff --git a/duniverse/mirage-crypto/tests/dune b/duniverse/mirage-crypto/tests/dune index b053eae51..aa838ea2e 100644 --- a/duniverse/mirage-crypto/tests/dune +++ b/duniverse/mirage-crypto/tests/dune @@ -69,3 +69,9 @@ (libraries alcotest mirage-crypto-ec wycheproof asn1-combinators mirage-crypto-pk mirage-crypto) (package mirage-crypto-ec)) + +(tests + (names test_eio_rng test_eio_entropy_collection) + (modules test_eio_rng test_eio_entropy_collection) + (libraries mirage-crypto-rng-eio duration eio_main) + (package mirage-crypto-rng-eio)) diff --git a/duniverse/mirage-crypto/tests/test_eio_entropy_collection.ml b/duniverse/mirage-crypto/tests/test_eio_entropy_collection.ml new file mode 100644 index 000000000..1b7822e59 --- /dev/null +++ b/duniverse/mirage-crypto/tests/test_eio_entropy_collection.ml @@ -0,0 +1,36 @@ +module Printing_rng = struct + type g = unit + + let block = 16 + let create ?time:_ () = () + let generate ~g:_ _n = assert false + let seeded ~g:_ = true + let pools = 1 + + let reseed ~g:_ data = + Format.printf "reseeding: %a@.%!" Cstruct.hexdump_pp data + + let accumulate ~g:_ source = + let print data = + Format.printf "accumulate: (src: %a) %a@.%!" + Mirage_crypto_rng.Entropy.pp_source source Cstruct.hexdump_pp data + in + `Acc print +end + +let () = + Eio_main.run @@ fun env -> + Mirage_crypto_rng_eio.run (module Printing_rng) env @@ fun () -> + Eio.Fiber.both + begin fun () -> + let sleep = Duration.(of_sec 2 |> to_f) in + Eio.Time.sleep env#clock sleep + end + begin fun () -> + Format.printf "entropy sources: %a@,%!" + (fun ppf -> List.iter (fun x -> + Mirage_crypto_rng.Entropy.pp_source ppf x; + Format.pp_print_space ppf ())) + (Mirage_crypto_rng.Entropy.sources ()) + end + diff --git a/duniverse/mirage-crypto/tests/test_eio_rng.ml b/duniverse/mirage-crypto/tests/test_eio_rng.ml new file mode 100644 index 000000000..12ae89cdb --- /dev/null +++ b/duniverse/mirage-crypto/tests/test_eio_rng.ml @@ -0,0 +1,11 @@ +open Mirage_crypto_rng + +let () = + Eio_main.run @@ fun env -> + Mirage_crypto_rng_eio.run (module Fortuna) env @@ fun () -> + let random_num = Mirage_crypto_rng.generate 32 in + assert (Cstruct.length random_num = 32); + Printf.printf "32 bit random number: %S\n%!" (Cstruct.to_string random_num); + let random_num = Mirage_crypto_rng.generate 16 in + assert (Cstruct.length random_num = 16); + Printf.printf "16 bit random number: %S\n%!" (Cstruct.to_string random_num); diff --git a/duniverse/mtime/B0.ml b/duniverse/mtime/B0.ml index 1ddd0d642..1c26b596e 100644 --- a/duniverse/mtime/B0.ml +++ b/duniverse/mtime/B0.ml @@ -1,5 +1,4 @@ open B0_kit.V000 -open B00_std open Result.Syntax (* OCaml library names *) diff --git a/duniverse/mtime/CHANGES.md b/duniverse/mtime/CHANGES.md index 4eff925d9..0931c2934 100644 --- a/duniverse/mtime/CHANGES.md +++ b/duniverse/mtime/CHANGES.md @@ -1,3 +1,25 @@ +v2.0.0 2022-12-02 Zagreb +------------------------ + +* Use the new `js_of_ocaml` ocamlfind `META` standard to link JavaScript + stubs (#28). +* `Mtime_clock` use `CLOCK_BOOTTIME` rather than `CLOCK_MONOTONIC` + on Linux and `mach_continuous_time` rather than `mach_absolute_time` + on macOS. This means that on these platforms sleep time is taken + into account (#10). Thanks to Bikal Lem for the patch. +* Add `Mtime.{to,of}_float_ns`. +* Remove deprecated values `Mtime.s_to_*` and `Mtime.Span.to_*` floating + points functions. Note that the implementation of `Mtime.Span.to_*` + functions was broken if your span exceeded `Int64.max_int`. Thanks + to Thomas Leonard for the report (#46). +* Change implementation of `Mtime.Span.pp` and remove + `Mtime.Span.pp_float_s`. The implementation no longer uses floating + point arithmetic and always over approximates the result, no + duration is printed shorter than it is. The output is no longer + US-ASCII but UTF-8 encoded since U+03BC is used for µs. +* Stop installing the clock interface in `mtime.clock`, this package + is now empty (#42). + v1.4.0 2022-02-17 La Forclaz (VS) --------------------------------- diff --git a/duniverse/mtime/README.md b/duniverse/mtime/README.md index 802161bd6..21bfe3e11 100644 --- a/duniverse/mtime/README.md +++ b/duniverse/mtime/README.md @@ -1,6 +1,6 @@ Mtime — Monotonic wall-clock time for OCaml =========================================== -v1.4.0+dune2 +2.0.0+dune Mtime has platform independent support for monotonic wall-clock time in pure OCaml. This time increases monotonically and is not subject to @@ -14,7 +14,7 @@ Mtime has a no dependency. Mtime_clock depends on your system library or JavaScript runtime system. Mtime and its libraries are distributed under the ISC license. -Home page: http://erratique.ch/software/mtime +Home page: # Installation @@ -27,13 +27,17 @@ instructions. # Documentation -The documentation and API reference is automatically generated from -the source interfaces. It can be consulted [online][doc] or via -`odig doc mtime`. +The documentation can be consulted [online] or via `odig doc mtime`. -[doc]: http://erratique.ch/software/mtime/doc/ +Questions are welcome but better asked on the [OCaml forum] than on +the issue tracker. + +[online]: http://erratique.ch/software/mtime/doc/ +[OCaml forum]: https://discuss.ocaml.org/ # Sample programs +See [test/min_clock.ml](test/min_clock.ml). + If you installed mtime with `opam` sample programs are located in -the directory `opam config var mtime:doc`. +the directory `opam var mtime:doc`. diff --git a/duniverse/mtime/doc/index.mld b/duniverse/mtime/doc/index.mld index c292b3e7a..5595e5f2c 100644 --- a/duniverse/mtime/doc/index.mld +++ b/duniverse/mtime/doc/index.mld @@ -1,4 +1,4 @@ -{0 Mtime {%html: v1.4.0+dune2%}} +{0 Mtime {%html: 2.0.0+dune%}} Mtime has platform independent support for monotonic wall-clock time. This time increases monotonically and is not subject to operating diff --git a/duniverse/mtime/dune-project b/duniverse/mtime/dune-project index 4d1a3e79b..97b78deec 100644 --- a/duniverse/mtime/dune-project +++ b/duniverse/mtime/dune-project @@ -1,3 +1,3 @@ (lang dune 1.0) (name mtime) -(version v1.4.0+dune2) +(version 2.0.0+dune) diff --git a/duniverse/mtime/mtime.opam b/duniverse/mtime/mtime.opam index 0e801e470..bf64f6712 100644 --- a/duniverse/mtime/mtime.opam +++ b/duniverse/mtime/mtime.opam @@ -1,4 +1,4 @@ -version: "v1.4.0+dune2" +version: "2.0.0+dune" opam-version: "2.0" name: "mtime" synopsis: "Monotonic wall-clock time for OCaml" diff --git a/duniverse/mtime/pkg/META b/duniverse/mtime/pkg/META index 66313979f..fa0bf9197 100644 --- a/duniverse/mtime/pkg/META +++ b/duniverse/mtime/pkg/META @@ -1,5 +1,5 @@ description = "Monotonic wall-clock time for OCaml" -version = "1.4.0+dune2" +version = "2.0.0+dune" requires = "" archive(byte) = "mtime.cma" archive(native) = "mtime.cmxa" @@ -8,7 +8,7 @@ plugin(native) = "mtime.cmxs" package "top" ( description = "Mtime toplevel support" - version = "1.4.0+dune2" + version = "2.0.0+dune" requires = "mtime" directory = "top" archive(byte) = "mtime_top.cma" @@ -19,19 +19,19 @@ package "top" ( package "clock" ( description = "Monotonic time clock interface" - version = "1.4.0+dune2" + version = "2.0.0+dune" requires = "" directory = "clock" package "os" ( description = "Mtime_clock for your platform (including JavaScript)" - version = "1.4.0+dune2" + version = "2.0.0+dune" requires = "mtime" directory = "os" archive(byte) = "mtime_clock.cma" archive(native) = "mtime_clock.cmxa" plugin(byte) = "mtime_clock.cma" plugin(native) = "mtime_clock.cmxs" - linkopts(javascript) = "+mtime.clock.os/runtime.js" + jsoo_runtime = "runtime.js" exists_if = "mtime_clock.cma") ) diff --git a/duniverse/mtime/pkg/pkg.ml b/duniverse/mtime/pkg/pkg.ml index 83715341c..6bd83594f 100755 --- a/duniverse/mtime/pkg/pkg.ml +++ b/duniverse/mtime/pkg/pkg.ml @@ -8,7 +8,6 @@ let () = Ok [ Pkg.mllib "src/mtime.mllib"; Pkg.mllib ~api:[] "src/mtime_top.mllib" ~dst_dir:"top/"; Pkg.lib "src/mtime_top_init.ml"; - Pkg.lib ~exts:Exts.interface "src/mtime_clock" ~dst:"clock/"; Pkg.mllib "src-clock/mtime_clock.mllib" ~dst_dir:"clock/os/"; Pkg.clib "src-clock/libmtime_clock_stubs.clib" ~lib_dst_dir:"clock/os/"; Pkg.lib "src-clock/runtime.js" ~dst:"clock/os/"; diff --git a/duniverse/mtime/src-clock/mtime_clock.mli b/duniverse/mtime/src-clock/mtime_clock.mli index d35b9a04a..853a2856a 100644 --- a/duniverse/mtime/src-clock/mtime_clock.mli +++ b/duniverse/mtime/src-clock/mtime_clock.mli @@ -83,11 +83,15 @@ val period_ns : unit -> int64 option {1:platform_support Platform support} {ul - {- Platforms with a POSIX clock (includes Linux) use + {- Linux uses {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} + with {{:https://www.man7.org/linux/man-pages/man3/clock_settime.3.html} + CLOCK_BOOTTIME}. This means that sleep time is taken into account.} + {- Platforms with a POSIX clock use {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} with CLOCK_MONOTONIC.} {- Darwin uses - {{:https://developer.apple.com/library/mac/qa/qa1398/_index.html}[mach_absolute_time]}.} + {{:https://developer.apple.com/documentation/kernel/1646199-mach_continuous_time}[mach_continous_time]}. + This means that sleep time is taken into account.} {- Windows uses {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. } {- JavaScript uses diff --git a/duniverse/mtime/src-clock/mtime_clock_stubs.c b/duniverse/mtime/src-clock/mtime_clock_stubs.c index 93bdfc1be..280a2bb43 100644 --- a/duniverse/mtime/src-clock/mtime_clock_stubs.c +++ b/duniverse/mtime/src-clock/mtime_clock_stubs.c @@ -22,6 +22,9 @@ #elif defined(__unix__) || defined(__unix) #include + #if defined(__linux__) + #define OCAML_MTIME_LINUX + #endif #if defined(_POSIX_VERSION) #define OCAML_MTIME_POSIX #endif @@ -49,16 +52,16 @@ void ocaml_mtime_clock_init_scale (void) CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) { static uint64_t start = 0L; - if (start == 0L) { start = mach_absolute_time (); } + if (start == 0L) { start = mach_continuous_time (); } if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); } - uint64_t now = mach_absolute_time (); + uint64_t now = mach_continuous_time (); return caml_copy_int64 (((now - start) * scale.numer) / scale.denom); } CAMLprim value ocaml_mtime_clock_now_ns (value unit) { if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); } - uint64_t now = mach_absolute_time (); + uint64_t now = mach_continuous_time (); return caml_copy_int64 ((now * scale.numer) / scale.denom); } @@ -75,14 +78,21 @@ CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit) { static struct timespec start = {0}; struct timespec now; + clockid_t clockid; + +#if defined(OCAML_MTIME_LINUX) + clockid = CLOCK_BOOTTIME; +#else + clockid = CLOCK_MONOTONIC; +#endif if (start.tv_sec == 0) { - if (clock_gettime (CLOCK_MONOTONIC, &start)) + if (clock_gettime (clockid, &start)) OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); } - if (clock_gettime (CLOCK_MONOTONIC, &now)) + if (clock_gettime (clockid, &now)) OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed"); return caml_copy_int64 ((uint64_t)(now.tv_sec - start.tv_sec) * diff --git a/duniverse/mtime/src/mtime.ml b/duniverse/mtime/src/mtime.ml index f793d8ffb..dfd270bf4 100644 --- a/duniverse/mtime/src/mtime.ml +++ b/duniverse/mtime/src/mtime.ml @@ -3,24 +3,6 @@ Distributed under the ISC license, see terms at the end of the file. ---------------------------------------------------------------------------*) -(* Time scale conversion *) - -let ns_to_s = 1e-9 -let us_to_s = 1e-6 -let ms_to_s = 1e-3 -let min_to_s = 60. -let hour_to_s = 3600. -let day_to_s = 86_400. -let year_to_s = 31_557_600. - -let s_to_ns = 1e9 -let s_to_us = 1e6 -let s_to_ms = 1e3 -let s_to_min = 1. /. min_to_s -let s_to_hour = 1. /. hour_to_s -let s_to_day = 1. /. day_to_s -let s_to_year = 1. /. year_to_s - (* Time spans Time spans are in nanoseconds and we represent them by an unsigned @@ -64,84 +46,95 @@ module Span = struct let to_uint64_ns s = s let of_uint64_ns ns = ns + let max_float_int = 9007199254740992. (* 2^53. *) + let int64_min_int_float = Int64.to_float Int64.min_int + let int64_max_int_float = Int64.to_float Int64.max_int + + let of_float_ns sf = + if sf < 0. || sf >= max_float_int || not (Float.is_finite sf) + then None else Some (Int64.of_float sf) + + let to_float_ns s = + if Int64.compare 0L s <= 0 then Int64.to_float s else + int64_max_int_float +. (-. int64_min_int_float +. Int64.to_float s) + let unsafe_of_uint64_ns_option nsopt = nsopt - let to_ns s = (Int64.to_float s) - let to_us s = (Int64.to_float s) *. 1e-3 - let to_ms s = (Int64.to_float s) *. 1e-6 - let to_s s = (Int64.to_float s) *. 1e-9 - - let ns_to_min = ns_to_s *. s_to_min - let to_min s = (Int64.to_float s) *. ns_to_min - - let ns_to_hour = ns_to_s *. s_to_hour - let to_hour s = (Int64.to_float s) *. ns_to_hour - - let ns_to_day = ns_to_s *. s_to_day - let to_day s = (Int64.to_float s) *. ns_to_day - - let ns_to_year = ns_to_s *. s_to_year - let to_year s = (Int64.to_float s) *. ns_to_year - - (* Formatting - - Maybe one day we could replace this by B00_std.Fmt.uint64_ns_span - which does all the arithmetic on uint64. *) - - let round x = floor (x +. 0.5) - let round_dfrac d x = (* rounds [x] to the [d]th decimal digit *) - if x -. (round x) = 0. then x else (* x is an integer. *) - let m = 10. ** (float d) in (* m moves 10^-d to 1. *) - (floor ((x *. m) +. 0.5)) /. m - - let pp_float_s ppf span = - let m = abs_float span in - if m < ms_to_s then - (* m < 1ms, if < 100us, print us with 3 frac digit w.o. trailing zeros - if >= 100us, print us without frac digit *) - let us = span /. us_to_s in - let us = if abs_float us < 100. then round_dfrac 3 us else round us in - if abs_float us >= 1000. then Format.fprintf ppf "%gms" (copysign 1. us) - else Format.fprintf ppf "%gus" us - else if m < 1. then - (* m < 1s, if < 100ms, print ms with 3 frac digit w.o. trailing zeros - if >= 100ms, print ms without frac digit *) - let ms = span /. ms_to_s in - let ms = if abs_float ms < 100. then round_dfrac 3 ms else round ms in - if abs_float ms >= 1000. then Format.fprintf ppf "%gs" (copysign 1. ms) - else Format.fprintf ppf "%gms" ms - else if m < min_to_s then - (* m < 1min, print [s] with 3 frac digit w.o. trailing zeros *) - let s = round_dfrac 3 span in - if abs_float s >= 60. then Format.fprintf ppf "%gmin" (copysign 1. s) - else Format.fprintf ppf "%gs" s - else - (* m >= 1min - From here on we show the two (or one if the second is zero) largest - significant units and no longer care about rounding the lowest unit, - we just truncate. *) - if m < hour_to_s then - let m, rem = truncate (span /. min_to_s), mod_float span min_to_s in - let s = truncate rem in - if s = 0 then Format.fprintf ppf "%dmin" m else - Format.fprintf ppf "%dmin%ds" m (abs s) - else if m < day_to_s then - let h, rem = truncate (span /. hour_to_s), mod_float span hour_to_s in - let m = truncate (rem /. min_to_s) in - if m = 0 then Format.fprintf ppf "%dh" h else - Format.fprintf ppf "%dh%dmin" h (abs m) - else if m < year_to_s then - let d, rem = truncate (span /. day_to_s), mod_float span day_to_s in - let h = truncate (rem /. hour_to_s) in - if h = 0 then Format.fprintf ppf "%dd" d else - Format.fprintf ppf "%dd%dh" d (abs h) - else - let y, rem = truncate (span /. year_to_s), mod_float span year_to_s in - let d = truncate (rem /. day_to_s) in - if d = 0 then Format.fprintf ppf "%da" y else - Format.fprintf ppf "%da%dd" y (abs d) - - let pp ppf s = pp_float_s ppf (to_s s) + (* Formatting *) + + let pf = Format.fprintf + + let rec pp_si_span unit_str unit_str_len si_unit si_higher_unit ppf span = + let geq x y = Int64.unsigned_compare x y >= 0 in + let m = Int64.unsigned_div span si_unit in + let n = Int64.unsigned_rem span si_unit in + let pp_unit ppf () = Format.pp_print_as ppf unit_str_len unit_str in + match m with + | m when geq m 100L -> (* No fractional digit *) + let m_up = if Int64.equal n 0L then m else Int64.succ m in + let span' = Int64.mul m_up si_unit in + if geq span' si_higher_unit then pp ppf span' else + (pf ppf "%Ld" m_up; pp_unit ppf ()) + | m when geq m 10L -> (* One fractional digit w.o. trailing zero *) + let f_factor = Int64.unsigned_div si_unit 10L in + let f_m = Int64.unsigned_div n f_factor in + let f_n = Int64.unsigned_rem n f_factor in + let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in + begin match f_m_up with + | 0L -> pf ppf "%Ld" m; pp_unit ppf () + | f when geq f 10L -> + pp ppf Int64.(add (mul m si_unit) (mul f f_factor)) + | f -> pf ppf "%Ld.%Ld" m f; pp_unit ppf () + end + | m -> (* Two or zero fractional digits w.o. trailing zero *) + let f_factor = Int64.unsigned_div si_unit 100L in + let f_m = Int64.unsigned_div n f_factor in + let f_n = Int64.unsigned_rem n f_factor in + let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in + match f_m_up with + | 0L -> pf ppf "%Ld" m; pp_unit ppf () + | f when geq f 100L -> + pp ppf Int64.(add (mul m si_unit) (mul f f_factor)) + | f when Int64.equal (Int64.rem f 10L) 0L -> + pf ppf "%Ld.%Ld" m (Int64.div f 10L); pp_unit ppf () + | f -> + pf ppf "%Ld.%02Ld" m f; pp_unit ppf () + + and pp_non_si unit_str unit unit_lo_str unit_lo unit_lo_size ppf span = + let geq x y = Int64.unsigned_compare x y >= 0 in + let m = Int64.unsigned_div span unit in + let n = Int64.unsigned_rem span unit in + if Int64.equal n 0L then pf ppf "%Ld%s" m unit_str else + let f_m = Int64.unsigned_div n unit_lo in + let f_n = Int64.unsigned_rem n unit_lo in + let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in + match f_m_up with + | f when geq f unit_lo_size -> + pp ppf Int64.(add (mul m unit) (mul f unit_lo)) + | f -> + pf ppf "%Ld%s%Ld%s" m unit_str f unit_lo_str + + and pp ppf span = + let geq x y = Int64.unsigned_compare x y >= 0 in + let lt x y = Int64.unsigned_compare x y = -1 in + match span with + | sp when lt sp us -> pf ppf "%Ldns" sp + | sp when lt sp ms -> pp_si_span "\xCE\xBCs" 2 us ms ppf sp + | sp when lt sp s -> pp_si_span "ms" 2 ms s ppf sp + | sp when lt sp min -> pp_si_span "s" 1 s min ppf sp + | sp when lt sp hour -> pp_non_si "min" min "s" s 60L ppf sp + | sp when lt sp day -> pp_non_si "h" hour "min" min 60L ppf sp + | sp when lt sp year -> pp_non_si "d" day "h" hour 24L ppf sp | sp -> + let m = Int64.unsigned_div sp year in + let n = Int64.unsigned_rem sp year in + if Int64.equal n 0L then pf ppf "%Lda" m else + let f_m = Int64.unsigned_div n day in + let f_n = Int64.unsigned_rem n day in + let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in + match f_m_up with + | f when geq f 366L -> pf ppf "%Lda" (Int64.succ m) + | f -> pf ppf "%Lda%Ldd" m f + let dump ppf s = Format.fprintf ppf "%Lu" s end diff --git a/duniverse/mtime/src/mtime.mli b/duniverse/mtime/src/mtime.mli index 6d8d9ca97..542ec0da2 100644 --- a/duniverse/mtime/src/mtime.mli +++ b/duniverse/mtime/src/mtime.mli @@ -75,25 +75,32 @@ module Span : sig positive. *) val ns : span - (** [ns] is a nanosecond duration, 1·10{^-9}s. *) + (** [ns] is a nanosecond duration, 1·10{^-9}s. + @since 1.4.0 *) val us : span - (** [us] is a microsecond duration, 1·10{^-6}s. *) + (** [us] is a microsecond duration, 1·10{^-6}s. + @since 1.4.0 *) val ms : span - (** [ms] is a millisecond duration, 1·10{^-3}s. *) + (** [ms] is a millisecond duration, 1·10{^-3}s. + @since 1.4.0 *) val s : span - (** [s] is a second duration, 1s. *) + (** [s] is a second duration, 1s. + @since 1.4.0 *) val min : span - (** [min] is a minute duration, 60s. *) + (** [min] is a minute duration, 60s. + @since 1.4.0 *) val hour : span - (** [hour] is an hour duration, 3600s. *) + (** [hour] is an hour duration, 3600s. + @since 1.4.0 *) val day : span - (** [day] is a day duration, 86'400s. *) + (** [day] is a day duration, 86'400s. + @since 1.4.0 *) val year : span (** [year] is a Julian year duration (365.25 days), 31'557'600s. *) @@ -108,41 +115,34 @@ module Span : sig (** [of_uint64_ns u] is the {e unsigned} 64-bit integer nanosecond span [u] as a span. *) - val to_ns : span -> float - (** [to_ns span] is [span] in nanoseconds (1e-9s). *) + val of_float_ns : float -> span option + (** [of_float_ns f] is the positive floating point nanosecond span [f] as + a span. This is [None] if [f] is negative, non finite, or + larger or equal than 2{^53} (~104 days, the largest exact floating point + integer). + @since 2.0.0 *) - val to_us : span -> float - (** [to_us span] is [span] in microseconds (1e-6s). *) - - val to_ms : span -> float - (** [to_ms span] is [span] in milliseconds (1e-3s). *) - - val to_s : span -> float - (** [to_s span] is [span] in seconds. *) - - val to_min : span -> float - (** [to_min span] is [span] in SI-accepted minutes (60s). *) - - val to_hour : span -> float - (** [to_hour span] is [span] in SI-accepted hours (3600s). *) - - val to_day : span -> float - (** [to_day span] is [span] in SI-accepted days (24 hours, 86400s). *) - - val to_year : span -> float - (** [to_year span] is [span] in Julian years (365.25 days, 31'557'600s). *) + val to_float_ns : span -> float + (** [to_float_ns s] is [span] as a nanosecond floating point span. + Note that if [s] is larger than 2{^53} (~104 days, the largest + exact floating point integer) the result is an approximation and + will not round trip with {!of_float_ns}. + @since 2.0.0 *) (** {1:fmt Formatters} *) val pp : Format.formatter -> span -> unit - (** [pp_span ppf span] formats an unspecified representation of - [span] on [ppf]. The representation is not fixed-width, - depends on the magnitude of [span] and uses locale - independent {{!convert}standard time scale} abbreviations. *) + (** [pp] formats spans according to their magnitude using SI + prefixes on seconds and accepted non-SI units. Years are counted + in Julian years (365.25 SI-accepted days) as + {{:http://www.iau.org/publications/proceedings_rules/units/}defined} + by the International Astronomical Union. - val pp_float_s : Format.formatter -> float -> unit - (** [pp_float_s] formats like {!pp} does but on a floating - point seconds time span value (which can be negative). *) + Rounds towards positive infinity, i.e. over approximates, no + duration is formatted shorter than it is. + + The output is UTF-8 encoded, it uses U+03BC for [µs] + (10{^-6}[s]). *) val dump : Format.formatter -> t -> unit (** [dump ppf span] formats an unspecified raw representation of [span] @@ -213,7 +213,7 @@ val sub_span : t -> span -> t option (** {2:fmt Formatting} *) val pp : Format.formatter -> t -> unit -(** [pp ppf t] formats [t] as an {e unsigned} 64-bit integer +(** [pp] formats [t] as an {e unsigned} 64-bit integer nanosecond timestamp. Note that the absolute value is meaningless. *) @@ -221,94 +221,6 @@ val dump : Format.formatter -> t -> unit (** [dump ppf t] formats an unspecified raw representation of [t] on [ppf]. *) -(** {1:timescale Time scale conversion (deprecated)} - - The following convenience constants relate time scales to seconds. - Used as multiplicands they can be used to convert these units - to and from seconds. - - The constants are defined according to - {{:http://www.bipm.org/en/publications/si-brochure/chapter3.html}SI - prefixes} on seconds and - {{:http://www.bipm.org/en/publications/si-brochure/table6.html}accepted - non-SI units}. Years are counted in Julian years (365.25 SI-accepted days) - as {{:http://www.iau.org/publications/proceedings_rules/units/}defined} - by the International Astronomical Union (IAU). *) - -val ns_to_s : float -[@@ocaml.deprecated "Use 1e-9 instead."] -(** [ns_to_s] is [1e-9] the number of seconds in one nanosecond. - @deprecated *) - -val us_to_s : float -[@@ocaml.deprecated "Use 1e-6 instead."] -(** [us_to_s] is [1e-6], the number of seconds in one microsecond. - @deprecated *) - -val ms_to_s : float -[@@ocaml.deprecated "Use 1e-3 instead."] -(** [ms_to_s] is [1e-3], the number of seconds in one millisecond. - @deprecated *) - -val min_to_s : float -[@@ocaml.deprecated "Use 60. instead."] -(** [min_to_s] is [60.], the number of seconds in one SI-accepted minute. - @deprecated *) - -val hour_to_s : float -[@@ocaml.deprecated "Use 3600. instead."] -(** [hour_to_s] is [3600.], the number of seconds in one SI-accepted hour. - @deprecated *) - -val day_to_s : float -[@@ocaml.deprecated "Use 86_400. instead."] -(** [day_to_s] is [86_400.], the number of seconds in one SI-accepted day. - @deprecated *) - -val year_to_s : float -[@@ocaml.deprecated "Use 31_557_600. instead."] -(** [year_to_s] is [31_557_600.], the number of seconds in a Julian year. - @deprecated *) - -val s_to_ns : float -[@@ocaml.deprecated "Use 1e9 instead."] -(** [s_to_ns] is [1e9] the number of nanoseconds in one second. - @deprecated *) - -val s_to_us : float -[@@ocaml.deprecated "Use 1e6 instead."] -(** [s_to_us] is [1e6], the number of microseconds in one second. - @deprecated *) - -val s_to_ms : float -[@@ocaml.deprecated "Use 1e3 instead."] -(** [s_to_ms] is [1e3], the number of milliseconds in one second. - @deprecated *) - -val s_to_min : float -[@@ocaml.deprecated "Use (1. /. 60.) instead."] -(** [s_to_min] is [1. /. 60.], the number of SI-accepted minutes in - one second. - @deprecated *) - -val s_to_hour : float -[@@ocaml.deprecated "Use (1. /. 3600.) instead."] -(** [s_to_hour] is [1. /. 3600.], the number of SI-accepted hours in - one second. - @deprecated *) - -val s_to_day : float -[@@ocaml.deprecated "Use (1. /. 86400.) instead."] -(** [s_to_day] is [1. /. 86400.], the number of SI-accepted days in - one second. - @deprecated *) - -val s_to_year : float -[@@ocaml.deprecated "Use (1. /. 31_557_600.) instead."] -(** [s_to_year] is [1. /. 31_557_600.], the number of Julian years - in one second. - @deprecated *) - (*--------------------------------------------------------------------------- Copyright (c) 2015 The mtime programmers diff --git a/duniverse/mtime/src/mtime_clock.mli b/duniverse/mtime/src/mtime_clock.mli index d35b9a04a..853a2856a 100644 --- a/duniverse/mtime/src/mtime_clock.mli +++ b/duniverse/mtime/src/mtime_clock.mli @@ -83,11 +83,15 @@ val period_ns : unit -> int64 option {1:platform_support Platform support} {ul - {- Platforms with a POSIX clock (includes Linux) use + {- Linux uses {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} + with {{:https://www.man7.org/linux/man-pages/man3/clock_settime.3.html} + CLOCK_BOOTTIME}. This means that sleep time is taken into account.} + {- Platforms with a POSIX clock use {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]} with CLOCK_MONOTONIC.} {- Darwin uses - {{:https://developer.apple.com/library/mac/qa/qa1398/_index.html}[mach_absolute_time]}.} + {{:https://developer.apple.com/documentation/kernel/1646199-mach_continuous_time}[mach_continous_time]}. + This means that sleep time is taken into account.} {- Windows uses {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. } {- JavaScript uses diff --git a/duniverse/mtime/test/min_clock.ml b/duniverse/mtime/test/min_clock.ml index 02c0db870..49c56b5de 100644 --- a/duniverse/mtime/test/min_clock.ml +++ b/duniverse/mtime/test/min_clock.ml @@ -8,7 +8,7 @@ -package mtime.clock.os -linkpkg -o min_clock.byte min_clock.ml js_of_ocaml \ - $(ocamlfind query mtime.clock.os -predicates javascript -o-format) \ + $(ocamlfind query -format "%+(jsoo_runtime)" -r mtime.clock.os) \ min_clock.byte *) diff --git a/duniverse/mtime/test/tests.ml b/duniverse/mtime/test/tests.ml index 6ea25008f..8d74ff96f 100644 --- a/duniverse/mtime/test/tests.ml +++ b/duniverse/mtime/test/tests.ml @@ -23,150 +23,225 @@ let log_result () = log "[FAIL] %d failure(s) out of %d" !fail !count; () -[@@@alert "-deprecated"] -let test_secs_in () = - log "Testing Mtime.{s_to_*,*_to_s}"; - let equalf f f' = abs_float (f -. f') < 1e-9 in - - assert (Mtime.ns_to_s = 1e-9); - assert (Mtime.us_to_s = 1e-6); - assert (Mtime.ms_to_s = 1e-3); - assert (Mtime.min_to_s = 60.); - assert (Mtime.hour_to_s = (60. *. 60.)); - assert (Mtime.day_to_s = (24. *. 60. *. 60.)); - assert (Mtime.year_to_s = (365.25 *. 24. *. 60. *. 60.)); - assert (equalf (Mtime.s_to_ns *. 1e-9) 1.); - assert (equalf (Mtime.s_to_us *. 1e-6) 1.); - assert (equalf (Mtime.s_to_ms *. 1e-3) 1.); - assert (equalf (Mtime.s_to_min *. 60.) 1.); - assert (equalf (Mtime.s_to_hour *. (60. *. 60.)) 1.); - assert (equalf (Mtime.s_to_day *. (24. *. 60. *. 60.)) 1.); - assert (equalf (Mtime.s_to_year *. (365.25 *. 24. *. 60. *. 60.)) 1.); - () -[@@@alert "+deprecated"] - -let test_pp_span_s () = - (* N.B. this test may fail as it may be sensitive to black art of - floating point formatting. Also note that ties on negative - numbers round towards positive infinity, i.e. -0.5 rounds to 0. *) - log "Testing Mtime.pp_span_s"; - let pp s = Format.asprintf "%a" Mtime.Span.pp_float_s s in +let test_pp_span () = + log "Testing Mtime.pp_span"; + (* The floating point stuff here comes from the previous incarnations + of the formatter. Let's keep that it exercices a bit the of_float_ns. *) + let pp s = + let s = Option.get (Mtime.Span.of_float_ns (s *. 1e+9)) in + Format.asprintf "%a" Mtime.Span.pp s + in let eq_str s s' = if s <> s' then failwith (Printf.sprintf "%S <> %S" s s') in (* sub ns scale *) - eq_str (pp 1.0e-10) "0us"; - eq_str (pp ~-.1.0e-10) "0us"; - eq_str (pp 4.0e-10) "0us"; - eq_str (pp ~-.4.0e-10) "0us"; - eq_str (pp 6.0e-10) "0.001us"; - eq_str (pp ~-.6.0e-10) "-0.001us"; - eq_str (pp 9.0e-10) "0.001us"; - eq_str (pp ~-.9.0e-10) "-0.001us"; + eq_str (pp 1.0e-10) "0ns"; + eq_str (pp 4.0e-10) "0ns"; + eq_str (pp 6.0e-10) "0ns"; + eq_str (pp 9.0e-10) "0ns"; (* ns scale *) - eq_str (pp 2.0e-9) "0.002us"; - eq_str (pp ~-.2.0e-9) "-0.002us"; - eq_str (pp 2.136767676e-9) "0.002us"; - eq_str (pp ~-.2.136767676e-9) "-0.002us"; - eq_str (pp 2.6e-9) "0.003us"; - eq_str (pp ~-.2.6e-9) "-0.003us"; - eq_str (pp 2.836767676e-9) "0.003us"; - eq_str (pp ~-.2.836767676e-9) "-0.003us"; + eq_str (pp 2.0e-9) "2ns"; + eq_str (pp 2.136767676e-9) "2ns"; + eq_str (pp 2.6e-9) "2ns"; + eq_str (pp 2.836767676e-9) "2ns"; (* us scale *) - eq_str (pp 2.0e-6) "2us"; - eq_str (pp ~-.2.0e-6) "-2us"; - eq_str (pp 2.555e-6) "2.555us"; - eq_str (pp ~-.2.555e-6) "-2.555us"; - eq_str (pp 2.5556e-6) "2.556us"; - eq_str (pp ~-.2.5556e-6) "-2.556us"; - eq_str (pp 99.9994e-6) "99.999us"; - eq_str (pp ~-.99.9994e-6) "-99.999us"; - eq_str (pp 99.9996e-6) "100us"; - eq_str (pp ~-.99.9996e-6) "-100us"; - eq_str (pp 100.1555e-6) "100us"; - eq_str (pp ~-.100.1555e-6) "-100us"; - eq_str (pp 100.5555e-6) "101us"; - eq_str (pp ~-.100.5555e-6) "-101us"; - eq_str (pp 100.6555e-6) "101us"; - eq_str (pp ~-.100.6555e-6) "-101us"; - eq_str (pp 999.4e-6) "999us"; - eq_str (pp ~-.999.4e-6) "-999us"; + eq_str (pp 2.0e-6) "2μs"; + eq_str (pp 2.555e-6) "2.56μs"; + eq_str (pp 2.5556e-6) "2.56μs"; + eq_str (pp 99.9994e-6) "100μs"; + eq_str (pp 99.9996e-6) "100μs"; + eq_str (pp 100.1555e-6) "101μs"; + eq_str (pp 100.5555e-6) "101μs"; + eq_str (pp 100.6555e-6) "101μs"; + eq_str (pp 999.4e-6) "1ms"; eq_str (pp 999.6e-6) "1ms"; - eq_str (pp ~-.999.6e-6) "-1ms"; (* ms scale *) eq_str (pp 1e-3) "1ms"; - eq_str (pp ~-.1e-3) "-1ms"; - eq_str (pp 1.555e-3) "1.555ms"; - eq_str (pp ~-.1.555e-3) "-1.555ms"; - eq_str (pp 1.5556e-3) "1.556ms"; - eq_str (pp ~-.1.5556e-3) "-1.556ms"; - eq_str (pp 99.9994e-3) "99.999ms"; - eq_str (pp ~-.99.9994e-3) "-99.999ms"; + eq_str (pp 1.555e-3) "1.56ms"; + eq_str (pp 1.5556e-3) "1.56ms"; + eq_str (pp 99.9994e-3) "100ms"; eq_str (pp 99.9996e-3) "100ms"; - eq_str (pp ~-.99.9996e-3) "-100ms"; - eq_str (pp 100.1555e-3) "100ms"; - eq_str (pp ~-.100.1555e-3) "-100ms"; + eq_str (pp 100.1555e-3) "101ms"; eq_str (pp 100.5555e-3) "101ms"; - eq_str (pp ~-.100.5555e-3) "-101ms"; eq_str (pp 100.6555e-3) "101ms"; - eq_str (pp ~-.100.6555e-3) "-101ms"; - eq_str (pp 999.4e-3) "999ms"; - eq_str (pp ~-.999.4e-3) "-999ms"; + eq_str (pp 999.4e-3) "1s"; eq_str (pp 999.6e-3) "1s"; - eq_str (pp ~-.999.6e-3) "-1s"; (* s scale *) eq_str (pp 1.) "1s"; - eq_str (pp ~-.1.) "-1s"; - eq_str (pp 1.555) "1.555s"; - eq_str (pp ~-.1.555) "-1.555s"; - eq_str (pp 1.5554) "1.555s"; - eq_str (pp ~-.1.5554) "-1.555s"; - eq_str (pp 1.5556) "1.556s"; - eq_str (pp ~-.1.5556) "-1.556s"; + eq_str (pp 1.555) "1.56s"; + eq_str (pp 1.5554) "1.56s"; + eq_str (pp 1.5556) "1.56s"; eq_str (pp 59.) "59s"; - eq_str (pp ~-.59.) "-59s"; - eq_str (pp 59.9994) "59.999s"; - eq_str (pp ~-.59.9994) "-59.999s"; + eq_str (pp 59.9994) "1min"; eq_str (pp 59.9996) "1min"; - eq_str (pp ~-.59.9996) "-1min"; (* min scale *) eq_str (pp 60.) "1min"; - eq_str (pp ~-.60.) "-1min"; eq_str (pp 62.) "1min2s"; - eq_str (pp ~-.62.) "-1min2s"; - eq_str (pp 62.4) "1min2s"; - eq_str (pp ~-.62.4) "-1min2s"; + eq_str (pp 62.4) "1min3s"; eq_str (pp 3599.) "59min59s"; - eq_str (pp ~-.3599.) "-59min59s"; (* hour scale *) eq_str (pp 3600.0) "1h"; - eq_str (pp ~-.3600.0) "-1h"; - eq_str (pp 3629.0) "1h"; - eq_str (pp ~-.3629.0) "-1h"; + eq_str (pp 3629.0) "1h1min"; eq_str (pp 3660.0) "1h1min"; - eq_str (pp ~-.3660.0) "-1h1min"; - eq_str (pp 7164.0) "1h59min"; - eq_str (pp ~-.7164.0) "-1h59min"; + eq_str (pp 7164.0) "2h"; eq_str (pp 7200.0) "2h"; - eq_str (pp ~-.7200.0) "-2h"; - eq_str (pp 86399.) "23h59min"; - eq_str (pp ~-.86399.) "-23h59min"; + eq_str (pp 86399.) "1d"; (* day scale *) eq_str (pp 86400.) "1d"; - eq_str (pp ~-.86400.) "-1d"; eq_str (pp (86400. +. (23. *. 3600.))) "1d23h"; - eq_str (pp ~-.(86400. +. (23. *. 3600.))) "-1d23h"; eq_str (pp (86400. +. (24. *. 3600.))) "2d"; - eq_str (pp ~-.(86400. +. (24. *. 3600.))) "-2d"; - eq_str (pp (365.25 *. 86_400. -. 1.)) "365d5h"; - eq_str (pp ~-.(365.25 *. 86_400. -. 1.)) "-365d5h"; - (* year scale *) - eq_str (pp (31557600.)) "1a"; - eq_str (pp ~-.(365.25 *. 86_400.)) "-1a"; - eq_str (pp (365.25 *. 86_400. +. 86400.)) "1a1d"; - eq_str (pp ~-.(365.25 *. 86_400. +. 86400.)) "-1a1d"; - eq_str (pp (365.25 *. 2. *. 86_400.)) "2a"; - eq_str (pp ~-.(365.25 *. 2. *. 86_400.)) "-2a"; - eq_str (pp (365.25 *. 2. *. 86_400. -. 1.)) "1a365d"; - eq_str (pp ~-.(365.25 *. 2. *. 86_400. -. 1.)) "-1a365d"; + (* These tests come from the b0 test suite *); + let span s = + Format.asprintf "%a" + Mtime.Span.pp (Mtime.Span.of_uint64_ns (Int64.of_string s)); + in + assert (span "0u0" = "0ns"); + assert (span "0u999" = "999ns"); + assert (span "0u1_000" = "1μs"); + assert (span "0u1_001" = "1.01μs"); + assert (span "0u1_009" = "1.01μs"); + assert (span "0u1_010" = "1.01μs"); + assert (span "0u1_011" = "1.02μs"); + assert (span "0u1_090" = "1.09μs"); + assert (span "0u1_091" = "1.1μs"); + assert (span "0u1_100" = "1.1μs"); + assert (span "0u1_101" = "1.11μs"); + assert (span "0u1_109" = "1.11μs"); + assert (span "0u1_110" = "1.11μs"); + assert (span "0u1_111" = "1.12μs"); + assert (span "0u1_990" = "1.99μs"); + assert (span "0u1_991" = "2μs"); + assert (span "0u1_999" = "2μs"); + assert (span "0u2_000" = "2μs"); + assert (span "0u2_001" = "2.01μs"); + assert (span "0u9_990" = "9.99μs"); + assert (span "0u9_991" = "10μs"); + assert (span "0u9_999" = "10μs"); + assert (span "0u10_000" = "10μs"); + assert (span "0u10_001" = "10.1μs"); + assert (span "0u10_099" = "10.1μs"); + assert (span "0u10_100" = "10.1μs"); + assert (span "0u10_101" = "10.2μs"); + assert (span "0u10_900" = "10.9μs"); + assert (span "0u10_901" = "11μs"); + assert (span "0u10_999" = "11μs"); + assert (span "0u11_000" = "11μs"); + assert (span "0u11_001" = "11.1μs"); + assert (span "0u11_099" = "11.1μs"); + assert (span "0u11_100" = "11.1μs"); + assert (span "0u11_101" = "11.2μs"); + assert (span "0u99_900" = "99.9μs"); + assert (span "0u99_901" = "100μs"); + assert (span "0u99_999" = "100μs"); + assert (span "0u100_000" = "100μs"); + assert (span "0u100_001" = "101μs"); + assert (span "0u100_999" = "101μs"); + assert (span "0u101_000" = "101μs"); + assert (span "0u101_001" = "102μs"); + assert (span "0u101_999" = "102μs"); + assert (span "0u102_000" = "102μs"); + assert (span "0u999_000" = "999μs"); + assert (span "0u999_001" = "1ms"); + assert (span "0u999_001" = "1ms"); + assert (span "0u999_999" = "1ms"); + assert (span "0u1_000_000" = "1ms"); + assert (span "0u1_000_001" = "1.01ms"); + assert (span "0u1_009_999" = "1.01ms"); + assert (span "0u1_010_000" = "1.01ms"); + assert (span "0u1_010_001" = "1.02ms"); + assert (span "0u9_990_000" = "9.99ms"); + assert (span "0u9_990_001" = "10ms"); + assert (span "0u9_999_999" = "10ms"); + assert (span "0u10_000_000" = "10ms"); + assert (span "0u10_000_001" = "10.1ms"); + assert (span "0u10_000_001" = "10.1ms"); + assert (span "0u10_099_999" = "10.1ms"); + assert (span "0u10_100_000" = "10.1ms"); + assert (span "0u10_100_001" = "10.2ms"); + assert (span "0u99_900_000" = "99.9ms"); + assert (span "0u99_900_001" = "100ms"); + assert (span "0u99_999_999" = "100ms"); + assert (span "0u100_000_000" = "100ms"); + assert (span "0u100_000_001" = "101ms"); + assert (span "0u100_999_999" = "101ms"); + assert (span "0u101_000_000" = "101ms"); + assert (span "0u101_000_001" = "102ms"); + assert (span "0u999_000_000" = "999ms"); + assert (span "0u999_000_001" = "1s"); + assert (span "0u999_999_999" = "1s"); + assert (span "0u1_000_000_000" = "1s"); + assert (span "0u1_000_000_001" = "1.01s"); + assert (span "0u1_009_999_999" = "1.01s"); + assert (span "0u1_010_000_000" = "1.01s"); + assert (span "0u1_010_000_001" = "1.02s"); + assert (span "0u1_990_000_000" = "1.99s"); + assert (span "0u1_990_000_001" = "2s"); + assert (span "0u1_999_999_999" = "2s"); + assert (span "0u2_000_000_000" = "2s"); + assert (span "0u2_000_000_001" = "2.01s"); + assert (span "0u9_990_000_000" = "9.99s"); + assert (span "0u9_999_999_999" = "10s"); + assert (span "0u10_000_000_000" = "10s"); + assert (span "0u10_000_000_001" = "10.1s"); + assert (span "0u10_099_999_999" = "10.1s"); + assert (span "0u10_100_000_000" = "10.1s"); + assert (span "0u10_100_000_001" = "10.2s"); + assert (span "0u59_900_000_000" = "59.9s"); + assert (span "0u59_900_000_001" = "1min"); + assert (span "0u59_999_999_999" = "1min"); + assert (span "0u60_000_000_000" = "1min"); + assert (span "0u60_000_000_001" = "1min1s"); + assert (span "0u60_999_999_999" = "1min1s"); + assert (span "0u61_000_000_000" = "1min1s"); + assert (span "0u61_000_000_001" = "1min2s"); + assert (span "0u119_000_000_000" = "1min59s"); + assert (span "0u119_000_000_001" = "2min"); + assert (span "0u119_999_999_999" = "2min"); + assert (span "0u120_000_000_000" = "2min"); + assert (span "0u120_000_000_001" = "2min1s"); + assert (span "0u3599_000_000_000" = "59min59s"); + assert (span "0u3599_000_000_001" = "1h"); + assert (span "0u3599_999_999_999" = "1h"); + assert (span "0u3600_000_000_000" = "1h"); + assert (span "0u3600_000_000_001" = "1h1min"); + assert (span "0u3659_000_000_000" = "1h1min"); + assert (span "0u3659_000_000_001" = "1h1min"); + assert (span "0u3659_999_999_999" = "1h1min"); + assert (span "0u3660_000_000_000" = "1h1min"); + assert (span "0u3660_000_000_001" = "1h2min"); + assert (span "0u3660_000_000_001" = "1h2min"); + assert (span "0u3660_000_000_001" = "1h2min"); + assert (span "0u3720_000_000_000" = "1h2min"); + assert (span "0u3720_000_000_001" = "1h3min"); + assert (span "0u7140_000_000_000" = "1h59min"); + assert (span "0u7140_000_000_001" = "2h"); + assert (span "0u7199_999_999_999" = "2h"); + assert (span "0u7200_000_000_000" = "2h"); + assert (span "0u7200_000_000_001" = "2h1min"); + assert (span "0u86340_000_000_000" = "23h59min"); + assert (span "0u86340_000_000_001" = "1d"); + assert (span "0u86400_000_000_000" = "1d"); + assert (span "0u86400_000_000_001" = "1d1h"); + assert (span "0u89999_999_999_999" = "1d1h"); + assert (span "0u90000_000_000_000" = "1d1h"); + assert (span "0u90000_000_000_001" = "1d2h"); + assert (span "0u169200_000_000_000" = "1d23h"); + assert (span "0u169200_000_000_001" = "2d"); + assert (span "0u169200_000_000_001" = "2d"); + assert (span "0u172799_999_999_999" = "2d"); + assert (span "0u172800_000_000_000" = "2d"); + assert (span "0u172800_000_000_001" = "2d1h"); + assert (span "0u31536000_000_000_000" = "365d"); + assert (span "0u31554000_000_000_000" = "365d5h"); + assert ( + (* Technically this should round to a year but it does get rendered. + I don't think it matters, it's not inacurate per se. *) + span "0u31554000_000_000_001" = "365d6h"); + assert (span "0u31557600_000_000_000" = "1a"); + assert (span "0u31557600_000_000_001" = "1a1d"); + assert (span "0u63028800_000_000_000" = "1a365d"); + assert (span "0u63093600_000_000_000" = "1a365d"); + assert (span "0u63093600_000_000_001" = "2a"); + assert (span "0u63115200_000_000_000" = "2a"); + assert (span "0u63115200_000_000_001" = "2a1d"); () let test_counters () = @@ -179,7 +254,7 @@ let test_counters () = let do_count max = let span = count max in let span_ns = Mtime.Span.to_uint64_ns span in - let span_s = Mtime.Span.to_s span in + let span_s = 0. (* Mtime.Span.to_s span *) in log " * Count to % 8d: % 10Luns %.10fs %a" max span_ns span_s Mtime.Span.pp span in @@ -196,7 +271,7 @@ let test_elapsed () = log "Test Mtime_clock.elapsed ns - s - pp - dump"; let span = Mtime_clock.elapsed () in log " * Elapsed: %Luns - %gs - %a - %a" - (Mtime.Span.to_uint64_ns span) (Mtime.Span.to_s span) + (Mtime.Span.to_uint64_ns span) (Mtime.Span.to_float_ns span *. 1e-9) Mtime.Span.pp span Mtime.Span.dump span; () @@ -205,7 +280,8 @@ let test_now () = let t = Mtime_clock.now () in let span = Mtime.(span t (of_uint64_ns 0_L)) in log " * System: %Luns - %gs - %a - %a" - (Mtime.to_uint64_ns t) (Mtime.Span.to_s span) Mtime.pp t Mtime.dump t; + (Mtime.to_uint64_ns t) (Mtime.Span.to_float_ns span *. 1e-9) + Mtime.pp t Mtime.dump t; () let test_span_compare () = @@ -248,16 +324,31 @@ let test_span_arith () = assert (Mtime.Span.(equal (add (abs_diff max_span one) one) max_span)); () +let test_float_ns () = + log "Test Mtime.{to,of}_float_ns"; + assert (Mtime.Span.to_float_ns Mtime.Span.max_span = (2. ** 64.) -. 1.); + assert (Mtime.Span.to_float_ns Mtime.Span.min_span = 0.); + assert (Mtime.Span.of_float_ns (2. ** 53. -. 1.) = + Some (Mtime.Span.of_uint64_ns (Int64.(sub (shift_left 1L 53) one)))); + assert (Mtime.Span.of_float_ns (2. ** 53.) = None); + assert (Mtime.Span.of_float_ns 0. = Some Mtime.Span.zero); + assert (Mtime.Span.of_float_ns (-.0.) = Some Mtime.Span.zero); + assert (Mtime.Span.of_float_ns infinity = None); + assert (Mtime.Span.of_float_ns nan = None); + assert (Mtime.Span.of_float_ns (-3.) = None); + assert (Mtime.Span.of_float_ns 1. = Some Mtime.Span.one); + () + let run () = test test_available (); - test test_secs_in (); - test test_pp_span_s (); + test test_pp_span (); test test_counters (); test test_elapsed (); test test_now (); test test_span_compare (); test test_span_constants (); test_span_arith (); + test_float_ns (); log_result (); exit !fail diff --git a/duniverse/ocaml-conduit/.ocamlformat b/duniverse/ocaml-conduit/.ocamlformat index 4eae7930d..731d702cd 100644 --- a/duniverse/ocaml-conduit/.ocamlformat +++ b/duniverse/ocaml-conduit/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.19.0 +version = 0.23.0 profile = conventional break-infix = fit-or-vertical parse-docstrings = true diff --git a/duniverse/ocaml-conduit/CHANGES.md b/duniverse/ocaml-conduit/CHANGES.md index 17e5c401d..df538e58b 100644 --- a/duniverse/ocaml-conduit/CHANGES.md +++ b/duniverse/ocaml-conduit/CHANGES.md @@ -1,3 +1,26 @@ +## v6.1.0 (2022-12-15) + +done by @psafont in #417: +* conduit-lwt-unix-ssl: allow users to create a client ssl_context and use it for + any connections. This allows users to manage the lifecycle of the context. +* conduit-lwt-unix-ssl: domain name verification can be disabled by users, + it's enabled by default. The library returns an error when the hostname + verification is turned on but it cannot be performed, this follows the TLS + implementation. +* conduit-lwt-unix-ssl: IP verification can be enabled by users, it's disabled + by default. +* conduit-lwt-unix-ssl: SNI is not sent when there isn't a domain name available +* conduit-lwt-unix: avoid direct use of Ssl in conduit_lwt_unix (#418 @psafont) + +## v6.0.1 (2022-10-25) + +* conduit-mirage: adapt to dns 6.4.0 changes, Resolver_mirage.v is now in Lwt.t + monad (#416 @hannesm) + +## v6.0.0 (2022-10-11) + +* conduit-mirage: delay parsing of nameservers (#415 @reynir, review by @dinosaure) + ## v5.1.1 (2022-07-04) * conduit-mirage: pass peer name to Tls.Config.client, fixes diff --git a/duniverse/ocaml-conduit/conduit-async.opam b/duniverse/ocaml-conduit/conduit-async.opam index b78b3485a..8208e6475 100644 --- a/duniverse/ocaml-conduit/conduit-async.opam +++ b/duniverse/ocaml-conduit/conduit-async.opam @@ -1,4 +1,4 @@ -version: "5.1.1" +version: "6.1.0" opam-version: "2.0" maintainer: "anil@recoil.org" authors: [ diff --git a/duniverse/ocaml-conduit/conduit-lwt-unix.opam b/duniverse/ocaml-conduit/conduit-lwt-unix.opam index 5e9fdec80..0a8330702 100644 --- a/duniverse/ocaml-conduit/conduit-lwt-unix.opam +++ b/duniverse/ocaml-conduit/conduit-lwt-unix.opam @@ -1,4 +1,4 @@ -version: "5.1.1" +version: "6.1.0" opam-version: "2.0" maintainer: "anil@recoil.org" authors: [ @@ -27,7 +27,7 @@ depends: [ depopts: ["tls" "lwt_ssl" "launchd"] conflicts: [ "tls" {< "0.14.0"} - "ssl" {< "0.5.9"} + "ssl" {< "0.5.12"} ] build: [ ["dune" "subst"] {dev} diff --git a/duniverse/ocaml-conduit/conduit-lwt.opam b/duniverse/ocaml-conduit/conduit-lwt.opam index 210ddff7e..2ce989205 100644 --- a/duniverse/ocaml-conduit/conduit-lwt.opam +++ b/duniverse/ocaml-conduit/conduit-lwt.opam @@ -1,4 +1,4 @@ -version: "5.1.1" +version: "6.1.0" opam-version: "2.0" maintainer: "anil@recoil.org" authors: [ diff --git a/duniverse/ocaml-conduit/conduit-mirage.opam b/duniverse/ocaml-conduit/conduit-mirage.opam index 7ec7963de..205253a71 100644 --- a/duniverse/ocaml-conduit/conduit-mirage.opam +++ b/duniverse/ocaml-conduit/conduit-mirage.opam @@ -1,4 +1,4 @@ -version: "5.1.1" +version: "6.1.0" opam-version: "2.0" maintainer: "anil@recoil.org" authors: ["Anil Madhavapeddy" "Thomas Leonard" "Thomas Gazagnaire"] @@ -18,7 +18,7 @@ depends: [ "mirage-flow-combinators" {>= "2.0.0"} "mirage-random" {>= "2.0.0"} "mirage-time" {>= "2.0.0"} - "dns-client" {>= "6.0.0"} + "dns-client" {>= "6.4.0"} "conduit-lwt" {=version} "vchan" {>= "5.0.0"} "xenstore" diff --git a/duniverse/ocaml-conduit/conduit.opam b/duniverse/ocaml-conduit/conduit.opam index 56412c9d7..cd48967b8 100644 --- a/duniverse/ocaml-conduit/conduit.opam +++ b/duniverse/ocaml-conduit/conduit.opam @@ -1,4 +1,4 @@ -version: "5.1.1" +version: "6.1.0" opam-version: "2.0" maintainer: "anil@recoil.org" authors: [ diff --git a/duniverse/ocaml-conduit/dune-project b/duniverse/ocaml-conduit/dune-project index f63eb9980..5af99f245 100644 --- a/duniverse/ocaml-conduit/dune-project +++ b/duniverse/ocaml-conduit/dune-project @@ -1,3 +1,3 @@ (lang dune 2.0) (name conduit) -(version v5.1.1) +(version v6.1.0) diff --git a/duniverse/ocaml-conduit/src/conduit-async/v2.dummy.mli b/duniverse/ocaml-conduit/src/conduit-async/v2.dummy.mli index 5654a5e12..909a67cbb 100644 --- a/duniverse/ocaml-conduit/src/conduit-async/v2.dummy.mli +++ b/duniverse/ocaml-conduit/src/conduit-async/v2.dummy.mli @@ -5,4 +5,4 @@ include and type ssl_conn = [ `Ssl_not_compiled_in ] and type ssl_opt = [ `Ssl_not_compiled_in ] and type allowed_ciphers = - [ `Only of string list | `Openssl_default | `Secure ] + [ `Only of string list | `Openssl_default | `Secure ] diff --git a/duniverse/ocaml-conduit/src/conduit-async/v2.real.mli b/duniverse/ocaml-conduit/src/conduit-async/v2.real.mli index 4f9ae6f35..250022662 100644 --- a/duniverse/ocaml-conduit/src/conduit-async/v2.real.mli +++ b/duniverse/ocaml-conduit/src/conduit-async/v2.real.mli @@ -8,4 +8,4 @@ include and type ssl_opt = Ssl.Opt.t and type verify_mode = Ssl.Verify_mode.t and type allowed_ciphers = - [ `Only of string list | `Openssl_default | `Secure ] + [ `Only of string list | `Openssl_default | `Secure ] diff --git a/duniverse/ocaml-conduit/src/conduit-async/v3.dummy.mli b/duniverse/ocaml-conduit/src/conduit-async/v3.dummy.mli index f19635284..b53400983 100644 --- a/duniverse/ocaml-conduit/src/conduit-async/v3.dummy.mli +++ b/duniverse/ocaml-conduit/src/conduit-async/v3.dummy.mli @@ -5,4 +5,4 @@ include and type ssl_conn = [ `Ssl_not_compiled_in ] and type ssl_opt = [ `Ssl_not_compiled_in ] and type allowed_ciphers = - [ `Only of string list | `Openssl_default | `Secure ] + [ `Only of string list | `Openssl_default | `Secure ] diff --git a/duniverse/ocaml-conduit/src/conduit-async/v3.real.mli b/duniverse/ocaml-conduit/src/conduit-async/v3.real.mli index 2835e9615..3731fb58e 100644 --- a/duniverse/ocaml-conduit/src/conduit-async/v3.real.mli +++ b/duniverse/ocaml-conduit/src/conduit-async/v3.real.mli @@ -8,4 +8,4 @@ include and type ssl_opt = Ssl.Opt.t and type verify_mode = Ssl.Verify_mode.t and type allowed_ciphers = - [ `Only of string list | `Openssl_default | `Secure ] + [ `Only of string list | `Openssl_default | `Secure ] diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.ml b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.ml index 33deaebc4..ef53d46c1 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.ml +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.ml @@ -108,6 +108,8 @@ type ctx = { src : Unix.sockaddr option; tls_own_key : tls_own_key; tls_authenticator : Conduit_lwt_tls.X509.authenticator; + ssl_client_verify : Conduit_lwt_unix_ssl.Client.verify; + ssl_ctx : Conduit_lwt_unix_ssl.Client.context; } let string_of_unix_sockaddr sa = @@ -154,19 +156,25 @@ let default_ctx = src = None; tls_own_key = `None; tls_authenticator = Lazy.force Conduit_lwt_tls.X509.default_authenticator; + ssl_client_verify = Conduit_lwt_unix_ssl.Client.default_verify; + ssl_ctx = Conduit_lwt_unix_ssl.Client.default_ctx; } let init ?src ?(tls_own_key = `None) ?(tls_authenticator = Lazy.force Conduit_lwt_tls.X509.default_authenticator) - () = + ?(ssl_ctx = Conduit_lwt_unix_ssl.Client.default_ctx) + ?(ssl_client_verify = Conduit_lwt_unix_ssl.Client.default_verify) () = + let no_source_ctx = + { src = None; tls_own_key; tls_authenticator; ssl_ctx; ssl_client_verify } + in match src with - | None -> Lwt.return { src = None; tls_own_key; tls_authenticator } + | None -> Lwt.return no_source_ctx | Some host -> ( let open Unix in Lwt_unix.getaddrinfo host "0" [ AI_PASSIVE; AI_SOCKTYPE SOCK_STREAM ] >>= function | { ai_addr; _ } :: _ -> - Lwt.return { src = Some ai_addr; tls_own_key; tls_authenticator } + Lwt.return { no_source_ctx with src = Some ai_addr } | [] -> Lwt.fail_with "Invalid conduit source address specified") module Sockaddr_io = struct @@ -279,11 +287,11 @@ let connect_with_tls_native ~ctx (`Hostname hostname, `IP ip, `Port port) = let flow = TCP { fd; ip; port } in (flow, ic, oc) -let connect_with_openssl ~ctx (`Hostname hostname, `IP ip, `Port port) = +let connect_with_openssl ~ctx (`Hostname host_addr, `IP ip, `Port port) = let sa = Unix.ADDR_INET (Ipaddr_unix.to_inet_addr ip, port) in let ctx_ssl = match ctx.tls_own_key with - | `None -> None + | `None -> ctx.ssl_ctx | `TLS (`Crt_file_path certfile, `Key_file_path keyfile, password) -> let password = match password with `No_password -> None | `Password fn -> Some fn @@ -291,9 +299,10 @@ let connect_with_openssl ~ctx (`Hostname hostname, `IP ip, `Port port) = let ctx_ssl = Conduit_lwt_unix_ssl.Client.create_ctx ~certfile ~keyfile ?password () in - Some ctx_ssl + ctx_ssl in - Conduit_lwt_unix_ssl.Client.connect ?ctx:ctx_ssl ?src:ctx.src ~hostname sa + Conduit_lwt_unix_ssl.Client.connect ~ctx:ctx_ssl ?src:ctx.src + ~hostname:host_addr ~ip ~verify:ctx.ssl_client_verify sa >>= fun (fd, ic, oc) -> let flow = TCP { fd; ip; port } in Lwt.return (flow, ic, oc) diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.mli b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.mli index 1fb1d9d9d..8e4653403 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.mli +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix.mli @@ -161,16 +161,22 @@ val init : ?src:string -> ?tls_own_key:tls_own_key -> ?tls_authenticator:Conduit_lwt_tls.X509.authenticator -> + ?ssl_ctx:Conduit_lwt_unix_ssl.Client.context -> + ?ssl_client_verify:Conduit_lwt_unix_ssl.Client.verify -> unit -> ctx io -(** [init ?src ?tls_own_key ()] will initialize a Unix conduit that binds to the - [src] interface if specified. If TLS server connections are used, then - [tls_server_key] must contain a valid certificate to be used to advertise a - TLS connection. +(** [init ?src ?tls_own_key ?tls_authenticator ?ssl_ctx ()] will initialize a + Unix conduit that binds to the [src] interface if specified. - The certificate is validated using [tls_authenticator]. By default, the + If TLS server connections are used, then [tls_own_key] must contain a valid + certificate to be used to advertise a TLS connection. In TLS mode the + certificate is validated using [tls_authenticator]. By default, the validation is using the {{:https://github.com/mirage/ca-certs} OS trust - anchors}. *) + anchors}. + + If SSL client connections are used, then [tls_own_key] may contain a valid + certificate to be used to advertise a TLS connection. If it's not configured + [ssl_ctx] will be used to configure OpenSSL. *) val connect : ctx:ctx -> client -> (flow * ic * oc) io (** [connect ~ctx client] establishes an outgoing connection via the [ctx] diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml index b8441fce0..04c7c20ca 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.ml @@ -16,10 +16,16 @@ *) module Client = struct - let default_ctx = `Ssl_not_available + type verify = { hostname : bool; ip : bool } + + let default_verify = { hostname = true; ip = true } + + type context = Ssl_not_available + + let default_ctx = Ssl_not_available let create_ctx ?certfile:_ ?keyfile:_ ?password:_ () = default_ctx - let connect ?(ctx = default_ctx) ?src:_ ?hostname:_ _sa = + let connect ?(ctx = default_ctx) ?src:_ ?hostname:_ ?ip:_ ?verify:_ _sa = ignore ctx; Lwt.fail_with "Ssl not available" end diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli index d0573f122..c490cc6f9 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.dummy.mli @@ -18,19 +18,27 @@ (** TLS/SSL connections via {{:http://www.openssl.org} OpenSSL} C bindings *) module Client : sig - val default_ctx : [ `Ssl_not_available ] + type verify = { hostname : bool; ip : bool } + + val default_verify : verify + + type context = Ssl_not_available + + val default_ctx : context val create_ctx : ?certfile:string -> ?keyfile:string -> ?password:(bool -> string) -> unit -> - [ `Ssl_not_available ] + context val connect : - ?ctx:[ `Ssl_not_available ] -> + ?ctx:context -> ?src:Lwt_unix.sockaddr -> ?hostname:string -> + ?ip:Ipaddr.t -> + ?verify:verify -> Lwt_unix.sockaddr -> (Lwt_unix.file_descr * Lwt_io.input_channel * Lwt_io.output_channel) Lwt.t end diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml index 39515c03b..d0a524eb6 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.ml @@ -35,6 +35,8 @@ let chans_of_fd sock = (Lwt_ssl.get_fd sock, ic, oc) module Client = struct + type context = Ssl.context + let create_ctx ?certfile ?keyfile ?password () = let ctx = Ssl.create_context Ssl.SSLv23 Ssl.Client_context in Ssl.disable_protocols ctx [ Ssl.SSLv23 ]; @@ -52,24 +54,61 @@ module Client = struct let default_ctx = create_ctx () - let connect ?(ctx = default_ctx) ?src ?hostname sa = + type verify = { hostname : bool; ip : bool } + + let default_verify = { hostname = true; ip = false } + + let validate_hostname host_addr = + try + let _ = Domain_name.(host_exn (of_string_exn host_addr)) in + host_addr + with Invalid_argument msg -> + let s = + Printf.sprintf "couldn't convert %s to a [`host] Domain_name.t: %s" + host_addr msg + in + invalid_arg s + + let verification { hostname; ip } = function + | None, _ when hostname -> invalid_arg "impossible to verify hostname" + | _, None when ip -> invalid_arg "impossible to verify ip" + | h, i -> + let hostname = + if hostname && h <> None then Option.map validate_hostname h else None + in + let ip = if ip && i <> None then i else None in + (hostname, ip) + + let connect ?(ctx = default_ctx) ?src ?hostname ?ip ?verify sa = + let verify = Option.value ~default:default_verify verify in + let to_verify = verification verify (hostname, ip) in Conduit_lwt_server.with_socket sa (fun fd -> (match src with | None -> Lwt.return_unit | Some src_sa -> Lwt_unix.bind fd src_sa) >>= fun () -> Lwt_unix.connect fd sa >>= fun () -> - (match hostname with - | Some host -> - let s = Lwt_ssl.embed_uninitialized_socket fd ctx in - let ssl = Lwt_ssl.ssl_socket_of_uninitialized_socket s in - Ssl.set_client_SNI_hostname ssl host; - (* Enable hostname verification *) - Ssl.set_hostflags ssl [ Ssl.No_partial_wildcards ]; - Ssl.set_host ssl host; - Lwt_ssl.ssl_perform_handshake s - | None -> Lwt_ssl.ssl_connect fd ctx) - >>= fun sock -> Lwt.return (chans_of_fd sock)) + let with_socket f = + let s = Lwt_ssl.embed_uninitialized_socket fd ctx in + let socket = Lwt_ssl.ssl_socket_of_uninitialized_socket s in + f socket; + Lwt_ssl.ssl_perform_handshake s + in + let maybe_verify ssl = function + | Some hostname, Some ip -> + Ssl.set_hostflags ssl [ Ssl.No_partial_wildcards ]; + Ssl.set_client_SNI_hostname ssl hostname; + Ssl.set_host ssl hostname; + Ssl.set_ip ssl (Ipaddr.to_string ip) + | Some hostname, None -> + Ssl.set_hostflags ssl [ Ssl.No_partial_wildcards ]; + Ssl.set_client_SNI_hostname ssl hostname; + Ssl.set_host ssl hostname + | None, Some ip -> Ssl.set_ip ssl (Ipaddr.to_string ip) + | None, None -> () + in + with_socket (fun ssl -> maybe_verify ssl to_verify) >>= fun sock -> + Lwt.return (chans_of_fd sock)) end module Server = struct diff --git a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli index 8a3f25304..f1ab57bc4 100644 --- a/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli +++ b/duniverse/ocaml-conduit/src/conduit-lwt-unix/conduit_lwt_unix_ssl.real.mli @@ -18,7 +18,13 @@ (** TLS/SSL connections via {{:http://www.openssl.org} OpenSSL} C bindings *) module Client : sig - val default_ctx : Ssl.context + type verify = { hostname : bool; ip : bool } + + val default_verify : verify + + type context = Ssl.context + + val default_ctx : context val create_ctx : ?certfile:string -> @@ -28,9 +34,11 @@ module Client : sig Ssl.context val connect : - ?ctx:Ssl.context -> + ?ctx:context -> ?src:Lwt_unix.sockaddr -> ?hostname:string -> + ?ip:Ipaddr.t -> + ?verify:verify -> Lwt_unix.sockaddr -> (Lwt_unix.file_descr * Lwt_io.input_channel * Lwt_io.output_channel) Lwt.t end diff --git a/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.ml b/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.ml index a2d602f73..572170293 100644 --- a/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.ml +++ b/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.ml @@ -113,20 +113,19 @@ struct let register ?nameservers s res = (* DNS stub resolver *) - let nameservers = Option.map (fun ns -> (`Tcp, ns)) nameservers in - let dns = DNS.create ?nameservers s in + DNS.connect ?nameservers s >|= fun dns -> let f = dns_stub_resolver dns in Resolver_lwt.add_rewrite ~host:"" ~f res; let service = Resolver_lwt.(service res ++ static_service) in Resolver_lwt.set_service ~f:service res; let vchan_tld = ".xen" in let vchan_res = vchan_resolver ~tld:vchan_tld in - Resolver_lwt.add_rewrite ~host:vchan_tld ~f:vchan_res res + Resolver_lwt.add_rewrite ~host:vchan_tld ~f:vchan_res res; + Ok () let v ?nameservers stack = let res = Resolver_lwt.init () in - register ?nameservers stack res; - res + register ?nameservers stack res >|= Result.map (fun () -> res) type t = Resolver_lwt.t end diff --git a/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.mli b/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.mli index c0bfb5eef..070b2c62b 100644 --- a/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.mli +++ b/duniverse/ocaml-conduit/src/conduit-mirage/resolver_mirage.mli @@ -39,11 +39,7 @@ module Make include S val v : - ?nameservers: - [ `Plaintext of Ipaddr.t * int - | `Tls of Tls.Config.client * Ipaddr.t * int ] - list -> - S.t -> - t - (** [v ~nameservers stack ()] TODO *) + ?nameservers:string list -> S.t -> (t, [> `Msg of string ]) result Lwt.t + (** [v ~nameservers stack ()] TODO. An error is returned if any of the + nameserver specifications do not parse. *) end diff --git a/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_client.ml b/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_client.ml index 8ba7dac17..6a43f73b2 100644 --- a/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_client.ml +++ b/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_client.ml @@ -5,4 +5,5 @@ let main = foreign "Unikernel.Client" (time @-> job) let () = register ~libraries:[ "conduit.mirage"; "vchan.xen" ] - ~packages:[ "conduit"; "vchan" ] "vchan_client" [ main $ default_time ] + ~packages:[ "conduit"; "vchan" ] "vchan_client" + [ main $ default_time ] diff --git a/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_server.ml b/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_server.ml index e96802dc1..77bdfd62c 100644 --- a/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_server.ml +++ b/duniverse/ocaml-conduit/tests/conduit-mirage/vchan/config_server.ml @@ -5,4 +5,5 @@ let main = foreign "Unikernel.Server" (time @-> job) let () = register ~libraries:[ "conduit.mirage"; "vchan.xen" ] - ~packages:[ "conduit"; "vchan" ] "vchan_server" [ main $ default_time ] + ~packages:[ "conduit"; "vchan" ] "vchan_server" + [ main $ default_time ] diff --git a/duniverse/ocaml-ctypes/ctypes-foreign.opam b/duniverse/ocaml-ctypes/ctypes-foreign.opam index e497b0268..6236b50f3 100644 --- a/duniverse/ocaml-ctypes/ctypes-foreign.opam +++ b/duniverse/ocaml-ctypes/ctypes-foreign.opam @@ -1,6 +1,5 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.20.1+dune" synopsis: "Dynamic access to foreign C libraries using Ctypes" description: """ @@ -10,10 +9,11 @@ maintainer: ["Jeremy Yallop "] authors: ["Jeremy Yallop"] license: "MIT" tags: ["org:mirage" "org:ocamllabs"] -homepage: "https://github.com/dune-universe/ocaml-ctypes" -bug-reports: "https://github.com/dune-universe/ocaml-ctypes/issues" +homepage: "https://github.com/ocamllabs/ocaml-ctypes" +doc: "https://ocamllabs.github.io/ocaml-ctypes/" +bug-reports: "https://github.com/ocamllabs/ocaml-ctypes/issues" depends: [ - "dune" {>= "2.8"} + "dune" {>= "2.9"} "ocaml" {>= "4.03.0"} "ctypes" {= version} "dune-configurator" @@ -34,12 +34,14 @@ build: [ name "-j" jobs + "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] + ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/dune-universe/ocaml-ctypes.git" +dev-repo: "git+https://github.com/ocamllabs/ocaml-ctypes.git" post-messages: "This package requires libffi on your system" {failure} depexts: [ ["libffi-dev"] {os-distribution = "debian"} diff --git a/duniverse/ocaml-ctypes/ctypes.opam b/duniverse/ocaml-ctypes/ctypes.opam index 370e1a70c..45c8a911e 100644 --- a/duniverse/ocaml-ctypes/ctypes.opam +++ b/duniverse/ocaml-ctypes/ctypes.opam @@ -1,6 +1,5 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.20.1+dune" synopsis: "Combinators for binding to C libraries without writing any C" description: """ @@ -12,7 +11,7 @@ can use these combinators to describe the types of the functions that you want to call, then bind directly to those functions -- all without writing or generating any C! -To install the optional `ctypes.foreign` interface (which uses `libffi` to +To install the optional `ctypes-foreign` interface (which uses `libffi` to provide dynamic access to foreign libraries), you will need to also install the `ctypes-foreign` package. @@ -23,10 +22,11 @@ maintainer: ["Jeremy Yallop "] authors: ["Jeremy Yallop"] license: "MIT" tags: ["org:mirage" "org:ocamllabs"] -homepage: "https://github.com/dune-universe/ocaml-ctypes" -bug-reports: "https://github.com/dune-universe/ocaml-ctypes/issues" +homepage: "https://github.com/ocamllabs/ocaml-ctypes" +doc: "https://ocamllabs.github.io/ocaml-ctypes/" +bug-reports: "https://github.com/ocamllabs/ocaml-ctypes/issues" depends: [ - "dune" {>= "2.8"} + "dune" {>= "2.9"} "ocaml" {>= "4.03.0"} "integers" "dune-configurator" @@ -45,9 +45,11 @@ build: [ name "-j" jobs + "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] + ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/dune-universe/ocaml-ctypes.git" +dev-repo: "git+https://github.com/ocamllabs/ocaml-ctypes.git" diff --git a/duniverse/ocaml-ctypes/dune-project b/duniverse/ocaml-ctypes/dune-project index 721c5d5c9..c8b4bfc5b 100644 --- a/duniverse/ocaml-ctypes/dune-project +++ b/duniverse/ocaml-ctypes/dune-project @@ -1,6 +1,5 @@ -(lang dune 2.8) +(lang dune 2.9) (name ctypes) -(version 0.20.1+dune) (formatting (enabled_for dune)) (use_standard_c_and_cxx_flags true) @@ -9,7 +8,8 @@ (license MIT) (maintainers "Jeremy Yallop ") (authors "Jeremy Yallop") -(source (github dune-universe/ocaml-ctypes)) +(source (github ocamllabs/ocaml-ctypes)) +(documentation "https://ocamllabs.github.io/ocaml-ctypes/") (package (name ctypes) @@ -32,7 +32,7 @@ can use these combinators to describe the types of the functions that you want to call, then bind directly to those functions -- all without writing or generating any C! -To install the optional `ctypes.foreign` interface (which uses `libffi` to +To install the optional `ctypes-foreign` interface (which uses `libffi` to provide dynamic access to foreign libraries), you will need to also install the `ctypes-foreign` package. diff --git a/duniverse/ocaml-ctypes/examples/ncurses/stub-generation/dune b/duniverse/ocaml-ctypes/examples/ncurses/stub-generation/dune index 6911f9b21..62a5c63f4 100644 --- a/duniverse/ocaml-ctypes/examples/ncurses/stub-generation/dune +++ b/duniverse/ocaml-ctypes/examples/ncurses/stub-generation/dune @@ -1,3 +1,3 @@ (executable (name ncurses_stub_cmd) - (libraries ncurses_bindings ncurses_generated)) + (libraries ncurses_bindings ncurses_generated unix)) diff --git a/duniverse/ocaml-ctypes/tests/clib/dune b/duniverse/ocaml-ctypes/tests/clib/dune index cdae01cbb..94878ff4d 100644 --- a/duniverse/ocaml-ctypes/tests/clib/dune +++ b/duniverse/ocaml-ctypes/tests/clib/dune @@ -9,7 +9,9 @@ (rule (target clib%{ext_dll}) - (deps (source_tree ../../src/ctypes) test_functions.h) + (deps + (source_tree ../../src/ctypes) + test_functions.h) (action (run %{cc} diff --git a/duniverse/ocaml-ctypes/tests/test-arrays/test_array.ml b/duniverse/ocaml-ctypes/tests/test-arrays/test_array.ml index 3f7925469..620cff9cf 100644 --- a/duniverse/ocaml-ctypes/tests/test-arrays/test_array.ml +++ b/duniverse/ocaml-ctypes/tests/test-arrays/test_array.ml @@ -6,6 +6,7 @@ *) open OUnit2 +module Float_ = struct let float = float end (*has to be above the module Ctypes*) open Ctypes let _ = Dl.(dlopen ~filename:"../clib/clib.so" ~flags:[RTLD_NOW]) @@ -45,7 +46,7 @@ let test_multidimensional_arrays _ = (* three dimensions *) let three = Array.make (array 2 (array 5 float)) 10 in - let float = Stdlib.float in + let float = Float_.float in for i = 0 to 9 do for j = 0 to 1 do diff --git a/duniverse/ocaml-ctypes/tests/test-cstdlib/test_cstdlib.ml b/duniverse/ocaml-ctypes/tests/test-cstdlib/test_cstdlib.ml index f31488ef2..14f6ae687 100644 --- a/duniverse/ocaml-ctypes/tests/test-cstdlib/test_cstdlib.ml +++ b/duniverse/ocaml-ctypes/tests/test-cstdlib/test_cstdlib.ml @@ -179,7 +179,7 @@ struct let cmpi m1 m2 = let mi1 = from_voidp mi m1 in let mi2 = from_voidp mi m2 in - Stdlib.compare + compare (as_string (!@(mi1 |-> name))) (as_string (!@(mi2 |-> name))) diff --git a/duniverse/ocaml-ctypes/tests/test-pointers/test_pointers.ml b/duniverse/ocaml-ctypes/tests/test-pointers/test_pointers.ml index b0ba203ee..d9ec45d3b 100644 --- a/duniverse/ocaml-ctypes/tests/test-pointers/test_pointers.ml +++ b/duniverse/ocaml-ctypes/tests/test-pointers/test_pointers.ml @@ -64,7 +64,7 @@ struct (allocate (ptr (ptr int)) (allocate (ptr int) (allocate int 4))) in assert_equal ~msg:"Passing pointers to pointers" - Stdlib.(1 + 2 + 3 + 4) + (1 + 2 + 3 + 4) (accept_pointers_to_pointers p pp ppp pppp) diff --git a/duniverse/ocaml-ctypes/tests/test-views/test_views.ml b/duniverse/ocaml-ctypes/tests/test-views/test_views.ml index 21a02926f..8205540ff 100644 --- a/duniverse/ocaml-ctypes/tests/test-views/test_views.ml +++ b/duniverse/ocaml-ctypes/tests/test-views/test_views.ml @@ -82,7 +82,7 @@ struct (-1) (accepting_possibly_null_funptr None 2 3); assert_equal ~msg:"passing non-null function pointer" - 5 (accepting_possibly_null_funptr (Some Pervasives.(+)) 2 3); + 5 (accepting_possibly_null_funptr (Some (+)) 2 3); assert_equal ~msg:"passing non-null function pointer obtained from C" 6 (accepting_possibly_null_funptr (returning_funptr 1) 2 3); diff --git a/duniverse/ocaml-magic-mime/CHANGES.md b/duniverse/ocaml-magic-mime/CHANGES.md index 9a9bfff0f..9c4b12c2a 100644 --- a/duniverse/ocaml-magic-mime/CHANGES.md +++ b/duniverse/ocaml-magic-mime/CHANGES.md @@ -1,3 +1,10 @@ +v1.3.0 2022-10-31 +----------------- + +* Allow an optional default if the MIME type is unknown (@hannesm, #25) +* Add a function to map MIME type to file extensions (@DolphinChips, #24) +* Fix documentation (@MisterDA, #23) + v1.2.0 2021-07-13 ----------------- diff --git a/duniverse/ocaml-magic-mime/README.md b/duniverse/ocaml-magic-mime/README.md index a4aa769e3..addcfc045 100644 --- a/duniverse/ocaml-magic-mime/README.md +++ b/duniverse/ocaml-magic-mime/README.md @@ -18,7 +18,7 @@ For example, here's how to lookup MIME types in the `utop` REPL: The following files need to be edited to add MIME types: -- mime.types: this is obtained by synching from the Apache Foundation's +- mime.types: this is obtained by syncing from the Apache Foundation's [mime.types](https://svn.apache.org/repos/asf/httpd/httpd/trunk/docs/conf/mime.types) in the Apache Subversion repository. - x-mime.types: these are the extension types, so non-standard `x-` prefixes are used here. diff --git a/duniverse/ocaml-magic-mime/dune-project b/duniverse/ocaml-magic-mime/dune-project index edd7bec0d..24f434a77 100644 --- a/duniverse/ocaml-magic-mime/dune-project +++ b/duniverse/ocaml-magic-mime/dune-project @@ -1,3 +1,3 @@ (lang dune 1.0) (name magic-mime) -(version v1.2.0) +(version v1.3.0) diff --git a/duniverse/ocaml-magic-mime/generator/generate_mime_types.ml b/duniverse/ocaml-magic-mime/generator/generate_mime_types.ml index a4c531bdd..bc71cd24d 100644 --- a/duniverse/ocaml-magic-mime/generator/generate_mime_types.ml +++ b/duniverse/ocaml-magic-mime/generator/generate_mime_types.ml @@ -21,11 +21,19 @@ open Str let files = ref [] -let extensions = ref true +type mode = + | Regular + | Files + | Mime +let mode = ref Regular + +let set_mode mode' () = mode := mode' let options = [ - "--files", Arg.Clear extensions, + "--files", Arg.Unit (set_mode Files), "Generate function mapping on filenames rather than on extensions" ; + "--mime", Arg.Unit (set_mode Mime), + "Generate function mapping MIME types to file extensions" ; ] let file_iter fn c = @@ -35,10 +43,16 @@ let file_iter fn c = let _ = Arg.parse options (fun s -> files := s :: !files) (Printf.sprintf "Usage: %s [options]\nwhere options are:" Sys.argv.(0)); - let fun_name = if !extensions then "map_extension" else "map_file" in + let mode = !mode in + let fun_name, default_arg, default = + match mode with + | Regular -> "map_extension", "?(default= \"application/octet-stream\")", "default" + | Files -> "map_file", "?(default= \"application/octet-stream\")", "default" + | Mime -> "map_mime", "", "[]" + in let dup = Hashtbl.create 101 in printf "(* This function is autogenerated by: %s *)\n" (String.concat " " (Array.to_list Sys.argv)); - printf "let %s = function\n" fun_name; + printf "let %s %s = function\n" fun_name default_arg; List.iter (fun fname -> let fin = open_in fname in file_iter (fun l -> @@ -46,15 +60,24 @@ let _ = | [] -> () | [_] -> () | [mime;_] when String.length mime > 0 && mime.[0] = '#' -> () - | [mime;exts] -> - List.iter (fun e -> - if not (Hashtbl.mem dup e) then begin - printf " | \"%s\" -> \"%s\"\n" (String.escaped e) (String.escaped mime); - Hashtbl.add dup e () - end - ) (split (regexp " +") exts) + | [mime;exts] -> begin + match mode with + | Mime -> + if not (Hashtbl.mem dup mime) then begin + let format_list oc l = List.map String.escaped l |> String.concat "\"; \"" |> fprintf oc "[\"%s\"]" in + printf " | \"%s\" -> %a\n" (String.escaped mime) format_list (split (regexp " +") exts); + Hashtbl.add dup mime () + end + | _ -> + List.iter (fun e -> + if not (Hashtbl.mem dup e) then begin + printf " | \"%s\" -> \"%s\"\n" (String.escaped e) (String.escaped mime); + Hashtbl.add dup e () + end + ) (split (regexp " +") exts) + end | _ -> () ) fin; close_in fin ) (List.rev !files); - printf " | _ -> \"application/octet-stream\"\n%!" + printf " | _ -> %s\n%!" default diff --git a/duniverse/ocaml-magic-mime/magic-mime.opam b/duniverse/ocaml-magic-mime/magic-mime.opam index 7cff43739..b0e5ddce7 100644 --- a/duniverse/ocaml-magic-mime/magic-mime.opam +++ b/duniverse/ocaml-magic-mime/magic-mime.opam @@ -1,4 +1,4 @@ -version: "1.2.0" +version: "1.3.0" opam-version: "2.0" name: "magic-mime" synopsis: "Map filenames to common MIME types" diff --git a/duniverse/ocaml-magic-mime/src/dune b/duniverse/ocaml-magic-mime/src/dune index c3dff819f..103f73c51 100644 --- a/duniverse/ocaml-magic-mime/src/dune +++ b/duniverse/ocaml-magic-mime/src/dune @@ -8,4 +8,5 @@ (deps ../mime.types ../x-mime.types ../files.types) (action (with-stdout-to %{targets} (progn (run ../generator/generate_mime_types.exe ../mime.types ../x-mime.types) - (run ../generator/generate_mime_types.exe ../files.types --files))))) + (run ../generator/generate_mime_types.exe ../files.types --files) + (run ../generator/generate_mime_types.exe ../mime.types ../x-mime.types --mime))))) diff --git a/duniverse/ocaml-magic-mime/src/magic_mime.ml b/duniverse/ocaml-magic-mime/src/magic_mime.ml index a4fe4e816..03943a929 100644 --- a/duniverse/ocaml-magic-mime/src/magic_mime.ml +++ b/duniverse/ocaml-magic-mime/src/magic_mime.ml @@ -22,8 +22,22 @@ let get_extension filename = String.sub filename (i+1) (String.length filename - i - 1) else search_dot (i - 1) in search_dot (String.length filename - 1) + (* Given a full filename, lookup its MIME type *) -let lookup filename = +let lookup ?default filename = match get_extension filename with - | "" -> Mime_types.map_file filename - | ext -> Mime_types.map_extension (String.lowercase_ascii ext) + | "" -> Mime_types.map_file ?default filename + | ext -> Mime_types.map_extension ?default (String.lowercase_ascii ext) + +let reverse_lookup mime = + let mime' = + let string_length = String.length mime in + let rec strip_parameters i = + if i = string_length || mime.[i] = ';' then + String.sub mime 0 i + else + strip_parameters (i + 1) + in + strip_parameters 0 + in + Mime_types.map_mime mime' diff --git a/duniverse/ocaml-magic-mime/src/magic_mime.mli b/duniverse/ocaml-magic-mime/src/magic_mime.mli index bce78ab09..9d64c84bb 100644 --- a/duniverse/ocaml-magic-mime/src/magic_mime.mli +++ b/duniverse/ocaml-magic-mime/src/magic_mime.mli @@ -16,8 +16,16 @@ (** Convert file extensions to MIME types *) -val lookup : string -> string -(** [lookup filename] will return a MIME type for the full [filename] +val lookup : ?default:string -> string -> string +(** [lookup ~default filename] will return a MIME type for the full [filename] supplied by examining its extension and look it up by using - {!Mime_types.map_extension} or {!Mime_Types.map_file} if there + {!Mime_types.map_extension} or {!Mime_types.map_file} if there is no file extension present. *) + +(** Convert MIME types to file extensions *) + +val reverse_lookup : string -> string list +(** [reverse_lookup mime] will return a list of file extensions for the + MIME type supplied by stripping any parameters and looking it up by + using {!Mime_types.map_mime}. + If an unknown MIME type is supplied, empty list is returned. *) diff --git a/duniverse/ocaml-magic-mime/src/mime_types.mli b/duniverse/ocaml-magic-mime/src/mime_types.mli index b20ab08a0..f346b5b8c 100644 --- a/duniverse/ocaml-magic-mime/src/mime_types.mli +++ b/duniverse/ocaml-magic-mime/src/mime_types.mli @@ -16,10 +16,16 @@ (** Database of file extensions to MIME types from RFC2045 onwards. *) -(** [map_extension e] converts the file extension [e] into a MIME type, - defaulting to [application/octet-stream] if it is unknown. *) -val map_extension : string -> string +(** [map_extension ~default e] converts the file extension [e] into a MIME type, + defaulting to [default] (which is [application/octet-stream] by default) if + it is unknown. *) +val map_extension : ?default:string -> string -> string -(** [map_file f] converts the filename [f] into a MIME type, - defaulting to [application/octet-stream] if it is unknown. *) -val map_file : string -> string +(** [map_file ~default f] converts the filename [f] into a MIME type, + defaulting to [default] (which is [application/octet-stream] by default) if + it is unknown. *) +val map_file : ?default:string -> string -> string + +(** [map_mime m] converts the MIME type [m] into a list of acceptable + file extensions, defaulting to an empty list if it is unknown. *) +val map_mime : string -> string list diff --git a/duniverse/ocaml-tls/CHANGES.md b/duniverse/ocaml-tls/CHANGES.md index 47833e878..eec31e531 100644 --- a/duniverse/ocaml-tls/CHANGES.md +++ b/duniverse/ocaml-tls/CHANGES.md @@ -1,3 +1,8 @@ +## v0.15.4 (2022-09-27) + +* New package tls-eio (#451 @talex5) +* Tls_async: expose tls_handler (#448 @mbacarella, reviewed by @torinnd) + ## v0.15.3 (2022-03-29) * Upgrade to v0.15 of Jane Street packages (#444 @bcc32) diff --git a/duniverse/ocaml-tls/README.md b/duniverse/ocaml-tls/README.md index 2410a4ddc..d12223a1f 100644 --- a/duniverse/ocaml-tls/README.md +++ b/duniverse/ocaml-tls/README.md @@ -1,6 +1,6 @@ ## TLS - Transport Layer Security purely in OCaml -v0.15.3 +v0.15.4 Transport Layer Security (TLS) is probably the most widely deployed security protocol on the Internet. It provides communication privacy to prevent diff --git a/duniverse/ocaml-tls/async/examples/dune b/duniverse/ocaml-tls/async/examples/dune index a594035d3..f470f4764 100644 --- a/duniverse/ocaml-tls/async/examples/dune +++ b/duniverse/ocaml-tls/async/examples/dune @@ -2,10 +2,12 @@ (name test_client) (modules test_client) (preprocess (pps ppx_jane)) + (enabled_if (< %{ocaml_version} 5.0.0)) (libraries async core core_unix.command_unix tls-async)) (executable (name test_server) (modules test_server) (preprocess (pps ppx_jane)) + (enabled_if (< %{ocaml_version} 5.0.0)) (libraries async core core_unix.command_unix tls-async)) diff --git a/duniverse/ocaml-tls/async/examples/test_server.ml b/duniverse/ocaml-tls/async/examples/test_server.ml index 77d68587d..593be885c 100644 --- a/duniverse/ocaml-tls/async/examples/test_server.ml +++ b/duniverse/ocaml-tls/async/examples/test_server.ml @@ -4,7 +4,7 @@ open! Async let server_cert = "./certificates/server.pem" let server_key = "./certificates/server.key" -let serve_tls port handler = +let serve_tls ~low_level port handler = let%bind certificate = Tls_async.X509_async.Certificate.of_pem_file server_cert |> Deferred.Or_error.ok_exn in @@ -21,10 +21,18 @@ let serve_tls port handler = in let where_to_listen = Tcp.Where_to_listen.of_port port in let on_handler_error = `Ignore in - Tls_async.listen ~on_handler_error config where_to_listen handler + if low_level then + Tcp.Server.create + ~on_handler_error + where_to_listen + (fun sa -> + printf !"connection establised from %{Socket.Address.Inet} starting TLS\n" sa; + Tls_async.upgrade_server_handler ~config (handler sa)) + else + Tls_async.listen ~on_handler_error config where_to_listen handler ;; -let test_server port = +let test_server ~low_level port = let handler (_ : Socket.Address.Inet.t) (_ : Tls_async.Session.t) rd wr = let pipe = Reader.pipe rd in let rec read_from_pipe () = @@ -35,17 +43,18 @@ let test_server port = in read_from_pipe () in - serve_tls port handler + serve_tls ~low_level port handler ;; let cmd = let open Command.Let_syntax in Command.async ~summary:"test server" - (let%map_open port = anon ("PORT" %: int) in + (let%map_open port = anon ("PORT" %: int) + and low_level = flag "-low-level" no_arg ~doc:"set up Tcp.server directly" in fun () -> let open Deferred.Let_syntax in - let%bind server = test_server port in + let%bind server = test_server ~low_level port in Tcp.Server.close_finished server) ;; diff --git a/duniverse/ocaml-tls/async/tls_async.ml b/duniverse/ocaml-tls/async/tls_async.ml index c82f87f7b..afeedfec4 100644 --- a/duniverse/ocaml-tls/async/tls_async.ml +++ b/duniverse/ocaml-tls/async/tls_async.ml @@ -65,6 +65,25 @@ let upgrade_client_reader_writer_to_tls ?host config rw = upgrade_connection tls_session rw |> Deferred.ok ;; +type 'a io_handler = Reader.t -> Writer.t -> 'a Deferred.t +type 'a tls_handler = Session.t -> 'a io_handler + +let upgrade_server_handler ~config handle_client outer_reader outer_writer = + let%bind ( tls_session + , inner_reader + , inner_writer + , `Tls_closed_and_flushed_downstream inner_cafd ) + = + upgrade_server_reader_writer_to_tls config (outer_reader, outer_writer) + |> Deferred.Or_error.ok_exn + in + Monitor.protect + (fun () -> handle_client tls_session inner_reader inner_writer) + ~finally:(fun () -> + Deferred.all_unit + [ Reader.close inner_reader; Writer.close inner_writer; inner_cafd ]) +;; + let listen ?buffer_age_limit ?max_connections @@ -76,21 +95,6 @@ let listen where_to_listen handle_client = - let tls_handler sock outer_reader outer_writer = - let%bind ( tls_session - , inner_reader - , inner_writer - , `Tls_closed_and_flushed_downstream inner_cafd ) - = - upgrade_server_reader_writer_to_tls config (outer_reader, outer_writer) - |> Deferred.Or_error.ok_exn - in - Monitor.protect - (fun () -> handle_client sock tls_session inner_reader inner_writer) - ~finally:(fun () -> - Deferred.all_unit - [ Reader.close inner_reader; Writer.close inner_writer; inner_cafd ]) - in Tcp.Server.create ?buffer_age_limit ?max_connections @@ -99,7 +103,8 @@ let listen ?socket ~on_handler_error where_to_listen - tls_handler + (fun sock -> + upgrade_server_handler ~config (handle_client sock)) ;; let connect diff --git a/duniverse/ocaml-tls/async/tls_async.mli b/duniverse/ocaml-tls/async/tls_async.mli index 0c42d2041..b4894b8a1 100644 --- a/duniverse/ocaml-tls/async/tls_async.mli +++ b/duniverse/ocaml-tls/async/tls_async.mli @@ -24,6 +24,23 @@ val listen -> ('address -> Session.t -> Reader.t -> Writer.t -> unit Deferred.t) -> ('address, 'listening_on) Tcp.Server.t Deferred.t +type 'a io_handler = Reader.t -> Writer.t -> 'a Deferred.t +type 'a tls_handler = Session.t -> 'a io_handler + +(** [upgrade_server_handler] is what [listen] calls to handle each client. + It is exposed so that low-level end-users of the library can use tls-async + inside of code that manages Tcp services directly. + + The [tls_handler] argument will be called with the client Tls session, + reader and writer to be used for cleartext data. + + The outer [reader] and [writer] will read encrypted data from and write + encrypted data to the connected socket. *) +val upgrade_server_handler + : config:Tls.Config.server + -> 'a tls_handler + -> 'a io_handler + (** [connect] behaves similarly to [Tcp.connect], exposing a cleartext reader and writer. Callers should ensure they close the [Writer.t] and wait for the [unit Deferred.t] returned by [`Closed_and_flushed_downstream] to completely shut down the TLS connection diff --git a/duniverse/ocaml-tls/dune-project b/duniverse/ocaml-tls/dune-project index 831069edd..67e2fc8e3 100644 --- a/duniverse/ocaml-tls/dune-project +++ b/duniverse/ocaml-tls/dune-project @@ -1,3 +1,5 @@ -(lang dune 1.0) +(lang dune 3.0) (name tls) -(version v0.15.3) +(version v0.15.4) +(formatting disabled) +(using mdx 0.2) diff --git a/duniverse/ocaml-tls/eio/dune b/duniverse/ocaml-tls/eio/dune new file mode 100644 index 000000000..b0de7a284 --- /dev/null +++ b/duniverse/ocaml-tls/eio/dune @@ -0,0 +1,5 @@ +(library + (name tls_eio) + (public_name tls-eio) + (wrapped false) + (libraries tls eio ptime.clock.os)) diff --git a/duniverse/ocaml-tls/eio/tests/dune b/duniverse/ocaml-tls/eio/tests/dune new file mode 100644 index 000000000..9caa98cd3 --- /dev/null +++ b/duniverse/ocaml-tls/eio/tests/dune @@ -0,0 +1,13 @@ +(copy_files ../../certificates/*.crt) +(copy_files ../../certificates/*.key) +(copy_files ../../certificates/*.pem) + +(mdx + (package tls-eio) + (deps + server.pem + server.key + server-ec.pem + server-ec.key + (package tls-eio) + (package eio_main))) diff --git a/duniverse/ocaml-tls/eio/tests/tls_eio.md b/duniverse/ocaml-tls/eio/tests/tls_eio.md new file mode 100644 index 000000000..dace2d701 --- /dev/null +++ b/duniverse/ocaml-tls/eio/tests/tls_eio.md @@ -0,0 +1,116 @@ +```ocaml +# #require "eio_main";; +# #require "tls-eio";; +# #require "mirage-crypto-rng-eio";; +``` + +```ocaml +open Eio.Std + +module Flow = Eio.Flow +``` + +## Test client + +```ocaml +let null_auth ?ip:_ ~host:_ _ = Ok None + +let mypsk = ref None + +let ticket_cache = { + Tls.Config.lookup = (fun _ -> None) ; + ticket_granted = (fun psk epoch -> + Logs.info (fun m -> m "ticket granted %a %a" + Sexplib.Sexp.pp_hum (Tls.Core.sexp_of_psk13 psk) + Sexplib.Sexp.pp_hum (Tls.Core.sexp_of_epoch_data epoch)) ; + mypsk := Some (psk, epoch)) ; + lifetime = 0l ; + timestamp = Ptime_clock.now +} + +let test_client ~net (host, service) = + match Eio.Net.getaddrinfo_stream net host ~service with + | [] -> failwith "No addresses found!" + | addr :: _ -> + let authenticator = null_auth in + Switch.run @@ fun sw -> + let socket = Eio.Net.connect ~sw net addr in + let flow = + let host = + Result.to_option + (Result.bind (Domain_name.of_string host) Domain_name.host) + in + Tls_eio.client_of_flow + Tls.Config.(client ~version:(`TLS_1_0, `TLS_1_3) ?cached_ticket:!mypsk ~ticket_cache ~authenticator ~ciphers:Ciphers.supported ()) + ?host socket + in + let req = String.concat "\r\n" [ + "GET / HTTP/1.1" ; "Host: " ^ host ; "Connection: close" ; "" ; "" + ] in + Flow.copy_string req flow; + let r = Eio.Buf_read.of_flow flow ~max_size:max_int in + let line = Eio.Buf_read.take 3 r in + traceln "client <- %s" line; + traceln "client done." +``` + +## Test server + +```ocaml +let server_config dir = + let ( / ) = Eio.Path.( / ) in + let certificate = + X509_eio.private_of_pems + ~cert:(dir / "server.pem") + ~priv_key:(dir / "server.key") + in + let ec_certificate = + X509_eio.private_of_pems + ~cert:(dir / "server-ec.pem") + ~priv_key:(dir / "server-ec.key") + in + let certificates = `Multiple [ certificate ; ec_certificate ] in + Tls.Config.(server ~version:(`TLS_1_0, `TLS_1_3) ~certificates ~ciphers:Ciphers.supported ()) + +let serve_ssl ~config server_s callback = + Switch.run @@ fun sw -> + let client, addr = Eio.Net.accept ~sw server_s in + let flow = Tls_eio.server_of_flow config client in + traceln "server -> connect"; + callback flow addr +``` + +## Test case + +```ocaml +# Eio_main.run @@ fun env -> + let net = env#net in + let certificates_dir = env#cwd in + Mirage_crypto_rng_eio.run (module Mirage_crypto_rng.Fortuna) env @@ fun () -> + Switch.run @@ fun sw -> + let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, 4433) in + let listening_socket = Eio.Net.listen ~sw net ~backlog:5 ~reuse_addr:true addr in + (* Eio.Time.with_timeout_exn env#clock 0.1 @@ fun () -> *) + Fiber.both + (fun () -> + traceln "server -> start @@ %a" Eio.Net.Sockaddr.pp addr; + let config = server_config certificates_dir in + serve_ssl ~config listening_socket @@ fun flow _addr -> + traceln "handler accepted"; + let r = Eio.Buf_read.of_flow flow ~max_size:max_int in + let line = Eio.Buf_read.line r in + traceln "handler + %s" line; + Flow.copy_string line flow + ) + (fun () -> + test_client ~net ("127.0.0.1", "4433") + ) + ;; ++server -> start @ tcp:127.0.0.1:4433 ++server -> connect ++handler accepted ++handler + GET / HTTP/1.1 ++client <- GET ++client done. +- : unit = () +``` diff --git a/duniverse/ocaml-tls/eio/tls_eio.ml b/duniverse/ocaml-tls/eio/tls_eio.ml new file mode 100644 index 000000000..332b04071 --- /dev/null +++ b/duniverse/ocaml-tls/eio/tls_eio.ml @@ -0,0 +1,232 @@ +module Flow = Eio.Flow + +exception Tls_alert of Tls.Packet.alert_type +exception Tls_failure of Tls.Engine.failure + +module Raw = struct + + (* We could replace [`Eof] with [`Error End_of_file] and then use + a regular [result] type here. *) + type t = { + flow : Flow.two_way ; + mutable state : [ `Active of Tls.Engine.state + | `Eof + | `Error of exn ] ; + mutable linger : Cstruct.t option ; + recv_buf : Cstruct.t ; + } + + let read_t t cs = + try Flow.read t.flow cs + with + | End_of_file as ex -> + t.state <- `Eof; + raise ex + | exn -> + (match t.state with + | `Error _ | `Eof -> () + | `Active _ -> t.state <- `Error exn) ; + raise exn + + let write_t t cs = + try Flow.copy (Flow.cstruct_source [cs]) t.flow + with exn -> + (match t.state with + | `Error _ | `Eof -> () + | `Active _ -> t.state <- `Error exn) ; + raise exn + + let try_write_t t cs = + try write_t t cs + with _ -> Eio.Fiber.check () (* Error is in [t.state] *) + + let rec read_react t = + + let handle tls buf = + match Tls.Engine.handle_tls tls buf with + | Ok (state', `Response resp, `Data data) -> + let state' = match state' with + | `Ok tls -> `Active tls + | `Eof -> raise End_of_file + | `Alert a -> `Error (Tls_alert a) + in + t.state <- state' ; + Option.iter (try_write_t t) resp; + data + + | Error (alert, `Response resp) -> + t.state <- `Error (Tls_failure alert) ; + write_t t resp; read_react t + in + + match t.state with + | `Error e -> raise e + | `Eof -> raise End_of_file + | `Active _ -> + let n = read_t t t.recv_buf in + match (t.state, n) with + | (`Active tls, n) -> handle tls (Cstruct.sub t.recv_buf 0 n) + | (`Error e, _) -> raise e + | (`Eof, _) -> raise End_of_file + + let rec read t buf = + + let writeout res = + let open Cstruct in + let rlen = length res in + let n = min (length buf) rlen in + blit res 0 buf 0 n ; + t.linger <- + (if n < rlen then Some (sub res n (rlen - n)) else None) ; + n in + + match t.linger with + | Some res -> writeout res + | None -> + match read_react t with + | None -> read t buf + | Some res -> writeout res + + let writev t css = + match t.state with + | `Error err -> raise err + | `Eof -> raise End_of_file + | `Active tls -> + match Tls.Engine.send_application_data tls css with + | Some (tls, tlsdata) -> + ( t.state <- `Active tls ; write_t t tlsdata ) + | None -> invalid_arg "tls: write: socket not ready" + + let write t cs = writev t [cs] + + (* + * XXX bad XXX + * This is a point that should particularly be protected from concurrent r/w. + * Doing this before a `t` is returned is safe; redoing it during rekeying is + * not, as the API client already sees the `t` and can mistakenly interleave + * writes while this is in progress. + * *) + let rec drain_handshake t = + let push_linger t mcs = + match (mcs, t.linger) with + | (None, _) -> () + | (scs, None) -> t.linger <- scs + | (Some cs, Some l) -> t.linger <- Some (Cstruct.append l cs) + in + match t.state with + | `Active tls when not (Tls.Engine.handshake_in_progress tls) -> + t + | _ -> + let cs = read_react t in + push_linger t cs; drain_handshake t + + let reneg ?authenticator ?acceptable_cas ?cert ?(drop = true) t = + match t.state with + | `Error err -> raise err + | `Eof -> raise End_of_file + | `Active tls -> + match Tls.Engine.reneg ?authenticator ?acceptable_cas ?cert tls with + | None -> invalid_arg "tls: can't renegotiate" + | Some (tls', buf) -> + if drop then t.linger <- None ; + t.state <- `Active tls' ; + write_t t buf; + ignore (drain_handshake t : t) + + let key_update ?request t = + match t.state with + | `Error err -> raise err + | `Eof -> raise End_of_file + | `Active tls -> + match Tls.Engine.key_update ?request tls with + | Error _ -> invalid_arg "tls: can't update key" + | Ok (tls', buf) -> + t.state <- `Active tls' ; + write_t t buf + + let close_tls t = + match t.state with + | `Active tls -> + let (_, buf) = Tls.Engine.send_close_notify tls in + t.state <- `Eof ; (* XXX: this looks wrong - we're only trying to close the sending side *) + write_t t buf + | _ -> () + + (* Not sure if we need to keep both directions open on the underlying flow when closing + one direction at the TLS level. *) + let shutdown t = function + | `Send -> close_tls t + | `All -> close_tls t; Flow.shutdown t.flow `All + | `Receive -> () (* Not obvious how to do this with TLS, so ignore for now. *) + + let server_of_flow config flow = + drain_handshake { + state = `Active (Tls.Engine.server config) ; + flow = (flow :> Flow.two_way) ; + linger = None ; + recv_buf = Cstruct.create 4096 + } + + let client_of_flow config ?host flow = + let config' = match host with + | None -> config + | Some host -> Tls.Config.peer config host + in + let t = { + state = `Eof ; + flow = (flow :> Flow.two_way); + linger = None ; + recv_buf = Cstruct.create 4096 + } in + let (tls, init) = Tls.Engine.client config' in + let t = { t with state = `Active tls } in + write_t t init; + drain_handshake t + + + let epoch t = + match t.state with + | `Active tls -> ( match Tls.Engine.epoch tls with + | `InitialEpoch -> assert false (* can never occur! *) + | `Epoch data -> Ok data ) + | `Eof -> Error () + | `Error _ -> Error () + + let copy_from t src = + try + while true do + let buf = Cstruct.create 4096 in + let got = Flow.read src buf in + write t (Cstruct.sub buf 0 got) + done + with End_of_file -> () +end + +type t = < + Eio.Flow.two_way; + t : Raw.t; +> + +let of_t t = + object + inherit Eio.Flow.two_way + method read_into = Raw.read t + method copy = Raw.copy_from t + method shutdown = Raw.shutdown t + method t = t + end + +let server_of_flow config flow = Raw.server_of_flow config flow |> of_t +let client_of_flow config ?host flow = Raw.client_of_flow config ?host flow |> of_t + +let reneg ?authenticator ?acceptable_cas ?cert ?drop (t:t) = Raw.reneg ?authenticator ?acceptable_cas ?cert ?drop t#t +let key_update ?request (t:t) = Raw.key_update ?request t#t +let epoch (t:t) = Raw.epoch t#t + +let () = + Printexc.register_printer (function + | Tls_alert typ -> + Some ("TLS alert from peer: " ^ Tls.Packet.alert_type_to_string typ) + | Tls_failure f -> + Some ("TLS failure: " ^ Tls.Engine.string_of_failure f) + | _ -> None) diff --git a/duniverse/ocaml-tls/eio/tls_eio.mli b/duniverse/ocaml-tls/eio/tls_eio.mli new file mode 100644 index 000000000..38d60c92a --- /dev/null +++ b/duniverse/ocaml-tls/eio/tls_eio.mli @@ -0,0 +1,53 @@ +(** Effectful operations using Eio for pure TLS. + + The pure TLS is state and buffer in, state and buffer out. This + module uses Eio for communication over the network. *) + +(** [Tls_alert] exception received from the other endpoint *) +exception Tls_alert of Tls.Packet.alert_type + +(** [Tls_failure] exception while processing incoming data *) +exception Tls_failure of Tls.Engine.failure + +type t = private < Eio.Flow.two_way; .. > + +(** {2 Constructors} *) + +(** [server_of_flow server flow] is [t], after server-side TLS + handshake of [flow] using [server] configuration. + + You must ensure a RNG is installed while using TLS, e.g. using [Mirage_crypto_rng_eio]. + Ideally, this would be part of the [server] config so you couldn't forget it, + but for now you'll get a runtime error if you forget. *) +val server_of_flow : Tls.Config.server -> #Eio.Flow.two_way -> t + +(** [client_of_flow client ~host fd] is [t], after client-side + TLS handshake of [flow] using [client] configuration and [host]. + + You must ensure a RNG is installed while using TLS, e.g. using [Mirage_crypto_rng_eio]. + Ideally, this would be part of the [client] config so you couldn't forget it, + but for now you'll get a runtime error if you forget. *) +val client_of_flow : Tls.Config.client -> ?host:[ `host ] Domain_name.t -> #Eio.Flow.two_way -> t + +(** {2 Control of TLS features} *) + +(** [reneg ~authenticator ~acceptable_cas ~cert ~drop t] renegotiates the + session, and blocks until the renegotiation finished. Optionally, a new + [authenticator] and [acceptable_cas] can be used. The own certificate can + be adjusted by [cert]. If [drop] is [true] (the default), + application data received before the renegotiation finished is dropped. *) +val reneg : + ?authenticator:X509.Authenticator.t -> + ?acceptable_cas:X509.Distinguished_name.t list -> + ?cert:Tls.Config.own_cert -> + ?drop:bool -> + t -> unit + +(** [key_update ~request t] updates the traffic key and requests a traffic key + update from the peer if [request] is provided and [true] (the default). + This is only supported in TLS 1.3. *) +val key_update : ?request:bool -> t -> unit + +(** [epoch t] returns [epoch], which contains information of the + active session. *) +val epoch : t -> (Tls.Core.epoch_data, unit) result diff --git a/duniverse/ocaml-tls/eio/x509_eio.ml b/duniverse/ocaml-tls/eio/x509_eio.ml new file mode 100644 index 000000000..2b7a96b85 --- /dev/null +++ b/duniverse/ocaml-tls/eio/x509_eio.ml @@ -0,0 +1,92 @@ +open Eio.Std + +module Path = Eio.Path + +let () = Path.( / ) + +let read_file path = + Path.load path |> Cstruct.of_string + +let extension str = + let n = String.length str in + let rec scan = function + | i when i = 0 -> None + | i when str.[i - 1] = '.' -> + Some (String.sub str i (n - i)) + | i -> scan (pred i) in + scan n + + +let private_of_pems ~cert ~priv_key = + let certs = + try + let pem = read_file cert in + match X509.Certificate.decode_pem_multiple pem with + | Ok cs -> cs + | Error (`Msg m) -> invalid_arg ("failed to parse certificates " ^ m) + with Invalid_argument m -> + Fmt.failwith "Private certificates %a: %s" Path.pp cert m + in + let pk = + try + let pem = read_file priv_key in + match X509.Private_key.decode_pem pem with + | Ok key -> key + | Error (`Msg m) -> invalid_arg ("failed to parse private key " ^ m) + with Invalid_argument m -> + Fmt.failwith "Private key (%a): %s" Path.pp priv_key m + in + (certs, pk) + +let certs_of_pem path = + try + let pem = read_file path in + match X509.Certificate.decode_pem_multiple pem with + | Ok cs -> cs + | Error (`Msg m) -> invalid_arg ("failed to parse certificates " ^ m) + with Invalid_argument m -> + Fmt.failwith "Certificates in %a: %s" Path.pp path m + +let certs_of_pem_dir path = + Path.read_dir path + |> List.filter (fun file -> extension file = Some "crt") + |> Eio.Fiber.map (fun file -> certs_of_pem (path file)) + |> List.concat + +let crl_of_pem path = + try + let data = read_file path in + match X509.CRL.decode_der data with + | Ok cs -> cs + | Error (`Msg m) -> invalid_arg ("failed to parse CRL " ^ m) + with Invalid_argument m -> + Fmt.failwith "CRL in %a: %s" Path.pp path m + +let crls_of_pem_dir path = + Path.read_dir path + |> Fiber.map (fun file -> crl_of_pem (path file)) + +(* Would be better to take an Eio.Time.clock here, but that API is likely to change soon. *) +let authenticator ?allowed_hashes ?crls param = + let time () = Some (Ptime_clock.now ()) in + let of_cas cas = + let crls = Option.map crls_of_pem_dir crls in + X509.Authenticator.chain_of_trust ?allowed_hashes ?crls ~time cas + and dotted_hex_to_cs hex = + Cstruct.of_hex (String.map (function ':' -> ' ' | x -> x) hex) + and fingerp hash fingerprint = + X509.Authenticator.server_key_fingerprint ~time ~hash ~fingerprint + and cert_fingerp hash fingerprint = + X509.Authenticator.server_cert_fingerprint ~time ~hash ~fingerprint + in + match param with + | `Ca_file path -> certs_of_pem path |> of_cas + | `Ca_dir path -> certs_of_pem_dir path |> of_cas + | `Key_fingerprint (hash, fp) -> fingerp hash fp + | `Hex_key_fingerprint (hash, fp) -> + let fp = dotted_hex_to_cs fp in + fingerp hash fp + | `Cert_fingerprint (hash, fp) -> cert_fingerp hash fp + | `Hex_cert_fingerprint (hash, fp) -> + let fp = dotted_hex_to_cs fp in + cert_fingerp hash fp diff --git a/duniverse/ocaml-tls/eio/x509_eio.mli b/duniverse/ocaml-tls/eio/x509_eio.mli new file mode 100644 index 000000000..653d5596f --- /dev/null +++ b/duniverse/ocaml-tls/eio/x509_eio.mli @@ -0,0 +1,26 @@ +(** X.509 certificate handling using Eio. *) + +(** [private_of_pems ~cert ~priv_key] is [priv], after reading the + private key and certificate chain from the given PEM-encoded + files. *) +val private_of_pems : cert:_ Eio.Path.t -> priv_key:_ Eio.Path.t -> Tls.Config.certchain + +(** [certs_of_pem file] is [certificates], which are read from the + PEM-encoded [file]. *) +val certs_of_pem : _ Eio.Path.t -> X509.Certificate.t list + +(** [certs_of_pem_dir dir] is [certificates], which are read from all + PEM-encoded files in [dir]. *) +val certs_of_pem_dir : _ Eio.Path.t -> X509.Certificate.t list + +(** [authenticator methods] constructs an [authenticator] using the + specified method and data. *) +val authenticator : ?allowed_hashes:Mirage_crypto.Hash.hash list -> ?crls:_ Eio.Path.t -> + [ `Ca_file of _ Eio.Path.t + | `Ca_dir of _ Eio.Path.t + | `Key_fingerprint of Mirage_crypto.Hash.hash * Cstruct.t + | `Hex_key_fingerprint of Mirage_crypto.Hash.hash * string + | `Cert_fingerprint of Mirage_crypto.Hash.hash * Cstruct.t + | `Hex_cert_fingerprint of Mirage_crypto.Hash.hash * string + ] + -> X509.Authenticator.t diff --git a/duniverse/ocaml-tls/lib/engine.mli b/duniverse/ocaml-tls/lib/engine.mli index 92583cbfa..2b319b09c 100644 --- a/duniverse/ocaml-tls/lib/engine.mli +++ b/duniverse/ocaml-tls/lib/engine.mli @@ -31,7 +31,7 @@ functional matter ({!Engine}, this module), and effectful parts: {!Tls_lwt} and {!Tls_mirage}. - {e v0.15.3 - {{:https://github.com/mirleft/ocaml-tls }homepage}} *) + {e v0.15.4} *) (** {1 Abstract state type} *) diff --git a/duniverse/ocaml-tls/lwt/examples/echo_client.ml b/duniverse/ocaml-tls/lwt/examples/echo_client.ml index 2637eeaff..9bc5765c0 100644 --- a/duniverse/ocaml-tls/lwt/examples/echo_client.ml +++ b/duniverse/ocaml-tls/lwt/examples/echo_client.ml @@ -63,7 +63,7 @@ let trust = let cmd = let term = Term.(const jump $ setup_log $ port $ host $ trust) - and info = Cmd.info "server" ~version:"0.15.3" + and info = Cmd.info "server" ~version:"0.15.4" in Cmd.v info term diff --git a/duniverse/ocaml-tls/lwt/examples/echo_server.ml b/duniverse/ocaml-tls/lwt/examples/echo_server.ml index 8e1e6a279..bef525f74 100644 --- a/duniverse/ocaml-tls/lwt/examples/echo_server.ml +++ b/duniverse/ocaml-tls/lwt/examples/echo_server.ml @@ -68,7 +68,7 @@ let port = let cmd = let term = Term.(ret (const echo_server $ setup_log $ port)) - and info = Cmd.info "server" ~version:"0.15.3" + and info = Cmd.info "server" ~version:"0.15.4" in Cmd.v info term diff --git a/duniverse/ocaml-tls/lwt/examples/fuzz_server.ml b/duniverse/ocaml-tls/lwt/examples/fuzz_server.ml index 3c45762e3..3df81cfa0 100644 --- a/duniverse/ocaml-tls/lwt/examples/fuzz_server.ml +++ b/duniverse/ocaml-tls/lwt/examples/fuzz_server.ml @@ -94,7 +94,7 @@ let port = let cmd = let term = Term.(ret (const jump $ setup_log $ port)) - and info = Cmd.info "server" ~version:"0.15.3" + and info = Cmd.info "server" ~version:"0.15.4" in Cmd.v info term diff --git a/duniverse/ocaml-tls/lwt/examples/test_client.ml b/duniverse/ocaml-tls/lwt/examples/test_client.ml index 2b2571695..57d7327e2 100644 --- a/duniverse/ocaml-tls/lwt/examples/test_client.ml +++ b/duniverse/ocaml-tls/lwt/examples/test_client.ml @@ -45,7 +45,7 @@ open Cmdliner let cmd = let term = Term.(ret (const jump $ setup_log)) - and info = Cmd.info "test_client" ~version:"0.15.3" + and info = Cmd.info "test_client" ~version:"0.15.4" in Cmd.v info term diff --git a/duniverse/ocaml-tls/tls-async.opam b/duniverse/ocaml-tls/tls-async.opam index 3df91d6b7..3d8c7c5e2 100644 --- a/duniverse/ocaml-tls/tls-async.opam +++ b/duniverse/ocaml-tls/tls-async.opam @@ -1,4 +1,4 @@ -version: "0.15.3" +version: "0.15.4" opam-version: "2.0" homepage: "https://github.com/mirleft/ocaml-tls" dev-repo: "git+https://github.com/mirleft/ocaml-tls.git" @@ -15,8 +15,8 @@ build: [ ] depends: [ - "ocaml" {>= "4.08.0"} - "dune" {>= "1.0"} + "ocaml" {>= "4.08.0" & < "5.0.0"} + "dune" {>= "3.0"} "tls" {= version} "x509" {>= "0.14.0"} "ptime" {>= "0.8.1"} diff --git a/duniverse/ocaml-tls/tls-eio.opam b/duniverse/ocaml-tls/tls-eio.opam new file mode 100644 index 000000000..d324d2530 --- /dev/null +++ b/duniverse/ocaml-tls/tls-eio.opam @@ -0,0 +1,44 @@ +version: "0.15.4" +opam-version: "2.0" +homepage: "https://github.com/mirleft/ocaml-tls" +dev-repo: "git+https://github.com/mirleft/ocaml-tls.git" +bug-reports: "https://github.com/mirleft/ocaml-tls/issues" +doc: "https://mirleft.github.io/ocaml-tls/doc" +authors: ["Thomas Leonard"] +maintainer: ["Hannes Mehnert " "David Kaloper "] +license: "BSD-2-Clause" + +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] + +depends: [ + "ocaml" {>= "5.0.0"} + "dune" {>= "3.0"} + "tls" {= version} + "mirage-crypto-rng" {>= "0.8.0"} + "mirage-crypto-rng-eio" {>= "0.8.0" with-test} + "x509" {>= "0.15.0"} + "eio" {>= "0.5"} + "eio_main" {>= "0.5" with-test} + "mdx" {with-test} +] +tags: [ "org:mirage"] +synopsis: "Transport Layer Security purely in OCaml - Eio" +description: """ +Transport Layer Security (TLS) is probably the most widely deployed security +protocol on the Internet. It provides communication privacy to prevent +eavesdropping, tampering, and message forgery. Furthermore, it optionally +provides authentication of the involved endpoints. TLS is commonly deployed for +securing web services ([HTTPS](http://tools.ietf.org/html/rfc2818)), emails, +virtual private networks, and wireless networks. + +TLS uses asymmetric cryptography to exchange a symmetric key, and optionally +authenticate (using X.509) either or both endpoints. It provides algorithmic +agility, which means that the key exchange method, symmetric encryption +algorithm, and hash algorithm are negotiated. + +Read [further](https://nqsb.io) and our [Usenix Security 2015 paper](https://usenix15.nqsb.io). +""" \ No newline at end of file diff --git a/duniverse/ocaml-tls/tls-mirage.opam b/duniverse/ocaml-tls/tls-mirage.opam index 197b47ee9..f139653d2 100644 --- a/duniverse/ocaml-tls/tls-mirage.opam +++ b/duniverse/ocaml-tls/tls-mirage.opam @@ -1,4 +1,4 @@ -version: "0.15.3" +version: "0.15.4" opam-version: "2.0" homepage: "https://github.com/mirleft/ocaml-tls" dev-repo: "git+https://github.com/mirleft/ocaml-tls.git" @@ -16,7 +16,7 @@ build: [ depends: [ "ocaml" {>= "4.08.0"} - "dune" {>= "1.0"} + "dune" {>= "3.0"} "tls" {= version} "x509" {>= "0.13.0"} "fmt" {>= "0.8.7"} diff --git a/duniverse/ocaml-tls/tls.opam b/duniverse/ocaml-tls/tls.opam index bda7804e6..582a0b24e 100644 --- a/duniverse/ocaml-tls/tls.opam +++ b/duniverse/ocaml-tls/tls.opam @@ -1,4 +1,4 @@ -version: "0.15.3" +version: "0.15.4" opam-version: "2.0" homepage: "https://github.com/mirleft/ocaml-tls" dev-repo: "git+https://github.com/mirleft/ocaml-tls.git" @@ -16,7 +16,7 @@ build: [ depends: [ "ocaml" {>= "4.08.0"} - "dune" {>= "1.0"} + "dune" {>= "3.0"} "ppx_sexp_conv" {>= "v0.9.0"} "ppx_cstruct" {>= "3.0.0"} "cstruct" {>= "6.0.0"} diff --git a/duniverse/ocaml-x509/CHANGES.md b/duniverse/ocaml-x509/CHANGES.md index 9f43a0d56..501f97023 100644 --- a/duniverse/ocaml-x509/CHANGES.md +++ b/duniverse/ocaml-x509/CHANGES.md @@ -1,3 +1,14 @@ +## v0.16.2 (2022-10-05) + +* Improve parse error message of Authenticator.of_string (mirage/ocaml-git#593 + by @dinosaure, mirage/ocaml-git#582 by @reynir) + +## v0.16.1 (2022-09-14) + +* Support ECDSA signatures where the hash algorithm output length exceeds the + size of the elliptic curve (by truncating, and using the leftmost bits). + Reported as #158 by @torinnd, fixed in #159 by @hannesm + ## v0.16.0 (2022-02-15) * Provide X509.Authenticator.of_string to construct an Authenticator.t from diff --git a/duniverse/ocaml-x509/README.md b/duniverse/ocaml-x509/README.md index 40d1392f0..4ffd548b2 100644 --- a/duniverse/ocaml-x509/README.md +++ b/duniverse/ocaml-x509/README.md @@ -1,6 +1,6 @@ ## X.509 - Public Key Infrastructure purely in OCaml -v0.16.0 +v0.16.2 X.509 is a public key infrastructure used mostly on the Internet. It consists of certificates which include public keys and identifiers, signed by an authority. Authorities must be exchanged over a second channel to establish the diff --git a/duniverse/ocaml-x509/dune-project b/duniverse/ocaml-x509/dune-project index c40885b36..e76b984ea 100644 --- a/duniverse/ocaml-x509/dune-project +++ b/duniverse/ocaml-x509/dune-project @@ -1,3 +1,3 @@ (lang dune 1.2) (name x509) -(version v0.16.0) +(version v0.16.2) diff --git a/duniverse/ocaml-x509/lib/authenticator.ml b/duniverse/ocaml-x509/lib/authenticator.ml index 2fe4d21a2..771d4544b 100644 --- a/duniverse/ocaml-x509/lib/authenticator.ml +++ b/duniverse/ocaml-x509/lib/authenticator.ml @@ -39,8 +39,21 @@ let fingerprint_of_string s = in Ok (Cstruct.of_string d) +let format = + {| +The format of an authenticator is: +- [none]: no authentication +- [key-fp(:?):]: to authenticate a peer via + its key fingerprintf (hash is optional and defaults to SHA256) +- [cert-fp(:?):]: to authenticate a peer via + its certificate fingerprint (hash is optional and defaults to SHA256) +- [trust-anchor(:)+] to authenticate a peer from + a list of certificates (certificate must be in PEM format witthout header and + footer (----BEGIN CERTIFICATE----) and without newlines). +|} + let of_string str = - match String.split_on_char ':' str with + begin match String.split_on_char ':' str with | [ "key-fp" ; hash ; tls_key_fingerprint ] -> let* hash = hash_of_string (String.lowercase_ascii hash) in let* fingerprint = fingerprint_of_string tls_key_fingerprint in @@ -67,3 +80,4 @@ let of_string str = Ok (fun time -> chain_of_trust ~time (List.rev anchors)) | [ "none" ] -> Ok (fun _ ?ip:_ ~host:_ _ -> Ok None) | _ -> Error (`Msg (Fmt.str "Invalid TLS authenticator: %S" str)) + end |> Result.map_error (function `Msg e -> `Msg (e ^ format)) diff --git a/duniverse/ocaml-x509/lib/private_key.ml b/duniverse/ocaml-x509/lib/private_key.ml index 6db1c7942..0bfa783b8 100644 --- a/duniverse/ocaml-x509/lib/private_key.ml +++ b/duniverse/ocaml-x509/lib/private_key.ml @@ -106,10 +106,10 @@ let sign hash ?scheme key data = | #ecdsa as key, `ECDSA -> let* d = hashed () in Ok (ecdsa_to_cs (match key with - | `P224 key -> P224.Dsa.sign ~key d - | `P256 key -> P256.Dsa.sign ~key d - | `P384 key -> P384.Dsa.sign ~key d - | `P521 key -> P521.Dsa.sign ~key d)) + | `P224 key -> P224.Dsa.(sign ~key (Public_key.trunc byte_length d)) + | `P256 key -> P256.Dsa.(sign ~key (Public_key.trunc byte_length d)) + | `P384 key -> P384.Dsa.(sign ~key (Public_key.trunc byte_length d)) + | `P521 key -> P521.Dsa.(sign ~key (Public_key.trunc byte_length d)))) | _ -> Error (`Msg "invalid key and signature scheme combination") with | Mirage_crypto_pk.Rsa.Insufficient_key -> diff --git a/duniverse/ocaml-x509/lib/public_key.ml b/duniverse/ocaml-x509/lib/public_key.ml index 3cbebf00a..82344d56a 100644 --- a/duniverse/ocaml-x509/lib/public_key.ml +++ b/duniverse/ocaml-x509/lib/public_key.ml @@ -113,6 +113,12 @@ let hashed hash data = let n = Cstruct.length d and m = Mirage_crypto.Hash.digest_size hash in if n = m then Ok d else Error (`Msg "digested data of invalid size") +let trunc len data = + if Cstruct.length data > len then + Cstruct.sub data 0 len + else + data + let verify hash ?scheme ~signature key data = let open Mirage_crypto_ec in let ok_if_true p = if p then Ok () else Error (`Msg "bad signature") in @@ -141,10 +147,10 @@ let verify hash ?scheme ~signature key data = let* s = ecdsa_of_cs signature in ok_if_true (match key with - | `P224 key -> P224.Dsa.verify ~key s d - | `P256 key -> P256.Dsa.verify ~key s d - | `P384 key -> P384.Dsa.verify ~key s d - | `P521 key -> P521.Dsa.verify ~key s d) + | `P224 key -> P224.Dsa.verify ~key s (trunc P224.Dsa.byte_length d) + | `P256 key -> P256.Dsa.verify ~key s (trunc P256.Dsa.byte_length d) + | `P384 key -> P384.Dsa.verify ~key s (trunc P384.Dsa.byte_length d) + | `P521 key -> P521.Dsa.verify ~key s (trunc P521.Dsa.byte_length d)) | _ -> Error (`Msg "invalid key and signature scheme combination") let encode_der = Asn.pub_info_to_cstruct diff --git a/duniverse/ocaml-x509/lib/x509.mli b/duniverse/ocaml-x509/lib/x509.mli index 3981e8812..452bf63e9 100644 --- a/duniverse/ocaml-x509/lib/x509.mli +++ b/duniverse/ocaml-x509/lib/x509.mli @@ -49,7 +49,7 @@ extension is marked as critical in a certificate, but not handled, the validation will fail. - {e v0.16.0 - {{:https://github.com/mirleft/ocaml-x509 }homepage}} *) + {e v0.16.2 - {{:https://github.com/mirleft/ocaml-x509 }homepage}} *) (** Hostnames (strict, wildcard), used for validation. *) module Host : sig diff --git a/duniverse/ocaml-x509/tests/regression.ml b/duniverse/ocaml-x509/tests/regression.ml index 58e24805d..b0a19c642 100644 --- a/duniverse/ocaml-x509/tests/regression.ml +++ b/duniverse/ocaml-x509/tests/regression.ml @@ -265,6 +265,19 @@ let ip_address () = | Error ce -> Alcotest.failf "validation of IP address failed: %a" Validation.pp_chain_error ce +let p256_sha384 () = + let file = "p256_sha384" in + match Certificate.decode_pem (regression file) with + | Error (`Msg msg) -> + Alcotest.failf "P256 certificate with SHA384 %s, decoding error %s" + file msg + | Ok cert -> + match Validation.valid_ca cert with + | Error e -> + Alcotest.failf "verifying P256 certificate failed %a" + Validation.pp_ca_error e + | Ok () -> () + let regression_tests = [ "RSA: key too small (jc_jc)", `Quick, test_jc_jc ; "jc_ca", `Quick, test_jc_ca_fail ; @@ -286,6 +299,7 @@ let regression_tests = [ "p384 certificate", `Quick, le_p384_root ; "p256 key", `Quick, p256_key ; "ip_address", `Quick, ip_address ; + "p256 with sha384", `Quick, p256_sha384 ; ] let host_set_test = diff --git a/duniverse/ocaml-x509/tests/regression/p256_sha384.pem b/duniverse/ocaml-x509/tests/regression/p256_sha384.pem new file mode 100644 index 000000000..ae4ff6e78 --- /dev/null +++ b/duniverse/ocaml-x509/tests/regression/p256_sha384.pem @@ -0,0 +1,13 @@ +-----BEGIN CERTIFICATE----- +MIICADCCAaagAwIBAgIUHyCUM78QgqYYqanmNGJYTXnAk20wCgYIKoZIzj0EAwMw +TzELMAkGA1UEBhMCQVUxITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0 +ZDEdMBsGA1UEAwwUcDI1NiBrZXkgd2l0aCBzaGEzODQwHhcNMjIwOTEzMTA1NDQ1 +WhcNMjMwOTA4MTA1NDQ1WjBPMQswCQYDVQQGEwJBVTEhMB8GA1UECgwYSW50ZXJu +ZXQgV2lkZ2l0cyBQdHkgTHRkMR0wGwYDVQQDDBRwMjU2IGtleSB3aXRoIHNoYTM4 +NDBZMBMGByqGSM49AgEGCCqGSM49AwEHA0IABFjrBgci81MwGVNjEtG2gexFcJbK +Y2niGcoU2rAmQrB6PyfbhBHFCwmVwPEGyB39bRI+Toy6qFMMSK35EktMmGujYDBe +MB0GA1UdDgQWBBRqwn0D+5XJdoUbL0JWG+eYO+xRcDAfBgNVHSMEGDAWgBRqwn0D ++5XJdoUbL0JWG+eYO+xRcDAPBgNVHRMBAf8EBTADAQH/MAsGA1UdDwQEAwICBDAK +BggqhkjOPQQDAwNIADBFAiACu3r0M9V45MGoH9Pv2eXPwNfSiEtcEI5VzxbvO24z +/AIhAKATujXQk8FiBG0jH2982DzQBIQ03OkoA7MmReOomiY/ +-----END CERTIFICATE----- diff --git a/duniverse/ocaml-x509/x509.opam b/duniverse/ocaml-x509/x509.opam index 8f8bf9957..baf659cab 100644 --- a/duniverse/ocaml-x509/x509.opam +++ b/duniverse/ocaml-x509/x509.opam @@ -1,4 +1,4 @@ -version: "0.16.0" +version: "0.16.2" opam-version: "2.0" maintainer: [ "Hannes Mehnert " @@ -21,7 +21,7 @@ depends: [ "base64" {>= "3.3.0"} "mirage-crypto" "mirage-crypto-pk" - "mirage-crypto-ec" {>= "0.10.0"} + "mirage-crypto-ec" {>= "0.10.7"} "mirage-crypto-rng" "fmt" {>= "0.8.7"} "alcotest" {with-test} diff --git a/duniverse/ppx_expect/evaluator/ppx_expect_evaluator.ml b/duniverse/ppx_expect/evaluator/ppx_expect_evaluator.ml index efb125bfc..7808cbac5 100644 --- a/duniverse/ppx_expect/evaluator/ppx_expect_evaluator.ml +++ b/duniverse/ppx_expect/evaluator/ppx_expect_evaluator.ml @@ -5,15 +5,6 @@ open Expect_test_matcher module Test_result = Ppx_inline_test_lib.Runtime.Test_result module Collector_test_outcome = Expect_test_collector.Test_outcome -module Obj = struct - module Extension_constructor = struct - [@@@ocaml.warning "-3"] - - let of_val = Stdlib.Obj.extension_constructor - let name = Stdlib.Obj.extension_name - end -end - type group = { filename : File.Name.t ; file_contents : string @@ -41,7 +32,7 @@ let convert_collector_test ~allow_output_patterns (test : Collector_test_outcome try Exn.to_string exn with | exn -> let name = - Obj.Extension_constructor.of_val exn |> Obj.Extension_constructor.name + Caml.Obj.Extension_constructor.of_val exn |> Caml.Obj.Extension_constructor.name in Printf.sprintf "(\"%s(Cannot print more details, Exn.to_string failed)\")" name in diff --git a/duniverse/ppx_expect/ppx_expect.opam b/duniverse/ppx_expect/ppx_expect.opam index 7a00b9432..7f228f583 100644 --- a/duniverse/ppx_expect/ppx_expect.opam +++ b/duniverse/ppx_expect/ppx_expect.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.15.0" +version: "v0.15.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/ppx_expect" diff --git a/duniverse/ppxlib/.git-blame-ignore-revs b/duniverse/ppxlib/.git-blame-ignore-revs index ffb5c48b0..a2ee08316 100644 --- a/duniverse/ppxlib/.git-blame-ignore-revs +++ b/duniverse/ppxlib/.git-blame-ignore-revs @@ -3,3 +3,6 @@ #The commit upgrading to ocamlformat 0.20.0 50c1f3736e58be5cf18ad02debf9653799625bfc + +#The commit upgrading to ocamlformat 0.24.1 +0970c3a7f91291bd92eb277331b5b6af20b608e9 diff --git a/duniverse/ppxlib/.ocamlformat b/duniverse/ppxlib/.ocamlformat index 21ebb7576..dd9f5db54 100644 --- a/duniverse/ppxlib/.ocamlformat +++ b/duniverse/ppxlib/.ocamlformat @@ -1,3 +1,3 @@ -version=0.20.0 +version=0.24.1 profile=conventional parse-docstrings=true diff --git a/duniverse/ppxlib/CHANGES.md b/duniverse/ppxlib/CHANGES.md index 70e794774..12b8a9877 100644 --- a/duniverse/ppxlib/CHANGES.md +++ b/duniverse/ppxlib/CHANGES.md @@ -1,3 +1,17 @@ +0.28.0 (05/10/2022) +------------------- + +- Make `esequence` right-associative. (#366, @ceastlund) + +- Deprecate unused attributes in `Deriving.Generator` (#368, @sim642) + +- Remove a pattern match on mutable state in a function argument. (#362, @ceastlund) + +- Add code-path manipulation attributes. (#352, @ceastlund) + +- Update context-free rules to collect expansion errors generated by ppxlib and + propagate them to top level without failing. (#358 and #361, @ceastlund) + 0.27.0 (14/06/2022) ------------------- @@ -36,6 +50,11 @@ - Bump ppxlib's AST to 4.14/5.00 (#320, @pitag-ha) +0.25.1 (17/06/2022) +------------------- + +- Add support for OCaml 5.0 (#355, @pitag-ha) + 0.25.0 (03/03/2022) ------------------- diff --git a/duniverse/ppxlib/README.md b/duniverse/ppxlib/README.md index 8f191174e..83dcfd1df 100644 --- a/duniverse/ppxlib/README.md +++ b/duniverse/ppxlib/README.md @@ -7,8 +7,7 @@ [appveyor]: https://ci.appveyor.com/project/diml/ppxlib/branch/main [appveyor-img]: https://ci.appveyor.com/api/projects/status/bogbsm33uvh083jx?svg=true -[User manual][man] -[API documentation][api-doc] +[Ppxlib documentation][doc] # Overview @@ -24,7 +23,7 @@ ways of automatically traversing values of a given type, in particular allowing to inject a complex structured value into generated code. For more information about ppxlib and how to use it, please consult the -[user manual][man]. +[documentation][doc]. # What is the relation between ppxlib and other ppx libraries? @@ -41,6 +40,5 @@ This repository was created by merging several older smaller projects that were developed at Jane Street. See [the history](HISTORY.md) for more details. -[man]: http://ppxlib.readthedocs.io/ -[api-doc]: https://ocaml-ppx.github.io/ppxlib/index.html +[doc]: https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html [future-of-ppx]: https://discuss.ocaml.org/t/the-future-of-ppx/3766 diff --git a/duniverse/ppxlib/ast/ast.ml b/duniverse/ppxlib/ast/ast.ml index 9c5ce92c9..534608f86 100644 --- a/duniverse/ppxlib/ast/ast.ml +++ b/duniverse/ppxlib/ast/ast.ml @@ -221,7 +221,9 @@ and core_type_desc = Parsetree.core_type_desc = [Ppat_constraint]} node corresponding to a constraint on a let-binding: - {[ let x : 'a1 ... 'an. T = e ... ]} + {[ + let x : 'a1 ... 'an. T = e ... + ]} - Under {{!class_field_kind.Cfk_virtual} [Cfk_virtual]} for methods (not values). @@ -8397,5 +8399,1987 @@ class virtual ['res] lift = method cases : cases -> 'res = self#list self#case end +class virtual ['ctx, 'res] lift_map_with_context = + object (self) + method virtual record : 'ctx -> (string * 'res) list -> 'res + method virtual constr : 'ctx -> string -> 'res list -> 'res + method virtual tuple : 'ctx -> 'res list -> 'res + method virtual other : 'a. 'ctx -> 'a -> 'res + method virtual bool : 'ctx -> bool -> bool * 'res + method virtual char : 'ctx -> char -> char * 'res + method virtual int : 'ctx -> int -> int * 'res + + method virtual list + : 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a list -> 'a list * 'res + + method virtual option + : 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a option -> 'a option * 'res + + method virtual string : 'ctx -> string -> string * 'res + + method position : 'ctx -> position -> position * 'res = + fun ctx { pos_fname; pos_lnum; pos_bol; pos_cnum } -> + let pos_fname = self#string ctx pos_fname in + let pos_lnum = self#int ctx pos_lnum in + let pos_bol = self#int ctx pos_bol in + let pos_cnum = self#int ctx pos_cnum in + ( { + pos_fname = Stdlib.fst pos_fname; + pos_lnum = Stdlib.fst pos_lnum; + pos_bol = Stdlib.fst pos_bol; + pos_cnum = Stdlib.fst pos_cnum; + }, + self#record ctx + [ + ("pos_fname", Stdlib.snd pos_fname); + ("pos_lnum", Stdlib.snd pos_lnum); + ("pos_bol", Stdlib.snd pos_bol); + ("pos_cnum", Stdlib.snd pos_cnum); + ] ) + + method location : 'ctx -> location -> location * 'res = + fun ctx { loc_start; loc_end; loc_ghost } -> + let loc_start = self#position ctx loc_start in + let loc_end = self#position ctx loc_end in + let loc_ghost = self#bool ctx loc_ghost in + ( { + loc_start = Stdlib.fst loc_start; + loc_end = Stdlib.fst loc_end; + loc_ghost = Stdlib.fst loc_ghost; + }, + self#record ctx + [ + ("loc_start", Stdlib.snd loc_start); + ("loc_end", Stdlib.snd loc_end); + ("loc_ghost", Stdlib.snd loc_ghost); + ] ) + + method location_stack : 'ctx -> location_stack -> location_stack * 'res = + self#list self#location + + method loc + : 'a. ('ctx -> 'a -> 'a * 'res) -> 'ctx -> 'a loc -> 'a loc * 'res = + fun _a ctx { txt; loc } -> + let txt = _a ctx txt in + let loc = self#location ctx loc in + ( { txt = Stdlib.fst txt; loc = Stdlib.fst loc }, + self#record ctx [ ("txt", Stdlib.snd txt); ("loc", Stdlib.snd loc) ] + ) + + method longident : 'ctx -> longident -> longident * 'res = + fun ctx x -> + match x with + | Lident a -> + let a = self#string ctx a in + (Lident (Stdlib.fst a), self#constr ctx "Lident" [ Stdlib.snd a ]) + | Ldot (a, b) -> + let a = self#longident ctx a in + let b = self#string ctx b in + ( Ldot (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ldot" [ Stdlib.snd a; Stdlib.snd b ] ) + | Lapply (a, b) -> + let a = self#longident ctx a in + let b = self#longident ctx b in + ( Lapply (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Lapply" [ Stdlib.snd a; Stdlib.snd b ] ) + + method longident_loc : 'ctx -> longident_loc -> longident_loc * 'res = + self#loc self#longident + + method rec_flag : 'ctx -> rec_flag -> rec_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method direction_flag : 'ctx -> direction_flag -> direction_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method private_flag : 'ctx -> private_flag -> private_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method mutable_flag : 'ctx -> mutable_flag -> mutable_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method virtual_flag : 'ctx -> virtual_flag -> virtual_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method override_flag : 'ctx -> override_flag -> override_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method closed_flag : 'ctx -> closed_flag -> closed_flag * 'res = + fun ctx x -> (x, self#other ctx x) + + method label : 'ctx -> label -> label * 'res = self#string + + method arg_label : 'ctx -> arg_label -> arg_label * 'res = + fun ctx x -> + match x with + | Nolabel -> (Nolabel, self#constr ctx "Nolabel" []) + | Labelled a -> + let a = self#string ctx a in + ( Labelled (Stdlib.fst a), + self#constr ctx "Labelled" [ Stdlib.snd a ] ) + | Optional a -> + let a = self#string ctx a in + ( Optional (Stdlib.fst a), + self#constr ctx "Optional" [ Stdlib.snd a ] ) + + method variance : 'ctx -> variance -> variance * 'res = + fun ctx x -> (x, self#other ctx x) + + method injectivity : 'ctx -> injectivity -> injectivity * 'res = + fun ctx x -> (x, self#other ctx x) + + method constant : 'ctx -> constant -> constant * 'res = + fun ctx x -> + match x with + | Pconst_integer (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in + ( Pconst_integer (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pconst_integer" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pconst_char a -> + let a = self#char ctx a in + ( Pconst_char (Stdlib.fst a), + self#constr ctx "Pconst_char" [ Stdlib.snd a ] ) + | Pconst_string (a, b, c) -> + let a = self#string ctx a in + let b = self#location ctx b in + let c = self#option self#string ctx c in + ( Pconst_string (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pconst_string" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pconst_float (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in + ( Pconst_float (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pconst_float" [ Stdlib.snd a; Stdlib.snd b ] ) + + method attribute : 'ctx -> attribute -> attribute * 'res = + fun ctx { attr_name; attr_payload; attr_loc } -> + let attr_name = self#loc self#string ctx attr_name in + let attr_payload = self#payload ctx attr_payload in + let attr_loc = self#location ctx attr_loc in + ( { + attr_name = Stdlib.fst attr_name; + attr_payload = Stdlib.fst attr_payload; + attr_loc = Stdlib.fst attr_loc; + }, + self#record ctx + [ + ("attr_name", Stdlib.snd attr_name); + ("attr_payload", Stdlib.snd attr_payload); + ("attr_loc", Stdlib.snd attr_loc); + ] ) + + method extension : 'ctx -> extension -> extension * 'res = + fun ctx (a, b) -> + let a = self#loc self#string ctx a in + let b = self#payload ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] ) + + method attributes : 'ctx -> attributes -> attributes * 'res = + self#list self#attribute + + method payload : 'ctx -> payload -> payload * 'res = + fun ctx x -> + match x with + | PStr a -> + let a = self#structure ctx a in + (PStr (Stdlib.fst a), self#constr ctx "PStr" [ Stdlib.snd a ]) + | PSig a -> + let a = self#signature ctx a in + (PSig (Stdlib.fst a), self#constr ctx "PSig" [ Stdlib.snd a ]) + | PTyp a -> + let a = self#core_type ctx a in + (PTyp (Stdlib.fst a), self#constr ctx "PTyp" [ Stdlib.snd a ]) + | PPat (a, b) -> + let a = self#pattern ctx a in + let b = self#option self#expression ctx b in + ( PPat (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "PPat" [ Stdlib.snd a; Stdlib.snd b ] ) + + method core_type : 'ctx -> core_type -> core_type * 'res = + fun ctx { ptyp_desc; ptyp_loc; ptyp_loc_stack; ptyp_attributes } -> + let ptyp_desc = self#core_type_desc ctx ptyp_desc in + let ptyp_loc = self#location ctx ptyp_loc in + let ptyp_loc_stack = self#location_stack ctx ptyp_loc_stack in + let ptyp_attributes = self#attributes ctx ptyp_attributes in + ( { + ptyp_desc = Stdlib.fst ptyp_desc; + ptyp_loc = Stdlib.fst ptyp_loc; + ptyp_loc_stack = Stdlib.fst ptyp_loc_stack; + ptyp_attributes = Stdlib.fst ptyp_attributes; + }, + self#record ctx + [ + ("ptyp_desc", Stdlib.snd ptyp_desc); + ("ptyp_loc", Stdlib.snd ptyp_loc); + ("ptyp_loc_stack", Stdlib.snd ptyp_loc_stack); + ("ptyp_attributes", Stdlib.snd ptyp_attributes); + ] ) + + method core_type_desc : 'ctx -> core_type_desc -> core_type_desc * 'res = + fun ctx x -> + match x with + | Ptyp_any -> (Ptyp_any, self#constr ctx "Ptyp_any" []) + | Ptyp_var a -> + let a = self#string ctx a in + ( Ptyp_var (Stdlib.fst a), + self#constr ctx "Ptyp_var" [ Stdlib.snd a ] ) + | Ptyp_arrow (a, b, c) -> + let a = self#arg_label ctx a in + let b = self#core_type ctx b in + let c = self#core_type ctx c in + ( Ptyp_arrow (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Ptyp_arrow" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Ptyp_tuple a -> + let a = self#list self#core_type ctx a in + ( Ptyp_tuple (Stdlib.fst a), + self#constr ctx "Ptyp_tuple" [ Stdlib.snd a ] ) + | Ptyp_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in + ( Ptyp_constr (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ptyp_constr" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ptyp_object (a, b) -> + let a = self#list self#object_field ctx a in + let b = self#closed_flag ctx b in + ( Ptyp_object (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ptyp_object" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ptyp_class (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in + ( Ptyp_class (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ptyp_class" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ptyp_alias (a, b) -> + let a = self#core_type ctx a in + let b = self#string ctx b in + ( Ptyp_alias (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ptyp_alias" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ptyp_variant (a, b, c) -> + let a = self#list self#row_field ctx a in + let b = self#closed_flag ctx b in + let c = self#option (self#list self#label) ctx c in + ( Ptyp_variant (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Ptyp_variant" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Ptyp_poly (a, b) -> + let a = self#list (self#loc self#string) ctx a in + let b = self#core_type ctx b in + ( Ptyp_poly (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ptyp_poly" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ptyp_package a -> + let a = self#package_type ctx a in + ( Ptyp_package (Stdlib.fst a), + self#constr ctx "Ptyp_package" [ Stdlib.snd a ] ) + | Ptyp_extension a -> + let a = self#extension ctx a in + ( Ptyp_extension (Stdlib.fst a), + self#constr ctx "Ptyp_extension" [ Stdlib.snd a ] ) + + method package_type : 'ctx -> package_type -> package_type * 'res = + fun ctx (a, b) -> + let a = self#longident_loc ctx a in + let b = + self#list + (fun ctx (a, b) -> + let a = self#longident_loc ctx a in + let b = self#core_type ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] ) + + method row_field : 'ctx -> row_field -> row_field * 'res = + fun ctx { prf_desc; prf_loc; prf_attributes } -> + let prf_desc = self#row_field_desc ctx prf_desc in + let prf_loc = self#location ctx prf_loc in + let prf_attributes = self#attributes ctx prf_attributes in + ( { + prf_desc = Stdlib.fst prf_desc; + prf_loc = Stdlib.fst prf_loc; + prf_attributes = Stdlib.fst prf_attributes; + }, + self#record ctx + [ + ("prf_desc", Stdlib.snd prf_desc); + ("prf_loc", Stdlib.snd prf_loc); + ("prf_attributes", Stdlib.snd prf_attributes); + ] ) + + method row_field_desc : 'ctx -> row_field_desc -> row_field_desc * 'res = + fun ctx x -> + match x with + | Rtag (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#bool ctx b in + let c = self#list self#core_type ctx c in + ( Rtag (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Rtag" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Rinherit a -> + let a = self#core_type ctx a in + ( Rinherit (Stdlib.fst a), + self#constr ctx "Rinherit" [ Stdlib.snd a ] ) + + method object_field : 'ctx -> object_field -> object_field * 'res = + fun ctx { pof_desc; pof_loc; pof_attributes } -> + let pof_desc = self#object_field_desc ctx pof_desc in + let pof_loc = self#location ctx pof_loc in + let pof_attributes = self#attributes ctx pof_attributes in + ( { + pof_desc = Stdlib.fst pof_desc; + pof_loc = Stdlib.fst pof_loc; + pof_attributes = Stdlib.fst pof_attributes; + }, + self#record ctx + [ + ("pof_desc", Stdlib.snd pof_desc); + ("pof_loc", Stdlib.snd pof_loc); + ("pof_attributes", Stdlib.snd pof_attributes); + ] ) + + method object_field_desc + : 'ctx -> object_field_desc -> object_field_desc * 'res = + fun ctx x -> + match x with + | Otag (a, b) -> + let a = self#loc self#label ctx a in + let b = self#core_type ctx b in + ( Otag (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Otag" [ Stdlib.snd a; Stdlib.snd b ] ) + | Oinherit a -> + let a = self#core_type ctx a in + ( Oinherit (Stdlib.fst a), + self#constr ctx "Oinherit" [ Stdlib.snd a ] ) + + method pattern : 'ctx -> pattern -> pattern * 'res = + fun ctx { ppat_desc; ppat_loc; ppat_loc_stack; ppat_attributes } -> + let ppat_desc = self#pattern_desc ctx ppat_desc in + let ppat_loc = self#location ctx ppat_loc in + let ppat_loc_stack = self#location_stack ctx ppat_loc_stack in + let ppat_attributes = self#attributes ctx ppat_attributes in + ( { + ppat_desc = Stdlib.fst ppat_desc; + ppat_loc = Stdlib.fst ppat_loc; + ppat_loc_stack = Stdlib.fst ppat_loc_stack; + ppat_attributes = Stdlib.fst ppat_attributes; + }, + self#record ctx + [ + ("ppat_desc", Stdlib.snd ppat_desc); + ("ppat_loc", Stdlib.snd ppat_loc); + ("ppat_loc_stack", Stdlib.snd ppat_loc_stack); + ("ppat_attributes", Stdlib.snd ppat_attributes); + ] ) + + method pattern_desc : 'ctx -> pattern_desc -> pattern_desc * 'res = + fun ctx x -> + match x with + | Ppat_any -> (Ppat_any, self#constr ctx "Ppat_any" []) + | Ppat_var a -> + let a = self#loc self#string ctx a in + ( Ppat_var (Stdlib.fst a), + self#constr ctx "Ppat_var" [ Stdlib.snd a ] ) + | Ppat_alias (a, b) -> + let a = self#pattern ctx a in + let b = self#loc self#string ctx b in + ( Ppat_alias (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_alias" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_constant a -> + let a = self#constant ctx a in + ( Ppat_constant (Stdlib.fst a), + self#constr ctx "Ppat_constant" [ Stdlib.snd a ] ) + | Ppat_interval (a, b) -> + let a = self#constant ctx a in + let b = self#constant ctx b in + ( Ppat_interval (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_interval" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_tuple a -> + let a = self#list self#pattern ctx a in + ( Ppat_tuple (Stdlib.fst a), + self#constr ctx "Ppat_tuple" [ Stdlib.snd a ] ) + | Ppat_construct (a, b) -> + let a = self#longident_loc ctx a in + let b = + self#option + (fun ctx (a, b) -> + let a = self#list (self#loc self#string) ctx a in + let b = self#pattern ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( Ppat_construct (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_construct" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_variant (a, b) -> + let a = self#label ctx a in + let b = self#option self#pattern ctx b in + ( Ppat_variant (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_variant" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_record (a, b) -> + let a = + self#list + (fun ctx (a, b) -> + let a = self#longident_loc ctx a in + let b = self#pattern ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx a + in + let b = self#closed_flag ctx b in + ( Ppat_record (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_record" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_array a -> + let a = self#list self#pattern ctx a in + ( Ppat_array (Stdlib.fst a), + self#constr ctx "Ppat_array" [ Stdlib.snd a ] ) + | Ppat_or (a, b) -> + let a = self#pattern ctx a in + let b = self#pattern ctx b in + ( Ppat_or (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_or" [ Stdlib.snd a; Stdlib.snd b ] ) + | Ppat_constraint (a, b) -> + let a = self#pattern ctx a in + let b = self#core_type ctx b in + ( Ppat_constraint (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_constraint" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Ppat_type a -> + let a = self#longident_loc ctx a in + ( Ppat_type (Stdlib.fst a), + self#constr ctx "Ppat_type" [ Stdlib.snd a ] ) + | Ppat_lazy a -> + let a = self#pattern ctx a in + ( Ppat_lazy (Stdlib.fst a), + self#constr ctx "Ppat_lazy" [ Stdlib.snd a ] ) + | Ppat_unpack a -> + let a = self#loc (self#option self#string) ctx a in + ( Ppat_unpack (Stdlib.fst a), + self#constr ctx "Ppat_unpack" [ Stdlib.snd a ] ) + | Ppat_exception a -> + let a = self#pattern ctx a in + ( Ppat_exception (Stdlib.fst a), + self#constr ctx "Ppat_exception" [ Stdlib.snd a ] ) + | Ppat_extension a -> + let a = self#extension ctx a in + ( Ppat_extension (Stdlib.fst a), + self#constr ctx "Ppat_extension" [ Stdlib.snd a ] ) + | Ppat_open (a, b) -> + let a = self#longident_loc ctx a in + let b = self#pattern ctx b in + ( Ppat_open (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Ppat_open" [ Stdlib.snd a; Stdlib.snd b ] ) + + method expression : 'ctx -> expression -> expression * 'res = + fun ctx { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } -> + let pexp_desc = self#expression_desc ctx pexp_desc in + let pexp_loc = self#location ctx pexp_loc in + let pexp_loc_stack = self#location_stack ctx pexp_loc_stack in + let pexp_attributes = self#attributes ctx pexp_attributes in + ( { + pexp_desc = Stdlib.fst pexp_desc; + pexp_loc = Stdlib.fst pexp_loc; + pexp_loc_stack = Stdlib.fst pexp_loc_stack; + pexp_attributes = Stdlib.fst pexp_attributes; + }, + self#record ctx + [ + ("pexp_desc", Stdlib.snd pexp_desc); + ("pexp_loc", Stdlib.snd pexp_loc); + ("pexp_loc_stack", Stdlib.snd pexp_loc_stack); + ("pexp_attributes", Stdlib.snd pexp_attributes); + ] ) + + method expression_desc : 'ctx -> expression_desc -> expression_desc * 'res = + fun ctx x -> + match x with + | Pexp_ident a -> + let a = self#longident_loc ctx a in + ( Pexp_ident (Stdlib.fst a), + self#constr ctx "Pexp_ident" [ Stdlib.snd a ] ) + | Pexp_constant a -> + let a = self#constant ctx a in + ( Pexp_constant (Stdlib.fst a), + self#constr ctx "Pexp_constant" [ Stdlib.snd a ] ) + | Pexp_let (a, b, c) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in + let c = self#expression ctx c in + ( Pexp_let (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pexp_let" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pexp_function a -> + let a = self#cases ctx a in + ( Pexp_function (Stdlib.fst a), + self#constr ctx "Pexp_function" [ Stdlib.snd a ] ) + | Pexp_fun (a, b, c, d) -> + let a = self#arg_label ctx a in + let b = self#option self#expression ctx b in + let c = self#pattern ctx c in + let d = self#expression ctx d in + ( Pexp_fun (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c, Stdlib.fst d), + self#constr ctx "Pexp_fun" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c; Stdlib.snd d ] ) + | Pexp_apply (a, b) -> + let a = self#expression ctx a in + let b = + self#list + (fun ctx (a, b) -> + let a = self#arg_label ctx a in + let b = self#expression ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( Pexp_apply (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_apply" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_match (a, b) -> + let a = self#expression ctx a in + let b = self#cases ctx b in + ( Pexp_match (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_match" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_try (a, b) -> + let a = self#expression ctx a in + let b = self#cases ctx b in + ( Pexp_try (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_try" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_tuple a -> + let a = self#list self#expression ctx a in + ( Pexp_tuple (Stdlib.fst a), + self#constr ctx "Pexp_tuple" [ Stdlib.snd a ] ) + | Pexp_construct (a, b) -> + let a = self#longident_loc ctx a in + let b = self#option self#expression ctx b in + ( Pexp_construct (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_construct" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_variant (a, b) -> + let a = self#label ctx a in + let b = self#option self#expression ctx b in + ( Pexp_variant (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_variant" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_record (a, b) -> + let a = + self#list + (fun ctx (a, b) -> + let a = self#longident_loc ctx a in + let b = self#expression ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx a + in + let b = self#option self#expression ctx b in + ( Pexp_record (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_record" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_field (a, b) -> + let a = self#expression ctx a in + let b = self#longident_loc ctx b in + ( Pexp_field (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_field" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_setfield (a, b, c) -> + let a = self#expression ctx a in + let b = self#longident_loc ctx b in + let c = self#expression ctx c in + ( Pexp_setfield (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pexp_setfield" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pexp_array a -> + let a = self#list self#expression ctx a in + ( Pexp_array (Stdlib.fst a), + self#constr ctx "Pexp_array" [ Stdlib.snd a ] ) + | Pexp_ifthenelse (a, b, c) -> + let a = self#expression ctx a in + let b = self#expression ctx b in + let c = self#option self#expression ctx c in + ( Pexp_ifthenelse (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pexp_ifthenelse" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pexp_sequence (a, b) -> + let a = self#expression ctx a in + let b = self#expression ctx b in + ( Pexp_sequence (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_sequence" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_while (a, b) -> + let a = self#expression ctx a in + let b = self#expression ctx b in + ( Pexp_while (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_while" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_for (a, b, c, d, e) -> + let a = self#pattern ctx a in + let b = self#expression ctx b in + let c = self#expression ctx c in + let d = self#direction_flag ctx d in + let e = self#expression ctx e in + ( Pexp_for + ( Stdlib.fst a, + Stdlib.fst b, + Stdlib.fst c, + Stdlib.fst d, + Stdlib.fst e ), + self#constr ctx "Pexp_for" + [ + Stdlib.snd a; + Stdlib.snd b; + Stdlib.snd c; + Stdlib.snd d; + Stdlib.snd e; + ] ) + | Pexp_constraint (a, b) -> + let a = self#expression ctx a in + let b = self#core_type ctx b in + ( Pexp_constraint (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_constraint" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Pexp_coerce (a, b, c) -> + let a = self#expression ctx a in + let b = self#option self#core_type ctx b in + let c = self#core_type ctx c in + ( Pexp_coerce (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pexp_coerce" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pexp_send (a, b) -> + let a = self#expression ctx a in + let b = self#loc self#label ctx b in + ( Pexp_send (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_send" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_new a -> + let a = self#longident_loc ctx a in + ( Pexp_new (Stdlib.fst a), + self#constr ctx "Pexp_new" [ Stdlib.snd a ] ) + | Pexp_setinstvar (a, b) -> + let a = self#loc self#label ctx a in + let b = self#expression ctx b in + ( Pexp_setinstvar (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_setinstvar" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Pexp_override a -> + let a = + self#list + (fun ctx (a, b) -> + let a = self#loc self#label ctx a in + let b = self#expression ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx a + in + ( Pexp_override (Stdlib.fst a), + self#constr ctx "Pexp_override" [ Stdlib.snd a ] ) + | Pexp_letmodule (a, b, c) -> + let a = self#loc (self#option self#string) ctx a in + let b = self#module_expr ctx b in + let c = self#expression ctx c in + ( Pexp_letmodule (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pexp_letmodule" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pexp_letexception (a, b) -> + let a = self#extension_constructor ctx a in + let b = self#expression ctx b in + ( Pexp_letexception (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_letexception" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Pexp_assert a -> + let a = self#expression ctx a in + ( Pexp_assert (Stdlib.fst a), + self#constr ctx "Pexp_assert" [ Stdlib.snd a ] ) + | Pexp_lazy a -> + let a = self#expression ctx a in + ( Pexp_lazy (Stdlib.fst a), + self#constr ctx "Pexp_lazy" [ Stdlib.snd a ] ) + | Pexp_poly (a, b) -> + let a = self#expression ctx a in + let b = self#option self#core_type ctx b in + ( Pexp_poly (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_poly" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_object a -> + let a = self#class_structure ctx a in + ( Pexp_object (Stdlib.fst a), + self#constr ctx "Pexp_object" [ Stdlib.snd a ] ) + | Pexp_newtype (a, b) -> + let a = self#loc self#string ctx a in + let b = self#expression ctx b in + ( Pexp_newtype (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_newtype" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_pack a -> + let a = self#module_expr ctx a in + ( Pexp_pack (Stdlib.fst a), + self#constr ctx "Pexp_pack" [ Stdlib.snd a ] ) + | Pexp_open (a, b) -> + let a = self#open_declaration ctx a in + let b = self#expression ctx b in + ( Pexp_open (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pexp_open" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pexp_letop a -> + let a = self#letop ctx a in + ( Pexp_letop (Stdlib.fst a), + self#constr ctx "Pexp_letop" [ Stdlib.snd a ] ) + | Pexp_extension a -> + let a = self#extension ctx a in + ( Pexp_extension (Stdlib.fst a), + self#constr ctx "Pexp_extension" [ Stdlib.snd a ] ) + | Pexp_unreachable -> + (Pexp_unreachable, self#constr ctx "Pexp_unreachable" []) + + method case : 'ctx -> case -> case * 'res = + fun ctx { pc_lhs; pc_guard; pc_rhs } -> + let pc_lhs = self#pattern ctx pc_lhs in + let pc_guard = self#option self#expression ctx pc_guard in + let pc_rhs = self#expression ctx pc_rhs in + ( { + pc_lhs = Stdlib.fst pc_lhs; + pc_guard = Stdlib.fst pc_guard; + pc_rhs = Stdlib.fst pc_rhs; + }, + self#record ctx + [ + ("pc_lhs", Stdlib.snd pc_lhs); + ("pc_guard", Stdlib.snd pc_guard); + ("pc_rhs", Stdlib.snd pc_rhs); + ] ) + + method letop : 'ctx -> letop -> letop * 'res = + fun ctx { let_; ands; body } -> + let let_ = self#binding_op ctx let_ in + let ands = self#list self#binding_op ctx ands in + let body = self#expression ctx body in + ( { + let_ = Stdlib.fst let_; + ands = Stdlib.fst ands; + body = Stdlib.fst body; + }, + self#record ctx + [ + ("let_", Stdlib.snd let_); + ("ands", Stdlib.snd ands); + ("body", Stdlib.snd body); + ] ) + + method binding_op : 'ctx -> binding_op -> binding_op * 'res = + fun ctx { pbop_op; pbop_pat; pbop_exp; pbop_loc } -> + let pbop_op = self#loc self#string ctx pbop_op in + let pbop_pat = self#pattern ctx pbop_pat in + let pbop_exp = self#expression ctx pbop_exp in + let pbop_loc = self#location ctx pbop_loc in + ( { + pbop_op = Stdlib.fst pbop_op; + pbop_pat = Stdlib.fst pbop_pat; + pbop_exp = Stdlib.fst pbop_exp; + pbop_loc = Stdlib.fst pbop_loc; + }, + self#record ctx + [ + ("pbop_op", Stdlib.snd pbop_op); + ("pbop_pat", Stdlib.snd pbop_pat); + ("pbop_exp", Stdlib.snd pbop_exp); + ("pbop_loc", Stdlib.snd pbop_loc); + ] ) + + method value_description + : 'ctx -> value_description -> value_description * 'res = + fun ctx { pval_name; pval_type; pval_prim; pval_attributes; pval_loc } -> + let pval_name = self#loc self#string ctx pval_name in + let pval_type = self#core_type ctx pval_type in + let pval_prim = self#list self#string ctx pval_prim in + let pval_attributes = self#attributes ctx pval_attributes in + let pval_loc = self#location ctx pval_loc in + ( { + pval_name = Stdlib.fst pval_name; + pval_type = Stdlib.fst pval_type; + pval_prim = Stdlib.fst pval_prim; + pval_attributes = Stdlib.fst pval_attributes; + pval_loc = Stdlib.fst pval_loc; + }, + self#record ctx + [ + ("pval_name", Stdlib.snd pval_name); + ("pval_type", Stdlib.snd pval_type); + ("pval_prim", Stdlib.snd pval_prim); + ("pval_attributes", Stdlib.snd pval_attributes); + ("pval_loc", Stdlib.snd pval_loc); + ] ) + + method type_declaration + : 'ctx -> type_declaration -> type_declaration * 'res = + fun ctx + { + ptype_name; + ptype_params; + ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc; + } -> + let ptype_name = self#loc self#string ctx ptype_name in + let ptype_params = + self#list + (fun ctx (a, b) -> + let a = self#core_type ctx a in + let b = + (fun ctx (a, b) -> + let a = self#variance ctx a in + let b = self#injectivity ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx ptype_params + in + let ptype_cstrs = + self#list + (fun ctx (a, b, c) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in + let c = self#location ctx c in + ( (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] )) + ctx ptype_cstrs + in + let ptype_kind = self#type_kind ctx ptype_kind in + let ptype_private = self#private_flag ctx ptype_private in + let ptype_manifest = self#option self#core_type ctx ptype_manifest in + let ptype_attributes = self#attributes ctx ptype_attributes in + let ptype_loc = self#location ctx ptype_loc in + ( { + ptype_name = Stdlib.fst ptype_name; + ptype_params = Stdlib.fst ptype_params; + ptype_cstrs = Stdlib.fst ptype_cstrs; + ptype_kind = Stdlib.fst ptype_kind; + ptype_private = Stdlib.fst ptype_private; + ptype_manifest = Stdlib.fst ptype_manifest; + ptype_attributes = Stdlib.fst ptype_attributes; + ptype_loc = Stdlib.fst ptype_loc; + }, + self#record ctx + [ + ("ptype_name", Stdlib.snd ptype_name); + ("ptype_params", Stdlib.snd ptype_params); + ("ptype_cstrs", Stdlib.snd ptype_cstrs); + ("ptype_kind", Stdlib.snd ptype_kind); + ("ptype_private", Stdlib.snd ptype_private); + ("ptype_manifest", Stdlib.snd ptype_manifest); + ("ptype_attributes", Stdlib.snd ptype_attributes); + ("ptype_loc", Stdlib.snd ptype_loc); + ] ) + + method type_kind : 'ctx -> type_kind -> type_kind * 'res = + fun ctx x -> + match x with + | Ptype_abstract -> (Ptype_abstract, self#constr ctx "Ptype_abstract" []) + | Ptype_variant a -> + let a = self#list self#constructor_declaration ctx a in + ( Ptype_variant (Stdlib.fst a), + self#constr ctx "Ptype_variant" [ Stdlib.snd a ] ) + | Ptype_record a -> + let a = self#list self#label_declaration ctx a in + ( Ptype_record (Stdlib.fst a), + self#constr ctx "Ptype_record" [ Stdlib.snd a ] ) + | Ptype_open -> (Ptype_open, self#constr ctx "Ptype_open" []) + + method label_declaration + : 'ctx -> label_declaration -> label_declaration * 'res = + fun ctx { pld_name; pld_mutable; pld_type; pld_loc; pld_attributes } -> + let pld_name = self#loc self#string ctx pld_name in + let pld_mutable = self#mutable_flag ctx pld_mutable in + let pld_type = self#core_type ctx pld_type in + let pld_loc = self#location ctx pld_loc in + let pld_attributes = self#attributes ctx pld_attributes in + ( { + pld_name = Stdlib.fst pld_name; + pld_mutable = Stdlib.fst pld_mutable; + pld_type = Stdlib.fst pld_type; + pld_loc = Stdlib.fst pld_loc; + pld_attributes = Stdlib.fst pld_attributes; + }, + self#record ctx + [ + ("pld_name", Stdlib.snd pld_name); + ("pld_mutable", Stdlib.snd pld_mutable); + ("pld_type", Stdlib.snd pld_type); + ("pld_loc", Stdlib.snd pld_loc); + ("pld_attributes", Stdlib.snd pld_attributes); + ] ) + + method constructor_declaration + : 'ctx -> constructor_declaration -> constructor_declaration * 'res = + fun ctx { pcd_name; pcd_vars; pcd_args; pcd_res; pcd_loc; pcd_attributes } -> + let pcd_name = self#loc self#string ctx pcd_name in + let pcd_vars = self#list (self#loc self#string) ctx pcd_vars in + let pcd_args = self#constructor_arguments ctx pcd_args in + let pcd_res = self#option self#core_type ctx pcd_res in + let pcd_loc = self#location ctx pcd_loc in + let pcd_attributes = self#attributes ctx pcd_attributes in + ( { + pcd_name = Stdlib.fst pcd_name; + pcd_vars = Stdlib.fst pcd_vars; + pcd_args = Stdlib.fst pcd_args; + pcd_res = Stdlib.fst pcd_res; + pcd_loc = Stdlib.fst pcd_loc; + pcd_attributes = Stdlib.fst pcd_attributes; + }, + self#record ctx + [ + ("pcd_name", Stdlib.snd pcd_name); + ("pcd_vars", Stdlib.snd pcd_vars); + ("pcd_args", Stdlib.snd pcd_args); + ("pcd_res", Stdlib.snd pcd_res); + ("pcd_loc", Stdlib.snd pcd_loc); + ("pcd_attributes", Stdlib.snd pcd_attributes); + ] ) + + method constructor_arguments + : 'ctx -> constructor_arguments -> constructor_arguments * 'res = + fun ctx x -> + match x with + | Pcstr_tuple a -> + let a = self#list self#core_type ctx a in + ( Pcstr_tuple (Stdlib.fst a), + self#constr ctx "Pcstr_tuple" [ Stdlib.snd a ] ) + | Pcstr_record a -> + let a = self#list self#label_declaration ctx a in + ( Pcstr_record (Stdlib.fst a), + self#constr ctx "Pcstr_record" [ Stdlib.snd a ] ) + + method type_extension : 'ctx -> type_extension -> type_extension * 'res = + fun ctx + { + ptyext_path; + ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes; + } -> + let ptyext_path = self#longident_loc ctx ptyext_path in + let ptyext_params = + self#list + (fun ctx (a, b) -> + let a = self#core_type ctx a in + let b = + (fun ctx (a, b) -> + let a = self#variance ctx a in + let b = self#injectivity ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx ptyext_params + in + let ptyext_constructors = + self#list self#extension_constructor ctx ptyext_constructors + in + let ptyext_private = self#private_flag ctx ptyext_private in + let ptyext_loc = self#location ctx ptyext_loc in + let ptyext_attributes = self#attributes ctx ptyext_attributes in + ( { + ptyext_path = Stdlib.fst ptyext_path; + ptyext_params = Stdlib.fst ptyext_params; + ptyext_constructors = Stdlib.fst ptyext_constructors; + ptyext_private = Stdlib.fst ptyext_private; + ptyext_loc = Stdlib.fst ptyext_loc; + ptyext_attributes = Stdlib.fst ptyext_attributes; + }, + self#record ctx + [ + ("ptyext_path", Stdlib.snd ptyext_path); + ("ptyext_params", Stdlib.snd ptyext_params); + ("ptyext_constructors", Stdlib.snd ptyext_constructors); + ("ptyext_private", Stdlib.snd ptyext_private); + ("ptyext_loc", Stdlib.snd ptyext_loc); + ("ptyext_attributes", Stdlib.snd ptyext_attributes); + ] ) + + method extension_constructor + : 'ctx -> extension_constructor -> extension_constructor * 'res = + fun ctx { pext_name; pext_kind; pext_loc; pext_attributes } -> + let pext_name = self#loc self#string ctx pext_name in + let pext_kind = self#extension_constructor_kind ctx pext_kind in + let pext_loc = self#location ctx pext_loc in + let pext_attributes = self#attributes ctx pext_attributes in + ( { + pext_name = Stdlib.fst pext_name; + pext_kind = Stdlib.fst pext_kind; + pext_loc = Stdlib.fst pext_loc; + pext_attributes = Stdlib.fst pext_attributes; + }, + self#record ctx + [ + ("pext_name", Stdlib.snd pext_name); + ("pext_kind", Stdlib.snd pext_kind); + ("pext_loc", Stdlib.snd pext_loc); + ("pext_attributes", Stdlib.snd pext_attributes); + ] ) + + method type_exception : 'ctx -> type_exception -> type_exception * 'res = + fun ctx { ptyexn_constructor; ptyexn_loc; ptyexn_attributes } -> + let ptyexn_constructor = + self#extension_constructor ctx ptyexn_constructor + in + let ptyexn_loc = self#location ctx ptyexn_loc in + let ptyexn_attributes = self#attributes ctx ptyexn_attributes in + ( { + ptyexn_constructor = Stdlib.fst ptyexn_constructor; + ptyexn_loc = Stdlib.fst ptyexn_loc; + ptyexn_attributes = Stdlib.fst ptyexn_attributes; + }, + self#record ctx + [ + ("ptyexn_constructor", Stdlib.snd ptyexn_constructor); + ("ptyexn_loc", Stdlib.snd ptyexn_loc); + ("ptyexn_attributes", Stdlib.snd ptyexn_attributes); + ] ) + + method extension_constructor_kind + : 'ctx -> + extension_constructor_kind -> + extension_constructor_kind * 'res = + fun ctx x -> + match x with + | Pext_decl (a, b, c) -> + let a = self#list (self#loc self#string) ctx a in + let b = self#constructor_arguments ctx b in + let c = self#option self#core_type ctx c in + ( Pext_decl (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pext_decl" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pext_rebind a -> + let a = self#longident_loc ctx a in + ( Pext_rebind (Stdlib.fst a), + self#constr ctx "Pext_rebind" [ Stdlib.snd a ] ) + + method class_type : 'ctx -> class_type -> class_type * 'res = + fun ctx { pcty_desc; pcty_loc; pcty_attributes } -> + let pcty_desc = self#class_type_desc ctx pcty_desc in + let pcty_loc = self#location ctx pcty_loc in + let pcty_attributes = self#attributes ctx pcty_attributes in + ( { + pcty_desc = Stdlib.fst pcty_desc; + pcty_loc = Stdlib.fst pcty_loc; + pcty_attributes = Stdlib.fst pcty_attributes; + }, + self#record ctx + [ + ("pcty_desc", Stdlib.snd pcty_desc); + ("pcty_loc", Stdlib.snd pcty_loc); + ("pcty_attributes", Stdlib.snd pcty_attributes); + ] ) + + method class_type_desc : 'ctx -> class_type_desc -> class_type_desc * 'res = + fun ctx x -> + match x with + | Pcty_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in + ( Pcty_constr (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcty_constr" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pcty_signature a -> + let a = self#class_signature ctx a in + ( Pcty_signature (Stdlib.fst a), + self#constr ctx "Pcty_signature" [ Stdlib.snd a ] ) + | Pcty_arrow (a, b, c) -> + let a = self#arg_label ctx a in + let b = self#core_type ctx b in + let c = self#class_type ctx c in + ( Pcty_arrow (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pcty_arrow" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pcty_extension a -> + let a = self#extension ctx a in + ( Pcty_extension (Stdlib.fst a), + self#constr ctx "Pcty_extension" [ Stdlib.snd a ] ) + | Pcty_open (a, b) -> + let a = self#open_description ctx a in + let b = self#class_type ctx b in + ( Pcty_open (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcty_open" [ Stdlib.snd a; Stdlib.snd b ] ) + + method class_signature : 'ctx -> class_signature -> class_signature * 'res = + fun ctx { pcsig_self; pcsig_fields } -> + let pcsig_self = self#core_type ctx pcsig_self in + let pcsig_fields = self#list self#class_type_field ctx pcsig_fields in + ( { + pcsig_self = Stdlib.fst pcsig_self; + pcsig_fields = Stdlib.fst pcsig_fields; + }, + self#record ctx + [ + ("pcsig_self", Stdlib.snd pcsig_self); + ("pcsig_fields", Stdlib.snd pcsig_fields); + ] ) + + method class_type_field + : 'ctx -> class_type_field -> class_type_field * 'res = + fun ctx { pctf_desc; pctf_loc; pctf_attributes } -> + let pctf_desc = self#class_type_field_desc ctx pctf_desc in + let pctf_loc = self#location ctx pctf_loc in + let pctf_attributes = self#attributes ctx pctf_attributes in + ( { + pctf_desc = Stdlib.fst pctf_desc; + pctf_loc = Stdlib.fst pctf_loc; + pctf_attributes = Stdlib.fst pctf_attributes; + }, + self#record ctx + [ + ("pctf_desc", Stdlib.snd pctf_desc); + ("pctf_loc", Stdlib.snd pctf_loc); + ("pctf_attributes", Stdlib.snd pctf_attributes); + ] ) + + method class_type_field_desc + : 'ctx -> class_type_field_desc -> class_type_field_desc * 'res = + fun ctx x -> + match x with + | Pctf_inherit a -> + let a = self#class_type ctx a in + ( Pctf_inherit (Stdlib.fst a), + self#constr ctx "Pctf_inherit" [ Stdlib.snd a ] ) + | Pctf_val a -> + let a = + (fun ctx (a, b, c, d) -> + let a = self#loc self#label ctx a in + let b = self#mutable_flag ctx b in + let c = self#virtual_flag ctx c in + let d = self#core_type ctx d in + ( (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c, Stdlib.fst d), + self#tuple ctx + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c; Stdlib.snd d ] + )) + ctx a + in + ( Pctf_val (Stdlib.fst a), + self#constr ctx "Pctf_val" [ Stdlib.snd a ] ) + | Pctf_method a -> + let a = + (fun ctx (a, b, c, d) -> + let a = self#loc self#label ctx a in + let b = self#private_flag ctx b in + let c = self#virtual_flag ctx c in + let d = self#core_type ctx d in + ( (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c, Stdlib.fst d), + self#tuple ctx + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c; Stdlib.snd d ] + )) + ctx a + in + ( Pctf_method (Stdlib.fst a), + self#constr ctx "Pctf_method" [ Stdlib.snd a ] ) + | Pctf_constraint a -> + let a = + (fun ctx (a, b) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx a + in + ( Pctf_constraint (Stdlib.fst a), + self#constr ctx "Pctf_constraint" [ Stdlib.snd a ] ) + | Pctf_attribute a -> + let a = self#attribute ctx a in + ( Pctf_attribute (Stdlib.fst a), + self#constr ctx "Pctf_attribute" [ Stdlib.snd a ] ) + | Pctf_extension a -> + let a = self#extension ctx a in + ( Pctf_extension (Stdlib.fst a), + self#constr ctx "Pctf_extension" [ Stdlib.snd a ] ) + + method class_infos + : 'a. + ('ctx -> 'a -> 'a * 'res) -> + 'ctx -> + 'a class_infos -> + 'a class_infos * 'res = + fun _a ctx + { pci_virt; pci_params; pci_name; pci_expr; pci_loc; pci_attributes } -> + let pci_virt = self#virtual_flag ctx pci_virt in + let pci_params = + self#list + (fun ctx (a, b) -> + let a = self#core_type ctx a in + let b = + (fun ctx (a, b) -> + let a = self#variance ctx a in + let b = self#injectivity ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx pci_params + in + let pci_name = self#loc self#string ctx pci_name in + let pci_expr = _a ctx pci_expr in + let pci_loc = self#location ctx pci_loc in + let pci_attributes = self#attributes ctx pci_attributes in + ( { + pci_virt = Stdlib.fst pci_virt; + pci_params = Stdlib.fst pci_params; + pci_name = Stdlib.fst pci_name; + pci_expr = Stdlib.fst pci_expr; + pci_loc = Stdlib.fst pci_loc; + pci_attributes = Stdlib.fst pci_attributes; + }, + self#record ctx + [ + ("pci_virt", Stdlib.snd pci_virt); + ("pci_params", Stdlib.snd pci_params); + ("pci_name", Stdlib.snd pci_name); + ("pci_expr", Stdlib.snd pci_expr); + ("pci_loc", Stdlib.snd pci_loc); + ("pci_attributes", Stdlib.snd pci_attributes); + ] ) + + method class_description + : 'ctx -> class_description -> class_description * 'res = + self#class_infos self#class_type + + method class_type_declaration + : 'ctx -> class_type_declaration -> class_type_declaration * 'res = + self#class_infos self#class_type + + method class_expr : 'ctx -> class_expr -> class_expr * 'res = + fun ctx { pcl_desc; pcl_loc; pcl_attributes } -> + let pcl_desc = self#class_expr_desc ctx pcl_desc in + let pcl_loc = self#location ctx pcl_loc in + let pcl_attributes = self#attributes ctx pcl_attributes in + ( { + pcl_desc = Stdlib.fst pcl_desc; + pcl_loc = Stdlib.fst pcl_loc; + pcl_attributes = Stdlib.fst pcl_attributes; + }, + self#record ctx + [ + ("pcl_desc", Stdlib.snd pcl_desc); + ("pcl_loc", Stdlib.snd pcl_loc); + ("pcl_attributes", Stdlib.snd pcl_attributes); + ] ) + + method class_expr_desc : 'ctx -> class_expr_desc -> class_expr_desc * 'res = + fun ctx x -> + match x with + | Pcl_constr (a, b) -> + let a = self#longident_loc ctx a in + let b = self#list self#core_type ctx b in + ( Pcl_constr (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcl_constr" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pcl_structure a -> + let a = self#class_structure ctx a in + ( Pcl_structure (Stdlib.fst a), + self#constr ctx "Pcl_structure" [ Stdlib.snd a ] ) + | Pcl_fun (a, b, c, d) -> + let a = self#arg_label ctx a in + let b = self#option self#expression ctx b in + let c = self#pattern ctx c in + let d = self#class_expr ctx d in + ( Pcl_fun (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c, Stdlib.fst d), + self#constr ctx "Pcl_fun" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c; Stdlib.snd d ] ) + | Pcl_apply (a, b) -> + let a = self#class_expr ctx a in + let b = + self#list + (fun ctx (a, b) -> + let a = self#arg_label ctx a in + let b = self#expression ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx b + in + ( Pcl_apply (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcl_apply" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pcl_let (a, b, c) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in + let c = self#class_expr ctx c in + ( Pcl_let (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pcl_let" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pcl_constraint (a, b) -> + let a = self#class_expr ctx a in + let b = self#class_type ctx b in + ( Pcl_constraint (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcl_constraint" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pcl_extension a -> + let a = self#extension ctx a in + ( Pcl_extension (Stdlib.fst a), + self#constr ctx "Pcl_extension" [ Stdlib.snd a ] ) + | Pcl_open (a, b) -> + let a = self#open_description ctx a in + let b = self#class_expr ctx b in + ( Pcl_open (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pcl_open" [ Stdlib.snd a; Stdlib.snd b ] ) + + method class_structure : 'ctx -> class_structure -> class_structure * 'res = + fun ctx { pcstr_self; pcstr_fields } -> + let pcstr_self = self#pattern ctx pcstr_self in + let pcstr_fields = self#list self#class_field ctx pcstr_fields in + ( { + pcstr_self = Stdlib.fst pcstr_self; + pcstr_fields = Stdlib.fst pcstr_fields; + }, + self#record ctx + [ + ("pcstr_self", Stdlib.snd pcstr_self); + ("pcstr_fields", Stdlib.snd pcstr_fields); + ] ) + + method class_field : 'ctx -> class_field -> class_field * 'res = + fun ctx { pcf_desc; pcf_loc; pcf_attributes } -> + let pcf_desc = self#class_field_desc ctx pcf_desc in + let pcf_loc = self#location ctx pcf_loc in + let pcf_attributes = self#attributes ctx pcf_attributes in + ( { + pcf_desc = Stdlib.fst pcf_desc; + pcf_loc = Stdlib.fst pcf_loc; + pcf_attributes = Stdlib.fst pcf_attributes; + }, + self#record ctx + [ + ("pcf_desc", Stdlib.snd pcf_desc); + ("pcf_loc", Stdlib.snd pcf_loc); + ("pcf_attributes", Stdlib.snd pcf_attributes); + ] ) + + method class_field_desc + : 'ctx -> class_field_desc -> class_field_desc * 'res = + fun ctx x -> + match x with + | Pcf_inherit (a, b, c) -> + let a = self#override_flag ctx a in + let b = self#class_expr ctx b in + let c = self#option (self#loc self#string) ctx c in + ( Pcf_inherit (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#constr ctx "Pcf_inherit" + [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] ) + | Pcf_val a -> + let a = + (fun ctx (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#mutable_flag ctx b in + let c = self#class_field_kind ctx c in + ( (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] )) + ctx a + in + (Pcf_val (Stdlib.fst a), self#constr ctx "Pcf_val" [ Stdlib.snd a ]) + | Pcf_method a -> + let a = + (fun ctx (a, b, c) -> + let a = self#loc self#label ctx a in + let b = self#private_flag ctx b in + let c = self#class_field_kind ctx c in + ( (Stdlib.fst a, Stdlib.fst b, Stdlib.fst c), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b; Stdlib.snd c ] )) + ctx a + in + ( Pcf_method (Stdlib.fst a), + self#constr ctx "Pcf_method" [ Stdlib.snd a ] ) + | Pcf_constraint a -> + let a = + (fun ctx (a, b) -> + let a = self#core_type ctx a in + let b = self#core_type ctx b in + ( (Stdlib.fst a, Stdlib.fst b), + self#tuple ctx [ Stdlib.snd a; Stdlib.snd b ] )) + ctx a + in + ( Pcf_constraint (Stdlib.fst a), + self#constr ctx "Pcf_constraint" [ Stdlib.snd a ] ) + | Pcf_initializer a -> + let a = self#expression ctx a in + ( Pcf_initializer (Stdlib.fst a), + self#constr ctx "Pcf_initializer" [ Stdlib.snd a ] ) + | Pcf_attribute a -> + let a = self#attribute ctx a in + ( Pcf_attribute (Stdlib.fst a), + self#constr ctx "Pcf_attribute" [ Stdlib.snd a ] ) + | Pcf_extension a -> + let a = self#extension ctx a in + ( Pcf_extension (Stdlib.fst a), + self#constr ctx "Pcf_extension" [ Stdlib.snd a ] ) + + method class_field_kind + : 'ctx -> class_field_kind -> class_field_kind * 'res = + fun ctx x -> + match x with + | Cfk_virtual a -> + let a = self#core_type ctx a in + ( Cfk_virtual (Stdlib.fst a), + self#constr ctx "Cfk_virtual" [ Stdlib.snd a ] ) + | Cfk_concrete (a, b) -> + let a = self#override_flag ctx a in + let b = self#expression ctx b in + ( Cfk_concrete (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Cfk_concrete" [ Stdlib.snd a; Stdlib.snd b ] ) + + method class_declaration + : 'ctx -> class_declaration -> class_declaration * 'res = + self#class_infos self#class_expr + + method module_type : 'ctx -> module_type -> module_type * 'res = + fun ctx { pmty_desc; pmty_loc; pmty_attributes } -> + let pmty_desc = self#module_type_desc ctx pmty_desc in + let pmty_loc = self#location ctx pmty_loc in + let pmty_attributes = self#attributes ctx pmty_attributes in + ( { + pmty_desc = Stdlib.fst pmty_desc; + pmty_loc = Stdlib.fst pmty_loc; + pmty_attributes = Stdlib.fst pmty_attributes; + }, + self#record ctx + [ + ("pmty_desc", Stdlib.snd pmty_desc); + ("pmty_loc", Stdlib.snd pmty_loc); + ("pmty_attributes", Stdlib.snd pmty_attributes); + ] ) + + method module_type_desc + : 'ctx -> module_type_desc -> module_type_desc * 'res = + fun ctx x -> + match x with + | Pmty_ident a -> + let a = self#longident_loc ctx a in + ( Pmty_ident (Stdlib.fst a), + self#constr ctx "Pmty_ident" [ Stdlib.snd a ] ) + | Pmty_signature a -> + let a = self#signature ctx a in + ( Pmty_signature (Stdlib.fst a), + self#constr ctx "Pmty_signature" [ Stdlib.snd a ] ) + | Pmty_functor (a, b) -> + let a = self#functor_parameter ctx a in + let b = self#module_type ctx b in + ( Pmty_functor (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pmty_functor" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pmty_with (a, b) -> + let a = self#module_type ctx a in + let b = self#list self#with_constraint ctx b in + ( Pmty_with (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pmty_with" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pmty_typeof a -> + let a = self#module_expr ctx a in + ( Pmty_typeof (Stdlib.fst a), + self#constr ctx "Pmty_typeof" [ Stdlib.snd a ] ) + | Pmty_extension a -> + let a = self#extension ctx a in + ( Pmty_extension (Stdlib.fst a), + self#constr ctx "Pmty_extension" [ Stdlib.snd a ] ) + | Pmty_alias a -> + let a = self#longident_loc ctx a in + ( Pmty_alias (Stdlib.fst a), + self#constr ctx "Pmty_alias" [ Stdlib.snd a ] ) + + method functor_parameter + : 'ctx -> functor_parameter -> functor_parameter * 'res = + fun ctx x -> + match x with + | Unit -> (Unit, self#constr ctx "Unit" []) + | Named (a, b) -> + let a = self#loc (self#option self#string) ctx a in + let b = self#module_type ctx b in + ( Named (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Named" [ Stdlib.snd a; Stdlib.snd b ] ) + + method signature : 'ctx -> signature -> signature * 'res = + self#list self#signature_item + + method signature_item : 'ctx -> signature_item -> signature_item * 'res = + fun ctx { psig_desc; psig_loc } -> + let psig_desc = self#signature_item_desc ctx psig_desc in + let psig_loc = self#location ctx psig_loc in + ( { psig_desc = Stdlib.fst psig_desc; psig_loc = Stdlib.fst psig_loc }, + self#record ctx + [ + ("psig_desc", Stdlib.snd psig_desc); + ("psig_loc", Stdlib.snd psig_loc); + ] ) + + method signature_item_desc + : 'ctx -> signature_item_desc -> signature_item_desc * 'res = + fun ctx x -> + match x with + | Psig_value a -> + let a = self#value_description ctx a in + ( Psig_value (Stdlib.fst a), + self#constr ctx "Psig_value" [ Stdlib.snd a ] ) + | Psig_type (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#type_declaration ctx b in + ( Psig_type (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Psig_type" [ Stdlib.snd a; Stdlib.snd b ] ) + | Psig_typesubst a -> + let a = self#list self#type_declaration ctx a in + ( Psig_typesubst (Stdlib.fst a), + self#constr ctx "Psig_typesubst" [ Stdlib.snd a ] ) + | Psig_typext a -> + let a = self#type_extension ctx a in + ( Psig_typext (Stdlib.fst a), + self#constr ctx "Psig_typext" [ Stdlib.snd a ] ) + | Psig_exception a -> + let a = self#type_exception ctx a in + ( Psig_exception (Stdlib.fst a), + self#constr ctx "Psig_exception" [ Stdlib.snd a ] ) + | Psig_module a -> + let a = self#module_declaration ctx a in + ( Psig_module (Stdlib.fst a), + self#constr ctx "Psig_module" [ Stdlib.snd a ] ) + | Psig_modsubst a -> + let a = self#module_substitution ctx a in + ( Psig_modsubst (Stdlib.fst a), + self#constr ctx "Psig_modsubst" [ Stdlib.snd a ] ) + | Psig_recmodule a -> + let a = self#list self#module_declaration ctx a in + ( Psig_recmodule (Stdlib.fst a), + self#constr ctx "Psig_recmodule" [ Stdlib.snd a ] ) + | Psig_modtype a -> + let a = self#module_type_declaration ctx a in + ( Psig_modtype (Stdlib.fst a), + self#constr ctx "Psig_modtype" [ Stdlib.snd a ] ) + | Psig_modtypesubst a -> + let a = self#module_type_declaration ctx a in + ( Psig_modtypesubst (Stdlib.fst a), + self#constr ctx "Psig_modtypesubst" [ Stdlib.snd a ] ) + | Psig_open a -> + let a = self#open_description ctx a in + ( Psig_open (Stdlib.fst a), + self#constr ctx "Psig_open" [ Stdlib.snd a ] ) + | Psig_include a -> + let a = self#include_description ctx a in + ( Psig_include (Stdlib.fst a), + self#constr ctx "Psig_include" [ Stdlib.snd a ] ) + | Psig_class a -> + let a = self#list self#class_description ctx a in + ( Psig_class (Stdlib.fst a), + self#constr ctx "Psig_class" [ Stdlib.snd a ] ) + | Psig_class_type a -> + let a = self#list self#class_type_declaration ctx a in + ( Psig_class_type (Stdlib.fst a), + self#constr ctx "Psig_class_type" [ Stdlib.snd a ] ) + | Psig_attribute a -> + let a = self#attribute ctx a in + ( Psig_attribute (Stdlib.fst a), + self#constr ctx "Psig_attribute" [ Stdlib.snd a ] ) + | Psig_extension (a, b) -> + let a = self#extension ctx a in + let b = self#attributes ctx b in + ( Psig_extension (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Psig_extension" [ Stdlib.snd a; Stdlib.snd b ] ) + + method module_declaration + : 'ctx -> module_declaration -> module_declaration * 'res = + fun ctx { pmd_name; pmd_type; pmd_attributes; pmd_loc } -> + let pmd_name = self#loc (self#option self#string) ctx pmd_name in + let pmd_type = self#module_type ctx pmd_type in + let pmd_attributes = self#attributes ctx pmd_attributes in + let pmd_loc = self#location ctx pmd_loc in + ( { + pmd_name = Stdlib.fst pmd_name; + pmd_type = Stdlib.fst pmd_type; + pmd_attributes = Stdlib.fst pmd_attributes; + pmd_loc = Stdlib.fst pmd_loc; + }, + self#record ctx + [ + ("pmd_name", Stdlib.snd pmd_name); + ("pmd_type", Stdlib.snd pmd_type); + ("pmd_attributes", Stdlib.snd pmd_attributes); + ("pmd_loc", Stdlib.snd pmd_loc); + ] ) + + method module_substitution + : 'ctx -> module_substitution -> module_substitution * 'res = + fun ctx { pms_name; pms_manifest; pms_attributes; pms_loc } -> + let pms_name = self#loc self#string ctx pms_name in + let pms_manifest = self#longident_loc ctx pms_manifest in + let pms_attributes = self#attributes ctx pms_attributes in + let pms_loc = self#location ctx pms_loc in + ( { + pms_name = Stdlib.fst pms_name; + pms_manifest = Stdlib.fst pms_manifest; + pms_attributes = Stdlib.fst pms_attributes; + pms_loc = Stdlib.fst pms_loc; + }, + self#record ctx + [ + ("pms_name", Stdlib.snd pms_name); + ("pms_manifest", Stdlib.snd pms_manifest); + ("pms_attributes", Stdlib.snd pms_attributes); + ("pms_loc", Stdlib.snd pms_loc); + ] ) + + method module_type_declaration + : 'ctx -> module_type_declaration -> module_type_declaration * 'res = + fun ctx { pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc } -> + let pmtd_name = self#loc self#string ctx pmtd_name in + let pmtd_type = self#option self#module_type ctx pmtd_type in + let pmtd_attributes = self#attributes ctx pmtd_attributes in + let pmtd_loc = self#location ctx pmtd_loc in + ( { + pmtd_name = Stdlib.fst pmtd_name; + pmtd_type = Stdlib.fst pmtd_type; + pmtd_attributes = Stdlib.fst pmtd_attributes; + pmtd_loc = Stdlib.fst pmtd_loc; + }, + self#record ctx + [ + ("pmtd_name", Stdlib.snd pmtd_name); + ("pmtd_type", Stdlib.snd pmtd_type); + ("pmtd_attributes", Stdlib.snd pmtd_attributes); + ("pmtd_loc", Stdlib.snd pmtd_loc); + ] ) + + method open_infos + : 'a. + ('ctx -> 'a -> 'a * 'res) -> + 'ctx -> + 'a open_infos -> + 'a open_infos * 'res = + fun _a ctx { popen_expr; popen_override; popen_loc; popen_attributes } -> + let popen_expr = _a ctx popen_expr in + let popen_override = self#override_flag ctx popen_override in + let popen_loc = self#location ctx popen_loc in + let popen_attributes = self#attributes ctx popen_attributes in + ( { + popen_expr = Stdlib.fst popen_expr; + popen_override = Stdlib.fst popen_override; + popen_loc = Stdlib.fst popen_loc; + popen_attributes = Stdlib.fst popen_attributes; + }, + self#record ctx + [ + ("popen_expr", Stdlib.snd popen_expr); + ("popen_override", Stdlib.snd popen_override); + ("popen_loc", Stdlib.snd popen_loc); + ("popen_attributes", Stdlib.snd popen_attributes); + ] ) + + method open_description + : 'ctx -> open_description -> open_description * 'res = + self#open_infos self#longident_loc + + method open_declaration + : 'ctx -> open_declaration -> open_declaration * 'res = + self#open_infos self#module_expr + + method include_infos + : 'a. + ('ctx -> 'a -> 'a * 'res) -> + 'ctx -> + 'a include_infos -> + 'a include_infos * 'res = + fun _a ctx { pincl_mod; pincl_loc; pincl_attributes } -> + let pincl_mod = _a ctx pincl_mod in + let pincl_loc = self#location ctx pincl_loc in + let pincl_attributes = self#attributes ctx pincl_attributes in + ( { + pincl_mod = Stdlib.fst pincl_mod; + pincl_loc = Stdlib.fst pincl_loc; + pincl_attributes = Stdlib.fst pincl_attributes; + }, + self#record ctx + [ + ("pincl_mod", Stdlib.snd pincl_mod); + ("pincl_loc", Stdlib.snd pincl_loc); + ("pincl_attributes", Stdlib.snd pincl_attributes); + ] ) + + method include_description + : 'ctx -> include_description -> include_description * 'res = + self#include_infos self#module_type + + method include_declaration + : 'ctx -> include_declaration -> include_declaration * 'res = + self#include_infos self#module_expr + + method with_constraint : 'ctx -> with_constraint -> with_constraint * 'res = + fun ctx x -> + match x with + | Pwith_type (a, b) -> + let a = self#longident_loc ctx a in + let b = self#type_declaration ctx b in + ( Pwith_type (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_type" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pwith_module (a, b) -> + let a = self#longident_loc ctx a in + let b = self#longident_loc ctx b in + ( Pwith_module (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_module" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pwith_modtype (a, b) -> + let a = self#longident_loc ctx a in + let b = self#module_type ctx b in + ( Pwith_modtype (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_modtype" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pwith_modtypesubst (a, b) -> + let a = self#longident_loc ctx a in + let b = self#module_type ctx b in + ( Pwith_modtypesubst (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_modtypesubst" + [ Stdlib.snd a; Stdlib.snd b ] ) + | Pwith_typesubst (a, b) -> + let a = self#longident_loc ctx a in + let b = self#type_declaration ctx b in + ( Pwith_typesubst (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_typesubst" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Pwith_modsubst (a, b) -> + let a = self#longident_loc ctx a in + let b = self#longident_loc ctx b in + ( Pwith_modsubst (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pwith_modsubst" [ Stdlib.snd a; Stdlib.snd b ] ) + + method module_expr : 'ctx -> module_expr -> module_expr * 'res = + fun ctx { pmod_desc; pmod_loc; pmod_attributes } -> + let pmod_desc = self#module_expr_desc ctx pmod_desc in + let pmod_loc = self#location ctx pmod_loc in + let pmod_attributes = self#attributes ctx pmod_attributes in + ( { + pmod_desc = Stdlib.fst pmod_desc; + pmod_loc = Stdlib.fst pmod_loc; + pmod_attributes = Stdlib.fst pmod_attributes; + }, + self#record ctx + [ + ("pmod_desc", Stdlib.snd pmod_desc); + ("pmod_loc", Stdlib.snd pmod_loc); + ("pmod_attributes", Stdlib.snd pmod_attributes); + ] ) + + method module_expr_desc + : 'ctx -> module_expr_desc -> module_expr_desc * 'res = + fun ctx x -> + match x with + | Pmod_ident a -> + let a = self#longident_loc ctx a in + ( Pmod_ident (Stdlib.fst a), + self#constr ctx "Pmod_ident" [ Stdlib.snd a ] ) + | Pmod_structure a -> + let a = self#structure ctx a in + ( Pmod_structure (Stdlib.fst a), + self#constr ctx "Pmod_structure" [ Stdlib.snd a ] ) + | Pmod_functor (a, b) -> + let a = self#functor_parameter ctx a in + let b = self#module_expr ctx b in + ( Pmod_functor (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pmod_functor" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pmod_apply (a, b) -> + let a = self#module_expr ctx a in + let b = self#module_expr ctx b in + ( Pmod_apply (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pmod_apply" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pmod_constraint (a, b) -> + let a = self#module_expr ctx a in + let b = self#module_type ctx b in + ( Pmod_constraint (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pmod_constraint" [ Stdlib.snd a; Stdlib.snd b ] + ) + | Pmod_unpack a -> + let a = self#expression ctx a in + ( Pmod_unpack (Stdlib.fst a), + self#constr ctx "Pmod_unpack" [ Stdlib.snd a ] ) + | Pmod_extension a -> + let a = self#extension ctx a in + ( Pmod_extension (Stdlib.fst a), + self#constr ctx "Pmod_extension" [ Stdlib.snd a ] ) + + method structure : 'ctx -> structure -> structure * 'res = + self#list self#structure_item + + method structure_item : 'ctx -> structure_item -> structure_item * 'res = + fun ctx { pstr_desc; pstr_loc } -> + let pstr_desc = self#structure_item_desc ctx pstr_desc in + let pstr_loc = self#location ctx pstr_loc in + ( { pstr_desc = Stdlib.fst pstr_desc; pstr_loc = Stdlib.fst pstr_loc }, + self#record ctx + [ + ("pstr_desc", Stdlib.snd pstr_desc); + ("pstr_loc", Stdlib.snd pstr_loc); + ] ) + + method structure_item_desc + : 'ctx -> structure_item_desc -> structure_item_desc * 'res = + fun ctx x -> + match x with + | Pstr_eval (a, b) -> + let a = self#expression ctx a in + let b = self#attributes ctx b in + ( Pstr_eval (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pstr_eval" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pstr_value (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#value_binding ctx b in + ( Pstr_value (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pstr_value" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pstr_primitive a -> + let a = self#value_description ctx a in + ( Pstr_primitive (Stdlib.fst a), + self#constr ctx "Pstr_primitive" [ Stdlib.snd a ] ) + | Pstr_type (a, b) -> + let a = self#rec_flag ctx a in + let b = self#list self#type_declaration ctx b in + ( Pstr_type (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pstr_type" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pstr_typext a -> + let a = self#type_extension ctx a in + ( Pstr_typext (Stdlib.fst a), + self#constr ctx "Pstr_typext" [ Stdlib.snd a ] ) + | Pstr_exception a -> + let a = self#type_exception ctx a in + ( Pstr_exception (Stdlib.fst a), + self#constr ctx "Pstr_exception" [ Stdlib.snd a ] ) + | Pstr_module a -> + let a = self#module_binding ctx a in + ( Pstr_module (Stdlib.fst a), + self#constr ctx "Pstr_module" [ Stdlib.snd a ] ) + | Pstr_recmodule a -> + let a = self#list self#module_binding ctx a in + ( Pstr_recmodule (Stdlib.fst a), + self#constr ctx "Pstr_recmodule" [ Stdlib.snd a ] ) + | Pstr_modtype a -> + let a = self#module_type_declaration ctx a in + ( Pstr_modtype (Stdlib.fst a), + self#constr ctx "Pstr_modtype" [ Stdlib.snd a ] ) + | Pstr_open a -> + let a = self#open_declaration ctx a in + ( Pstr_open (Stdlib.fst a), + self#constr ctx "Pstr_open" [ Stdlib.snd a ] ) + | Pstr_class a -> + let a = self#list self#class_declaration ctx a in + ( Pstr_class (Stdlib.fst a), + self#constr ctx "Pstr_class" [ Stdlib.snd a ] ) + | Pstr_class_type a -> + let a = self#list self#class_type_declaration ctx a in + ( Pstr_class_type (Stdlib.fst a), + self#constr ctx "Pstr_class_type" [ Stdlib.snd a ] ) + | Pstr_include a -> + let a = self#include_declaration ctx a in + ( Pstr_include (Stdlib.fst a), + self#constr ctx "Pstr_include" [ Stdlib.snd a ] ) + | Pstr_attribute a -> + let a = self#attribute ctx a in + ( Pstr_attribute (Stdlib.fst a), + self#constr ctx "Pstr_attribute" [ Stdlib.snd a ] ) + | Pstr_extension (a, b) -> + let a = self#extension ctx a in + let b = self#attributes ctx b in + ( Pstr_extension (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pstr_extension" [ Stdlib.snd a; Stdlib.snd b ] ) + + method value_binding : 'ctx -> value_binding -> value_binding * 'res = + fun ctx { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } -> + let pvb_pat = self#pattern ctx pvb_pat in + let pvb_expr = self#expression ctx pvb_expr in + let pvb_attributes = self#attributes ctx pvb_attributes in + let pvb_loc = self#location ctx pvb_loc in + ( { + pvb_pat = Stdlib.fst pvb_pat; + pvb_expr = Stdlib.fst pvb_expr; + pvb_attributes = Stdlib.fst pvb_attributes; + pvb_loc = Stdlib.fst pvb_loc; + }, + self#record ctx + [ + ("pvb_pat", Stdlib.snd pvb_pat); + ("pvb_expr", Stdlib.snd pvb_expr); + ("pvb_attributes", Stdlib.snd pvb_attributes); + ("pvb_loc", Stdlib.snd pvb_loc); + ] ) + + method module_binding : 'ctx -> module_binding -> module_binding * 'res = + fun ctx { pmb_name; pmb_expr; pmb_attributes; pmb_loc } -> + let pmb_name = self#loc (self#option self#string) ctx pmb_name in + let pmb_expr = self#module_expr ctx pmb_expr in + let pmb_attributes = self#attributes ctx pmb_attributes in + let pmb_loc = self#location ctx pmb_loc in + ( { + pmb_name = Stdlib.fst pmb_name; + pmb_expr = Stdlib.fst pmb_expr; + pmb_attributes = Stdlib.fst pmb_attributes; + pmb_loc = Stdlib.fst pmb_loc; + }, + self#record ctx + [ + ("pmb_name", Stdlib.snd pmb_name); + ("pmb_expr", Stdlib.snd pmb_expr); + ("pmb_attributes", Stdlib.snd pmb_attributes); + ("pmb_loc", Stdlib.snd pmb_loc); + ] ) + + method toplevel_phrase : 'ctx -> toplevel_phrase -> toplevel_phrase * 'res = + fun ctx x -> + match x with + | Ptop_def a -> + let a = self#structure ctx a in + ( Ptop_def (Stdlib.fst a), + self#constr ctx "Ptop_def" [ Stdlib.snd a ] ) + | Ptop_dir a -> + let a = self#toplevel_directive ctx a in + ( Ptop_dir (Stdlib.fst a), + self#constr ctx "Ptop_dir" [ Stdlib.snd a ] ) + + method toplevel_directive + : 'ctx -> toplevel_directive -> toplevel_directive * 'res = + fun ctx { pdir_name; pdir_arg; pdir_loc } -> + let pdir_name = self#loc self#string ctx pdir_name in + let pdir_arg = self#option self#directive_argument ctx pdir_arg in + let pdir_loc = self#location ctx pdir_loc in + ( { + pdir_name = Stdlib.fst pdir_name; + pdir_arg = Stdlib.fst pdir_arg; + pdir_loc = Stdlib.fst pdir_loc; + }, + self#record ctx + [ + ("pdir_name", Stdlib.snd pdir_name); + ("pdir_arg", Stdlib.snd pdir_arg); + ("pdir_loc", Stdlib.snd pdir_loc); + ] ) + + method directive_argument + : 'ctx -> directive_argument -> directive_argument * 'res = + fun ctx { pdira_desc; pdira_loc } -> + let pdira_desc = self#directive_argument_desc ctx pdira_desc in + let pdira_loc = self#location ctx pdira_loc in + ( { + pdira_desc = Stdlib.fst pdira_desc; + pdira_loc = Stdlib.fst pdira_loc; + }, + self#record ctx + [ + ("pdira_desc", Stdlib.snd pdira_desc); + ("pdira_loc", Stdlib.snd pdira_loc); + ] ) + + method directive_argument_desc + : 'ctx -> directive_argument_desc -> directive_argument_desc * 'res = + fun ctx x -> + match x with + | Pdir_string a -> + let a = self#string ctx a in + ( Pdir_string (Stdlib.fst a), + self#constr ctx "Pdir_string" [ Stdlib.snd a ] ) + | Pdir_int (a, b) -> + let a = self#string ctx a in + let b = self#option self#char ctx b in + ( Pdir_int (Stdlib.fst a, Stdlib.fst b), + self#constr ctx "Pdir_int" [ Stdlib.snd a; Stdlib.snd b ] ) + | Pdir_ident a -> + let a = self#longident ctx a in + ( Pdir_ident (Stdlib.fst a), + self#constr ctx "Pdir_ident" [ Stdlib.snd a ] ) + | Pdir_bool a -> + let a = self#bool ctx a in + ( Pdir_bool (Stdlib.fst a), + self#constr ctx "Pdir_bool" [ Stdlib.snd a ] ) + + method cases : 'ctx -> cases -> cases * 'res = self#list self#case + end + [@@@end] [@@@end] diff --git a/duniverse/ppxlib/doc/manual.mld b/duniverse/ppxlib/doc/manual.mld index 431f1edc8..2b26f84f1 100644 --- a/duniverse/ppxlib/doc/manual.mld +++ b/duniverse/ppxlib/doc/manual.mld @@ -2,7 +2,7 @@ {1:what-is-ppx What is ppx} -{2 Overview} +{2:ppx-overview Overview} Ppx is a meta-programming system for the OCaml programming language. It allows developers to generate code at compile time in a principled way. The @@ -25,7 +25,7 @@ Ppxlib mainly supports two ways of generating code at compile time: by expanding an extension point or by expanding a [[@@deriving ...]] attribute after a type declaration. -{2 How does it works?} +{2 How does it work?} The ppx system is composed of 3 parts: @@ -114,7 +114,7 @@ them in the [preprocess] field of your [dune] file. For instance: (library (name my_lib) - (preprocess (pps (ppx_sexp_conv ppx_expect)))) + (preprocess (pps ppx_sexp_conv ppx_expect))) ]} Some ppx rewriters takes parameters in the form of command line flags. These can @@ -126,12 +126,12 @@ names from more command line flags. For instance: (library (name my_lib) (preprocess - (pps (ppx_sexp_conv ppx_expect -inline-test-drop)))) + (pps ppx_sexp_conv ppx_expect -inline-test-drop))) (library (name my_lib) (preprocess - (pps (ppx_sexp_conv ppx_expect -- --cookie "x=42")))) + (pps ppx_sexp_conv ppx_expect -- --cookie "x=42"))) ]} Once this is done, you can use whatever feature is offered by the ppx rewriter. @@ -179,7 +179,7 @@ your project do not need to install ppxlib and other ppx rewriters themselves. {[ (library (name my_lib) - (lint (pps (ppx_sexp_conv)))) + (lint (pps ppx_sexp_conv))) ]} Then to regenerate the parts between [[@@deriving_inline]] and [[@@@end]], run @@ -218,7 +218,7 @@ always prefer the above mentioned transformations instead when possible. {3 The OCaml AST} -As described in {!page-"ppx-overview"}, PPX rewriters don't operate at the text +As described in {!"ppx-overview"}, PPX rewriters don't operate at the text level but instead used the compiler's internal representation of the source code: the Abstract Syntax Tree or AST. @@ -254,13 +254,15 @@ you should be familiar with are: - {{!Ppxlib.Parsetree.expression}[expression]} which describes anything in OCaml that evaluates to a value, the right hand side of a let binding or the - branches of an if-then-else for instance. - - {{!Ppxlib.Parsetree.pattern}[pattern]} which is what you use to deconstruct an + branches of an if-then-else for instance. +- {{!Ppxlib.Parsetree.pattern}[pattern]} which is what you use to deconstruct an OCaml value, the left hand side of a let binding or a pattern-matching case - for example. - {{!Ppxlib.Parsetree.core_type}[core_type]} which describes type + for example. +- {{!Ppxlib.Parsetree.core_type}[core_type]} which describes type expressions ie what you use to explicitly constrain the type of an expression or describe the type of a value in your [.mli] files. Usually it's what comes - after a [:]. - {{!Ppxlib.Parsetree.structure_item}[structure_item]} and + after a [:]. +- {{!Ppxlib.Parsetree.structure_item}[structure_item]} and {{!Ppxlib.Parsetree.signature_item}[signature_item]} which describe the top level AST nodes you can find in a structure or signature such as type definitions, value declarations or module declarations. @@ -403,7 +405,7 @@ constructor. You'll note that there exists you wish to allow passing arguments to your deriver but to keep this tutorial simple we won't cover this here. The only mandatory argument to the constructor is a function which takes a labelled -{{!Ppxlib.Expansion_context.Deriving.t}[Expansion_context.Deriving.t]}, an +{{!Ppxlib.Expansion_context.Deriver.t}[Expansion_context.Deriver.t]}, an ['input_ast] and returns an ['output_ast] and that will give us a [('output_ast, 'input_ast) Deriving.Generator.t]. Much like the [expand] function described in the section about extension rewriters, this function is where the actual diff --git a/duniverse/ppxlib/dune-project b/duniverse/ppxlib/dune-project index 50a4ee046..cc059b6c1 100644 --- a/duniverse/ppxlib/dune-project +++ b/duniverse/ppxlib/dune-project @@ -1,6 +1,6 @@ (lang dune 2.7) (name ppxlib) -(version 0.27.0) +(version 0.28.0) (using cinaps 1.0) (allow_approximate_merlin) (implicit_transitive_deps false) @@ -20,7 +20,7 @@ (ocaml-compiler-libs (>= v0.11.0)) (ppx_derivers (>= 1.0)) (sexplib0 (>= v0.12)) - (sexplib0 (and :with-test (< "v0.15"))) ; Printexc.register_printer in sexplib0 changed + (sexplib0 (and :with-test (>= "v0.15"))) ; Printexc.register_printer in sexplib0 changed stdlib-shims (ocamlfind :with-test) (re (and :with-test (>= 1.9.0))) diff --git a/duniverse/ppxlib/old_rtd_doc/conf.py b/duniverse/ppxlib/old_rtd_doc/conf.py new file mode 100644 index 000000000..1816263e7 --- /dev/null +++ b/duniverse/ppxlib/old_rtd_doc/conf.py @@ -0,0 +1,161 @@ + +# -*- coding: utf-8 -*- +# +# ppxlib documentation build configuration file, created by +# sphinx-quickstart on Sun Aug 12 15:37:30 2018. +# +# This file is execfile()d with the current directory set to its +# containing dir. +# +# Note that not all possible configuration values are present in this +# autogenerated file. +# +# All configuration values have a default; values that are commented out +# serve to show the default. + +# If extensions (or modules to document with autodoc) are in another directory, +# add these directories to sys.path here. If the directory is relative to the +# documentation root, use os.path.abspath to make it absolute, like shown here. +# +# import os +# import sys +# sys.path.insert(0, os.path.abspath('.')) + + +# -- General configuration ------------------------------------------------ + +# If your documentation needs a minimal Sphinx version, state it here. +# +# needs_sphinx = '1.0' + +# Add any Sphinx extension module names here, as strings. They can be +# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom +# ones. +extensions = [] + +# Add any paths that contain templates here, relative to this directory. +templates_path = ['_templates'] + +# The suffix(es) of source filenames. +# You can specify multiple suffix as a list of string: +# +# source_suffix = ['.rst', '.md'] +source_suffix = '.rst' + +# The master toctree document. +master_doc = 'index' + +# General information about the project. +project = u'ppxlib' +copyright = u'2018, Jane Street Group, LLC' +author = u'Jane Street Group, LLC' + +# The language for content autogenerated by Sphinx. Refer to documentation +# for a list of supported languages. +# +# This is also used if you do content translation via gettext catalogs. +# Usually you set "language" from the command line for these cases. +language = None + +# List of patterns, relative to source directory, that match files and +# directories to ignore when looking for source files. +# This patterns also effect to html_static_path and html_extra_path +exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store'] + +# The name of the Pygments (syntax highlighting) style to use. +pygments_style = 'sphinx' + +# If true, `todo` and `todoList` produce output, else they produce nothing. +todo_include_todos = False + + +# -- Options for HTML output ---------------------------------------------- + +# The theme to use for HTML and HTML Help pages. See the documentation for +# a list of builtin themes. +# +html_theme = 'alabaster' + +# Theme options are theme-specific and customize the look and feel of a theme +# further. For a list of options available for each theme, see the +# documentation. +# +# html_theme_options = {} + +# Add any paths that contain custom static files (such as style sheets) here, +# relative to this directory. They are copied after the builtin static files, +# so a file named "default.css" will overwrite the builtin "default.css". +# html_static_path = ['_static'] + +# Custom sidebar templates, must be a dictionary that maps document names +# to template names. +# +# This is required for the alabaster theme +# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars +html_sidebars = { + '**': [ + 'relations.html', # needs 'show_related': True theme option to display + 'searchbox.html', + ] +} + + +# -- Options for HTMLHelp output ------------------------------------------ + +# Output file base name for HTML help builder. +htmlhelp_basename = 'ppxlibdoc' + + +# -- Options for LaTeX output --------------------------------------------- + +latex_elements = { + # The paper size ('letterpaper' or 'a4paper'). + # + # 'papersize': 'letterpaper', + + # The font size ('10pt', '11pt' or '12pt'). + # + # 'pointsize': '10pt', + + # Additional stuff for the LaTeX preamble. + # + # 'preamble': '', + + # Latex figure (float) alignment + # + # 'figure_align': 'htbp', +} + +# Grouping the document tree into LaTeX files. List of tuples +# (source start file, target name, title, +# author, documentclass [howto, manual, or own class]). +latex_documents = [ + (master_doc, 'ppxlib.tex', u'ppxlib Documentation', + u'Jane Street Group, LLC', 'manual'), +] + + +# -- Options for manual page output --------------------------------------- + +# One entry per manual page. List of tuples +# (source start file, name, description, authors, manual section). +man_pages = [ + (master_doc, 'ppxlib', u'ppxlib Documentation', + [author], 1) +] + + +# -- Options for Texinfo output ------------------------------------------- + +# Grouping the document tree into Texinfo files. List of tuples +# (source start file, target name, title, author, +# dir menu entry, description, category) +texinfo_documents = [ + (master_doc, 'ppxlib', u'ppxlib Documentation', + author, 'ppxlib', 'A comprehensive toolbox for ppx development.', + 'Miscellaneous'), +] + +import sphinx_rtd_theme + +html_theme_path = [sphinx_rtd_theme.get_html_theme_path()] diff --git a/duniverse/ppxlib/old_rtd_doc/index.rst b/duniverse/ppxlib/old_rtd_doc/index.rst new file mode 100644 index 000000000..ca4145a97 --- /dev/null +++ b/duniverse/ppxlib/old_rtd_doc/index.rst @@ -0,0 +1,2 @@ +.. meta:: + :http-equiv=Refresh: 0; url='https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html' diff --git a/duniverse/ppxlib/old_rtd_doc/ppx-for-end-users.rst b/duniverse/ppxlib/old_rtd_doc/ppx-for-end-users.rst new file mode 100644 index 000000000..ca4145a97 --- /dev/null +++ b/duniverse/ppxlib/old_rtd_doc/ppx-for-end-users.rst @@ -0,0 +1,2 @@ +.. meta:: + :http-equiv=Refresh: 0; url='https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html' diff --git a/duniverse/ppxlib/old_rtd_doc/ppx-for-plugin-authors.rst b/duniverse/ppxlib/old_rtd_doc/ppx-for-plugin-authors.rst new file mode 100644 index 000000000..ca4145a97 --- /dev/null +++ b/duniverse/ppxlib/old_rtd_doc/ppx-for-plugin-authors.rst @@ -0,0 +1,2 @@ +.. meta:: + :http-equiv=Refresh: 0; url='https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html' diff --git a/duniverse/ppxlib/old_rtd_doc/what-is-ppx.rst b/duniverse/ppxlib/old_rtd_doc/what-is-ppx.rst new file mode 100644 index 000000000..ca4145a97 --- /dev/null +++ b/duniverse/ppxlib/old_rtd_doc/what-is-ppx.rst @@ -0,0 +1,2 @@ +.. meta:: + :http-equiv=Refresh: 0; url='https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html' diff --git a/duniverse/ppxlib/ppxlib.opam b/duniverse/ppxlib/ppxlib.opam index af71e1814..51ecb1ca6 100644 --- a/duniverse/ppxlib/ppxlib.opam +++ b/duniverse/ppxlib/ppxlib.opam @@ -1,6 +1,6 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.27.0" +version: "0.28.0" synopsis: "Standard library for ppx rewriters" description: """ Ppxlib is the standard library for ppx rewriters and other programs @@ -26,7 +26,7 @@ depends: [ "ocaml-compiler-libs" {>= "v0.11.0"} "ppx_derivers" {>= "1.0"} "sexplib0" {>= "v0.12"} - "sexplib0" {with-test & < "v0.15"} + "sexplib0" {with-test & >= "v0.15"} "stdlib-shims" "ocamlfind" {with-test} "re" {with-test & >= "1.9.0"} diff --git a/duniverse/ppxlib/src/ast_builder.ml b/duniverse/ppxlib/src/ast_builder.ml index 0e53a64ed..99a2e4992 100644 --- a/duniverse/ppxlib/src/ast_builder.ml +++ b/duniverse/ppxlib/src/ast_builder.ml @@ -116,10 +116,10 @@ module Default = struct pexp_fun ~loc Asttypes.Nolabel None p e) let esequence ~loc el = - match el with + match List.rev el with | [] -> eunit ~loc | hd :: tl -> - List.fold_left tl ~init:hd ~f:(fun acc e -> pexp_sequence ~loc acc e) + List.fold_left tl ~init:hd ~f:(fun acc e -> pexp_sequence ~loc e acc) let pconstruct cd arg = ppat_construct ~loc:cd.pcd_loc (Located.map_lident cd.pcd_name) arg diff --git a/duniverse/ppxlib/src/ast_pattern.mli b/duniverse/ppxlib/src/ast_pattern.mli index f8dab6caa..9c609f676 100644 --- a/duniverse/ppxlib/src/ast_pattern.mli +++ b/duniverse/ppxlib/src/ast_pattern.mli @@ -13,25 +13,44 @@ open! Import To understand how to use it, let's consider the example of ppx_inline_test. We want to recognize patterns of the form: - {[ let%test "name" = expr ]} + {[ + let%test "name" = expr + ]} Which is a syntactic sugar for: - {[ [%%test let "name" = expr] ]} + {[ + [%%test let "name" = expr] + ]} If we wanted to write a function that recognizes the payload of [%%test] using normal pattern matching we would write: {[ let match_payload = function - | Pstr [ { pstr_desc = Pstr_value (Nonrecursive, - [ { pvb_pat = Ppat_constant (Constant_string - (name, None)) - ; pvb_expr = e - ; _ } ]) - ; _ } ] -> - (name, e) - | _ -> Location.raisef ... + | PStr + [ + { + pstr_desc = + Pstr_value + ( Nonrecursive, + [ + { + pvb_pat = + { + ppat_desc = + Ppat_constant (Pconst_string (name, _, None)); + _; + }; + pvb_expr = e; + _; + }; + ] ); + _; + }; + ] -> + (name, e) + | _ -> Location.raise_errorf "" ]} This is quite cumbersome, and this is still not right: this function drops @@ -42,27 +61,33 @@ open! Import {[ let build_payload ~loc name expr = - let (module B) = Ast_builder.with_loc loc in + let (module B) = Ast_builder.make loc in let open B in - pstr - [ pstr_value Nonrecursive (value_binding ~pat:(pstring name) ~expr) ] + Parsetree.PStr + [ + pstr_value Nonrecursive [ value_binding ~pat:(pstring name) ~expr ]; + ] ]} Constructing a first class pattern is almost as simple as replacing [Ast_builder] by [Ast_pattern]: {[ - let payload_pattern name expr = + let payload_pattern () = let open Ast_pattern in pstr - (pstr_value nonrecursive (value_binding ~pat:(pstring __) ~expr:__) + (pstr_value nonrecursive + (value_binding ~pat:(pstring __) ~expr:__ ^:: nil) ^:: nil) ]} Notice that the place-holders for [name] and [expr] have been replaced by - [__]. The following pattern with have type: + [__]. An extra unit argument appears because of value restriction. The + function above would create a pattern with type: - {[ (payload, string -> expression -> 'a, 'a) Ast_pattern.t ]} + {[ + (payload, string -> expression -> 'a, 'a) Ast_pattern.t + ]} which means that it matches values of type [payload] and captures a string and expression from it. The two captured elements comes from the use of @@ -118,11 +143,15 @@ val __' : ('a, 'a Loc.t -> 'b, 'b) t Note: this should only be used for types that do not embed a location. For instance you can use it to capture a string constant: - {[ estring __' ]} + {[ + estring __' + ]} but using it to capture an expression would not yield the expected result: - {[ pair (eint (int 42)) __' ]} + {[ + pair (eint (int 42)) __' + ]} In the latter case you should use the [pexp_loc] field of the captured expression instead. *) diff --git a/duniverse/ppxlib/src/ast_traverse.ml b/duniverse/ppxlib/src/ast_traverse.ml index 008f1b587..e44fbb0c2 100644 --- a/duniverse/ppxlib/src/ast_traverse.ml +++ b/duniverse/ppxlib/src/ast_traverse.ml @@ -1,39 +1,11 @@ open! Import +open Common.With_errors +include Ast_traverse0 -class map = +class virtual ['ctx, 'res] lift_map_with_context = object - inherit Ppxlib_traverse_builtins.map - inherit Ast.map - end - -class iter = - object - inherit Ppxlib_traverse_builtins.iter - inherit Ast.iter - end - -class ['acc] fold = - object - inherit ['acc] Ppxlib_traverse_builtins.fold - inherit ['acc] Ast.fold - end - -class ['acc] fold_map = - object - inherit ['acc] Ppxlib_traverse_builtins.fold_map - inherit ['acc] Ast.fold_map - end - -class ['ctx] map_with_context = - object - inherit ['ctx] Ppxlib_traverse_builtins.map_with_context - inherit ['ctx] Ast.map_with_context - end - -class virtual ['res] lift = - object - inherit ['res] Ppxlib_traverse_builtins.lift - inherit ['res] Ast.lift + inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context + inherit ['ctx, 'res] Ast.lift_map_with_context end let module_name = function None -> "_" | Some name -> name @@ -90,66 +62,214 @@ let var_names_of = let ec_enter_module_opt ~loc name_opt ctxt = Expansion_context.Base.enter_module ~loc (module_name name_opt) ctxt -class map_with_expansion_context = +let enter_value = + Attribute.declare "ppxlib.enter_value" Expression + Ast_pattern.(single_expr_payload (pexp_ident (lident __'))) + Fn.id + +let enter_module = + Attribute.declare "ppxlib.enter_module" Module_expr + Ast_pattern.(single_expr_payload (pexp_construct (lident __') none)) + Fn.id + +let do_not_enter_value_binding = + Attribute.declare "ppxlib.do_not_enter_value" Value_binding + Ast_pattern.(pstr nil) + () + +let do_not_enter_value_description = + Attribute.declare "ppxlib.do_not_enter_value" Value_description + Ast_pattern.(pstr nil) + () + +let do_not_enter_module_binding = + Attribute.declare "ppxlib.do_not_enter_module" Module_binding + Ast_pattern.(pstr nil) + () + +let do_not_enter_module_declaration = + Attribute.declare "ppxlib.do_not_enter_module" Module_declaration + Ast_pattern.(pstr nil) + () + +let do_not_enter_module_type_declaration = + Attribute.declare "ppxlib.do_not_enter_module" Module_type_declaration + Ast_pattern.(pstr nil) + () + +let do_not_enter_let_module = + Attribute.declare "ppxlib.do_not_enter_module" Expression + Ast_pattern.(pstr nil) + () + +class map_with_expansion_context_and_errors = + let return _ctx x = (x, []) in object (self) - inherit [Expansion_context.Base.t] map_with_context as super + inherit + [Expansion_context.Base.t, Location.Error.t list] lift_map_with_context as super + + method int = return + method string = return + method bool = return + method char = return + method float = return + method int32 = return + method int64 = return + method nativeint = return + method unit = return + + method array + : 'a. + (Expansion_context.Base.t -> 'a -> 'a * Location.Error.t list) -> + Expansion_context.Base.t -> + 'a array -> + 'a array * Location.Error.t list = + fun f ctx a -> + let list, errors = self#list f ctx (Array.to_list a) in + (Array.of_list list, errors) + + method other : 'a. Expansion_context.Base.t -> 'a -> Location.Error.t list = + fun _ _ -> [] + + method record _ctx fields = List.concat_map fields ~f:snd + method constr _ctx _tag args = List.concat args + method tuple _ctx l = List.concat l method! expression ctxt - { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } = + ({ pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } as expr) = + let with_value = + Attribute.get_res enter_value expr |> of_result ~default:None + >>| function + | None -> ctxt + | Some { loc; txt } -> Expansion_context.Base.enter_value ~loc txt ctxt + in + with_value >>= fun ctxt -> let ctxt = Expansion_context.Base.enter_expr ctxt in - let pexp_desc = + let pexp_desc, desc_errors = match pexp_desc with | Pexp_letmodule (name, module_expr, body) -> - let name = self#loc (self#option self#string) ctxt name in - let module_expr = - self#module_expr - (ec_enter_module_opt ~loc:module_expr.pmod_loc name.txt ctxt) - module_expr + let name, name_errors = + self#loc (self#option self#string) ctxt name + in + let module_expr, module_expr_errors = + let with_let_module = + Attribute.get_res do_not_enter_let_module expr + |> of_result ~default:None + >>| function + | Some () -> ctxt + | None -> + ec_enter_module_opt ~loc:module_expr.pmod_loc name.txt ctxt + in + with_let_module >>= fun ctxt -> self#module_expr ctxt module_expr + in + let body, body_errors = self#expression ctxt body in + let errors = + self#constr ctxt "Pexp_letmodule" + [ name_errors; module_expr_errors; body_errors ] in - let body = self#expression ctxt body in - Pexp_letmodule (name, module_expr, body) + (Pexp_letmodule (name, module_expr, body), errors) | _ -> self#expression_desc ctxt pexp_desc in - let pexp_loc = self#location ctxt pexp_loc in - let pexp_loc_stack = self#list self#location ctxt pexp_loc_stack in - let pexp_attributes = self#attributes ctxt pexp_attributes in - { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes } + let pexp_loc, loc_errors = self#location ctxt pexp_loc in + let pexp_loc_stack, loc_stack_errors = + self#list self#location ctxt pexp_loc_stack + in + let pexp_attributes, attributes_errors = + self#attributes ctxt pexp_attributes + in + ( { pexp_desc; pexp_loc; pexp_loc_stack; pexp_attributes }, + self#record ctxt + [ + ("pexp_desc", desc_errors); + ("pexp_loc", loc_errors); + ("pexp_loc_stack", loc_stack_errors); + ("attributes", attributes_errors); + ] ) + + method! module_expr ctxt me = + let with_module_expr = + Attribute.get_res enter_module me |> of_result ~default:None + >>| function + | None -> ctxt + | Some { loc; txt } -> Expansion_context.Base.enter_module ~loc txt ctxt + in + with_module_expr >>= fun ctxt -> super#module_expr ctxt me method! module_binding ctxt mb = - super#module_binding - (ec_enter_module_opt ~loc:mb.pmb_loc mb.pmb_name.txt ctxt) - mb + let with_module_binding = + Attribute.get_res do_not_enter_module_binding mb + |> of_result ~default:None + >>| function + | Some () -> ctxt + | None -> ec_enter_module_opt ~loc:mb.pmb_loc mb.pmb_name.txt ctxt + in + with_module_binding >>= fun ctxt -> super#module_binding ctxt mb method! module_declaration ctxt md = - super#module_declaration - (ec_enter_module_opt ~loc:md.pmd_loc md.pmd_name.txt ctxt) - md + let with_module_declaration = + Attribute.get_res do_not_enter_module_declaration md + |> of_result ~default:None + >>| function + | Some () -> ctxt + | None -> ec_enter_module_opt ~loc:md.pmd_loc md.pmd_name.txt ctxt + in + with_module_declaration >>= fun ctxt -> super#module_declaration ctxt md method! module_type_declaration ctxt mtd = - super#module_type_declaration - (Expansion_context.Base.enter_module ~loc:mtd.pmtd_loc mtd.pmtd_name.txt - ctxt) - mtd + let with_module_type_declaration = + Attribute.get_res do_not_enter_module_type_declaration mtd + |> of_result ~default:None + >>| function + | Some () -> ctxt + | None -> + Expansion_context.Base.enter_module ~loc:mtd.pmtd_loc + mtd.pmtd_name.txt ctxt + in + with_module_type_declaration >>= fun ctxt -> + super#module_type_declaration ctxt mtd method! value_description ctxt vd = - super#value_description - (Expansion_context.Base.enter_value ~loc:vd.pval_loc vd.pval_name.txt - ctxt) - vd - - method! value_binding ctxt { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } = - let all_var_names = var_names_of#pattern pvb_pat [] in - let in_binding_ctxt = - match all_var_names with - | [] | _ :: _ :: _ -> ctxt - | [ var_name ] -> - Expansion_context.Base.enter_value ~loc:pvb_loc var_name ctxt + let with_value_description = + Attribute.get_res do_not_enter_value_description vd + |> of_result ~default:None + >>| function + | Some () -> ctxt + | None -> + Expansion_context.Base.enter_value ~loc:vd.pval_loc vd.pval_name.txt + ctxt in - let pvb_pat = self#pattern ctxt pvb_pat in - let pvb_expr = self#expression in_binding_ctxt pvb_expr in - let pvb_attributes = self#attributes in_binding_ctxt pvb_attributes in - let pvb_loc = self#location ctxt pvb_loc in - { pvb_pat; pvb_expr; pvb_attributes; pvb_loc } + with_value_description >>= fun ctxt -> super#value_description ctxt vd + + method! value_binding ctxt + ({ pvb_pat; pvb_expr; pvb_attributes; pvb_loc } as vb) = + Attribute.get_res do_not_enter_value_binding vb |> of_result ~default:None + >>= function + | Some () -> super#value_binding ctxt vb + | None -> + let in_binding_ctxt = + match var_names_of#pattern pvb_pat [] with + | [] | _ :: _ :: _ -> ctxt + | [ var_name ] -> + Expansion_context.Base.enter_value ~loc:pvb_loc var_name ctxt + in + let pvb_pat, pat_errors = self#pattern ctxt pvb_pat in + let pvb_expr, expr_errors = + self#expression in_binding_ctxt pvb_expr + in + let pvb_attributes, attributes_errors = + self#attributes in_binding_ctxt pvb_attributes + in + let pvb_loc, loc_errors = self#location ctxt pvb_loc in + let errors = + self#record ctxt + [ + ("pvb_pat", pat_errors); + ("pvb_expr", expr_errors); + ("pvb_attributes", attributes_errors); + ("pvb_loc", loc_errors); + ] + in + ({ pvb_pat; pvb_expr; pvb_attributes; pvb_loc }, errors) end class sexp_of = diff --git a/duniverse/ppxlib/src/ast_traverse.mli b/duniverse/ppxlib/src/ast_traverse.mli index ff25ac7b7..23526d224 100644 --- a/duniverse/ppxlib/src/ast_traverse.mli +++ b/duniverse/ppxlib/src/ast_traverse.mli @@ -58,7 +58,18 @@ class ['ctx] map_with_context : end class map_with_path : [string] map_with_context -class map_with_expansion_context : [Expansion_context.Base.t] map_with_context + +val enter_value : (expression, string loc) Attribute.t +val enter_module : (module_expr, string loc) Attribute.t +val do_not_enter_value_binding : (value_binding, unit) Attribute.t +val do_not_enter_value_description : (value_description, unit) Attribute.t +val do_not_enter_module_binding : (module_binding, unit) Attribute.t +val do_not_enter_module_declaration : (module_declaration, unit) Attribute.t + +val do_not_enter_module_type_declaration : + (module_type_declaration, unit) Attribute.t + +val do_not_enter_let_module : (expression, unit) Attribute.t class virtual ['res] lift : object @@ -66,6 +77,23 @@ class virtual ['res] lift : inherit ['res] Ast.lift end +class virtual ['ctx, 'res] lift_map_with_context : + object + inherit ['ctx, 'res] Ppxlib_traverse_builtins.lift_map_with_context + inherit ['ctx, 'res] Ast.lift_map_with_context + end + +class map_with_expansion_context_and_errors : + object + inherit + [Expansion_context.Base.t, Location.Error.t list] Ppxlib_traverse_builtins + .std_lift_mappers_with_context + + inherit + [Expansion_context.Base.t, Location.Error.t list] Ast + .lift_map_with_context + end + class sexp_of : object inherit [Sexp.t] Ppxlib_traverse_builtins.std_lifters diff --git a/duniverse/ppxlib/src/ast_traverse0.ml b/duniverse/ppxlib/src/ast_traverse0.ml new file mode 100644 index 000000000..235f8956f --- /dev/null +++ b/duniverse/ppxlib/src/ast_traverse0.ml @@ -0,0 +1,37 @@ +open! Import + +class map = + object + inherit Ppxlib_traverse_builtins.map + inherit Ast.map + end + +class iter = + object + inherit Ppxlib_traverse_builtins.iter + inherit Ast.iter + end + +class ['acc] fold = + object + inherit ['acc] Ppxlib_traverse_builtins.fold + inherit ['acc] Ast.fold + end + +class ['acc] fold_map = + object + inherit ['acc] Ppxlib_traverse_builtins.fold_map + inherit ['acc] Ast.fold_map + end + +class ['ctx] map_with_context = + object + inherit ['ctx] Ppxlib_traverse_builtins.map_with_context + inherit ['ctx] Ast.map_with_context + end + +class virtual ['res] lift = + object + inherit ['res] Ppxlib_traverse_builtins.lift + inherit ['res] Ast.lift + end diff --git a/duniverse/ppxlib/src/ast_traverse0.mli b/duniverse/ppxlib/src/ast_traverse0.mli new file mode 100644 index 000000000..6ce0d44b1 --- /dev/null +++ b/duniverse/ppxlib/src/ast_traverse0.mli @@ -0,0 +1,37 @@ +open! Import + +class map : + object + inherit Ppxlib_traverse_builtins.map + inherit Ast.map + end + +class iter : + object + inherit Ppxlib_traverse_builtins.iter + inherit Ast.iter + end + +class ['acc] fold : + object + inherit ['acc] Ppxlib_traverse_builtins.fold + inherit ['acc] Ast.fold + end + +class ['acc] fold_map : + object + inherit ['acc] Ppxlib_traverse_builtins.fold_map + inherit ['acc] Ast.fold_map + end + +class ['ctx] map_with_context : + object + inherit ['ctx] Ppxlib_traverse_builtins.map_with_context + inherit ['ctx] Ast.map_with_context + end + +class virtual ['res] lift : + object + inherit ['res] Ppxlib_traverse_builtins.lift + inherit ['res] Ast.lift + end diff --git a/duniverse/ppxlib/src/attribute.ml b/duniverse/ppxlib/src/attribute.ml index bbaf2caf6..aa574b8d6 100644 --- a/duniverse/ppxlib/src/attribute.ml +++ b/duniverse/ppxlib/src/attribute.ml @@ -301,7 +301,7 @@ let mark_as_handled_manually = mark_as_seen let explicitly_drop = object - inherit Ast_traverse.iter + inherit Ast_traverse0.iter method! attribute = mark_as_seen end @@ -465,7 +465,7 @@ let collect_attribute_errors registrar context name = let collect_unused_attributes_errors = object (self) - inherit [Location.Error.t list] Ast_traverse.fold as super + inherit [Location.Error.t list] Ast_traverse0.fold as super method! attribute { attr_name = name; _ } _ = [ @@ -659,7 +659,7 @@ let raise_if_non_empty = function let check_unused = object (self) - inherit Ast_traverse.iter as super + inherit Ast_traverse0.iter as super method private check_node : type a. a Context.t -> a -> a = fun context node -> @@ -781,7 +781,7 @@ let reset_checks () = Attribute_table.clear not_seen let collect = object - inherit Ast_traverse.iter as super + inherit Ast_traverse0.iter as super method! attribute ({ attr_name = name; attr_payload = payload; _ } as attr) = @@ -807,7 +807,7 @@ let check_all_seen () = let remove_attributes_present_in table = object - inherit Ast_traverse.iter as super + inherit Ast_traverse0.iter as super method! attribute { attr_name = name; attr_payload = payload; _ } = super#payload payload; diff --git a/duniverse/ppxlib/src/attribute.mli b/duniverse/ppxlib/src/attribute.mli index 37928aded..5cbd1a1aa 100644 --- a/duniverse/ppxlib/src/attribute.mli +++ b/duniverse/ppxlib/src/attribute.mli @@ -108,7 +108,9 @@ val declare : "foo.default" declared in the previous example, on this code it will match the [@foo.default 0] attribute: - {[ type t = { x : int [@default 42] [@foo.default 0] } ]} + {[ + type t = { x : int [@default 42] [@foo.default 0] } + ]} This is to allow the user to specify a [@default] attribute for all re-writers that use it but still put a specific one for one specific @@ -192,24 +194,24 @@ module Floating : sig val convert : ('a, 'b) t list -> 'a -> 'b option end -val explicitly_drop : Ast_traverse.iter +val explicitly_drop : Ast_traverse0.iter (** Code that is voluntarily dropped by a rewriter needs to be given to this object. All attributes inside will be marked as handled. *) -val check_unused : Ast_traverse.iter +val check_unused : Ast_traverse0.iter (** Raise if there are unused attributes. *) -val collect_unused_attributes_errors : Location.Error.t list Ast_traverse.fold +val collect_unused_attributes_errors : Location.Error.t list Ast_traverse0.fold (** Collect all errors due to unused attributes. *) -val collect : Ast_traverse.iter +val collect : Ast_traverse0.iter (** Collect all attribute names. To be used in conjunction with {!check_all_seen}. *) val collect_unseen_errors : unit -> Location.Error.t list val check_all_seen : unit -> unit -(** Check that all attributes collected by {!freshen_and_collect} have been: +(** Check that all attributes collected by {!collect_unseen_errors} have been: - matched at least once by one of: {!get}, {!consume} or {!Floating.convert} - seen by [check_unused] (to allow allowlisted attributed to pass through) diff --git a/duniverse/ppxlib/src/common.ml b/duniverse/ppxlib/src/common.ml index e98ed4d54..45c57eab1 100644 --- a/duniverse/ppxlib/src/common.ml +++ b/duniverse/ppxlib/src/common.ml @@ -97,7 +97,7 @@ exception Type_is_recursive class type_is_recursive rec_flag tds = object (self) - inherit Ast_traverse.iter as super + inherit Ast_traverse0.iter as super val type_names : string list = List.map tds ~f:(fun td -> td.ptype_name.txt) method return_true () = raise_notrace Type_is_recursive @@ -185,7 +185,7 @@ let attributes_errors = let collect_attributes_errors = object - inherit [Location.Error.t list] Ast_traverse.fold + inherit [Location.Error.t list] Ast_traverse0.fold method! attribute a acc = attributes_errors [ a ] @ acc end @@ -196,7 +196,7 @@ let assert_no_attributes l = let assert_no_attributes_in = object - inherit Ast_traverse.iter + inherit Ast_traverse0.iter method! attribute a = assert_no_attributes [ a ] end @@ -253,3 +253,22 @@ let mk_named_sig ~loc ~sg_name ~handle_polymorphic_variant = function (pmty_ident ~loc (Located.lident mty ~loc)) [ Pwith_typesubst (Located.lident ~loc "t", for_subst) ])) | _ -> None + +module With_errors = struct + type 'a t = 'a * Location.Error.t list + + let return e = (e, []) + + let ( >>= ) (x, errors1) f = + let y, errors2 = f x in + (y, errors1 @ errors2) + + let ( >>| ) (x, errors) f = (f x, errors) + + let of_result result ~default = + match result with + | Ok x -> (x, []) + | Error errors -> (default, NonEmptyList.to_list errors) + + let combine_errors list = (List.map list ~f:fst, List.concat_map list ~f:snd) +end diff --git a/duniverse/ppxlib/src/common.mli b/duniverse/ppxlib/src/common.mli index e3b332496..00d0fccbb 100644 --- a/duniverse/ppxlib/src/common.mli +++ b/duniverse/ppxlib/src/common.mli @@ -18,9 +18,9 @@ val gen_symbol : ?prefix:string -> unit -> string val string_of_core_type : core_type -> string val assert_no_attributes : attributes -> unit -val assert_no_attributes_in : Ast_traverse.iter +val assert_no_attributes_in : Ast_traverse0.iter val attributes_errors : attributes -> Location.Error.t list -val collect_attributes_errors : Location.Error.t list Ast_traverse.fold +val collect_attributes_errors : Location.Error.t list Ast_traverse0.fold val get_type_param_name_res : core_type * (variance * injectivity) -> @@ -39,7 +39,7 @@ class type_is_recursive : rec_flag -> type_declaration list -> object - inherit Ast_traverse.iter + inherit Ast_traverse0.iter val type_names : string list method return_true : unit -> unit method go : unit -> rec_flag @@ -85,3 +85,16 @@ val mk_named_sig : - there are no constraints on the type parameters It will take care of giving fresh names to unnamed type parameters. *) + +module With_errors : sig + type 'a t = 'a * Location.Error.t list + + val return : 'a -> 'a t + val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t + val ( >>| ) : 'a t -> ('a -> 'b) -> 'b t + + val of_result : + ('a, Location.Error.t NonEmptyList.t) result -> default:'a -> 'a t + + val combine_errors : 'a t list -> 'a list t +end diff --git a/duniverse/ppxlib/src/context_free.ml b/duniverse/ppxlib/src/context_free.ml index fe790bad6..35e03dfba 100644 --- a/duniverse/ppxlib/src/context_free.ml +++ b/duniverse/ppxlib/src/context_free.ml @@ -1,6 +1,7 @@ (*$ open Ppxlib_cinaps_helpers $*) open! Import open Common +open With_errors module E = Extension module EC = Extension.Context module A = Attribute @@ -197,95 +198,79 @@ module Generated_code_hook = struct end let rec map_node_rec context ts super_call loc base_ctxt x = - let open Result in let ctxt = Expansion_context.Extension.make ~extension_point_loc:loc ~base:base_ctxt () in match EC.get_extension context x with - | None -> Ok (super_call base_ctxt x) + | None -> super_call base_ctxt x | Some (ext, attrs) -> ( - E.For_context.convert_res ts ~ctxt ext >>= fun converted -> + E.For_context.convert_res ts ~ctxt ext + |> With_errors.of_result ~default:None + >>= fun converted -> match converted with - | None -> Ok (super_call base_ctxt x) + | None -> super_call base_ctxt x | Some x -> - EC.merge_attributes_res context x attrs >>= fun x -> - map_node_rec context ts super_call loc base_ctxt x) + EC.merge_attributes_res context x attrs + |> With_errors.of_result ~default:x + >>= fun x -> map_node_rec context ts super_call loc base_ctxt x) let map_node context ts super_call loc base_ctxt x ~hook = - let open Result in let ctxt = Expansion_context.Extension.make ~extension_point_loc:loc ~base:base_ctxt () in - let res = - match EC.get_extension context x with - | None -> Ok (super_call base_ctxt x) - | Some (ext, attrs) -> ( - E.For_context.convert_res ts ~ctxt ext >>= fun converted -> - match converted with - | None -> Ok (super_call base_ctxt x) - | Some x -> - map_node_rec context ts super_call loc base_ctxt - (EC.merge_attributes context x attrs) - >>| fun generated_code -> - Generated_code_hook.replace hook context loc (Single generated_code); - generated_code) - in - match res with - | Ok e -> e - | Error (hd_err, _) -> - EC.node_of_extension context ~x (Location.Error.to_extension hd_err) + match EC.get_extension context x with + | None -> super_call base_ctxt x + | Some (ext, attrs) -> ( + E.For_context.convert_res ts ~ctxt ext + |> With_errors.of_result ~default:None + >>= fun converted -> + match converted with + | None -> super_call base_ctxt x + | Some x -> + map_node_rec context ts super_call loc base_ctxt + (EC.merge_attributes context x attrs) + >>| fun generated_code -> + Generated_code_hook.replace hook context loc (Single generated_code); + generated_code) let rec map_nodes context ts super_call get_loc base_ctxt l ~hook ~in_generated_code = match l with - | [] -> [] + | [] -> return [] | x :: l -> ( match EC.get_extension context x with | None -> (* These two lets force the evaluation order, so that errors are reported in the same order as they appear in the source file. *) - let x = super_call base_ctxt x in - let l = - map_nodes context ts super_call get_loc base_ctxt l ~hook - ~in_generated_code - in - x :: l + super_call base_ctxt x >>= fun x -> + map_nodes context ts super_call get_loc base_ctxt l ~hook + ~in_generated_code + >>| fun l -> x :: l | Some (ext, attrs) -> ( let extension_point_loc = get_loc x in let ctxt = Expansion_context.Extension.make ~extension_point_loc ~base:base_ctxt () in - match E.For_context.convert_inline_res ts ~ctxt ext with - | Ok None -> - let x = super_call base_ctxt x in - let l = - map_nodes context ts super_call get_loc base_ctxt l ~hook - ~in_generated_code - in - x :: l - | Ok (Some converted) -> - let attributes_errors = attributes_errors attrs in - if List.length attributes_errors = 0 then ( - let generated_code = - map_nodes context ts super_call get_loc base_ctxt converted - ~hook ~in_generated_code:true - in - if not in_generated_code then - Generated_code_hook.replace hook context extension_point_loc - (Many generated_code); - generated_code - @ map_nodes context ts super_call get_loc base_ctxt l ~hook - ~in_generated_code) - else - attributes_errors - |> List.map ~f:Location.Error.to_extension - |> List.map ~f:(EC.node_of_extension context ~x) - | Error l -> - l - |> NonEmptyList.map ~f:Location.Error.to_extension - |> NonEmptyList.map ~f:(EC.node_of_extension context ~x) - |> NonEmptyList.to_list)) + E.For_context.convert_inline_res ts ~ctxt ext + |> With_errors.of_result ~default:None + >>= function + | None -> + super_call base_ctxt x >>= fun x -> + map_nodes context ts super_call get_loc base_ctxt l ~hook + ~in_generated_code + >>| fun l -> x :: l + | Some converted -> + ((), attributes_errors attrs) >>= fun () -> + map_nodes context ts super_call get_loc base_ctxt converted ~hook + ~in_generated_code:true + >>= fun generated_code -> + if not in_generated_code then + Generated_code_hook.replace hook context extension_point_loc + (Many generated_code); + map_nodes context ts super_call get_loc base_ctxt l ~hook + ~in_generated_code + >>| fun code -> generated_code @ code)) let map_nodes = map_nodes ~in_generated_code:false @@ -313,12 +298,11 @@ let table_of_special_functions special_functions = attached, [get_group] returns the equivalent of [Some (List.map ~f:(Attribute.get attr) l)]. *) let rec get_group attr l = - let open Result in match l with - | [] -> Ok None + | [] -> return None | x :: l -> ( get_group attr l >>= fun group -> - Attribute.get_res attr x >>| fun attr2 -> + Attribute.get_res attr x |> of_result ~default:None >>| fun attr2 -> match (attr2, group) with | None, None -> None | None, Some vals -> Some (None :: vals) @@ -358,39 +342,41 @@ let context_free_attribute_modification ~loc = of one element; it only has [@@deriving]. *) let handle_attr_group_inline attrs rf ~items ~expanded_items ~loc ~base_ctxt = - let open Result in - List.fold_left attrs ~init:(Ok []) + List.fold_left attrs ~init:(return []) ~f:(fun acc (Rule.Attr_group_inline.T group) -> acc >>= fun acc -> get_group group.attribute items >>= fun g1 -> get_group group.attribute expanded_items >>= fun g2 -> match (g1, g2) with - | None, None -> Ok acc - | None, Some _ | Some _, None -> context_free_attribute_modification ~loc + | None, None -> return acc + | None, Some _ | Some _, None -> + context_free_attribute_modification ~loc |> of_result ~default:acc | Some values, Some _ -> let ctxt = Expansion_context.Deriver.make ~derived_item_loc:loc ~inline:group.expect ~base:base_ctxt () in let expect_items = group.expand ~ctxt rf expanded_items values in - Ok (expect_items :: acc)) + return (expect_items :: acc)) let handle_attr_inline attrs ~item ~expanded_item ~loc ~base_ctxt = - let open Result in - List.fold_left attrs ~init:(Ok []) ~f:(fun acc (Rule.Attr_inline.T a) -> + List.fold_left attrs ~init:(return []) ~f:(fun acc (Rule.Attr_inline.T a) -> acc >>= fun acc -> - Attribute.get_res a.attribute item >>= fun g1 -> - Attribute.get_res a.attribute expanded_item >>= fun g2 -> + Attribute.get_res a.attribute item |> of_result ~default:None + >>= fun g1 -> + Attribute.get_res a.attribute expanded_item |> of_result ~default:None + >>= fun g2 -> match (g1, g2) with - | None, None -> Ok acc - | None, Some _ | Some _, None -> context_free_attribute_modification ~loc + | None, None -> return acc + | None, Some _ | Some _, None -> + context_free_attribute_modification ~loc |> of_result ~default:acc | Some value, Some _ -> let ctxt = Expansion_context.Deriver.make ~derived_item_loc:loc ~inline:a.expect ~base:base_ctxt () in let expect_items = a.expand ~ctxt expanded_item value in - Ok (expect_items :: acc)) + return (expect_items :: acc)) module Expect_mismatch_handler = struct type t = { @@ -466,10 +452,10 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) let map_nodes = map_nodes ~hook in object (self) - inherit Ast_traverse.map_with_expansion_context as super + inherit Ast_traverse.map_with_expansion_context_and_errors as super (* No point recursing into every location *) - method! location _ x = x + method! location _ x = return x method! core_type base_ctxt x = map_node EC.core_type core_type super#core_type x.ptyp_loc base_ctxt x @@ -478,14 +464,30 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) map_node EC.pattern pattern super#pattern x.ppat_loc base_ctxt x method! expression base_ctxt e = - let e = + let with_context = + (* Make sure code-path attribute is applied before expanding. *) + Attribute.get_res Ast_traverse.enter_value e |> of_result ~default:None + >>= fun option -> + match option with + | None -> return (base_ctxt, e) + | Some { loc; txt } -> + Attribute.remove_seen_res Expression + [ T Ast_traverse.enter_value ] + e + |> of_result ~default:e + >>| fun e -> + (Expansion_context.Base.enter_value ~loc txt base_ctxt, e) + in + with_context >>= fun (base_ctxt, e) -> + let expanded = match e.pexp_desc with | Pexp_extension _ -> map_node EC.expression expression - (fun _ e -> e) + (fun _ e -> return e) e.pexp_loc base_ctxt e - | _ -> e + | _ -> return e in + expanded >>= fun e -> let expand_constant kind char text = match Hashtbl.find_opt constants (char, kind) with | None -> super#expression base_ctxt e @@ -523,7 +525,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) let { pexp_desc = _; pexp_loc; pexp_attributes; pexp_loc_stack } = e in let func = let { pexp_desc; pexp_loc; pexp_attributes; pexp_loc_stack } = func in - let pexp_attributes = self#attributes base_ctxt pexp_attributes in + self#attributes base_ctxt pexp_attributes >>| fun pexp_attributes -> { pexp_desc; pexp_loc (* location doesn't need to be traversed *); @@ -531,11 +533,14 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) pexp_loc_stack; } in + func >>= fun func -> let args = List.map args ~f:(fun (lab, exp) -> - (lab, self#expression base_ctxt exp)) + self#expression base_ctxt exp >>| fun exp -> (lab, exp)) + |> combine_errors in - let pexp_attributes = self#attributes base_ctxt pexp_attributes in + args >>= fun args -> + self#attributes base_ctxt pexp_attributes >>| fun pexp_attributes -> { pexp_loc; pexp_attributes; @@ -562,6 +567,18 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) x method! module_expr base_ctxt x = + ((* Make sure code-path attribute is applied before expanding. *) + Attribute.get_res Ast_traverse.enter_module x |> of_result ~default:None + >>= function + | None -> return (base_ctxt, x) + | Some { loc; txt } -> + Attribute.remove_seen_res Module_expr + [ T Ast_traverse.enter_module ] + x + |> of_result ~default:x + >>| fun x -> + (Expansion_context.Base.enter_module ~loc txt base_ctxt, x)) + >>= fun (base_ctxt, x) -> map_node EC.module_expr module_expr super#module_expr x.pmod_loc base_ctxt x @@ -574,54 +591,48 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) base_ctxt x method! class_structure base_ctxt { pcstr_self; pcstr_fields } = - let pcstr_self = self#pattern base_ctxt pcstr_self in - let pcstr_fields = - map_nodes EC.class_field class_field super#class_field - (fun x -> x.pcf_loc) - base_ctxt pcstr_fields - in - { pcstr_self; pcstr_fields } + self#pattern base_ctxt pcstr_self >>= fun pcstr_self -> + map_nodes EC.class_field class_field super#class_field + (fun x -> x.pcf_loc) + base_ctxt pcstr_fields + >>| fun pcstr_fields -> { pcstr_self; pcstr_fields } method! type_declaration base_ctxt x = map_node EC.Ppx_import ppx_import super#type_declaration x.ptype_loc base_ctxt x method! class_signature base_ctxt { pcsig_self; pcsig_fields } = - let pcsig_self = self#core_type base_ctxt pcsig_self in - let pcsig_fields = - map_nodes EC.class_type_field class_type_field super#class_type_field - (fun x -> x.pctf_loc) - base_ctxt pcsig_fields - in - { pcsig_self; pcsig_fields } + self#core_type base_ctxt pcsig_self >>= fun pcsig_self -> + map_nodes EC.class_type_field class_type_field super#class_type_field + (fun x -> x.pctf_loc) + base_ctxt pcsig_fields + >>| fun pcsig_fields -> { pcsig_self; pcsig_fields } (* TODO: try to factorize #structure and #signature without meta-programming *) (*$*) method! structure base_ctxt st = - let open Result in let rec with_extra_items item ~extra_items ~expect_items ~rest ~in_generated_code = - let extra_items = - loop (rev_concat extra_items) ~in_generated_code:true - in + loop (rev_concat extra_items) ~in_generated_code:true + >>= fun extra_items -> if not in_generated_code then Generated_code_hook.insert_after hook Structure_item item.pstr_loc (Many extra_items); let original_rest = rest in - let rest = loop rest ~in_generated_code in - let open Result in + loop rest ~in_generated_code >>= fun rest -> (match expect_items with - | [] -> Ok () + | [] -> return () | _ -> let expected = rev_concat expect_items in let pos = item.pstr_loc.loc_end in Code_matcher.match_structure_res original_rest ~pos ~expected ~mismatch_handler:(fun loc repl -> - expect_mismatch_handler.f Structure_item loc repl)) + expect_mismatch_handler.f Structure_item loc repl) + |> of_result ~default:()) >>| fun () -> item :: (extra_items @ rest) and loop st ~in_generated_code = match st with - | [] -> [] + | [] -> return [] | item :: rest -> ( let loc = item.pstr_loc in match item.pstr_desc with @@ -631,46 +642,22 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) Expansion_context.Extension.make ~extension_point_loc ~base:base_ctxt () in - match - E.For_context.convert_inline_res structure_item ~ctxt ext - with - | Ok None -> - let item = super#structure_item base_ctxt item in - let rest = self#structure base_ctxt rest in - item :: rest - | Ok (Some items) -> - let attributes_errors = attributes_errors attrs in - if List.length attributes_errors = 0 then ( - (* assert_no_attributes attrs; *) - let items = loop items ~in_generated_code:true in - if not in_generated_code then - Generated_code_hook.replace hook Structure_item - item.pstr_loc (Many items); - items @ loop rest ~in_generated_code) - else - (attributes_errors - |> List.map ~f:Location.Error.to_extension - |> List.map - ~f:(EC.node_of_extension EC.Structure_item ~x:item)) - @ loop rest ~in_generated_code - | Error err -> - (err - |> NonEmptyList.map ~f:Location.Error.to_extension - |> NonEmptyList.map - ~f:(EC.node_of_extension EC.Structure_item ~x:item) - |> NonEmptyList.to_list) - @ loop rest ~in_generated_code) + E.For_context.convert_inline_res structure_item ~ctxt ext + |> of_result ~default:None + >>= function + | None -> + super#structure_item base_ctxt item >>= fun item -> + self#structure base_ctxt rest >>| fun rest -> item :: rest + | Some items -> + ((), attributes_errors attrs) >>= fun () -> + (* assert_no_attributes attrs; *) + loop items ~in_generated_code:true >>= fun items -> + if not in_generated_code then + Generated_code_hook.replace hook Structure_item + item.pstr_loc (Many items); + loop rest ~in_generated_code >>| fun rest -> items @ rest) | _ -> ( - let error_of_extension e = - (e - |> NonEmptyList.map ~f:Location.Error.to_extension - |> NonEmptyList.map ~f:(fun e -> - Ast_builder.Default.pstr_extension ~loc:Location.none e - []) - |> NonEmptyList.to_list) - @ loop rest ~in_generated_code - in - let expanded_item = super#structure_item base_ctxt item in + super#structure_item base_ctxt item >>= fun expanded_item -> match (item.pstr_desc, expanded_item.pstr_desc) with | Pstr_type (rf, tds), Pstr_type (exp_rf, exp_tds) -> (* No context-free rule can rewrite rec flags atm, this @@ -678,75 +665,69 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) assert (Poly.(rf = exp_rf)); handle_attr_group_inline attr_str_type_decls rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_group_inline attr_str_type_decls_expect rf - ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_group_inline attr_str_type_decls_expect rf + ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Pstr_modtype mtd, Pstr_modtype exp_mtd -> handle_attr_inline attr_str_module_type_decls ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_str_module_type_decls_expect - ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_str_module_type_decls_expect + ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Pstr_typext te, Pstr_typext exp_te -> handle_attr_inline attr_str_type_exts ~item:te ~expanded_item:exp_te ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_str_type_exts_expect ~item:te - ~expanded_item:exp_te ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_str_type_exts_expect ~item:te + ~expanded_item:exp_te ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Pstr_exception ec, Pstr_exception exp_ec -> handle_attr_inline attr_str_exceptions ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_str_exceptions_expect ~item:ec - ~expanded_item:exp_ec ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_str_exceptions_expect ~item:ec + ~expanded_item:exp_ec ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | _, _ -> - let rest = self#structure base_ctxt rest in + self#structure base_ctxt rest >>| fun rest -> expanded_item :: rest)) in loop st ~in_generated_code:false (*$ str_to_sig _last_text_block *) method! signature base_ctxt sg = - let open Result in let rec with_extra_items item ~extra_items ~expect_items ~rest ~in_generated_code = - let extra_items = - loop (rev_concat extra_items) ~in_generated_code:true - in + loop (rev_concat extra_items) ~in_generated_code:true + >>= fun extra_items -> if not in_generated_code then Generated_code_hook.insert_after hook Signature_item item.psig_loc (Many extra_items); let original_rest = rest in - let rest = loop rest ~in_generated_code in - let open Result in + loop rest ~in_generated_code >>= fun rest -> (match expect_items with - | [] -> Ok () + | [] -> return () | _ -> let expected = rev_concat expect_items in let pos = item.psig_loc.loc_end in Code_matcher.match_signature_res original_rest ~pos ~expected ~mismatch_handler:(fun loc repl -> - expect_mismatch_handler.f Signature_item loc repl)) + expect_mismatch_handler.f Signature_item loc repl) + |> of_result ~default:()) >>| fun () -> item :: (extra_items @ rest) and loop sg ~in_generated_code = match sg with - | [] -> [] + | [] -> return [] | item :: rest -> ( let loc = item.psig_loc in match item.psig_desc with @@ -756,46 +737,22 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) Expansion_context.Extension.make ~extension_point_loc ~base:base_ctxt () in - match - E.For_context.convert_inline_res signature_item ~ctxt ext - with - | Ok None -> - let item = super#signature_item base_ctxt item in - let rest = self#signature base_ctxt rest in - item :: rest - | Ok (Some items) -> - let attributes_errors = attributes_errors attrs in - if List.length attributes_errors = 0 then ( - (* assert_no_attributes attrs; *) - let items = loop items ~in_generated_code:true in - if not in_generated_code then - Generated_code_hook.replace hook Signature_item - item.psig_loc (Many items); - items @ loop rest ~in_generated_code) - else - (attributes_errors - |> List.map ~f:Location.Error.to_extension - |> List.map - ~f:(EC.node_of_extension EC.Signature_item ~x:item)) - @ loop rest ~in_generated_code - | Error err -> - (err - |> NonEmptyList.map ~f:Location.Error.to_extension - |> NonEmptyList.map - ~f:(EC.node_of_extension EC.Signature_item ~x:item) - |> NonEmptyList.to_list) - @ loop rest ~in_generated_code) + E.For_context.convert_inline_res signature_item ~ctxt ext + |> of_result ~default:None + >>= function + | None -> + super#signature_item base_ctxt item >>= fun item -> + self#signature base_ctxt rest >>| fun rest -> item :: rest + | Some items -> + ((), attributes_errors attrs) >>= fun () -> + (* assert_no_attributes attrs; *) + loop items ~in_generated_code:true >>= fun items -> + if not in_generated_code then + Generated_code_hook.replace hook Signature_item + item.psig_loc (Many items); + loop rest ~in_generated_code >>| fun rest -> items @ rest) | _ -> ( - let error_of_extension e = - (e - |> NonEmptyList.map ~f:Location.Error.to_extension - |> NonEmptyList.map ~f:(fun e -> - Ast_builder.Default.psig_extension ~loc:Location.none e - []) - |> NonEmptyList.to_list) - @ loop rest ~in_generated_code - in - let expanded_item = super#signature_item base_ctxt item in + super#signature_item base_ctxt item >>= fun expanded_item -> match (item.psig_desc, expanded_item.psig_desc) with | Psig_type (rf, tds), Psig_type (exp_rf, exp_tds) -> (* No context-free rule can rewrite rec flags atm, this @@ -803,45 +760,41 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop) assert (Poly.(rf = exp_rf)); handle_attr_group_inline attr_sig_type_decls rf ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_group_inline attr_sig_type_decls_expect rf - ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_group_inline attr_sig_type_decls_expect rf + ~items:tds ~expanded_items:exp_tds ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Psig_modtype mtd, Psig_modtype exp_mtd -> handle_attr_inline attr_sig_module_type_decls ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_sig_module_type_decls_expect - ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_sig_module_type_decls_expect + ~item:mtd ~expanded_item:exp_mtd ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Psig_typext te, Psig_typext exp_te -> handle_attr_inline attr_sig_type_exts ~item:te ~expanded_item:exp_te ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_sig_type_exts_expect ~item:te - ~expanded_item:exp_te ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_sig_type_exts_expect ~item:te + ~expanded_item:exp_te ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | Psig_exception ec, Psig_exception exp_ec -> handle_attr_inline attr_sig_exceptions ~item:ec ~expanded_item:exp_ec ~loc ~base_ctxt - >>= (fun extra_items -> - handle_attr_inline attr_sig_exceptions_expect ~item:ec - ~expanded_item:exp_ec ~loc ~base_ctxt - >>= fun expect_items -> - with_extra_items expanded_item ~extra_items - ~expect_items ~rest ~in_generated_code) - |> handle_error ~f:error_of_extension + >>= fun extra_items -> + handle_attr_inline attr_sig_exceptions_expect ~item:ec + ~expanded_item:exp_ec ~loc ~base_ctxt + >>= fun expect_items -> + with_extra_items expanded_item ~extra_items ~expect_items + ~rest ~in_generated_code | _, _ -> - let rest = self#signature base_ctxt rest in + self#signature base_ctxt rest >>| fun rest -> expanded_item :: rest)) in loop sg ~in_generated_code:false diff --git a/duniverse/ppxlib/src/context_free.mli b/duniverse/ppxlib/src/context_free.mli index 0b1e7a702..2d677db8c 100644 --- a/duniverse/ppxlib/src/context_free.mli +++ b/duniverse/ppxlib/src/context_free.mli @@ -149,4 +149,6 @@ class map_top_down : -> ?generated_code_hook: Generated_code_hook.t (* default: Generated_code_hook.nop *) -> Rule.t list - -> Ast_traverse.map_with_expansion_context + -> object + inherit Ast_traverse.map_with_expansion_context_and_errors + end diff --git a/duniverse/ppxlib/src/deriving.ml b/duniverse/ppxlib/src/deriving.ml index 49ad6ea2f..e17f5b7c9 100644 --- a/duniverse/ppxlib/src/deriving.ml +++ b/duniverse/ppxlib/src/deriving.ml @@ -141,7 +141,6 @@ module Generator = struct spec : ('c, 'a) Args.t; gen : ctxt:Expansion_context.Deriver.t -> 'b -> 'c; arg_names : String.Set.t; - attributes : Attribute.packed list; deps : deriver list; } -> ('a, 'b) t @@ -149,9 +148,9 @@ module Generator = struct let deps (T t) = t.deps module V2 = struct - let make ?(attributes = []) ?(deps = []) spec gen = + let make ?attributes:(_ = []) ?(deps = []) spec gen = let arg_names = String.Set.of_list (Args.names spec) in - T { spec; gen; arg_names; attributes; deps } + T { spec; gen; arg_names; deps } let make_noarg ?attributes ?deps gen = make ?attributes ?deps Args.empty gen end @@ -655,29 +654,6 @@ let wrap_sig ~loc ~hide sg = in if wrap then wrap_sig ~loc ~hide sg else sg -(* +-----------------------------------------------------------------+ - | Remove attributes used by syntax extensions | - +-----------------------------------------------------------------+ *) -(* -let remove generators = - let attributes = - List.concat_map generators ~f:(fun (_, actual_generators, _) -> - List.concat_map actual_generators ~f:(fun (Generator.T g) -> g.attributes)) - in - object - inherit Ast_traverse.map - - (* Don't recurse through attributes and extensions *) - method! attribute x = x - method! extension x = x - - method! label_declaration ld = - Attribute.remove_seen Attribute.Context.label_declaration attributes ld - - method! constructor_declaration cd = - Attribute.remove_seen Attribute.Context.constructor_declaration attributes cd - end -*) (* +-----------------------------------------------------------------+ | Main expansion | +-----------------------------------------------------------------+ *) diff --git a/duniverse/ppxlib/src/deriving.mli b/duniverse/ppxlib/src/deriving.mli index 0c4d50116..e1377873b 100644 --- a/duniverse/ppxlib/src/deriving.mli +++ b/duniverse/ppxlib/src/deriving.mli @@ -46,31 +46,43 @@ module Generator : sig type ('output_ast, 'input_ast) t val make : - ?attributes:Attribute.packed list -> + ?attributes:Attribute.packed list (* deprecated, unused *) -> ?deps:deriver list -> ('f, 'output_ast) Args.t -> (loc:Location.t -> path:string -> 'input_ast -> 'f) -> ('output_ast, 'input_ast) t + (** [make args gen] creates a generator that can be passed to {!Deriving.add} + to generate an output AST from an input AST and generator arguments. + + [deps] is a list of derivers that this generator depends on. + + [attributes] is deprecated and unused. It is only kept for backward + compatibility. *) val make_noarg : - ?attributes:Attribute.packed list -> + ?attributes:Attribute.packed list (* deprecated, unused *) -> ?deps:deriver list -> (loc:Location.t -> path:string -> 'input_ast -> 'output_ast) -> ('output_ast, 'input_ast) t + (** Same as {!make}, but without arguments. *) module V2 : sig val make : - ?attributes:Attribute.packed list -> + ?attributes:Attribute.packed list (* deprecated, unused *) -> ?deps:deriver list -> ('f, 'output_ast) Args.t -> (ctxt:Expansion_context.Deriver.t -> 'input_ast -> 'f) -> ('output_ast, 'input_ast) t + (** Same as {!Generator.make}, but the generator has access to an expansion + context. *) val make_noarg : - ?attributes:Attribute.packed list -> + ?attributes:Attribute.packed list (* deprecated, unused *) -> ?deps:deriver list -> (ctxt:Expansion_context.Deriver.t -> 'input_ast -> 'output_ast) -> ('output_ast, 'input_ast) t + (** Same as {!Generator.make_noarg}, but the generator has access to an + expansion context. *) end val apply : diff --git a/duniverse/ppxlib/src/driver.ml b/duniverse/ppxlib/src/driver.ml index 1760bb878..cf4cc51bf 100644 --- a/duniverse/ppxlib/src/driver.ml +++ b/duniverse/ppxlib/src/driver.ml @@ -1,6 +1,8 @@ (*$ open Ppxlib_cinaps_helpers $*) open Import open Utils +open Common +open With_errors module Arg = Caml.Arg let exe_name = Caml.Filename.basename Caml.Sys.executable_name @@ -23,6 +25,12 @@ let styler = ref None let output_metadata_filename = ref None let corrected_suffix = ref ".ppx-corrected" +let ghost = + object + inherit Ast_traverse.map + method! location loc = { loc with loc_ghost = true } + end + module Lint_error = struct type t = Location.t * string @@ -69,12 +77,16 @@ module Instrument = struct type t = { transformation : - Expansion_context.Base.t -> Parsetree.structure -> Parsetree.structure; + Expansion_context.Base.t -> + Parsetree.structure -> + Parsetree.structure With_errors.t; position : pos; } module V2 = struct - let make transformation ~position = { transformation; position } + let make transformation ~position = + let transformation ctx st = return (transformation ctx st) in + { transformation; position } end let make transformation ~position = @@ -87,10 +99,14 @@ module Transform = struct name : string; aliases : string list; impl : - (Expansion_context.Base.t -> Parsetree.structure -> Parsetree.structure) + (Expansion_context.Base.t -> + Parsetree.structure -> + Parsetree.structure With_errors.t) option; intf : - (Expansion_context.Base.t -> Parsetree.signature -> Parsetree.signature) + (Expansion_context.Base.t -> + Parsetree.signature -> + Parsetree.signature With_errors.t) option; lint_impl : (Expansion_context.Base.t -> Parsetree.structure -> Lint_error.t list) @@ -99,10 +115,14 @@ module Transform = struct (Expansion_context.Base.t -> Parsetree.signature -> Lint_error.t list) option; preprocess_impl : - (Expansion_context.Base.t -> Parsetree.structure -> Parsetree.structure) + (Expansion_context.Base.t -> + Parsetree.structure -> + Parsetree.structure With_errors.t) option; preprocess_intf : - (Expansion_context.Base.t -> Parsetree.signature -> Parsetree.signature) + (Expansion_context.Base.t -> + Parsetree.signature -> + Parsetree.signature With_errors.t) option; enclose_impl : (Expansion_context.Base.t -> @@ -142,6 +162,14 @@ module Transform = struct Printf.eprintf " - first time was at %a\n" print_caller_id ct.registered_at; Printf.eprintf " - second time is at %a\n" print_caller_id caller_id); + let impl = Option.map impl ~f:(fun f ctx ast -> return (f ctx ast)) in + let intf = Option.map intf ~f:(fun f ctx ast -> return (f ctx ast)) in + let preprocess_impl = + Option.map preprocess_impl ~f:(fun f ctx ast -> return (f ctx ast)) + in + let preprocess_intf = + Option.map preprocess_intf ~f:(fun f ctx ast -> return (f ctx ast)) + in let ct = { name; @@ -212,52 +240,48 @@ module Transform = struct match input_name with Some input_name -> input_name | None -> "_none_" in let map_impl ctxt st_with_attrs = - let st = - let attrs, st = - List.split_while st_with_attrs ~f:(function - | { pstr_desc = Pstr_attribute _; _ } -> true - | _ -> false) - in - let file_path = File_path.get_default_path_str st in - let base_ctxt = - Expansion_context.Base.top_level ~tool_name ~file_path ~input_name - in - let header, footer = - match enclose_impl with - | None -> ([], []) - | Some f -> - let whole_loc = - loc_of_list st ~get_loc:(fun st -> st.Parsetree.pstr_loc) - in - gen_header_and_footer Structure_item whole_loc (f base_ctxt) - in - map#structure base_ctxt (List.concat [ attrs; header; st; footer ]) + let attrs, st = + List.split_while st_with_attrs ~f:(function + | { pstr_desc = Pstr_attribute _; _ } -> true + | _ -> false) in - match impl with None -> st | Some f -> f ctxt st + let file_path = File_path.get_default_path_str st in + let base_ctxt = + Expansion_context.Base.top_level ~tool_name ~file_path ~input_name + in + let header, footer = + match enclose_impl with + | None -> ([], []) + | Some f -> + let whole_loc = + loc_of_list st ~get_loc:(fun st -> st.Parsetree.pstr_loc) + in + gen_header_and_footer Structure_item whole_loc (f base_ctxt) + in + map#structure base_ctxt (List.concat [ attrs; header; st; footer ]) + >>= fun st -> match impl with None -> return st | Some f -> f ctxt st in let map_intf ctxt sg_with_attrs = - let sg = - let attrs, sg = - List.split_while sg_with_attrs ~f:(function - | { psig_desc = Psig_attribute _; _ } -> true - | _ -> false) - in - let file_path = File_path.get_default_path_sig sg in - let base_ctxt = - Expansion_context.Base.top_level ~tool_name ~file_path ~input_name - in - let header, footer = - match enclose_intf with - | None -> ([], []) - | Some f -> - let whole_loc = - loc_of_list sg ~get_loc:(fun sg -> sg.Parsetree.psig_loc) - in - gen_header_and_footer Signature_item whole_loc (f base_ctxt) - in - map#signature base_ctxt (List.concat [ attrs; header; sg; footer ]) + let attrs, sg = + List.split_while sg_with_attrs ~f:(function + | { psig_desc = Psig_attribute _; _ } -> true + | _ -> false) in - match intf with None -> sg | Some f -> f ctxt sg + let file_path = File_path.get_default_path_sig sg in + let base_ctxt = + Expansion_context.Base.top_level ~tool_name ~file_path ~input_name + in + let header, footer = + match enclose_intf with + | None -> ([], []) + | Some f -> + let whole_loc = + loc_of_list sg ~get_loc:(fun sg -> sg.Parsetree.psig_loc) + in + gen_header_and_footer Signature_item whole_loc (f base_ctxt) + in + map#signature base_ctxt (List.concat [ attrs; header; sg; footer ]) + >>= fun sg -> match intf with None -> return sg | Some f -> f ctxt sg in { t with impl = Some map_impl; intf = Some map_intf } @@ -487,20 +511,27 @@ let apply_transforms (type t) ~tool_name ~file_path ~field ~lint_field ~dropped_so_far ~hook ~expect_mismatch_handler ~input_name ~f_exception ~embed_errors x = let exception - Wrapper of t list * label loc list * (location * label) list * exn + Wrapper of + t list + * label loc list + * (location * label) list + * exn + * Location.Error.t list in let cts = get_whole_ast_passes ~tool_name ~hook ~expect_mismatch_handler ~input_name in - let return (x, _dropped, lint_errors) = + let finish (x, _dropped, lint_errors, errors) = ( x, List.map lint_errors ~f:(fun (loc, s) -> - Common.attribute_of_warning loc s) ) + Common.attribute_of_warning loc s), + errors ) in try let acc = - List.fold_left cts ~init:(x, [], []) - ~f:(fun (x, dropped, (lint_errors : _ list)) (ct : Transform.t) -> + List.fold_left cts ~init:(x, [], [], []) + ~f:(fun (x, dropped, (lint_errors : _ list), errors) (ct : Transform.t) + -> let input_name = match input_name with | Some input_name -> input_name @@ -515,15 +546,15 @@ let apply_transforms (type t) ~tool_name ~file_path ~field ~lint_field | Some f -> ( try lint_errors @ f ctxt x with exn when embed_errors -> - raise @@ Wrapper (x, dropped, lint_errors, exn)) + raise @@ Wrapper (x, dropped, lint_errors, exn, errors)) in match field ct with - | None -> (x, dropped, lint_errors) + | None -> (x, dropped, lint_errors, errors) | Some f -> - let x = + let x, more_errors = try f ctxt x with exn when embed_errors -> - raise @@ Wrapper (x, dropped, lint_errors, exn) + raise @@ Wrapper (x, dropped, lint_errors, exn, errors) in let dropped = if !debug_attribute_drop then ( @@ -533,11 +564,11 @@ let apply_transforms (type t) ~tool_name ~file_path ~field ~lint_field new_dropped) else [] in - (x, dropped, lint_errors)) + (x, dropped, lint_errors, errors @ more_errors)) in - Ok (return acc) - with Wrapper (x, dropped, lint_errors, exn) -> - Error (return (f_exception exn :: x, dropped, lint_errors)) + Ok (finish acc) + with Wrapper (x, dropped, lint_errors, exn, errors) -> + Error (finish (f_exception exn :: x, dropped, lint_errors, errors)) (*$*) @@ -615,6 +646,15 @@ let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name in st in + let with_errors errors st = + List.map errors ~f:(fun error -> + Ast_builder.Default.pstr_extension + ~loc:(Location.Error.get_location error) + (Location.Error.to_extension error) + [] + |> ghost#structure_item) + @ st + in let cookies_and_check st = Cookies.call_post_handlers T; let errors = @@ -636,16 +676,10 @@ let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name ((enforce_invariants !loc_fname)#structure st Non_intersecting_ranges.empty : Non_intersecting_ranges.t)); - let errors = - unused_attributes_errors @ unused_extension_errors @ not_seen_errors - in - errors - |> List.map ~f:Location.Error.to_extension - |> List.map ~f:(fun e -> - Ast_builder.Default.pstr_extension ~loc:Location.none e [])) + unused_attributes_errors @ unused_extension_errors @ not_seen_errors) else [] in - errors @ st + with_errors errors st in let file_path = File_path.get_default_path_str st in match @@ -657,8 +691,10 @@ let map_structure_gen st ~tool_name ~hook ~expect_mismatch_handler ~input_name ~f_exception:(fun exn -> exn_to_str_extension exn) ~embed_errors with - | Error (st, lint_errors) -> Error (lint lint_errors st) - | Ok (st, lint_errors) -> Ok (st |> lint lint_errors |> cookies_and_check) + | Error (st, lint_errors, errors) -> + Error (st |> lint lint_errors |> with_errors errors) + | Ok (st, lint_errors, errors) -> + Ok (st |> lint lint_errors |> cookies_and_check |> with_errors errors) let map_structure st = match @@ -690,6 +726,15 @@ let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name in sg in + let with_errors errors sg = + List.map errors ~f:(fun error -> + Ast_builder.Default.psig_extension + ~loc:(Location.Error.get_location error) + (Location.Error.to_extension error) + [] + |> ghost#signature_item) + @ sg + in let cookies_and_check sg = Cookies.call_post_handlers T; let errors = @@ -711,16 +756,10 @@ let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name ((enforce_invariants !loc_fname)#signature sg Non_intersecting_ranges.empty : Non_intersecting_ranges.t)); - let errors = - unused_attributes_errors @ unused_extension_errors @ not_seen_errors - in - errors - |> List.map ~f:Location.Error.to_extension - |> List.map ~f:(fun e -> - Ast_builder.Default.psig_extension ~loc:Location.none e [])) + unused_attributes_errors @ unused_extension_errors @ not_seen_errors) else [] in - errors @ sg + with_errors errors sg in let file_path = File_path.get_default_path_sig sg in match @@ -732,8 +771,10 @@ let map_signature_gen sg ~tool_name ~hook ~expect_mismatch_handler ~input_name ~f_exception:(fun exn -> exn_to_sig_extension exn) ~embed_errors with - | Error (sg, lint_errors) -> Error (lint lint_errors sg) - | Ok (sg, lint_errors) -> Ok (sg |> lint lint_errors |> cookies_and_check) + | Error (sg, lint_errors, errors) -> + Error (sg |> lint lint_errors |> with_errors errors) + | Ok (sg, lint_errors, errors) -> + Ok (sg |> lint lint_errors |> cookies_and_check |> with_errors errors) let map_signature sg = match diff --git a/duniverse/ppxlib/src/driver.mli b/duniverse/ppxlib/src/driver.mli index b087881ab..929a872df 100644 --- a/duniverse/ppxlib/src/driver.mli +++ b/duniverse/ppxlib/src/driver.mli @@ -174,7 +174,9 @@ val register_code_transformation : [@@deprecated "[since 2015-11] use register_transformation instead"] (** Same as: - {[ register_transformation ~name ~impl ~intf () ]} *) + {[ + register_transformation ~name ~impl ~intf () + ]} *) val register_correction : loc:Location.t -> repl:string -> unit (** Rewriters might call this function to suggest a correction to the code diff --git a/duniverse/ppxlib/src/extension.ml b/duniverse/ppxlib/src/extension.ml index 3180b42ad..67de6cf15 100644 --- a/duniverse/ppxlib/src/extension.ml +++ b/duniverse/ppxlib/src/extension.ml @@ -104,33 +104,6 @@ module Context = struct | Ppx_import, type_decl -> get_ppx_import_extension type_decl | _ -> None - let node_of_extension : - type a. ?loc:Location.t -> ?x:a -> a t -> extension -> a = - fun ?(loc = Location.none) ?x t -> - let open Ast_builder.Default in - match (t, x) with - | Class_expr, _ -> pcl_extension ~loc - | Class_field, _ -> pcf_extension ~loc - | Class_type_field, _ -> pctf_extension ~loc - | Class_type, _ -> pcty_extension ~loc - | Core_type, _ -> ptyp_extension ~loc - | Expression, _ -> pexp_extension ~loc - | Module_expr, _ -> pmod_extension ~loc - | Module_type, _ -> pmty_extension ~loc - | Pattern, _ -> ppat_extension ~loc - | Signature_item, _ -> fun ext -> psig_extension ~loc ext [] - | Structure_item, _ -> fun ext -> pstr_extension ~loc ext [] - | Ppx_import, Some x -> - fun ext -> - { - x with - ptype_manifest = Some (Ast_builder.Default.ptyp_extension ~loc ext); - } - | Ppx_import, None -> - failwith - "Ppxlib internal error: Item not provided to build an extension node \ - from a Ppx_import context." - let merge_attributes_res : type a. a t -> a -> attributes -> (a, Location.Error.t NonEmptyList.t) result = diff --git a/duniverse/ppxlib/src/extension.mli b/duniverse/ppxlib/src/extension.mli index 154314c1c..e31e9f39b 100644 --- a/duniverse/ppxlib/src/extension.mli +++ b/duniverse/ppxlib/src/extension.mli @@ -31,16 +31,6 @@ module Context : sig val structure_item : structure_item t val eq : 'a t -> 'b t -> ('a, 'b) equality val get_extension : 'a t -> 'a -> (extension * attributes) option - - val node_of_extension : ?loc:Location.t -> ?x:'a -> 'a t -> extension -> 'a - (** [node_of_extension ctx ext] turns an extension node into an AST node of - the same type as [ctx]. By default, the location of the node is - {!Location.none}. - - Only for the special case of [Ppx_import], a value of type - {!type_declaration} has to be passed as the named argument [x], the - extension node will be added as the {!ptype_manifest} of [x]. *) - val merge_attributes : 'a t -> 'a -> attributes -> 'a val merge_attributes_res : @@ -104,7 +94,7 @@ val declare_inline_with_path_arg : t module For_context : sig - (** This module is used to implement {!Context_free.V1.map_top_down} *) + (** This module is used to implement {!Context_free.map_top_down} *) type 'a t diff --git a/duniverse/ppxlib/src/name.ml b/duniverse/ppxlib/src/name.ml index 90fa5c82d..e7479ca11 100644 --- a/duniverse/ppxlib/src/name.ml +++ b/duniverse/ppxlib/src/name.ml @@ -218,8 +218,11 @@ module Registrar = struct | None -> ( let other_contexts = Hashtbl.fold - (fun ctx { all } acc -> - if Poly.( <> ) context ctx && String.Map.mem name all then + (fun ctx all_from_context acc -> + if + Poly.( <> ) context ctx + && String.Map.mem name all_from_context.all + then match t.string_of_context ctx with | None -> acc | Some s -> (s ^ "s") :: acc diff --git a/duniverse/ppxlib/src/name.mli b/duniverse/ppxlib/src/name.mli index 4e80b91bd..d582e57a3 100644 --- a/duniverse/ppxlib/src/name.mli +++ b/duniverse/ppxlib/src/name.mli @@ -27,7 +27,9 @@ val split_path : string -> string * string option val dot_suffixes : string -> string list (** [fold_dot_suffixes "foo.@bar.blah" ~init ~f] is - {[ [ "bar.blah"; "foo.bar.blah" ] ]} *) + {[ + [ "bar.blah"; "foo.bar.blah" ] + ]} *) module Registrar : sig type 'context t diff --git a/duniverse/ppxlib/src/ppxlib.ml b/duniverse/ppxlib/src/ppxlib.ml index 24569125e..7350364bd 100644 --- a/duniverse/ppxlib/src/ppxlib.ml +++ b/duniverse/ppxlib/src/ppxlib.ml @@ -1,7 +1,9 @@ (** Standard library for ppx rewriters *) (** Make sure code using Ppxlib doesn't refer to compiler-libs without being - explicit about it *) + explicit about it: + + @closed *) include struct [@@@warning "-3"] @@ -24,12 +26,11 @@ include struct with module Pprintast := Pprintast with module Syntaxerr := Syntaxerr) end -(** @inline *) -module Ast = Ppxlib_ast.Ast -(** Expose some modules from Ppxlib_ast; in particular, overwrite some of the +(** Expose some modules from {!Ppxlib_ast}; in particular, overwrite some of the modules above *) +module Ast = Ppxlib_ast.Ast module Ast_helper = Ppxlib_ast.Ast_helper module Asttypes = Ppxlib_ast.Asttypes module Parse = Ppxlib_ast.Parse @@ -38,7 +39,9 @@ module Pprintast = Ppxlib_ast.Pprintast module Selected_ast = Ppxlib_ast.Selected_ast include Ast -(** Include all the Ast definitions since we need them in every single ppx *) +(** Include all the Ast definitions since we need them in every single ppx + + @closed *) module Ast_builder = Ast_builder module Ast_pattern = Ast_pattern @@ -61,7 +64,9 @@ module Reserved_namespaces = Name.Reserved_namespaces module Spellcheck = Spellcheck module Quoter = Quoter module Ast_io = Utils.Ast_io.Read_bin + include Common +(** @closed *) (**/**) diff --git a/duniverse/ppxlib/test/base/test.ml b/duniverse/ppxlib/test/base/test.ml index 7cf282a5b..77c27e527 100644 --- a/duniverse/ppxlib/test/base/test.ml +++ b/duniverse/ppxlib/test/base/test.ml @@ -106,17 +106,17 @@ let _ = convert_longident "Base.( land )" let _ = convert_longident "A(B)" [%%expect{| -Exception: (Invalid_argument "Ppxlib.Longident.parse: \"A(B)\"") +Exception: Invalid_argument "Ppxlib.Longident.parse: \"A(B)\"". |}] let _ = convert_longident "A.B(C)" [%%expect{| -Exception: (Invalid_argument "Ppxlib.Longident.parse: \"A.B(C)\"") +Exception: Invalid_argument "Ppxlib.Longident.parse: \"A.B(C)\"". |}] let _ = convert_longident ")" [%%expect{| -Exception: (Invalid_argument "Ppxlib.Longident.parse: \")\"") +Exception: Invalid_argument "Ppxlib.Longident.parse: \")\"". |}] let _ = Ppxlib.Code_path.(file_path @@ top_level ~file_path:"dir/main.ml") diff --git a/duniverse/ppxlib/test/code_path/test.ml b/duniverse/ppxlib/test/code_path/test.ml index 8510046db..9c3ec05a7 100644 --- a/duniverse/ppxlib/test/code_path/test.ml +++ b/duniverse/ppxlib/test/code_path/test.ml @@ -97,3 +97,51 @@ 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))" |}] + +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))" +|}] diff --git a/duniverse/ppxlib/test/deriving/inline/example/ppx_deriving_example.ml b/duniverse/ppxlib/test/deriving/inline/example/ppx_deriving_example.ml index 077556b52..75b8d462e 100644 --- a/duniverse/ppxlib/test/deriving/inline/example/ppx_deriving_example.ml +++ b/duniverse/ppxlib/test/deriving/inline/example/ppx_deriving_example.ml @@ -7,7 +7,10 @@ include struct module Foo = struct end - let _ = [%foo] + let _ = + (); + (); + [%foo] end [@@ocaml.doc "@inline"] [@@@deriving.end] diff --git a/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml b/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml index 970179d54..ac632efee 100644 --- a/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml +++ b/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml @@ -1,9 +1,12 @@ open Ppxlib +open Ast_builder.Default (* [[@@deriving foo]] expands to: {[ - let _ = [%foo] + module Foo = struct end + + let _ = (); (); [%foo] ]} and then [[%foo]] expands to ["foo"]. @@ -53,7 +56,13 @@ let add_deriver () = ppat_loc_stack = []; }; pvb_expr = - expr (Pexp_extension ({ loc; txt = "foo" }, PStr [])); + esequence ~loc + [ + eunit ~loc; + eunit ~loc; + expr + (Pexp_extension ({ loc; txt = "foo" }, PStr [])); + ]; pvb_attributes = []; pvb_loc = loc; }; diff --git a/duniverse/ppxlib/test/driver/exception_handling/run.t b/duniverse/ppxlib/test/driver/exception_handling/run.t index f0a5cc6f6..d303b148a 100644 --- a/duniverse/ppxlib/test/driver/exception_handling/run.t +++ b/duniverse/ppxlib/test/driver/exception_handling/run.t @@ -102,10 +102,10 @@ and the whole AST is prepended with an error extension node. $ echo "let _ = [%gen_raise_exc] + [%gen_raise_exc]" > impl.ml $ ./extender.exe impl.ml - Fatal error: exception (Failure "A raised exception") + Fatal error: exception Failure("A raised exception") [2] $ ./extender.exe -embed-errors impl.ml - Fatal error: exception (Failure "A raised exception") + Fatal error: exception Failure("A raised exception") [2] In the case of derivers @@ -113,14 +113,14 @@ and the whole AST is prepended with an error extension node. $ echo "type a = int" > impl.ml $ echo "type b = int [@@deriving deriver_raised_exception]" >> impl.ml $ ./deriver.exe -embed-errors impl.ml - Fatal error: exception (Failure "A raised exception") + Fatal error: exception Failure("A raised exception") [2] In the case of whole file transformations: $ ./whole_file_exception.exe impl.ml - Fatal error: exception (Failure "An exception in a whole file transform") + Fatal error: exception Failure("An exception in a whole file transform") [2] $ ./whole_file_exception.exe -embed-errors impl.ml - Fatal error: exception (Failure "An exception in a whole file transform") + Fatal error: exception Failure("An exception in a whole file transform") [2] diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/dune b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/dune index 11fdce36a..41c402f83 100644 --- a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/dune +++ b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/dune @@ -1,14 +1,8 @@ (executable (name print_greetings) (libraries ppxlib) - (modules print_greetings) (preprocess (pps ppxlib.metaquot))) -(executable - (name print_magic_number) - (libraries astlib) - (modules print_magic_number)) - (cram - (deps print_greetings.exe print_magic_number.exe)) + (deps print_greetings.exe)) diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/test.t/run.t b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/run.t similarity index 82% rename from duniverse/ppxlib/test/driver/run_as_ppx_rewriter/test.t/run.t rename to duniverse/ppxlib/test/driver/run_as_ppx_rewriter/run.t index 80b7a4051..0befcacbc 100644 --- a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/test.t/run.t +++ b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/run.t @@ -9,13 +9,13 @@ The registered rewriters get applied when using `run_as_ppx_rewriter` as entry p > let () = [%print_hi] > let () = [%print_bye] > EOF - $ ocaml -ppx '../print_greetings.exe' file.ml + $ ocaml -ppx './print_greetings.exe' file.ml hi bye The driver's `shared_args` are taken into account, such as `-apply`... - $ ocaml -ppx '../print_greetings.exe -apply print_hi' file.ml + $ ocaml -ppx './print_greetings.exe -apply print_hi' file.ml hi File "./file.ml", line 2, characters 11-20: Error: Uninterpreted extension 'print_bye'. @@ -24,7 +24,7 @@ The driver's `shared_args` are taken into account, such as `-apply`... ... and `-check` $ echo "[@@@attr non_registered_attr]" > attribute_file.ml - $ ocaml -ppx '../print_greetings.exe -check' 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 [2] @@ -33,22 +33,22 @@ The driver's `shared_args` are taken into account, such as `-apply`... If a non-compatible file gets fed, the file name is reported correctly $ touch no_binary_ast.ml - $ ../print_greetings.exe no_binary_ast.ml some_output + $ ./print_greetings.exe no_binary_ast.ml some_output File "no_binary_ast.ml", line 1: Error: Expected a binary AST as input [1] The only possible usage is [extra_args] ... - $ ../print_greetings.exe some_input + $ ./print_greetings.exe some_input Usage: print_greetings.exe [extra_args] [2] ...in particular the order between the flags and the input/output matters. $ touch some_output - $ ../print_greetings.exe some_input some_output -check - ../print_greetings.exe: anonymous arguments not accepted. + $ ./print_greetings.exe some_input some_output -check + ./print_greetings.exe: anonymous arguments not accepted. print_greetings.exe [extra_args] -loc-filename File name to use in locations -reserve-namespace Mark the given namespace as reserved @@ -69,7 +69,7 @@ The only possible usage is [extra_args] ... The only exception is consulting help - $ ../print_greetings.exe -help + $ ./print_greetings.exe -help print_greetings.exe [extra_args] -loc-filename File name to use in locations -reserve-namespace Mark the given namespace as reserved @@ -86,12 +86,3 @@ The only exception is consulting help --cookie Same as -cookie -help Display this list of options --help Display this list of options - -Binary AST's of any by ppxlib supported OCaml version are supported. -The version is preserved. - - $ cat 406_binary_ast | ../print_magic_number.exe - Magic number: Caml1999N022 - - $ ../print_greetings.exe 406_binary_ast /dev/stdout | ../print_magic_number.exe - Magic number: Caml1999N022 diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/dune b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/dune new file mode 100644 index 000000000..9b74d4f75 --- /dev/null +++ b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/dune @@ -0,0 +1,19 @@ +(executable + (name identity_standalone) + (libraries ppxlib) + (modules identity_standalone)) + +(executable + (name print_magic_number) + (libraries astlib) + (modules print_magic_number)) + +(cram + (enabled_if + (or + (= %{system} linux) + (= %{system} linux_elf) + (= %{system} elf) + (= %{system} linux_eabihf) + (= %{system} linux_eabi))) + (deps identity_standalone.exe print_magic_number.exe)) diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/identity_standalone.ml b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/identity_standalone.ml new file mode 100644 index 000000000..491feba09 --- /dev/null +++ b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/identity_standalone.ml @@ -0,0 +1 @@ +let () = Ppxlib.Driver.run_as_ppx_rewriter () diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/print_magic_number.ml b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/print_magic_number.ml similarity index 100% rename from duniverse/ppxlib/test/driver/run_as_ppx_rewriter/print_magic_number.ml rename to duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/print_magic_number.ml diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter/test.t/406_binary_ast b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/406_binary_ast similarity index 100% rename from duniverse/ppxlib/test/driver/run_as_ppx_rewriter/test.t/406_binary_ast rename to duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/406_binary_ast diff --git a/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/run.t b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/run.t new file mode 100644 index 000000000..de79ed62b --- /dev/null +++ b/duniverse/ppxlib/test/driver/run_as_ppx_rewriter_preserve_version/test.t/run.t @@ -0,0 +1,8 @@ +Binary AST's of any by ppxlib supported OCaml version are supported. +The version is preserved. + + $ cat 406_binary_ast | ../print_magic_number.exe + Magic number: Caml1999N022 + + $ ../identity_standalone.exe 406_binary_ast /dev/stdout | ../print_magic_number.exe + Magic number: Caml1999N022 diff --git a/duniverse/ppxlib/test/error_embedding/run.t b/duniverse/ppxlib/test/error_embedding/run.t index 6801060d8..998f19e2f 100644 --- a/duniverse/ppxlib/test/error_embedding/run.t +++ b/duniverse/ppxlib/test/error_embedding/run.t @@ -22,9 +22,11 @@ Anything else will embed an error extension node $ echo "let _ = [%export_string \"string\" \"other\"]" >> parsing_payload_extension.ml $ echo "let _ = [%export_string identifier]" >> parsing_payload_extension.ml $ ./extender.exe parsing_payload_extension.ml + [%%ocaml.error "constant expected"] + [%%ocaml.error "constant expected"] let _ = "string" - let _ = [%ocaml.error "constant expected"] - let _ = [%ocaml.error "constant expected"] + let _ = [%export_string "string" "other"] + let _ = [%export_string identifier] $ echo "type a = int [@@deriving a_string]" > parsing_payload_deriver.ml $ echo "type b = int [@@deriving a_string unexpected_args]" >> parsing_payload_deriver.ml diff --git a/duniverse/ppxlib/test/expansion_context/dune b/duniverse/ppxlib/test/expansion_context/dune index 2696f50cc..6ecf2d6b6 100644 --- a/duniverse/ppxlib/test/expansion_context/dune +++ b/duniverse/ppxlib/test/expansion_context/dune @@ -2,7 +2,7 @@ (name register_print_ctxt) (modules register_print_ctxt) (kind ppx_rewriter) - (libraries ppxlib)) + (libraries stdppx ppxlib)) (executable (name standalone_print_ctxt) diff --git a/duniverse/ppxlib/test/expansion_context/register_print_ctxt.ml b/duniverse/ppxlib/test/expansion_context/register_print_ctxt.ml index 2518024dc..bd6201c66 100644 --- a/duniverse/ppxlib/test/expansion_context/register_print_ctxt.ml +++ b/duniverse/ppxlib/test/expansion_context/register_print_ctxt.ml @@ -1,3 +1,4 @@ +open Stdppx open Ppxlib let pprint_ctxt ctxt = @@ -11,7 +12,7 @@ let pprint_ctxt ctxt = let side_print_ctxt = object - inherit Ast_traverse.map_with_expansion_context as super + inherit Ast_traverse.map_with_expansion_context_and_errors as super method! structure ctxt st = pprint_ctxt ctxt; @@ -24,5 +25,21 @@ let side_print_ctxt = let () = Driver.V2.( - register_transformation ~impl:side_print_ctxt#structure - ~intf:side_print_ctxt#signature "print_ctxt") + register_transformation + ~impl:(fun ctxt structure -> + let structure, errors = side_print_ctxt#structure ctxt structure in + List.map errors ~f:(fun error -> + Ast_builder.Default.pstr_extension + ~loc:(Location.Error.get_location error) + (Location.Error.to_extension error) + []) + @ structure) + ~intf:(fun ctxt signature -> + let signature, errors = side_print_ctxt#signature ctxt signature in + List.map errors ~f:(fun error -> + Ast_builder.Default.psig_extension + ~loc:(Location.Error.get_location error) + (Location.Error.to_extension error) + []) + @ signature) + "print_ctxt") diff --git a/duniverse/ppxlib/test/expansion_context/run.t b/duniverse/ppxlib/test/expansion_context/run.t index fe0da0b4c..f73852e50 100644 --- a/duniverse/ppxlib/test/expansion_context/run.t +++ b/duniverse/ppxlib/test/expansion_context/run.t @@ -1,7 +1,7 @@ The three context fields can be accessed in a rewriter, both from within an implementation file $ echo "let x = 0" > file.ml - $ ./standalone_print_ctxt.exe file.ml | egrep 'tool_name|input_name|file_path' + $ ./standalone_print_ctxt.exe file.ml | grep -E 'tool_name|input_name|file_path' tool_name: ppx_driver input_name: file.ml file_path: file.ml @@ -9,7 +9,7 @@ The three context fields can be accessed in a rewriter, both from within an impl and from within an interface file $ echo "val x : int" > file.mli - $ ./standalone_print_ctxt.exe file.mli | egrep 'tool_name|input_name|file_path' + $ ./standalone_print_ctxt.exe file.mli | grep -E 'tool_name|input_name|file_path' tool_name: ppx_driver input_name: file.mli file_path: file.mli @@ -18,7 +18,7 @@ In most cases, the input name and the file path coincide. But there are some exc 1. empty files $ touch empty_file.ml - $ ./standalone_print_ctxt.exe empty_file.ml | egrep 'input_name|file_path' + $ ./standalone_print_ctxt.exe empty_file.ml | grep -E 'input_name|file_path' input_name: empty_file.ml file_path: @@ -28,12 +28,12 @@ In most cases, the input name and the file path coincide. But there are some exc > # 1 "file.ml" > let y = 0 > EOF - $ ./standalone_print_ctxt.exe directive.ml | egrep 'input_name|file_path' + $ ./standalone_print_ctxt.exe directive.ml | grep -E 'input_name|file_path' input_name: directive.ml file_path: file.ml 3. using `map_structure` (or `map_signature`) - $ echo "let x = 0" | ./map_structure_print_ctxt.exe | egrep 'input_name|file_path' + $ echo "let x = 0" | ./map_structure_print_ctxt.exe | grep -E 'input_name|file_path' input_name: _none_ file_path: lexbuf_pos_fname diff --git a/duniverse/ppxlib/test/ppx_import_support/test.ml b/duniverse/ppxlib/test/ppx_import_support/test.ml index e32d39b01..66fd12bf1 100644 --- a/duniverse/ppxlib/test/ppx_import_support/test.ml +++ b/duniverse/ppxlib/test/ppx_import_support/test.ml @@ -108,6 +108,6 @@ let id_for_core_types = (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'") +Failure + "Some ppx-es tried to register conflicting transformations: Extension 'id' on type declarations matches extension 'id'". |}] diff --git a/duniverse/ppxlib/test/traverse/test.ml b/duniverse/ppxlib/test/traverse/test.ml index 5efd9a418..4cc0df157 100644 --- a/duniverse/ppxlib/test/traverse/test.ml +++ b/duniverse/ppxlib/test/traverse/test.ml @@ -46,6 +46,14 @@ class virtual ['res] lift : 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 = diff --git a/duniverse/ppxlib/traverse/ppxlib_traverse.ml b/duniverse/ppxlib/traverse/ppxlib_traverse.ml index 6d92bc4cd..39c770f24 100644 --- a/duniverse/ppxlib/traverse/ppxlib_traverse.ml +++ b/duniverse/ppxlib/traverse/ppxlib_traverse.ml @@ -16,6 +16,23 @@ let tvar_of_var { txt; loc } = ptyp_var ~loc txt let evars_of_vars = List.map ~f:evar_of_var let pvars_of_vars = List.map ~f:pvar_of_var let tvars_of_vars = List.map ~f:tvar_of_var +let fst_expr ~loc expr = [%expr Stdlib.fst [%e expr]] +let snd_expr ~loc expr = [%expr Stdlib.snd [%e expr]] + +let methods_of_class_exn = function + | { + pstr_desc = + Pstr_class + [ + { + pci_expr = { pcl_desc = Pcl_structure { pcstr_fields = l; _ }; _ }; + _; + }; + ]; + _; + } -> + l + | _ -> assert false module Backends = struct class reconstructors = @@ -37,6 +54,8 @@ module Backends = struct method class_params : loc:Location.t -> (core_type * (variance * injectivity)) list + method virtual_methods : loc:Location.t -> class_field list + method apply : loc:Location.t -> expression -> expression list -> expression @@ -58,6 +77,7 @@ module Backends = struct method name = "map" inherit reconstructors method class_params ~loc:_ = [] + method virtual_methods ~loc:_ = [] method apply ~loc expr args = eapply ~loc expr args method abstract ~loc patt expr = pexp_fun ~loc Nolabel None patt expr method typ ~loc ty = ptyp_arrow ~loc Nolabel ty ty @@ -75,6 +95,7 @@ module Backends = struct method name = "iter" inherit reconstructors method class_params ~loc:_ = [] + method virtual_methods ~loc:_ = [] method apply ~loc expr args = eapply ~loc expr args method abstract ~loc patt expr = pexp_fun ~loc Nolabel None patt expr method typ ~loc ty = [%type: [%t ty] -> unit] @@ -96,6 +117,7 @@ module Backends = struct method class_params ~loc = [ (ptyp_var ~loc "acc", (NoVariance, NoInjectivity)) ] + method virtual_methods ~loc:_ = [] method apply ~loc expr args = eapply ~loc expr (args @ [ evar ~loc "acc" ]) method abstract ~loc patt expr = @@ -123,6 +145,7 @@ module Backends = struct method class_params ~loc = [ (ptyp_var ~loc "acc", (NoVariance, NoInjectivity)) ] + method virtual_methods ~loc:_ = [] method apply ~loc expr args = eapply ~loc expr (args @ [ evar ~loc "acc" ]) method abstract ~loc patt expr = @@ -169,6 +192,7 @@ module Backends = struct method class_params ~loc = [ (ptyp_var ~loc "ctx", (NoVariance, NoInjectivity)) ] + method virtual_methods ~loc:_ = [] method apply ~loc expr args = eapply ~loc expr (evar ~loc "ctx" :: args) method abstract ~loc patt expr = @@ -194,6 +218,17 @@ module Backends = struct method class_params ~loc = [ (ptyp_var ~loc "res", (NoVariance, NoInjectivity)) ] + method virtual_methods ~loc = + methods_of_class_exn + [%stri + class virtual blah = + object + method virtual record : (string * 'res) list -> 'res + method virtual constr : string -> 'res list -> 'res + method virtual tuple : 'res list -> 'res + method virtual other : 'a. 'a -> 'res + end] + method apply ~loc expr args = eapply ~loc expr args method abstract ~loc patt expr = pexp_fun ~loc Nolabel None patt expr method typ ~loc ty = [%type: [%t ty] -> 'res] @@ -223,8 +258,96 @@ module Backends = struct method tuple ~loc es = [%expr self#tuple [%e elist ~loc es]] end + let lift_mapper_with_context : what = + let uses_ctx = uses_var "ctx" in + object + method name = "lift_map_with_context" + + method class_params ~loc = + [ + (ptyp_var ~loc "ctx", (NoVariance, NoInjectivity)); + (ptyp_var ~loc "res", (NoVariance, NoInjectivity)); + ] + + method virtual_methods ~loc = + methods_of_class_exn + [%stri + class virtual blah = + object + method virtual record : 'ctx -> (string * 'res) list -> 'res + method virtual constr : 'ctx -> string -> 'res list -> 'res + method virtual tuple : 'ctx -> 'res list -> 'res + method virtual other : 'a. 'ctx -> 'a -> 'res + end] + + method apply ~loc expr args = eapply ~loc expr (evar ~loc "ctx" :: args) + + method abstract ~loc patt expr = + let ctx_pat = + if uses_ctx expr then pvar ~loc "ctx" else pvar ~loc "_ctx" + in + eabstract ~loc [ ctx_pat; patt ] expr + + method typ ~loc ty = [%type: 'ctx -> [%t ty] -> [%t ty] * 'res] + method any ~loc = [%expr fun ctx x -> (x, self#other ctx x)] + + method combine ~loc combinators ~reconstruct = + List.fold_right combinators ~init:reconstruct ~f:(fun (v, expr) acc -> + pexp_let ~loc Nonrecursive + [ value_binding ~loc ~pat:(pvar_of_var v) ~expr ] + acc) + + method record ~loc flds = + let record = + pexp_record ~loc + (List.map flds ~f:(fun (lab, e) -> (lab, fst_expr ~loc e))) + None + in + let flds = + elist ~loc + (List.map flds ~f:(fun (lab, e) -> + pexp_tuple + ~loc:{ lab.loc with loc_end = e.pexp_loc.loc_end } + [ + estring ~loc:lab.loc (string_of_lid lab.txt); + snd_expr ~loc e; + ])) + in + [%expr [%e record], self#record ctx [%e flds]] + + method construct ~loc id args = + let constr = + pexp_construct ~loc id + (pexp_tuple_opt ~loc (List.map args ~f:(fst_expr ~loc))) + in + let res = + let args = elist ~loc (List.map args ~f:(snd_expr ~loc)) in + [%expr + self#constr ctx + [%e estring ~loc:id.loc (string_of_lid id.txt)] + [%e args]] + in + [%expr [%e constr], [%e res]] + + method tuple ~loc es = + let tuple = pexp_tuple ~loc (List.map es ~f:(fst_expr ~loc)) in + let res = + [%expr + self#tuple ctx [%e elist ~loc (List.map es ~f:(snd_expr ~loc))]] + in + [%expr [%e tuple], [%e res]] + end + let all = - [ mapper; iterator; folder; fold_mapper; mapper_with_context; lifter ] + [ + mapper; + iterator; + folder; + fold_mapper; + mapper_with_context; + lifter; + lift_mapper_with_context; + ] end type what = Backends.what @@ -429,7 +552,7 @@ let type_deps = in Longident.Map.bindings map -let lift_virtual_methods ~loc methods = +let filter_virtual_methods ~methods ~virtual_methods = let collect = object inherit [String.Set.t] Ast_traverse.fold as super @@ -445,32 +568,7 @@ let lift_virtual_methods ~loc methods = end in let used = collect#list collect#class_field methods String.Set.empty in - let all_virtual_methods = - match - [%stri - class virtual blah = - object - method virtual record : (string * 'res) list -> 'res - method virtual constr : string -> 'res list -> 'res - method virtual tuple : 'res list -> 'res - method virtual other : 'a. 'a -> 'res - end] - with - | { - pstr_desc = - Pstr_class - [ - { - pci_expr = { pcl_desc = Pcl_structure { pcstr_fields = l; _ }; _ }; - _; - }; - ]; - _; - } -> - l - | _ -> assert false - in - List.filter all_virtual_methods ~f:(fun m -> + List.filter virtual_methods ~f:(fun m -> match m.pcf_desc with | Pcf_method (s, _, _) -> String.Set.mem s.txt used | _ -> false) @@ -500,9 +598,8 @@ let gen_class ~(what : what) ~loc tds = pcf_method ~loc (td.ptype_name, Public, Cfk_concrete (Fresh, mapper))) in let virtual_methods = - if String.equal what#name "lift" then - lift_virtual_methods ~loc methods @ virtual_methods - else virtual_methods + filter_virtual_methods ~methods ~virtual_methods:(what#virtual_methods ~loc) + @ virtual_methods in let virt = if List.is_empty virtual_methods then Concrete else Virtual in class_infos ~loc ~virt ~params:class_params ~name:{ loc; txt = what#name } diff --git a/duniverse/ppxlib/traverse_builtins/ppxlib_traverse_builtins.ml b/duniverse/ppxlib/traverse_builtins/ppxlib_traverse_builtins.ml index 79cd2c618..5ebb63fbf 100644 --- a/duniverse/ppxlib/traverse_builtins/ppxlib_traverse_builtins.ml +++ b/duniverse/ppxlib/traverse_builtins/ppxlib_traverse_builtins.ml @@ -5,6 +5,7 @@ module T = struct type ('a, 'acc) fold_map = 'a -> 'acc -> 'a * 'acc type ('ctx, 'a) map_with_context = 'ctx -> 'a -> 'a type ('a, 'res) lift = 'a -> 'res + type ('ctx, 'a, 'res) lift_map_with_context = 'ctx -> 'a -> 'a * 'res end class map = @@ -161,6 +162,52 @@ class virtual ['res] lift = | x :: l -> self#constr "::" [ f x; self#list f l ] end +class virtual ['ctx, 'res] lift_map_with_context = + object (self) + method virtual other : 'a. 'ctx -> 'a -> 'res + method virtual int : ('ctx, int, 'res) T.lift_map_with_context + method virtual string : ('ctx, string, 'res) T.lift_map_with_context + method virtual bool : ('ctx, bool, 'res) T.lift_map_with_context + method virtual char : ('ctx, char, 'res) T.lift_map_with_context + + method virtual array + : 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a array, 'res) T.lift_map_with_context + + method virtual float : ('ctx, float, 'res) T.lift_map_with_context + method virtual int32 : ('ctx, int32, 'res) T.lift_map_with_context + method virtual int64 : ('ctx, int64, 'res) T.lift_map_with_context + method virtual nativeint : ('ctx, nativeint, 'res) T.lift_map_with_context + method virtual unit : ('ctx, unit, 'res) T.lift_map_with_context + method virtual record : 'ctx -> (string * 'res) list -> 'res + method virtual constr : 'ctx -> string -> 'res list -> 'res + method virtual tuple : 'ctx -> 'res list -> 'res + + method option + : 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a option, 'res) T.lift_map_with_context = + fun f ctx x -> + match x with + | None -> (None, self#constr ctx "None" []) + | Some x -> + let x, res = f ctx x in + (Some x, self#constr ctx "Some" [ res ]) + + method list + : 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a list, 'res) T.lift_map_with_context = + fun f ctx l -> + match l with + | [] -> ([], self#constr ctx "[]" []) + | x :: l -> + let x, res_head = f ctx x in + let l, res_tail = self#list f ctx l in + (x :: l, self#constr ctx "::" [ res_head; res_tail ]) + end + class type ['res] std_lifters = object method other : 'a. ('a, 'res) T.lift @@ -180,3 +227,36 @@ class type ['res] std_lifters = method option : 'a. ('a, 'res) T.lift -> ('a option, 'res) T.lift method list : 'a. ('a, 'res) T.lift -> ('a list, 'res) T.lift end + +class type ['ctx, 'res] std_lift_mappers_with_context = + object + method other : 'a. 'ctx -> 'a -> 'res + method int : ('ctx, int, 'res) T.lift_map_with_context + method string : ('ctx, string, 'res) T.lift_map_with_context + method bool : ('ctx, bool, 'res) T.lift_map_with_context + method char : ('ctx, char, 'res) T.lift_map_with_context + + method array : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a array, 'res) T.lift_map_with_context + + method record : 'ctx -> (string * 'res) list -> 'res + method constr : 'ctx -> string -> 'res list -> 'res + method tuple : 'ctx -> 'res list -> 'res + method float : ('ctx, float, 'res) T.lift_map_with_context + method int32 : ('ctx, int32, 'res) T.lift_map_with_context + method int64 : ('ctx, int64, 'res) T.lift_map_with_context + method nativeint : ('ctx, nativeint, 'res) T.lift_map_with_context + method unit : ('ctx, unit, 'res) T.lift_map_with_context + + method option : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a option, 'res) T.lift_map_with_context + + method list : + 'a. + ('ctx, 'a, 'res) T.lift_map_with_context -> + ('ctx, 'a list, 'res) T.lift_map_with_context + end diff --git a/duniverse/sexp_pretty/sexp_pretty.opam b/duniverse/sexp_pretty/sexp_pretty.opam index fe6b29172..ab1e65534 100644 --- a/duniverse/sexp_pretty/sexp_pretty.opam +++ b/duniverse/sexp_pretty/sexp_pretty.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "v0.15.0" +version: "v0.15.1" maintainer: "Jane Street developers" authors: ["Jane Street Group, LLC"] homepage: "https://github.com/janestreet/sexp_pretty" diff --git a/duniverse/sexp_pretty/src/sexp_pretty.ml b/duniverse/sexp_pretty/src/sexp_pretty.ml index fa052671f..b6dc83aa5 100644 --- a/duniverse/sexp_pretty/src/sexp_pretty.ml +++ b/duniverse/sexp_pretty/src/sexp_pretty.ml @@ -75,15 +75,16 @@ let rainbow_open_tag conf tag = ;; let rainbow_tags conf = - { Format.mark_open_tag = - rainbow_open_tag conf - ; Format.mark_close_tag = + { Format.mark_open_stag = (function + | Format.String_tag tag -> rainbow_open_tag conf tag + | _ -> "") + ; Format.mark_close_stag = (fun _ -> match conf.comments with | Print (_, Some _clr, _) -> "" | _ -> "") - ; Format.print_open_tag = ignore - ; Format.print_close_tag = ignore + ; Format.print_open_stag = ignore + ; Format.print_close_stag = ignore } ;; @@ -1076,7 +1077,7 @@ module Print = struct end let setup conf fmt = - Format.pp_set_formatter_tag_functions fmt (rainbow_tags conf) [@ocaml.warning "-3"]; + Format.pp_set_formatter_stag_functions fmt (rainbow_tags conf); Format.pp_set_tags fmt true ;; diff --git a/rwo.opam b/rwo.opam index f25bc7165..dc3161874 100644 --- a/rwo.opam +++ b/rwo.opam @@ -10,13 +10,14 @@ license: "ISC" homepage: "https://github.com/realworldocaml/book" bug-reports: "https://github.com/realworldocaml/book/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.6"} "ocaml" {>= "4.14.0" & < "4.15.0"} "alcotest" "async" "async_graphics" "atdgen" "base" + "base-bytes" {= "base"} "cmdliner" {>= "1.1.0"} "cohttp-async" "conf-ncurses" @@ -51,12 +52,10 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] dev-repo: "git+https://github.com/realworldocaml/book.git" pin-depends: [ diff --git a/rwo.opam.locked b/rwo.opam.locked index be3b5dccb..e1bae7ba4 100644 --- a/rwo.opam.locked +++ b/rwo.opam.locked @@ -14,7 +14,7 @@ depends: [ "atd" {= "2.10.0" & ?vendor} "atdgen" {= "2.10.0" & ?vendor} "atdgen-runtime" {= "2.10.0" & ?vendor} - "base" {= "v0.15.0" & ?vendor} + "base" {= "v0.15.1" & ?vendor} "base-bigarray" {= "base"} "base-bytes" {= "base"} "base-threads" {= "base"} @@ -31,8 +31,8 @@ depends: [ "cmdliner" {= "1.1.1+dune" & ?vendor} "cohttp" {= "5.0.0" & ?vendor} "cohttp-async" {= "5.0.0" & ?vendor} - "conduit" {= "5.1.1" & ?vendor} - "conduit-async" {= "5.1.1" & ?vendor} + "conduit" {= "6.1.0" & ?vendor} + "conduit-async" {= "6.1.0" & ?vendor} "conf-gmp" {= "4"} "conf-gmp-powm-sec" {= "3"} "conf-libpcre" {= "1"} @@ -42,10 +42,10 @@ depends: [ "conf-pkg-config" {= "2"} "conf-texlive" {= "1"} "conf-tzdata" {= "1"} - "core" {= "v0.15.0" & ?vendor} + "core" {= "v0.15.1" & ?vendor} "core_bench" {= "v0.15.0" & ?vendor} "core_kernel" {= "v0.15.0" & ?vendor} - "core_unix" {= "v0.15.0" & ?vendor} + "core_unix" {= "v0.15.2" & ?vendor} "cppo" {= "1.6.9" & ?vendor} "csexp" {= "1.5.1" & ?vendor} "cstruct" {= "6.1.1" & ?vendor} @@ -53,10 +53,10 @@ depends: [ "ctypes" {= "0.20.1+dune" & ?vendor} "ctypes-foreign" {= "0.20.1+dune" & ?vendor} "domain-name" {= "0.4.0" & ?vendor} - "dune" {= "3.4.1"} - "dune-build-info" {= "3.4.1" & ?vendor} - "dune-configurator" {= "3.4.1" & ?vendor} - "duration" {= "0.2.0" & ?vendor} + "dune" {= "3.6.1"} + "dune-build-info" {= "3.6.1" & ?vendor} + "dune-configurator" {= "3.6.1" & ?vendor} + "duration" {= "0.2.1" & ?vendor} "easy-format" {= "1.3.4" & ?vendor} "eqaf" {= "0.9" & ?vendor} "expect_test_helpers_core" {= "v0.15.0" & ?vendor} @@ -78,22 +78,22 @@ depends: [ "logs" {= "0.7.0+dune2" & ?vendor} "lwt" {= "5.6.1" & ?vendor} "macaddr" {= "5.3.1" & ?vendor} - "magic-mime" {= "1.2.0" & ?vendor} + "magic-mime" {= "1.3.0" & ?vendor} "markup" {= "1.0.3" & ?vendor} "mdx" {= "2.1.0" & ?vendor} "menhir" {= "20220210" & ?vendor} "menhirLib" {= "20220210" & ?vendor} "menhirSdk" {= "20220210" & ?vendor} - "mirage-crypto" {= "0.10.6" & ?vendor} - "mirage-crypto-ec" {= "0.10.6" & ?vendor} - "mirage-crypto-pk" {= "0.10.6" & ?vendor} - "mirage-crypto-rng" {= "0.10.6" & ?vendor} + "mirage-crypto" {= "0.10.7" & ?vendor} + "mirage-crypto-ec" {= "0.10.7" & ?vendor} + "mirage-crypto-pk" {= "0.10.7" & ?vendor} + "mirage-crypto-rng" {= "0.10.7" & ?vendor} "mirage-no-solo5" {= "1"} "mirage-no-xen" {= "1"} - "mtime" {= "1.4.0+dune2" & ?vendor} + "mtime" {= "2.0.0+dune" & ?vendor} "num" {= "1.4+dune2" & ?vendor} - "ocaml" {= "4.14.0"} - "ocaml-base-compiler" {= "4.14.0"} + "ocaml" {= "4.14.1"} + "ocaml-base-compiler" {= "4.14.1"} "ocaml-compiler-libs" {= "v0.12.4" & ?vendor} "ocaml-config" {= "2"} "ocaml-options-vanilla" {= "1"} @@ -120,7 +120,7 @@ depends: [ "ppx_derivers" {= "1.2.1" & ?vendor} "ppx_disable_unused_warnings" {= "v0.15.0" & ?vendor} "ppx_enumerate" {= "v0.15.0" & ?vendor} - "ppx_expect" {= "v0.15.0" & ?vendor} + "ppx_expect" {= "v0.15.1" & ?vendor} "ppx_fields_conv" {= "v0.15.0" & ?vendor} "ppx_fixed_literal" {= "v0.15.0" & ?vendor} "ppx_hash" {= "v0.15.0" & ?vendor} @@ -141,14 +141,14 @@ depends: [ "ppx_string" {= "v0.15.0" & ?vendor} "ppx_typerep_conv" {= "v0.15.0" & ?vendor} "ppx_variants_conv" {= "v0.15.0" & ?vendor} - "ppxlib" {= "0.27.0" & ?vendor} + "ppxlib" {= "0.28.0" & ?vendor} "protocol_version_header" {= "v0.15.0" & ?vendor} "ptime" {= "1.0.0+dune2" & ?vendor} "re" {= "1.10.4" & ?vendor} "result" {= "1.5" & ?vendor} "rresult" {= "0.7.0+dune" & ?vendor} "seq" {= "base+dune" & ?vendor} - "sexp_pretty" {= "v0.15.0" & ?vendor} + "sexp_pretty" {= "v0.15.1" & ?vendor} "sexplib" {= "v0.15.1" & ?vendor} "sexplib0" {= "v0.15.1" & ?vendor} "spawn" {= "v0.15.1" & ?vendor} @@ -161,14 +161,14 @@ depends: [ "textwrap" {= "0.2.1" & ?vendor} "time_now" {= "v0.15.0" & ?vendor} "timezone" {= "v0.15.0" & ?vendor} - "tls" {= "0.15.3" & ?vendor} + "tls" {= "0.15.4" & ?vendor} "typerep" {= "v0.15.0" & ?vendor} "uchar" {= "0.0.2+dune2" & ?vendor} "uri" {= "4.2.0" & ?vendor} "uri-sexp" {= "4.2.0" & ?vendor} "uutf" {= "1.0.3+dune" & ?vendor} "variantslib" {= "v0.15.0" & ?vendor} - "x509" {= "0.16.0" & ?vendor} + "x509" {= "0.16.2" & ?vendor} "yojson" {= "2.0.2" & ?vendor} "zarith" {= "1.12+dune" & ?vendor} ] @@ -320,8 +320,8 @@ pin-depends: [ "https://github.com/ahrefs/atd/releases/download/2.10.0/atdts-2.10.0.tbz" ] [ - "base.v0.15.0" - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/base-v0.15.0.tar.gz" + "base.v0.15.1" + "https://github.com/janestreet/base/archive/refs/tags/v0.15.1.tar.gz" ] [ "base64.3.5.0" @@ -372,16 +372,16 @@ pin-depends: [ "https://github.com/mirage/ocaml-cohttp/releases/download/v5.0.0/cohttp-5.0.0.tbz" ] [ - "conduit.5.1.1" - "https://github.com/mirage/ocaml-conduit/releases/download/v5.1.1/conduit-5.1.1.tbz" + "conduit.6.1.0" + "https://github.com/mirage/ocaml-conduit/releases/download/v6.1.0/conduit-6.1.0.tbz" ] [ - "conduit-async.5.1.1" - "https://github.com/mirage/ocaml-conduit/releases/download/v5.1.1/conduit-5.1.1.tbz" + "conduit-async.6.1.0" + "https://github.com/mirage/ocaml-conduit/releases/download/v6.1.0/conduit-6.1.0.tbz" ] [ - "core.v0.15.0" - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core-v0.15.0.tar.gz" + "core.v0.15.1" + "https://github.com/janestreet/core/archive/refs/tags/v0.15.1.tar.gz" ] [ "core_bench.v0.15.0" @@ -392,8 +392,8 @@ pin-depends: [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core_kernel-v0.15.0.tar.gz" ] [ - "core_unix.v0.15.0" - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core_unix-v0.15.0.tar.gz" + "core_unix.v0.15.2" + "https://github.com/janestreet/core_unix/archive/refs/tags/v0.15.2.tar.gz" ] [ "cppo.1.6.9" @@ -413,27 +413,27 @@ pin-depends: [ ] [ "ctypes.0.20.1+dune" - "https://github.com/dune-universe/ocaml-ctypes/releases/download/0.20.1%2Bdune/ctypes-foreign-0.20.1.dune.tbz" + "git+https://github.com/avsm/ocaml-ctypes.git#64b6494d0f5d079eb279b3dcabdddb10fb3f024b" ] [ "ctypes-foreign.0.20.1+dune" - "https://github.com/dune-universe/ocaml-ctypes/releases/download/0.20.1%2Bdune/ctypes-foreign-0.20.1.dune.tbz" + "git+https://github.com/avsm/ocaml-ctypes.git#64b6494d0f5d079eb279b3dcabdddb10fb3f024b" ] [ "domain-name.0.4.0" "https://github.com/hannesm/domain-name/releases/download/v0.4.0/domain-name-0.4.0.tbz" ] [ - "dune-build-info.3.4.1" - "https://github.com/ocaml/dune/releases/download/3.4.1/dune-3.4.1.tbz" + "dune-build-info.3.6.1" + "https://github.com/ocaml/dune/releases/download/3.6.1/dune-3.6.1.tbz" ] [ - "dune-configurator.3.4.1" - "https://github.com/ocaml/dune/releases/download/3.4.1/dune-3.4.1.tbz" + "dune-configurator.3.6.1" + "https://github.com/ocaml/dune/releases/download/3.6.1/dune-3.6.1.tbz" ] [ - "duration.0.2.0" - "https://github.com/hannesm/duration/releases/download/0.2.0/duration-0.2.0.tbz" + "duration.0.2.1" + "https://github.com/hannesm/duration/releases/download/v0.2.1/duration-0.2.1.tbz" ] [ "easy-format.1.3.4" @@ -481,7 +481,7 @@ pin-depends: [ ] [ "integers.0.7.0" - "https://github.com/ocamllabs/ocaml-integers/archive/0.7.0.tar.gz" + "https://github.com/yallop/ocaml-integers/archive/0.7.0.tar.gz" ] [ "ipaddr.5.3.1" @@ -517,8 +517,8 @@ pin-depends: [ "https://github.com/mirage/ocaml-ipaddr/releases/download/v5.3.1/ipaddr-5.3.1.tbz" ] [ - "magic-mime.1.2.0" - "https://github.com/mirage/ocaml-magic-mime/releases/download/v1.2.0/magic-mime-v1.2.0.tbz" + "magic-mime.1.3.0" + "https://github.com/mirage/ocaml-magic-mime/releases/download/v1.3.0/magic-mime-1.3.0.tbz" ] [ "markup.1.0.3" "https://github.com/aantron/markup.ml/archive/1.0.3.tar.gz" @@ -540,24 +540,24 @@ pin-depends: [ "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" ] [ - "mirage-crypto.0.10.6" - "https://github.com/mirage/mirage-crypto/releases/download/v0.10.6/mirage-crypto-0.10.6.tbz" + "mirage-crypto.0.10.7" + "https://github.com/mirage/mirage-crypto/releases/download/v0.10.7/mirage-crypto-0.10.7.tbz" ] [ - "mirage-crypto-ec.0.10.6" - "https://github.com/mirage/mirage-crypto/releases/download/v0.10.6/mirage-crypto-0.10.6.tbz" + "mirage-crypto-ec.0.10.7" + "https://github.com/mirage/mirage-crypto/releases/download/v0.10.7/mirage-crypto-0.10.7.tbz" ] [ - "mirage-crypto-pk.0.10.6" - "https://github.com/mirage/mirage-crypto/releases/download/v0.10.6/mirage-crypto-0.10.6.tbz" + "mirage-crypto-pk.0.10.7" + "https://github.com/mirage/mirage-crypto/releases/download/v0.10.7/mirage-crypto-0.10.7.tbz" ] [ - "mirage-crypto-rng.0.10.6" - "https://github.com/mirage/mirage-crypto/releases/download/v0.10.6/mirage-crypto-0.10.6.tbz" + "mirage-crypto-rng.0.10.7" + "https://github.com/mirage/mirage-crypto/releases/download/v0.10.7/mirage-crypto-0.10.7.tbz" ] [ - "mtime.1.4.0+dune2" - "https://github.com/dune-universe/mtime/releases/download/v1.4.0%2Bdune2/mtime-v1.4.0.dune2.tbz" + "mtime.2.0.0+dune" + "https://github.com/dune-universe/mtime/releases/download/2.0.0%2Bdune/mtime-2.0.0.dune.tbz" ] [ "num.1.4+dune2" @@ -660,8 +660,8 @@ pin-depends: [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_enumerate-v0.15.0.tar.gz" ] [ - "ppx_expect.v0.15.0" - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_expect-v0.15.0.tar.gz" + "ppx_expect.v0.15.1" + "https://github.com/janestreet/ppx_expect/archive/refs/tags/v0.15.1.tar.gz" ] [ "ppx_fields_conv.v0.15.0" @@ -744,8 +744,8 @@ pin-depends: [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_variants_conv-v0.15.0.tar.gz" ] [ - "ppxlib.0.27.0" - "https://github.com/ocaml-ppx/ppxlib/releases/download/0.27.0/ppxlib-0.27.0.tbz" + "ppxlib.0.28.0" + "https://github.com/ocaml-ppx/ppxlib/releases/download/0.28.0/ppxlib-0.28.0.tbz" ] [ "protocol_version_header.v0.15.0" @@ -769,8 +769,8 @@ pin-depends: [ ] ["seq.base+dune" "https://github.com/c-cube/seq/archive/0.2.2.tar.gz"] [ - "sexp_pretty.v0.15.0" - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/sexp_pretty-v0.15.0.tar.gz" + "sexp_pretty.v0.15.1" + "https://github.com/janestreet/sexp_pretty/archive/refs/tags/v0.15.1.tar.gz" ] [ "sexplib.v0.15.1" @@ -821,8 +821,8 @@ pin-depends: [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/timezone-v0.15.0.tar.gz" ] [ - "tls.0.15.3" - "https://github.com/mirleft/ocaml-tls/releases/download/v0.15.3/tls-0.15.3.tbz" + "tls.0.15.4" + "https://github.com/mirleft/ocaml-tls/releases/download/v0.15.4/tls-0.15.4.tbz" ] [ "typerep.v0.15.0" @@ -849,8 +849,8 @@ pin-depends: [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/variantslib-v0.15.0.tar.gz" ] [ - "x509.0.16.0" - "https://github.com/mirleft/ocaml-x509/releases/download/v0.16.0/x509-0.16.0.tbz" + "x509.0.16.2" + "https://github.com/mirleft/ocaml-x509/releases/download/v0.16.2/x509-0.16.2.tbz" ] [ "yojson.2.0.2" @@ -907,6 +907,10 @@ x-opam-monorepo-duniverse-dirs: [ "git+https://github.com/avsm/async_graphics.git#a5a0ade9a31423d979fe395e089737277465e2de" "async_graphics" ] + [ + "git+https://github.com/avsm/ocaml-ctypes.git#64b6494d0f5d079eb279b3dcabdddb10fb3f024b" + "ocaml-ctypes" + ] [ "https://github.com/avsm/ocaml-print-intf/releases/download/v1.2.0/ocaml-print-intf-v1.2.0.tbz" "ocaml-print-intf" @@ -984,11 +988,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/dune-universe/mtime/releases/download/v1.4.0%2Bdune2/mtime-v1.4.0.dune2.tbz" + "https://github.com/dune-universe/mtime/releases/download/2.0.0%2Bdune/mtime-2.0.0.dune.tbz" "mtime" [ - "sha256=8da1cbd3a3b24e0d26571f1bf3874a1523195518bec5f53ffa82ad4d4aa53301" - "sha512=a5166aec2ae9631e42db18731f17dece339b1b5f15fb693fcfe94c6a96fccc47182bfc75bf0bffa46ae94cd316271be64ec811da2caad36122deb140ea73b959" + "sha256=7dd6d0ba21acd07c2c76d6519a58c09e420af0fba57cfd8dd8ce08535db03a54" + "sha512=75942aaad6e25d97b11e0038effc3bed980d336435bffbaecb67368e83299b17d77db92a79d9a010f5961fc8ede7ae346fa91182e6c002f964ce9e0944b6a9ac" ] ] [ @@ -999,14 +1003,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha512=7d6035bd96a71d248c31662b877330656cd29040f45a143695bfa96765b91cea2f4c04b6ff78fdfa5876c1032c3baf4fd22c679b0ae09858d93cf46c1474b5cb" ] ] - [ - "https://github.com/dune-universe/ocaml-ctypes/releases/download/0.20.1%2Bdune/ctypes-foreign-0.20.1.dune.tbz" - "ocaml-ctypes" - [ - "sha256=fd4ecf06c1d90931408c26708c21b7eb07bf703fdf06a793431451b7a1e8676f" - "sha512=241f2cf9b4dc9d352c7b5d487667dbef0d7708d025d9ae0adaab7389975ed76b67ef923d8041e4d6e3ce895d904f68ddded7812d514e117c32c4aae5fd9b5e2a" - ] - ] [ "https://github.com/dune-universe/ptime/releases/download/v1.0.0%2Bdune2/ptime-1.0.0.dune2.tbz" "ptime" @@ -1048,11 +1044,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/hannesm/duration/releases/download/0.2.0/duration-0.2.0.tbz" + "https://github.com/hannesm/duration/releases/download/v0.2.1/duration-0.2.1.tbz" "duration" [ - "sha256=ad14fb75a5a6f73fff7ef1721178925ee555cf0f23b23e3ab329184bc0c1ce69" - "sha512=6a259ca406739bfc6020c7de767e39c2a7ee06169aa1966d43d426b2a54fc69b81be6465d04b9bd8fbbbbfd9ebe1c82a1cbfbf62100a37eb0f7403f6cf53e3b8" + "sha256=c738c1f38cfb99820c121cd3ddf819de4b2228f0d50eacbd1cc3ce99e7c71e2b" + "sha512=0de9e15c7d6188872ddd9994f08616c4a1822e4ac92724efa2c312fbb2fc44cd7cbe4b36bcf66a8451d510c1fc95de481760afbcacb8f83e183262595dcf5f0c" ] ] [ @@ -1081,6 +1077,27 @@ x-opam-monorepo-duniverse-dirs: [ "bigstringaf" ["md5=0d8ceddeb7db821fd4e5235a75ae9752"] ] + [ + "https://github.com/janestreet/base/archive/refs/tags/v0.15.1.tar.gz" + "base" + [ + "sha256=755e303171ea267e3ba5af7aa8ea27537f3394d97c77d340b10f806d6ef61a14" + ] + ] + [ + "https://github.com/janestreet/core/archive/refs/tags/v0.15.1.tar.gz" + "core" + [ + "sha256=6f7bbdda1d97f2f542a45331f062127dd5264d6ed73ece7b2c6b330785dfc991" + ] + ] + [ + "https://github.com/janestreet/core_unix/archive/refs/tags/v0.15.2.tar.gz" + "core_unix" + [ + "sha256=486d0e954603960fa081b3fd23e3cc3e50ac0892544acd35f9c2919c4bf5f67b" + ] + ] [ "https://github.com/janestreet/jst-config/archive/refs/tags/v0.15.1.tar.gz" "jst-config" @@ -1103,6 +1120,13 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=92064a7fcebf1654d44f4d29abec0a9650505c3929b6d38fb293c2b69e5ca5ca" ] ] + [ + "https://github.com/janestreet/ppx_expect/archive/refs/tags/v0.15.1.tar.gz" + "ppx_expect" + [ + "sha256=dd3eaa86e921501414dac6b2f68238ff5455a0f7bec13f851dc51eba2f9a2097" + ] + ] [ "https://github.com/janestreet/ppx_sexp_conv/archive/refs/tags/v0.15.1.tar.gz" "ppx_sexp_conv" @@ -1115,6 +1139,13 @@ x-opam-monorepo-duniverse-dirs: [ "result" ["md5=1b82dec78849680b49ae9a8a365b831b"] ] + [ + "https://github.com/janestreet/sexp_pretty/archive/refs/tags/v0.15.1.tar.gz" + "sexp_pretty" + [ + "sha256=7e150c26068948fab42b2e9a1c2aec7032e204c02b77cf5ef14c0fab7b87e7e8" + ] + ] [ "https://github.com/janestreet/sexplib/archive/refs/tags/v0.15.1.tar.gz" "sexplib" @@ -1160,11 +1191,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/mirage/mirage-crypto/releases/download/v0.10.6/mirage-crypto-0.10.6.tbz" + "https://github.com/mirage/mirage-crypto/releases/download/v0.10.7/mirage-crypto-0.10.7.tbz" "mirage-crypto" [ - "sha256=01d6477a4edcad007b56983955d327f0e61c3f36494822f3755017d26e8f9410" - "sha512=870b7d0d32acde970afcd3fac2cb51131ac74bb20c887d07ddfccd239467a5dc8b700adf463427fa916393c503f106feb733cba5bf4b9d1f8eb57f52b5af9f9c" + "sha256=3e818a760c235c5b684c7b6b43b1cdd2a7dd04e0105b680d524f836eb988a69c" + "sha512=e9c3e6ac0fa3dae2dda9e91d5362ad08aaa65241b968a0c12484db4042146d6af7b46910784ce41bdd68783eede93f35a81aa37a2cd125dfc43503c78007b8b9" ] ] [ @@ -1184,11 +1215,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/mirage/ocaml-conduit/releases/download/v5.1.1/conduit-5.1.1.tbz" + "https://github.com/mirage/ocaml-conduit/releases/download/v6.1.0/conduit-6.1.0.tbz" "ocaml-conduit" [ - "sha256=89edc2d27f5f8fea44b1f8f9939bd792164eeba2e59744968479df9149de71be" - "sha512=7ae788320411c23e163fb13ed23235df923eeada15edf696e6c5ddc71eb28ea18d127f398ff90977a8cf232dd68436e2a69bae8569f2b042fb3047ef10630a96" + "sha256=a2e29088630bbef92c1a902192a09548ab4a6b3f75a7eee6722426eca1efc05f" + "sha512=308041a9cccf5b01827365ae9e75915bf33c812658ff1a802b275827f4c9af98dd991df9106a5b8d70374cc0d41398621bbafd8de829acfef4cb86e6b9523712" ] ] [ @@ -1208,11 +1239,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/mirage/ocaml-magic-mime/releases/download/v1.2.0/magic-mime-v1.2.0.tbz" + "https://github.com/mirage/ocaml-magic-mime/releases/download/v1.3.0/magic-mime-1.3.0.tbz" "ocaml-magic-mime" [ - "sha256=f121b67500f8dd97e2fc9fd5d01c7325e4c84bc5c0237442779fbd6fa20694f5" - "sha512=f55e39b11e145f97eaec6796cb99bdca3ac62130995fc36f82fdd097ab5ed6ff9130c671546b76b7c21777284977c02f6b6f74d5549a367481210342708886da" + "sha256=d835948a288d7efd9c49e1958b9f54260769ff4a0eb1f0829541876622f7cd9c" + "sha512=15da02dcd044805401454cca25cf4b564ffcf1cd929f7422fd43c7911e3c20f6e456bd49be4c1916b706104a1f4acc5bb06c7e52bf6b8cc8895c519a0a0ac051" ] ] [ @@ -1232,19 +1263,19 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/mirleft/ocaml-tls/releases/download/v0.15.3/tls-0.15.3.tbz" + "https://github.com/mirleft/ocaml-tls/releases/download/v0.15.4/tls-0.15.4.tbz" "ocaml-tls" [ - "sha256=5db456f98a2da3778296152f33dfb73e900c691c958805899fc8e6981f74465a" - "sha512=371b85c6afebeda0fcc8cc5252e3333d9c3ef3a6bdbee160bb194e2a5928fd537c811c6eec729f16852070944e627257d44c97142a259d00d0db66956a95df49" + "sha256=5f8d1d56b06f6069efd1d0a3de0c45cb488d3d13eb7f132c84ec7ba3f0d1c382" + "sha512=333352cb90bd1a43763571373e61fea1c0ea31f81ef728069344bf807e5a1916d3e249260b37bae62128961f4f7cbfd3cb22b1541088aa241e4637aec7aa7876" ] ] [ - "https://github.com/mirleft/ocaml-x509/releases/download/v0.16.0/x509-0.16.0.tbz" + "https://github.com/mirleft/ocaml-x509/releases/download/v0.16.2/x509-0.16.2.tbz" "ocaml-x509" [ - "sha256=67a6727fb4c38b919334eef2f8ef4eac0237029a439ff981d408eca8b9833595" - "sha512=c9b4cf55d16d8b1e6b6faa18fc9ac08065fa09937f07a3447d4b637539b37bea6374c98d184eba159a8ba8eba860303a78563097e47ef30529fedaaf722115c6" + "sha256=65ffd966350091e59ed385cb9aa30a81bc4dfea7bf6759a928cf36bde5d57f62" + "sha512=80b198ecb6ed05984a4e7e4dbb08ca685817b914bd9d6d05753c912b1f34a02d2dd60636c240a1c88819e6167c314607725d7cca716281b3ba5ee122c907eedc" ] ] [ @@ -1317,11 +1348,11 @@ x-opam-monorepo-duniverse-dirs: [ ["md5=5dc2bf130c1db3c731fe0fffc5648b41"] ] [ - "https://github.com/ocaml-ppx/ppxlib/releases/download/0.27.0/ppxlib-0.27.0.tbz" + "https://github.com/ocaml-ppx/ppxlib/releases/download/0.28.0/ppxlib-0.28.0.tbz" "ppxlib" [ - "sha256=764b96121d6ffd6a73820e0ec5235176bfc42b94cf2ff97e32d068a5c4b28c62" - "sha512=2dcce0be6acdb3e185bfdad2785303a405c617f99949316abe6793f785d7227c10795ca49e79290bd385873da635191b44e8a5c211de114a168846d5d26f505c" + "sha256=d87ae5f9a081206308ca964809b50a66aeb8e83d254801e8b9675448b60cf377" + "sha512=03270d43e91485e63c7dc115a71933ffd8cb2910c273d605d2800fa69f523dcd4de1fbe31fd6c2f6979675c681343bcf4e35be06934565bf28edf4ea03f5da8e" ] ] [ @@ -1333,11 +1364,11 @@ x-opam-monorepo-duniverse-dirs: [ ] ] [ - "https://github.com/ocaml/dune/releases/download/3.4.1/dune-3.4.1.tbz" + "https://github.com/ocaml/dune/releases/download/3.6.1/dune-3.6.1.tbz" "dune_" [ - "sha256=299fa33cffc108cc26ff59d5fc9d09f6cb0ab3ac280bf23a0114cfdc0b40c6c5" - "sha512=cb425d08c989fd27e1a87a6c72f37494866b508b0fe4ec05070adad995a99710b223a9047b6649776f63943dafb61903eefe4d5efde4c439103a89e2d6ff5337" + "sha256=f1d5ac04b7a027f3d549e25cf885ebf7acc135e0291c18e6b43123a799c143ce" + "sha512=64714ab6155cd04bc33d693fc7a6d9d61aa7a278357eeff159df324e083914fcd556459a3945acacf1bbc3775f2232ab0c78006ab8a434dc58dcf95ffdffac52" ] ] [ @@ -1364,11 +1395,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha512=1151d7edc8923516e9a36995a3f8938d323aaade759ad349ed15d6d8501db61ffbe63277e97c4d86149cf371306ac23df0f581ec7e02611f58335126e1870980" ] ] - [ - "https://github.com/ocamllabs/ocaml-integers/archive/0.7.0.tar.gz" - "ocaml-integers" - ["md5=201cf24143d7cb9a3921d572b6e6c42c"] - ] [ "https://github.com/ocsigen/lwt/archive/5.6.1.tar.gz" "lwt" @@ -1409,6 +1435,11 @@ x-opam-monorepo-duniverse-dirs: [ "sha512=0cba54075fc17c0dc3b60e9b9b241f7e85f2c6e372325e2a949ea251becd8a5c2d3ea843d2240ff005f3f9d76a1fbe20654405513cadc90c32f420bfc60af79b" ] ] + [ + "https://github.com/yallop/ocaml-integers/archive/0.7.0.tar.gz" + "ocaml-integers" + ["md5=201cf24143d7cb9a3921d572b6e6c42c"] + ] [ "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" "menhir" @@ -1445,13 +1476,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=49919d67c4197fed6a980a83a5e38f3c7311081dc40480c368c5b572a9cb3bc5" ] ] - [ - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/base-v0.15.0.tar.gz" - "base" - [ - "sha256=8657ae4324a9948457112245c49d97d2da95f157f780f5d97f0b924312a6a53d" - ] - ] [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/base_bigstring-v0.15.0.tar.gz" "base_bigstring" @@ -1473,13 +1497,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=7a4ba0daeacfb87e9cb7e8f49afac43a9bbb64dee4801fd789f1f188059d3690" ] ] - [ - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core-v0.15.0.tar.gz" - "core" - [ - "sha256=3a656f2b8605dd052da6459ad8dace3263d21efe15ef2b3bd36aaa8f8ce85e1f" - ] - ] [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core_bench-v0.15.0.tar.gz" "core_bench" @@ -1494,13 +1511,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=34a0288f16027c6b90e4ad16cb5cc677d7063d310faf918748ce70f1745116c0" ] ] - [ - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/core_unix-v0.15.0.tar.gz" - "core_unix" - [ - "sha256=0af9d2c0d2029a80858c730171e0bd70a1981b3e7021f8c31cd8dc54925da02d" - ] - ] [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/expect_test_helpers_core-v0.15.0.tar.gz" "expect_test_helpers_core" @@ -1613,13 +1623,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=deb5fb9ca12ade3e4fb8093f1cfdf50a03735b9db19a7535ad534331fb98d09b" ] ] - [ - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_expect-v0.15.0.tar.gz" - "ppx_expect" - [ - "sha256=06315a45b43da72f96719bcb183c0177b5198beae8c3ddce357e180a32f9ca7b" - ] - ] [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_fields_conv-v0.15.0.tar.gz" "ppx_fields_conv" @@ -1760,13 +1763,6 @@ x-opam-monorepo-duniverse-dirs: [ "sha256=d0c4e467bacc4bfb71dbd9575828634b222d4579b6ecc86b978f34dca1d1f3c7" ] ] - [ - "https://ocaml.janestreet.com/ocaml-core/v0.15/files/sexp_pretty-v0.15.0.tar.gz" - "sexp_pretty" - [ - "sha256=99e8643bc2bf9d0201702b165acccc9195bbb481093dc16ccb95c9fdfe015df1" - ] - ] [ "https://ocaml.janestreet.com/ocaml-core/v0.15/files/splittable_random-v0.15.0.tar.gz" "splittable_random"