28976

Committed 06 Nov 2024 09:44AM UTC coverage: 6.927% (+0.01%) from 6.913%

Build # 28976

Build Type

push

github

Committed by

web-flow

Commit Message

fix: Add or remove dune from package sets to allow resolving packages depending on it (#11103)

* fix: Add `dune` to existing packages to allow resolving

Signed-off-by: Marek Kubica <marek@tarides.com>

* Alternate solution which removes `dune` from formulas

Signed-off-by: Marek Kubica <marek@tarides.com>

* chore: leave a comment

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

* fix(pkg): use correct dune version to evaluate

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

---------

Signed-off-by: Marek Kubica <marek@tarides.com>
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
Co-authored-by: Rudi Grinberg <me@rgrinberg.com>

Run Details

1 of 6 new or added lines in 2 files covered. (16.67%)

1612 existing lines in 28 files now uncovered.

2951 of 42601 relevant lines covered (6.93%)

26740.63 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

13.64

/src/dune_rules/cinaps.ml

open Import
open Memo.O

type t =
  { loc : Loc.t
  ; files : Predicate_lang.Glob.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
  ; alias : Alias.Name.t option
  ; link_flags : Link_flags.Spec.t
  }

let name = "cinaps"
let cinaps_alias = Alias.Name.of_string name

include Stanza.Make (struct
    type nonrec t = t

    include Poly
  end)

let syntax =
  Dune_lang.Syntax.create
    ~name
    ~desc:"the cinaps extension"
    [ (1, 0), `Since (1, 11)
    ; (1, 1), `Since (3, 5)
    ; (1, 2), `Since (3, 7)
    ; (1, 3), `Since (3, 8)
    ]
;;

let decode =
  let open Dune_lang.Decoder in
  fields
    (let+ loc = loc
     and+ files = field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.true_
     and+ preprocess, preprocessor_deps = Preprocess.preprocess_fields
     and+ libraries =
       field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~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
     and+ alias = field_o "alias" Dune_lang.Alias.decode
     and+ link_flags =
       Link_flags.Spec.decode ~check:(Some (Dune_lang.Syntax.since syntax (1, 3)))
     (* TODO use this field? *)
     and+ _flags = Ocaml_flags.Spec.decode in
     { loc
     ; files
     ; libraries
     ; preprocess
     ; preprocessor_deps
     ; runtime_deps
     ; cinaps_version
     ; alias
     ; link_flags
     })
;;

let () =
  let open Dune_lang.Decoder in
  Dune_project.Extension.register_simple
    syntax
    (return
       [ ( name
         , let+ stanza = decode in
           [ make_stanza stanza ] )
       ])
;;

let gen_rules sctx t ~dir ~scope =
  let loc = t.loc in
  (* Files checked by cinaps *)
  let* cinapsed_files =
    Source_tree.files_of (Path.Build.drop_build_context_exn dir)
    >>| Path.Source.Set.to_list
    >>| List.filter_map ~f:(fun p ->
      if Predicate_lang.Glob.test
           t.files
           (Path.Source.basename p)
           ~standard:Predicate_lang.true_
      then
        Some
          (Path.Build.append_source (Super_context.context sctx |> Context.build_dir) p)
      else None)
  in
  let cinaps_dir =
    let stamp =
      let digest =
        if cinapsed_files = []
        then Digest.generic (t.loc, t.libraries, t.preprocess, t.preprocessor_deps)
        else
          Digest.generic (cinapsed_files, t.libraries, t.preprocess, t.preprocessor_deps)
      in
      String.take (Digest.to_string digest) 8
    in
    Path.Build.relative dir ("." ^ name ^ "." ^ stamp)
  in
  let main_module_name = Module_name.of_string name in
  let module_ = Module.generated ~kind:Impl [ main_module_name ] ~src_dir:cinaps_dir in
  let cinaps_ml =
    Module.source ~ml_kind:Ml_kind.Impl module_
    |> Option.value_exn
    |> Module.File.path
    |> Path.as_in_build_dir_exn
  in
  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
      (let prog =
         Super_context.resolve_program
           sctx
           ~dir
           ~where:Original_path
           ~loc:(Some loc)
           name
           ~hint:"opam install cinaps"
       in
       Command.run_dyn_prog
         ~dir:(Path.build dir)
         prog
         ~sandbox
         [ A "-staged"; Target cinaps_ml; Deps (List.map cinapsed_files ~f:Path.build) ])
  and* expander = Super_context.expander sctx ~dir in
  let* preprocess =
    Pp_spec_rules.make
      sctx
      ~dir
      ~expander
      ~lint:(Preprocess.Per_module.no_preprocessing ())
      ~preprocess:t.preprocess
      ~preprocessor_deps:t.preprocessor_deps
      ~instrumentation_deps:[]
      ~lib_name:None
      ~scope
  in
  let* modules =
    Pp_spec.pp_module preprocess module_ >>| Modules.With_vlib.singleton_exe
  in
  let dune_version = Scope.project scope |> Dune_project.dune_version in
  let names = Nonempty_list.[ t.loc, name ] in
  let compile_info =
    Lib.DB.resolve_user_written_deps
      (Scope.libs scope)
      (`Exe names)
      (Lib_dep.Direct (loc, Lib_name.of_string "cinaps.runtime") :: t.libraries)
      ~pps:(Preprocess.Per_module.pps t.preprocess)
      ~dune_version
      ~allow_overlaps:false
      ~forbidden_libraries:[]
  in
  let obj_dir = Obj_dir.make_exe ~dir:cinaps_dir ~name in
  let* cctx =
    let requires_compile = Lib.Compile.direct_requires compile_info in
    let requires_link = Lib.Compile.requires_link compile_info in
    Compilation_context.create
      ()
      ~super_context:sctx
      ~scope
      ~obj_dir
      ~modules
      ~opaque:(Explicit false)
      ~requires_compile
      ~requires_link
      ~flags:(Ocaml_flags.of_list [ "-w"; "-24" ])
      ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None)
      ~melange_package_name:None
      ~package:None
  in
  let* (_ : Exe.dep_graphs) =
    let link_args =
      let open Action_builder.O in
      let* link_flags =
        Action_builder.of_memo (Ocaml_flags_db.link_flags sctx ~dir t.link_flags)
      in
      let+ link_args = Link_flags.get ~use_standard_cxx_flags:false link_flags in
      Command.Args.As link_args
    in
    Exe.build_and_link
      cctx
      ~link_args
      ~program:{ name; main_module_name; loc }
      ~linkages:[ Exe.Linkage.native_or_custom (Compilation_context.ocaml cctx) ]
      ~promote:None
  in
  let action =
    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.deps
        (Dep.Set.of_files (cinaps_exe :: List.rev_map cinapsed_files ~f:Path.build))
    in
    Action.Full.make ~sandbox
    @@ A.chdir
         (Path.build dir)
         (A.progn
            [ A.run (Ok cinaps_exe) [ "-diff-cmd"; "-" ]
            ; A.concurrent
              @@ List.map cinapsed_files ~f:(fun fn ->
                Promote.Diff_action.diff
                  ~optional:true
                  (Path.build fn)
                  (Path.Build.extend_basename fn ~suffix:".cinaps-corrected"))
            ])
  in
  let cinaps_alias = Alias.make ~dir @@ Option.value t.alias ~default:cinaps_alias in
  let* () = Super_context.add_alias_action sctx ~dir ~loc cinaps_alias action in
  match t.alias with
  | Some _ -> Memo.return ()
  | None ->
    Rules.Produce.Alias.add_deps
      (Alias.make Alias0.runtest ~dir)
      (Alias_builder.alias cinaps_alias)
;;

1	open Import
2	open Memo.O
3
4	type t =
5	{ loc : Loc.t
6	; files : Predicate_lang.Glob.t
7	; libraries : Lib_dep.t list
8	; preprocess : Preprocess.Without_instrumentation.t Preprocess.Per_module.t
9	; preprocessor_deps : Dep_conf.t list
10	; runtime_deps : Dep_conf.t list
11	; cinaps_version : Syntax.Version.t
12	; alias : Alias.Name.t option
13	; link_flags : Link_flags.Spec.t
14	}
15
16	let name = "cinaps"
17	let cinaps_alias = Alias.Name.of_string name	38✔
18
19	include Stanza.Make (struct
20	type nonrec t = t
21
22	include Poly
23	end)
24
25	let syntax =
26	Dune_lang.Syntax.create	38✔
27	~name
28	~desc:"the cinaps extension"
29	[ (1, 0), `Since (1, 11)
30	; (1, 1), `Since (3, 5)
31	; (1, 2), `Since (3, 7)
32	; (1, 3), `Since (3, 8)
33	]
34	;;
35
36	let decode =
37	let open Dune_lang.Decoder in
38	fields	38✔
39	(let+ loc = loc
40	and+ files = field "files" Predicate_lang.Glob.decode ~default:Predicate_lang.true_	38✔
41	and+ preprocess, preprocessor_deps = Preprocess.preprocess_fields
42	and+ libraries =
43	field "libraries" (Lib_dep.L.decode ~allow_re_export:false) ~default:[]	38✔
44	and+ runtime_deps =
45	field	38✔
46	~default:[]
47	"runtime_deps"
48	(Dune_lang.Syntax.since syntax (1, 1) >>> repeat Dep_conf.decode)	38✔
49	and+ cinaps_version = Dune_lang.Syntax.get_exn syntax	38✔
50	and+ alias = field_o "alias" Dune_lang.Alias.decode	38✔
51	and+ link_flags =
52	Link_flags.Spec.decode ~check:(Some (Dune_lang.Syntax.since syntax (1, 3)))	38✔
53	(* TODO use this field? *)
54	and+ _flags = Ocaml_flags.Spec.decode in
55	{ loc	×
56	; files
57	; libraries
58	; preprocess
59	; preprocessor_deps
60	; runtime_deps
61	; cinaps_version
62	; alias
63	; link_flags
64	})
65	;;
66
67	let () =
68	let open Dune_lang.Decoder in
69	Dune_project.Extension.register_simple	38✔
70	syntax
71	(return	38✔
72	[ ( name
73	, let+ stanza = decode in
74	[ make_stanza stanza ] )	×
75	])
76	;;
77
78	let gen_rules sctx t ~dir ~scope =
79	let loc = t.loc in	×
80	(* Files checked by cinaps *)
81	let* cinapsed_files =
82	Source_tree.files_of (Path.Build.drop_build_context_exn dir)	×
83	>>\| Path.Source.Set.to_list	×
84	>>\| List.filter_map ~f:(fun p ->	×
85	if Predicate_lang.Glob.test	×
86	t.files
87	(Path.Source.basename p)	×
88	~standard:Predicate_lang.true_
89	then
90	Some	×
91	(Path.Build.append_source (Super_context.context sctx \|> Context.build_dir) p)	×
92	else None)	×
93	in
94	let cinaps_dir =	×
95	let stamp =
96	let digest =
97	if cinapsed_files = []
98	then Digest.generic (t.loc, t.libraries, t.preprocess, t.preprocessor_deps)	×
99	else
100	Digest.generic (cinapsed_files, t.libraries, t.preprocess, t.preprocessor_deps)	×
101	in
102	String.take (Digest.to_string digest) 8	×
103	in
104	Path.Build.relative dir ("." ^ name ^ "." ^ stamp)	×
105	in
106	let main_module_name = Module_name.of_string name in
107	let module_ = Module.generated ~kind:Impl [ main_module_name ] ~src_dir:cinaps_dir in	×
108	let cinaps_ml =	×
109	Module.source ~ml_kind:Ml_kind.Impl module_
110	\|> Option.value_exn	×
111	\|> Module.File.path	×
112	\|> Path.as_in_build_dir_exn	×
113	in
114	let cinaps_exe = Path.Build.relative cinaps_dir (name ^ ".exe") in	×
115	let* () =	×
116	(* Ask cinaps to produce a .ml file to build *)
117	let sandbox =
118	if t.cinaps_version >= (1, 1)
119	then Sandbox_config.needs_sandboxing	×
120	else Sandbox_config.default	×
121	in
122	Super_context.add_rule	×
123	sctx
124	~loc:t.loc
125	~dir
126	(let prog =
127	Super_context.resolve_program
128	sctx
129	~dir
130	~where:Original_path
131	~loc:(Some loc)
132	name
133	~hint:"opam install cinaps"
134	in
135	Command.run_dyn_prog	×
136	~dir:(Path.build dir)	×
137	prog
138	~sandbox
139	[ A "-staged"; Target cinaps_ml; Deps (List.map cinapsed_files ~f:Path.build) ])	×
140	and* expander = Super_context.expander sctx ~dir in	×
141	let* preprocess =	×
142	Pp_spec_rules.make	×
143	sctx
144	~dir
145	~expander
146	~lint:(Preprocess.Per_module.no_preprocessing ())	×
147	~preprocess:t.preprocess
148	~preprocessor_deps:t.preprocessor_deps
149	~instrumentation_deps:[]
150	~lib_name:None
151	~scope
152	in
153	let* modules =	×
154	Pp_spec.pp_module preprocess module_ >>\| Modules.With_vlib.singleton_exe	×
155	in
156	let dune_version = Scope.project scope \|> Dune_project.dune_version in	×
157	let names = Nonempty_list.[ t.loc, name ] in	×
158	let compile_info =
159	Lib.DB.resolve_user_written_deps
160	(Scope.libs scope)	×
161	(`Exe names)
162	(Lib_dep.Direct (loc, Lib_name.of_string "cinaps.runtime") :: t.libraries)	×
163	~pps:(Preprocess.Per_module.pps t.preprocess)	×
164	~dune_version
165	~allow_overlaps:false
166	~forbidden_libraries:[]
167	in
168	let obj_dir = Obj_dir.make_exe ~dir:cinaps_dir ~name in	×
169	let* cctx =
170	let requires_compile = Lib.Compile.direct_requires compile_info in
171	let requires_link = Lib.Compile.requires_link compile_info in	×
172	Compilation_context.create	×
173	()
174	~super_context:sctx
175	~scope
176	~obj_dir
177	~modules
178	~opaque:(Explicit false)
179	~requires_compile
180	~requires_link
181	~flags:(Ocaml_flags.of_list [ "-w"; "-24" ])	×
UNCOV 182	~js_of_ocaml:(Js_of_ocaml.Mode.Pair.make None)	×
183	~melange_package_name:None
184	~package:None
185	in
186	let* (_ : Exe.dep_graphs) =	×
187	let link_args =
188	let open Action_builder.O in
189	let* link_flags =
190	Action_builder.of_memo (Ocaml_flags_db.link_flags sctx ~dir t.link_flags)	×
191	in
192	let+ link_args = Link_flags.get ~use_standard_cxx_flags:false link_flags in	×
193	Command.Args.As link_args	×
194	in
195	Exe.build_and_link	×
196	cctx
197	~link_args
198	~program:{ name; main_module_name; loc }
199	~linkages:[ Exe.Linkage.native_or_custom (Compilation_context.ocaml cctx) ]	×
200	~promote:None
201	in
202	let action =	×
203	let open Action_builder.O in
204	let module A = Action in
205	let cinaps_exe = Path.build cinaps_exe in
206	let runtime_deps, sandbox =	×
207	let sandbox =
208	if t.cinaps_version >= (1, 1)
209	then Sandbox_config.needs_sandboxing	×
210	else Sandbox_config.no_special_requirements	×
211	in
212	Dep_conf_eval.unnamed ~sandbox ~expander t.runtime_deps	×
213	in
214	let* () = runtime_deps in
215	let+ () =	×
216	Action_builder.deps	×
217	(Dep.Set.of_files (cinaps_exe :: List.rev_map cinapsed_files ~f:Path.build))	×
218	in
219	Action.Full.make ~sandbox	×
220	@@ A.chdir	×
221	(Path.build dir)	×
222	(A.progn	×
223	[ A.run (Ok cinaps_exe) [ "-diff-cmd"; "-" ]	×
224	; A.concurrent	×
225	@@ List.map cinapsed_files ~f:(fun fn ->	×
226	Promote.Diff_action.diff	×
227	~optional:true
228	(Path.build fn)	×
229	(Path.Build.extend_basename fn ~suffix:".cinaps-corrected"))	×
230	])
231	in
232	let cinaps_alias = Alias.make ~dir @@ Option.value t.alias ~default:cinaps_alias in	×
233	let* () = Super_context.add_alias_action sctx ~dir ~loc cinaps_alias action in	×
234	match t.alias with	×
235	\| Some _ -> Memo.return ()	×
236	\| None ->	×
237	Rules.Produce.Alias.add_deps
238	(Alias.make Alias0.runtest ~dir)	×
239	(Alias_builder.alias cinaps_alias)	×
240	;;

ocaml / dune / 28976

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous