get back dune external-lib-deps tests

Get back the tests, pps libraries and some optional
librairies was forgotten.

Signed-off-by: Alpha DIALLO <[email protected]>

bin/external_lib_deps.ml

@@ -32,17 +32,18 @@ module Kind = struct
     | _ -> Required
 end
 
-type external_lib_dep = {
-  name: Lib_name.t;
-  kind: Kind.t;
-  missing: bool
-}
-
-type buildable = {
-  dir: Path.Source.t;
-  deps: Lib_dep.t list;
-  pps: Preprocess.With_instrumentation.t Preprocess.Per_module.t
-}
+type external_lib_dep =
+  { name : Lib_name.t
+  ; kind : Kind.t
+  ; missing : bool
+  }
+
+type lib_deps =
+  { dir : Path.Source.t
+  ; deps : Lib_dep.t list
+  ; pps : Preprocess.With_instrumentation.t Preprocess.Per_module.t
+  ; lib_availables : Lib_name.t list
+  }
 
 let pp_external_libs libs =
   Pp.enumerate libs ~f:(fun lib ->
@@ -59,75 +60,113 @@ let external_lib_pps db preprocess =
   let* pps =
     Resolve.Memo.read_memo
       (Preprocess.Per_module.with_instrumentation preprocess
-         ~instrumentation_backend:
-           (Lib.DB.instrumentation_backend db))
+         ~instrumentation_backend:(Lib.DB.instrumentation_backend db))
     >>| Preprocess.Per_module.pps
   in
-  Memo.parallel_map ~f:(fun (_,name) ->
-    let+ (found,db) =
-      resolve db name
-    in
-    if is_findlib_db db then
-      Some {name; kind = Kind.Required; missing = Option.is_none found}
-    else None) pps
+  Memo.parallel_map
+    ~f:(fun (_, name) ->
+      let+ found, db = resolve db name in
+      if is_findlib_db db then
+        Some { name; kind = Kind.Required; missing = Option.is_none found }
+      else None)
+    pps
   >>| List.filter_map ~f:(fun x -> x)
 
-let external_lib_deps db buildables =
+let external_resolve db name kind =
+  let open Memo.O in
+  let+ found, db = resolve db name in
+  if is_findlib_db db then Some { name; kind; missing = Option.is_none found }
+  else None
+
+let external_lib_deps db lib_deps =
   let open Memo.O in
-  buildables
-  |> Memo.parallel_map ~f:(fun {deps; dir; pps} ->
+  lib_deps
+  |> Memo.parallel_map ~f:(fun { deps; dir; pps; lib_availables } ->
          let* libs =
            deps
            |> Memo.parallel_map ~f:(fun lib ->
                   match lib with
-                  | Lib_dep.Direct (_, name) | Lib_dep.Re_export (_, name) ->
-                    let+ (found,db) = resolve db name in
-                    if is_findlib_db db then
-                      [{name; kind = Kind.Required; missing=Option.is_none found}]
-                    else
-                      []
+                  | 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
-                        let+ (found,db) = resolve db name in
-                        if is_findlib_db db then
-                          Some {name; kind = Kind.Optional; missing=Option.is_none found}
-                        else None)
-                      >>| List.filter_map ~f:(fun x -> x))
+                    |> 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* lib_availables =
+           Memo.parallel_map
+             ~f:(fun lib_name -> external_resolve db lib_name Kind.Optional)
+             lib_availables
+           >>| List.filter_map ~f:(fun x -> x)
+         in
          let+ pps = external_lib_pps db pps in
-         (dir, libs @ pps ))
+         (dir, libs @ pps @ lib_availables))
+
+let libs_availables s_vars_l =
+  List.map ~f:Dune_lang.String_with_vars.pforms s_vars_l
+  |> List.concat
+  |> List.filter_map ~f:(fun pform ->
+         match pform with
+         | Dune_lang.Pform.Macro (Dune_lang.Pform.Macro.Lib_available, name) ->
+           Some (Lib_name.of_string name)
+         | _ -> None)
 
