Fix post-processing of dune-package

- dune-site should replace paths in "sections", not "sites" - paths' substitution should be done in all cases (not only when a version is added to dune-package) fix #4389 Signed-off-by: Pierre-Yves Strub <[email protected]>
ocaml · Nov 20, 2021 · 0281cf2 · 0281cf2
1 parent a76e31f
commit 0281cf2
Show file tree

Hide file tree

Showing 6 changed files with 67 additions and 82 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -299,6 +299,8 @@ Unreleased
 2.9.2 (unreleased)
 ------------------
 
+- Fix post-processing of dune-package (fix #4389, @strub)
+
 - No longer reference deprecated Toploop functions when using dune files in
   OCaml syntax. (#4834, fixes #4830, @nojb)
 

diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml
@@ -133,8 +133,9 @@ module File_ops_real (W : Workspace) : File_operations = struct
   let get_vcs p = Dune_engine.Source_tree.nearest_vcs p
 
   type load_special_file_result =
-    | No_version_needed
-    | Need_version of (Format.formatter -> version:string -> unit)
+    { need_version : bool
+    ; callback : ?version:string -> Format.formatter -> unit
+    }
 
   let copy_special_file ~src ~package ~ic ~oc ~f =
     let open Fiber.O in
@@ -143,31 +144,34 @@ module File_ops_real (W : Workspace) : File_operations = struct
       Io.copy_channels ic oc;
       Fiber.return ()
     in
+
     match f ic with
+    | Some { need_version; callback } ->
+      let* version =
+        if need_version then
+          let* packages =
+            match Package.Name.Map.find workspace.packages package with
+            | None -> Fiber.return None
+            | Some package -> Memo.Build.run (get_vcs (Package.dir package))
+          in
+          match packages with
+          | None -> Fiber.return None
+          | Some vcs -> Memo.Build.run (Dune_engine.Vcs.describe vcs)
+        else
+          Fiber.return None
+      in
+      let ppf = Format.formatter_of_out_channel oc in
+      callback ppf ?version;
+      Format.pp_print_flush ppf ();
+      Fiber.return ()
+    | None -> plain_copy ()
     | exception _ ->
       User_warning.emit ~loc:(Loc.in_file src)
         [ Pp.text
             "Failed to parse file, not adding version and locations \
              information."
         ];
       plain_copy ()
-    | No_version_needed -> plain_copy ()
-    | Need_version print -> (
-      (match Package.Name.Map.find workspace.packages package with
-      | None -> Fiber.return None
-      | Some package -> Memo.Build.run (get_vcs (Package.dir package)))
-      >>= function
-      | None -> plain_copy ()
-      | Some vcs -> (
-        let open Fiber.O in
-        let* version = Memo.Build.run (Dune_engine.Vcs.describe vcs) in
-        match version with
-        | None -> plain_copy ()
-        | Some version ->
-          let ppf = Format.formatter_of_out_channel oc in
-          print ppf ~version;
-          Format.pp_print_flush ppf ();
-          Fiber.return ()))
 
   let process_meta ic =
     let lb = Lexing.from_channel ic in
@@ -185,15 +189,15 @@ module File_ops_real (W : Workspace) : File_operations = struct
       | Exit -> true
     in
     if not need_more_versions then
-      No_version_needed
+      None
     else
-      Need_version
-        (fun ppf ~version ->
-          let meta =
-            Dune_rules.Meta.add_versions meta ~get_version:(fun _ ->
-                Some version)
-          in
-          Pp.to_fmt ppf (Dune_rules.Meta.pp meta.entries))
+      let callback ?version ppf =
+        let meta =
+          Dune_rules.Meta.add_versions meta ~get_version:(fun _ -> version)
+        in
+        Pp.to_fmt ppf (Dune_rules.Meta.pp meta.entries)
+      in
+      Some { need_version = true; callback }
 
   let replace_sites
       ~(get_location : Dune_engine.Section.t -> Package.Name.t -> Stdune.Path.t)
@@ -206,9 +210,9 @@ module File_ops_real (W : Workspace) : File_operations = struct
     | None -> dp
     | Some name ->
       List.map dp ~f:(function
-        | Dune_lang.List ((Atom (A "sites") as sexp_sites) :: sites) ->
-          let sites =
-            List.map sites ~f:(function
+        | Dune_lang.List ((Atom (A "sections") as sexp_sections) :: sections) ->
+          let sections =
+            List.map sections ~f:(function
               | Dune_lang.List [ (Atom (A section) as section_sexp); _ ] ->
                 let path =
                   get_location
@@ -219,7 +223,7 @@ module File_ops_real (W : Workspace) : File_operations = struct
                 pair sexp string (section_sexp, Path.to_absolute_filename path)
               | _ -> assert false)
           in
-          Dune_lang.List (sexp_sites :: sites)
+          Dune_lang.List (sexp_sections :: sections)
         | x -> x)
 
   let process_dune_package ~get_location ic =
@@ -231,35 +235,38 @@ module File_ops_real (W : Workspace) : File_operations = struct
     (* replace sites with external path in the file *)
     let dp = replace_sites ~get_location dp in
     (* replace version if needed in the file *)
-    if
-      List.exists dp ~f:(function
-        | Dune_lang.List (Atom (A "version") :: _)
-        | Dune_lang.List [ Atom (A "use_meta"); Atom (A "true") ]
-        | Dune_lang.List [ Atom (A "use_meta") ] ->
-          true
-        | _ -> false)
-    then
-      No_version_needed
-    else
-      Need_version
-        (fun ppf ~version ->
+    let need_version =
+      not
+        (List.exists dp ~f:(function
+          | Dune_lang.List (Atom (A "version") :: _)
+          | Dune_lang.List [ Atom (A "use_meta"); Atom (A "true") ]
+          | Dune_lang.List [ Atom (A "use_meta") ] ->
+            true
+          | _ -> false))
+    in
+    let callback ?version ppf =
+      let dp =
+        match version with
+        | Some version -> (
           let version =
             Dune_lang.List
               [ Dune_lang.atom "version"
               ; Dune_lang.atom_or_quoted_string version
               ]
           in
-          let dp =
-            match dp with
-            | lang :: name :: rest -> lang :: name :: version :: rest
-            | [ lang ] -> [ lang; version ]
-            | [] -> [ version ]
-          in
-          Format.pp_open_vbox ppf 0;
-          List.iter dp ~f:(fun x ->
-              Dune_lang.Deprecated.pp ppf x;
-              Format.pp_print_cut ppf ());
-          Format.pp_close_box ppf ())
+          match dp with
+          | lang :: name :: rest -> lang :: name :: version :: rest
+          | [ lang ] -> [ lang; version ]
+          | [] -> [ version ])
+        | _ -> dp
+      in
+      Format.pp_open_vbox ppf 0;
+      List.iter dp ~f:(fun x ->
+          Dune_lang.Deprecated.pp ppf x;
+          Format.pp_print_cut ppf ());
+      Format.pp_close_box ppf ()
+    in
+    Some { need_version; callback }
 
   let copy_file ~src ~dst ~executable ~special_file ~package
       ~(conf : Dune_rules.Artifact_substitution.conf) =

diff --git a/otherlibs/site/test/github4389.t/run.t b/otherlibs/site/test/github4389.t/run.t
@@ -2,13 +2,11 @@
   $ dune install --prefix _install
   Installing _install/lib/github4389/META
   Installing _install/lib/github4389/dune-package
-  File "_build/install/default/lib/github4389/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
   Installing _install/bin/main
   $ grep sites _install/lib/github4389/dune-package
   (sites (github4389 share))
   $ grep -o '[^ ]*/_install/share/github4389' _install/lib/github4389/dune-package
-  [1]
+  $TESTCASE_ROOT/_install/share/github4389
   $ _install/bin/main
   n/a
   $TESTCASE_ROOT/_install/share/github4389/github4389
diff --git a/otherlibs/site/test/github4389_without_build_info.t/run.t b/otherlibs/site/test/github4389_without_build_info.t/run.t
@@ -2,12 +2,10 @@
   $ dune install --prefix _install
   Installing _install/lib/github4389/META
   Installing _install/lib/github4389/dune-package
-  File "_build/install/default/lib/github4389/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
   Installing _install/bin/main
   $ grep sites _install/lib/github4389/dune-package
   (sites (github4389 share))
   $ grep -o '[^ ]*/_install/share/github4389' _install/lib/github4389/dune-package
-  [1]
+  $TESTCASE_ROOT/_install/share/github4389
   $ _install/bin/main
   $TESTCASE_ROOT/_install/share/github4389/github4389
diff --git a/otherlibs/site/test/run.t b/otherlibs/site/test/run.t
@@ -176,8 +176,6 @@ Test with an opam like installation
   [1]
 
   $ dune install -p a --create-install-files a 2>&1 | sed -e "/^Copying/d"
-  File "_build/install/default/lib/a/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
 
   $ grep "_destdir" a/a.install -c
   7
@@ -194,19 +192,11 @@ Test with a normal installation
 --------------------------------
 
   $ dune install --prefix _install 2>&1 | sed -e "/^Installing/d"
-  File "_build/install/default/lib/a/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/b/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/c/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/d/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
 
 Once installed, we have the sites information:
 
   $ grep share/a _install/lib/a/dune-package
-    $TESTCASE_ROOT/_build/install/default/share/a))
+    $TESTCASE_ROOT/_install/share/a))
 
   $ OCAMLPATH=_install/lib:$OCAMLPATH _install/bin/c
   run a
