From bdf25d69f9af420f8649d0cde926c75df6b4d287 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 21 Mar 2024 17:10:36 -0700 Subject: [PATCH 1/3] test: show melange.emit regression attempting to read wrong ocamldep result Signed-off-by: Antonio Nuno Monteiro --- .../melange/unexpected-ocamldep-output.t | 57 +++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t diff --git a/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t new file mode 100644 index 00000000000..b1debca5b12 --- /dev/null +++ b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t @@ -0,0 +1,57 @@ +Show that `melange.emit` + correct dependency tracking reads the processed +file after any dialects have run + + $ cat > dune-project < (lang dune 3.11) + > (using melange 0.1) + > (dialect + > (name myd) + > (implementation + > (preprocess (run cat %{input-file})) + > (extension myd))) + > EOF + $ cat > dune < (melange.emit + > (target output) + > (alias mel) + > (libraries foo) + > (emit_stdlib false)) + > EOF + $ mkdir lib + $ cat > lib/dune < (library + > (name foo) + > (modes melange)) + > EOF + $ cat > lib/foo.myd < let name = Bar.name + > EOF + $ cat > lib/bar.ml < let name = "Zoe" + > EOF + $ dune build @mel + Error: ocamldep returned unexpected output for _build/default/lib/foo.myd: + > lib/foo.myd.ml: Bar + -> required by _build/default/output/lib/foo.js + -> required by alias mel + [1] + +Now try preprocessing too + + $ dune clean + $ cat > lib/dune < (library + > (name foo) + > (preprocess (action (run cat %{input-file}))) + > (modes melange)) + > EOF + $ dune build @mel + Error: ocamldep returned unexpected output for _build/default/lib/bar.ml: + > lib/bar.pp.ml: + -> required by _build/default/output/lib/bar.js + -> required by alias mel + Error: ocamldep returned unexpected output for _build/default/lib/foo.myd.ml: + > lib/foo.pp.myd.ml: Bar + -> required by _build/default/output/lib/foo.js + -> required by alias mel + [1] From a5b6c5a2de9e80d33af782f74ee31d9008274b28 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 21 Mar 2024 17:36:04 -0700 Subject: [PATCH 2/3] fix: read the processed file in Ocamldep.read_immediate_deps_of Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/melange/melange_rules.ml | 211 ++++++++++-------- src/dune_rules/module.mli | 2 +- .../melange/unexpected-ocamldep-output.t | 14 -- 3 files changed, 114 insertions(+), 113 deletions(-) diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 1037baaded4..54a6b455107 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -40,8 +40,21 @@ let make_js_name ~js_ext ~output m = Path.Build.relative dst_dir basename ;; -let impl_only_modules_defined_in_this_lib sctx lib = - let+ modules = Dir_contents.modules_of_lib sctx lib in +let modules_in_obj_dir ~sctx ~scope ~preprocess modules = + let* ocaml = Context.ocaml (Super_context.context sctx) in + let version = ocaml.version in + let* preprocess = + Resolve.Memo.read_memo + (Preprocess.Per_module.with_instrumentation + preprocess + ~instrumentation_backend:(Lib.DB.instrumentation_backend (Scope.libs scope))) + in + let pped_map = Staged.unstage (Preprocessing.pped_modules_map preprocess version) in + Modules.map_user_written modules ~f:(fun m -> Memo.return @@ pped_map m) +;; + +let impl_only_modules_defined_in_this_lib ~sctx ~scope lib = + let* modules = Dir_contents.modules_of_lib sctx lib in match modules with | None -> User_error.raise @@ -52,8 +65,12 @@ let impl_only_modules_defined_in_this_lib sctx lib = (Lib.name lib |> Lib_name.to_string) ] | Some modules -> + let info = Lib.info lib in + let+ modules = + let preprocess = Lib_info.preprocess info in + modules_in_obj_dir ~sctx ~scope ~preprocess modules + in let () = - let info = Lib.info lib in let modes = Lib_info.modes info in match modes.melange with | false -> @@ -69,8 +86,9 @@ let impl_only_modules_defined_in_this_lib sctx lib = ] | true -> () in - (* for a virtual library,this will return all modules *) - (Modules.split_by_lib modules).impl |> List.filter ~f:(Module.has ~ml_kind:Impl) + ( modules + , (* for a virtual library, this will return all modules *) + (Modules.split_by_lib modules).impl |> List.filter ~f:(Module.has ~ml_kind:Impl) ) ;; let cmj_glob = Glob.of_string_exn Loc.none "*.cmj" @@ -133,11 +151,11 @@ let js_targets_of_modules modules ~module_systems ~output = |> Path.Set.union_all ;; -let js_targets_of_libs sctx libs ~module_systems ~target_dir = +let js_targets_of_libs ~sctx ~scope ~module_systems ~target_dir libs = Resolve.Memo.List.concat_map module_systems ~f:(fun (_, js_ext) -> let open Memo.O in let of_lib lib = - let+ modules = impl_only_modules_defined_in_this_lib sctx lib in + let+ _, modules = impl_only_modules_defined_in_this_lib ~sctx ~scope lib in let output = output_of_lib ~target_dir lib in List.rev_map modules ~f:(fun m -> Path.build @@ make_js_name ~output ~js_ext m) in @@ -302,7 +320,7 @@ let setup_emit_cmj_rules @@ let open Resolve.Memo.O in Compilation_context.requires_link cctx - >>= js_targets_of_libs sctx ~module_systems ~target_dir + >>= js_targets_of_libs ~sctx ~scope ~module_systems ~target_dir in Action_builder.paths deps in @@ -403,18 +421,7 @@ let modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope (mel : Melange_stanzas Dir_contents.ocaml dir_contents >>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target }) in - let+ modules = - let* ocaml = Context.ocaml (Super_context.context sctx) in - let version = ocaml.version 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 pped_map = Staged.unstage (Preprocessing.pped_modules_map preprocess version) in - Modules.map_user_written modules ~f:(fun m -> Memo.return @@ pped_map m) - in + let+ modules = modules_in_obj_dir ~sctx ~scope ~preprocess:mel.preprocess modules in let modules_for_js = Modules.fold_no_vlib modules ~init:[] ~f:(fun x acc -> if Module.has x ~ml_kind:Impl then x :: acc else acc) @@ -463,88 +470,96 @@ let setup_entries_js m) ;; -let setup_js_rules_libraries - ~dir - ~scope - ~target_dir - ~sctx - ~requires_link - ~mode - (mel : Melange_stanzas.Emit.t) - = - let build_js = build_js ~sctx ~mode ~module_systems:mel.module_systems in - Memo.parallel_iter requires_link ~f:(fun lib -> - let open Memo.O in - let lib_compile_info = - Lib.Compile.for_lib - ~allow_overlaps:mel.allow_overlapping_dependencies - (Scope.libs scope) - lib - in - let info = Lib.info lib in - let loc = Lib_info.loc info in - let build_js = - let obj_dir = Lib_info.obj_dir info in - let pkg_name = Lib_info.package info in - build_js ~loc ~pkg_name ~obj_dir - in - let output = output_of_lib ~target_dir lib in - let* includes = - let+ requires_link = Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) in - cmj_includes ~requires_link ~scope - and* local_modules = - match Lib.Local.of_lib lib with - | Some lib -> - let+ modules = Dir_contents.modules_of_local_lib sctx lib in - let obj_dir = Lib.Local.obj_dir lib in - Some (modules, obj_dir) - | None -> Memo.return None - and* () = - setup_runtime_assets_rules - sctx - ~dir - ~target_dir - ~mode - ~output - ~for_:(`Library info) - mel - in - let* () = - match Lib.implements lib with - | None -> Memo.return () - | Some vlib -> - let* vlib = Resolve.Memo.read_memo vlib in - let* includes = - let+ requires_link = +let setup_js_rules_libraries = + let local_modules ~lib modules = + Lib.Local.of_lib lib + |> Option.map ~f:(fun lib -> + let obj_dir = Lib.Local.obj_dir lib in + modules, obj_dir) + in + fun ~dir ~scope ~target_dir ~sctx ~requires_link ~mode (mel : Melange_stanzas.Emit.t) -> + let build_js = build_js ~sctx ~mode ~module_systems:mel.module_systems in + Memo.parallel_iter requires_link ~f:(fun lib -> + let open Memo.O in + let lib_compile_info = + Lib.Compile.for_lib + ~allow_overlaps:mel.allow_overlapping_dependencies + (Scope.libs scope) + lib + in + let info = Lib.info lib in + let loc = Lib_info.loc info in + let build_js = + let obj_dir = Lib_info.obj_dir info in + let pkg_name = Lib_info.package info in + build_js ~loc ~pkg_name ~obj_dir + in + let output = output_of_lib ~target_dir lib in + let* includes = + let+ requires_link = + Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) + in + cmj_includes ~requires_link ~scope + and* () = + setup_runtime_assets_rules + sctx + ~dir + ~target_dir + ~mode + ~output + ~for_:(`Library info) + mel + in + let* () = + match Lib.implements lib with + | None -> Memo.return () + | Some vlib -> + let* vlib = Resolve.Memo.read_memo vlib in + let* includes = let+ requires_link = - Lib.Compile.for_lib - ~allow_overlaps:mel.allow_overlapping_dependencies - (Scope.libs scope) - vlib - |> Lib.Compile.requires_link - |> Memo.Lazy.force - in - let open Resolve.O in - let+ requires_link = requires_link in - (* Whenever a `concrete_lib` implementation contains a field - `(implements virt_lib)`, we also set up the JS targets for the - modules defined in `virt_lib`. + let+ requires_link = + Lib.Compile.for_lib + ~allow_overlaps:mel.allow_overlapping_dependencies + (Scope.libs scope) + vlib + |> Lib.Compile.requires_link + |> Memo.Lazy.force + in + let open Resolve.O in + let+ requires_link = requires_link in + (* Whenever a `concrete_lib` implementation contains a field + `(implements virt_lib)`, we also set up the JS targets for the + modules defined in `virt_lib`. - In the cases where `virt_lib` (concrete) modules depend on any - virtual modules (i.e. programming against the interface), we - need to make sure that the JS rules that dune emits for - `virt_lib` depend on `concrete_lib`, such that Melange can find - the correct `.cmj` file, which is needed to emit the correct - path in `import` / `require`. *) - lib :: requires_link + In the cases where `virt_lib` (concrete) modules depend on any + virtual modules (i.e. programming against the interface), we + need to make sure that the JS rules that dune emits for + `virt_lib` depend on `concrete_lib`, such that Melange can find + the correct `.cmj` file, which is needed to emit the correct + path in `import` / `require`. *) + lib :: requires_link + in + cmj_includes ~requires_link ~scope in - cmj_includes ~requires_link ~scope + let* local_modules, source_modules = + let+ lib_modules, source_modules = + impl_only_modules_defined_in_this_lib ~sctx ~scope vlib + in + local_modules ~lib:vlib lib_modules, source_modules + in + Memo.parallel_iter + source_modules + ~f:(build_js ~dir ~output ~includes ~local_modules) + in + let* local_modules, source_modules = + let+ lib_modules, source_modules = + impl_only_modules_defined_in_this_lib ~sctx ~scope lib in - impl_only_modules_defined_in_this_lib sctx vlib - >>= Memo.parallel_iter ~f:(build_js ~dir ~output ~includes ~local_modules) - in - let* source_modules = impl_only_modules_defined_in_this_lib sctx lib in - Memo.parallel_iter source_modules ~f:(build_js ~dir ~output ~local_modules ~includes)) + local_modules ~lib lib_modules, source_modules + in + Memo.parallel_iter + source_modules + ~f:(build_js ~dir ~output ~local_modules ~includes)) ;; let setup_js_rules_libraries_and_entries diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index 3d823e2ae99..7788038b68d 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -92,7 +92,7 @@ val visibility : t -> Visibility.t val encode : t -> src_dir:Path.t -> Dune_lang.t list val decode : src_dir:Path.t -> t Dune_lang.Decoder.t -(** [pped m] return [m] but with the preprocessed source paths paths *) +(** [pped m] return [m] but with the preprocessed source paths *) val pped : t -> t (** [ml_source m] returns [m] but with the OCaml syntax source paths *) diff --git a/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t index b1debca5b12..83bbb457c80 100644 --- a/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t +++ b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t @@ -30,11 +30,6 @@ file after any dialects have run > let name = "Zoe" > EOF $ dune build @mel - Error: ocamldep returned unexpected output for _build/default/lib/foo.myd: - > lib/foo.myd.ml: Bar - -> required by _build/default/output/lib/foo.js - -> required by alias mel - [1] Now try preprocessing too @@ -46,12 +41,3 @@ Now try preprocessing too > (modes melange)) > EOF $ dune build @mel - Error: ocamldep returned unexpected output for _build/default/lib/bar.ml: - > lib/bar.pp.ml: - -> required by _build/default/output/lib/bar.js - -> required by alias mel - Error: ocamldep returned unexpected output for _build/default/lib/foo.myd.ml: - > lib/foo.pp.myd.ml: Bar - -> required by _build/default/output/lib/foo.js - -> required by alias mel - [1] From 70c757d76e1711df7c9ca482f517c0b294b4f9f0 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 21 Mar 2024 20:23:52 -0700 Subject: [PATCH 3/3] fix(virtual_lib_compilation_test): only add dependency if impl exists Signed-off-by: Antonio Nuno Monteiro --- src/dune_rules/melange/melange_rules.ml | 83 ++++++++++++++----------- 1 file changed, 47 insertions(+), 36 deletions(-) diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 54a6b455107..778005b4cb0 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -41,9 +41,10 @@ let make_js_name ~js_ext ~output m = ;; let modules_in_obj_dir ~sctx ~scope ~preprocess modules = - let* ocaml = Context.ocaml (Super_context.context sctx) in - let version = ocaml.version in - let* preprocess = + let* version = + let+ ocaml = Context.ocaml (Super_context.context sctx) in + ocaml.version + and* preprocess = Resolve.Memo.read_memo (Preprocess.Per_module.with_instrumentation preprocess @@ -180,7 +181,7 @@ let build_js ~obj_dir ~sctx ~includes - ~local_modules + ~local_modules_and_obj_dir m = let open Memo.O in @@ -213,17 +214,24 @@ let build_js in With_targets.map_build command ~f:(fun command -> let open Action_builder.O in - let local_library_paths = - match local_modules with - | Some (modules, obj_dir) -> + match local_modules_and_obj_dir with + | Some (modules, obj_dir) -> + let paths = let+ module_deps = Dep_rules.immediate_deps_of m modules ~obj_dir ~ml_kind:Impl in - List.map module_deps ~f:(fun dep_m -> - Obj_dir.Module.cm_file_exn obj_dir dep_m ~kind:(Melange Cmj) |> Path.build) - | None -> Action_builder.return [] - in - Action_builder.dyn_paths_unit local_library_paths >>> command) + List.fold_left module_deps ~init:[] ~f:(fun acc dep_m -> + if Module.has dep_m ~ml_kind:Impl + then ( + let cmj_file = + let kind : Lib_mode.Cm_kind.t = Melange Cmj in + Obj_dir.Module.cm_file_exn obj_dir dep_m ~kind |> Path.build + in + cmj_file :: acc) + else acc) + in + Action_builder.dyn_paths_unit paths >>> command + | None -> command) in Super_context.add_rule sctx ~dir ~loc ~mode build) ;; @@ -455,7 +463,7 @@ let setup_entries_js setup_runtime_assets_rules sctx ~dir ~target_dir ~mode ~output ~for_:`Emit mel in Memo.parallel_iter modules_for_js ~f:(fun m -> - let local_modules = Some (local_modules, local_obj_dir) in + let local_modules_and_obj_dir = Some (local_modules, local_obj_dir) in build_js ~dir ~loc @@ -466,17 +474,26 @@ let setup_entries_js ~obj_dir ~sctx ~includes - ~local_modules + ~local_modules_and_obj_dir m) ;; let setup_js_rules_libraries = - let local_modules ~lib modules = + let local_modules_and_obj_dir ~lib modules = Lib.Local.of_lib lib |> Option.map ~f:(fun lib -> let obj_dir = Lib.Local.obj_dir lib in modules, obj_dir) in + let parallel_build_source_modules ~sctx ~scope ~f lib = + let* local_modules_and_obj_dir, source_modules = + let+ lib_modules, source_modules = + impl_only_modules_defined_in_this_lib ~sctx ~scope lib + in + local_modules_and_obj_dir ~lib lib_modules, source_modules + in + Memo.parallel_iter source_modules ~f:(f ~local_modules_and_obj_dir) + in fun ~dir ~scope ~target_dir ~sctx ~requires_link ~mode (mel : Melange_stanzas.Emit.t) -> let build_js = build_js ~sctx ~mode ~module_systems:mel.module_systems in Memo.parallel_iter requires_link ~f:(fun lib -> @@ -500,7 +517,8 @@ let setup_js_rules_libraries = Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) in cmj_includes ~requires_link ~scope - and* () = + in + let+ () = setup_runtime_assets_rules sctx ~dir @@ -509,8 +527,7 @@ let setup_js_rules_libraries = ~output ~for_:(`Library info) mel - in - let* () = + and+ () = match Lib.implements lib with | None -> Memo.return () | Some vlib -> @@ -541,25 +558,19 @@ let setup_js_rules_libraries = in cmj_includes ~requires_link ~scope in - let* local_modules, source_modules = - let+ lib_modules, source_modules = - impl_only_modules_defined_in_this_lib ~sctx ~scope vlib - in - local_modules ~lib:vlib lib_modules, source_modules - in - Memo.parallel_iter - source_modules - ~f:(build_js ~dir ~output ~includes ~local_modules) - in - let* local_modules, source_modules = - let+ lib_modules, source_modules = - impl_only_modules_defined_in_this_lib ~sctx ~scope lib - in - local_modules ~lib lib_modules, source_modules + parallel_build_source_modules + ~sctx + ~scope + vlib + ~f:(build_js ~dir ~output ~includes) + and+ () = + parallel_build_source_modules + ~sctx + ~scope + lib + ~f:(build_js ~dir ~output ~includes) in - Memo.parallel_iter - source_modules - ~f:(build_js ~dir ~output ~local_modules ~includes)) + ()) ;; let setup_js_rules_libraries_and_entries