-let libs (context : Context.t)
-      ({ Dune_rules.Main.conf; contexts = _; _ } : Dune_rules.Main.build_system) =
+let libs (context : Context.t) (build_system : Dune_rules.Main.build_system) =
+  let { Dune_rules.Main.conf; contexts = _; _ } = build_system in
   let open Dune_rules in
   let open Memo.O in
   let+ dune_files = Dune_load.Dune_files.eval conf.dune_files ~context in
   List.map dune_files ~f:(fun (dune_file : Dune_file.t) ->
-    List.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}]
-      | _ -> [])
-    |> List.concat)
+      List.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
+              ; lib_availables = []
+              }
+            ]
+          | Dune_file.Library lib ->
+            [ { deps = lib.buildable.libraries
+              ; dir
+              ; pps = lib.buildable.preprocess
+              ; lib_availables = []
+              }
+            ]
+          | Dune_file.Rule rule ->
+            let lib_availables =
+              Dune_lang.Action.list_of_string_with_vars (snd rule.action)
+              |> libs_availables
+            in
+            [ { deps = []
+              ; dir
+              ; pps = Preprocess.Per_module.no_preprocessing ()
+              ; lib_availables
+              }
+            ]
+          | _ -> [])
+      |> List.concat)
   |> List.flatten
 
 let libs_to_lib_map libs =
   List.fold_left
     ~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))
+          match n with
+          | Some k -> Some (Kind.merge k lib.kind)
+          | None -> Some lib.kind))
     ~init:Lib_name.Map.empty libs
 
 let libs_dir_to_map libs_dir =
@@ -138,17 +177,19 @@ let libs_dir_to_map libs_dir =
       | Some libs_map ->
         Dir_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))))
+               Some (Kind.merge k1 k2))))
     ~init:Dir_map.empty libs_dir
 
 let libs_sort libs =
   List.sort_uniq
     ~compare:(fun lib1 lib2 ->
-      String.compare (Lib_name.to_string lib1.name) (Lib_name.to_string lib2.name))
+      String.compare
+        (Lib_name.to_string lib1.name)
+        (Lib_name.to_string lib2.name))
     libs
 
 let run ~context_name ~external_resolved_libs ~sexp ~only_missing =
-  if only_missing then (
+  if only_missing then
     let missing =
       external_resolved_libs |> List.map ~f:snd |> List.concat
       |> List.filter_map ~f:(fun lib -> if lib.missing then Some lib else None)
@@ -170,35 +211,34 @@ let run ~context_name ~external_resolved_libs ~sexp ~only_missing =
            ]
            ~hints:
              [ Dune_engine.Utils.pp_command_hint
-               @@ (missing
-                   |> List.filter_map ~f:(fun lib ->
-                     match lib.kind with
-                     | Optional -> None
-                     | Required -> Some (Lib_name.to_string lib.name))
-                   |> fun libs -> String.concat ~sep:" " ("opam install"::libs))
-             ]))
-  else if sexp then (
+               @@ ( missing
+                  |> List.filter_map ~f:(fun lib ->
+                         match lib.kind with
+                         | Optional -> None
+                         | Required -> Some (Lib_name.to_string lib.name))
+                  |> fun libs -> String.concat ~sep:" " ("opam install" :: libs)
+                  )
+             ])
+  else if sexp then
     let sexp =
-      external_resolved_libs
-      |> libs_dir_to_map
+      external_resolved_libs |> libs_dir_to_map
       |> Dir_map.filter ~f:(fun m -> not (Lib_name.Map.is_empty m))
       |> Dir_map.to_dyn (fun libs -> Lib_name.Map.to_dyn Kind.to_dyn libs)
       |> Sexp.of_dyn
     in
     Format.printf "%a@." Pp.to_fmt
-      (Sexp.pp (Sexp.List [ Sexp.Atom context_name; sexp ])))
-  else (
+      (Sexp.pp (Sexp.List [ Sexp.Atom context_name; sexp ]))
+  else
     let external_libs =
-      external_resolved_libs
-      |> List.map ~f:snd |> List.concat |> libs_sort
+      external_resolved_libs |> List.map ~f:snd |> List.concat |> libs_sort
     in
     User_message.print
       (User_message.make
          [ Pp.textf
              "These are the external library dependencies in the %s context:"
              context_name
          ; pp_external_libs external_libs
-         ]))
+         ])
 
 let term =
   let+ common = Common.term
@@ -207,7 +247,10 @@ let term =
       value & flag
       & info [ "missing" ] ~doc:{|Only print out missing dependencies|})
   and+ sexp =
-    Arg.(value & flag & info [ "sexp" ] ~doc:{|Produce a s-expression output of dependencies by dir|})
+    Arg.(
+      value & flag
+      & info [ "sexp" ]
+          ~doc:{|Produce a s-expression output of dependencies by dir|})
   and+ context_name = Common.context_arg ~doc:"Build context to use." in
   let config = Common.init common in
   let external_resolved_libs =