@@ -224,14 +214,6 @@ Test with a relocatable installation
 --------------------------------
 
   $ dune install --prefix _install_relocatable --relocatable 2>&1 | sed -e "/^Installing/d"
-  File "_build/install/default/lib/a/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/b/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/c/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
-  File "_build/install/default/lib/d/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
 
 Once installed, we have the sites information:
 
@@ -372,8 +354,6 @@ Test compiling an external plugin
 
   $ OCAMLPATH=$(pwd)/_install/lib:$OCAMLPATH dune install --root=e --prefix $(pwd)/_install 2>&1 | sed -e "/^Installing/d"
   Entering directory 'e'
-  File "_build/install/default/lib/e/dune-package", line 1, characters 0-0:
-  Warning: Failed to parse file, not adding version and locations information.
 
   $ OCAMLPATH=_install/lib:$OCAMLPATH _install/bin/c
   run a

diff --git a/test/blackbox-tests/test-cases/deprecated-library-name/features.t b/test/blackbox-tests/test-cases/deprecated-library-name/features.t
@@ -59,7 +59,7 @@ tests that the "old_public_name" field is evaluated lazily
   (name a)
   (sections
    (lib
-    $TESTCASE_ROOT/a/_build/install/default/lib/a))
+    $TESTCASE_ROOT/a/../_install/lib/a))
   (files (lib (META dune-package)))
   (deprecated_library_name (old_public_name a) (new_public_name b))