src/dune_lang/action.ml

@@ -398,6 +398,31 @@ let rec map_string_with_vars t ~f =
   | Pipe (o, ts) -> Pipe (o, List.map ts ~f:(map_string_with_vars ~f))
   | Cram sw -> Cram (f sw)
 
+let rec list_of_string_with_vars t =
+  match t with
+  | Run (sw, xs) -> sw :: xs
+  | With_accepted_exit_codes (_, t) -> list_of_string_with_vars t
+  | Dynamic_run (sw, sws) -> sw :: sws
+  | Chdir (sw, t) -> sw :: list_of_string_with_vars t
+  | Setenv (sw1, sw2, t) -> sw1 :: sw2 :: list_of_string_with_vars t
+  | Redirect_out (_, sw, _, t) -> sw :: list_of_string_with_vars t
+  | Redirect_in (_, sw, t) -> sw :: list_of_string_with_vars t
+  | Ignore (_, t) -> list_of_string_with_vars t
+  | Progn xs -> List.map ~f:list_of_string_with_vars xs |> List.concat
+  | Echo xs -> xs
+  | Cat xs -> xs
+  | Copy (sw1, sw2) -> [ sw1; sw2 ]
+  | Symlink (sw1, sw2) -> [ sw1; sw2 ]
+  | Copy_and_add_line_directive (sw1, sw2) -> [ sw1; sw2 ]
+  | System sw -> [ sw ]
+  | Bash sw -> [ sw ]
+  | Write_file (sw1, _, sw2) -> [ sw1; sw2 ]
+  | Mkdir sw -> [ sw ]
+  | Diff diff -> [ diff.file1; diff.file2 ]
+  | No_infer t -> list_of_string_with_vars t
+  | Pipe (_, ts) -> List.map ~f:list_of_string_with_vars ts |> List.concat
+  | Cram sw -> [ sw ]
+
 let remove_locs = map_string_with_vars ~f:String_with_vars.remove_locs
 
 let compare_no_locs t1 t2 = Poly.compare (remove_locs t1) (remove_locs t2)

src/dune_lang/action.mli

@@ -92,6 +92,8 @@ type t =
   | Pipe of Outputs.t * t list
   | Cram of String_with_vars.t
 
+val list_of_string_with_vars : t -> String_with_vars.t list
+
 include Conv.S with type t := t
 
 (** Raises User_error on invalid action. *)

src/dune_lang/string_with_vars.ml

@@ -14,6 +14,14 @@ type t =
   ; loc : Loc.t
   }
 
+let pforms t =
+  List.filter_map
+    ~f:(fun v ->
+      match v with
+      | Pform (_, pform) -> Some pform
+      | _ -> None)
+    t.parts
+
 let compare_no_loc { quoted; parts; loc = _ } t =
   let open Ordering.O in
   let= () = Bool.compare quoted t.quoted in

src/dune_lang/string_with_vars.mli

@@ -10,6 +10,8 @@ open Dune_util
 (** A sequence of text and variables. *)
 type t
 
+val pforms : t -> Pform.t list
+
 val compare_no_loc : t -> t -> Ordering.t
 
 val equal_no_loc : t -> t -> bool

src/dune_rules/expander.ml

@@ -840,3 +840,5 @@ let expand_locks ~base expander locks =
   Memo.List.map locks ~f:(expand_lock ~base expander)
 
 let sites t = t.sites
+
+let bindings t = t.bindings

src/dune_rules/expander.mli

@@ -141,3 +141,5 @@ val expand_locks :
   base:[ `Of_expander | `This of Path.t ] -> t -> Locks.t -> Path.t list Memo.t
 
 val sites : t -> Sites.t
+
+val bindings : t -> value Pform.Map.t

src/dune_rules/lib.mli

@@ -102,7 +102,7 @@ module DB : sig
   (** A database allow to resolve library names *)
   type t
 
-  val parent: t -> t option
+  val parent : t -> t option
 
   val installed : Context.t -> t Memo.t
 

test/blackbox-tests/test-cases/external-lib-deps/missing.t/run.t

@@ -14,4 +14,3 @@ Expected: Only required packages are hinted, and no wrapping occurs in the insta
   - optional (optional)
   Hint: try:
     opam install a________ b________ c________ d________ e________ f________ h________ i________ j________
-  [1]