Add version corruption testcase and fix binary corruption

CHANGES.md

@@ -1,6 +1,9 @@
 Unreleased
 ----------
 
+- Fix binary corruption when installing or promoting in parallel (#6669, fixes
+  #6668, @edwintorok)
+
 - Fix running the RPC server on windows (#6721 fixes #6720, @rgrinberg)
 
 - Use colored output with GCC and Clang when compiling C stubs. The

src/dune_rules/artifact_substitution.ml

@@ -415,8 +415,6 @@ end
 
 let buf_len = max_len
 
-let buf = Bytes.create buf_len
-
 type mode =
   | Test
   | Copy of
@@ -469,6 +467,7 @@ output the replacement        |                                             |
     v} *)
 let parse ~input ~mode =
   let open Fiber.O in
+  let buf = Bytes.create buf_len in
   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 =

test/blackbox-tests/test-cases/dune

@@ -145,3 +145,7 @@
  (applies_to link-time-transitive-deps)
  (deps
   (package dune-build-info)))
+
+(cram
+ (applies_to version-corruption)
+ (deps %{bin:od} %{bin:git} %{bin:cmp} %{bin:sed} %{bin:chmod}))

test/blackbox-tests/test-cases/version-corruption.t

@@ -0,0 +1,122 @@
+Define a helper ./dump.sh unction with offsets removed, and one byte per line in
+hex (so that the output is compiler version / alignment independent).
+
+  $ cat >./dump.sh <<'EOF'
+  > set -eu
+  > od -v -A n -t x1 $1 | tr ' ' '\n' | sed '/^$/d'
+  > EOF
+  $ chmod +x ./dump.sh
+  $ cat >./compare.sh <<'EOF'
+  > set -eu
+  > ./dump.sh $1 >$1.dump
+  > ./dump.sh $2 >$2.dump
+  > cmp -l $1.dump $2.dump | wc -l | sed -e 's/^ *//'
+  > EOF
+  $ chmod +x compare.sh
+
+A repro that builds and installs multiple binaries, and promotes a bytecode and
+native executable in same rule (this is very likely to detect corruption with
+shared buffer):
+
+  $ git init --quiet
+  $ git commit -m init --allow-empty --quiet
+  $ git tag -a v0.0.1 -m v0.0.1
+  $ echo "(lang dune 2.0)" > dune-project
+  $ touch xapi-datamodel.opam
+  $ cat >dune <<EOF
+  > (executable
+  >   (modes byte exe)
+  >   (name gen_lifecycle)
+  >   (public_name gen_lifecycle)
+  >   (package xapi-datamodel)
+  >   (modules gen_lifecycle)
+  >   (libraries
+  >     dune-build-info)
+  >   (promote (until-clean)))
+  > ; use the binary promoted file from the source dir (not the build dir) that has
+  > ; the correct version number embedded
+  > (rule
+  >  (deps gen_lifecycle.exe)
+  >  (action (with-stdout-to datamodel_lifecycle.ml.generated (system %{project_root}/gen_lifecycle.exe))))
+  > (executables
+  >  (modes exe)
+  >  (public_names gen1)
+  >  (modules gen gen1)
+  >  (libraries dune-build-info))
+  > (executables
+  >  (modes byte)
+  >  (public_names gen2)
+  >  (modules genb gen2)
+  >  (libraries dune-build-info))
+  > EOF
+
+  $ cat >gen_lifecycle.ml <<EOF
+  > module Xapi_version = struct
+  >   let version, xapi_version_major, xapi_version_minor =
+  >     match Build_info.V1.version () with
+  >     | None -> ("0.0.0", 0, 0)
+  >     | Some v -> (
+  >         let str = Build_info.V1.Version.to_string v in
+  >         let version =
+  >           if String.starts_with ~prefix:"v" str then
+  >             String.sub str 1 (String.length str - 1)
+  >           else str
+  >         in
+  >         try
+  >           let maj, min =
+  >             Scanf.sscanf version "%d.%d.%s" (fun maj min _rest -> (maj, min))
+  >           in
+  >           (version, maj, min)
+  >         with _ ->
+  >           failwith
+  >             (Printf.sprintf
+  >                "Couldn't determine xapi version - got unexpected version from \
+  >                 dune: '%s'"
+  >                version))
+  > end
+  > let current_version =
+  >   print_endline Xapi_version.version;
+  >   print_endline Xapi_version.version;
+  >   print_endline Xapi_version.version;
+  >   print_endline Xapi_version.version;
+  >   Scanf.sscanf Xapi_version.version "%d.%d.%d%[.-]%s"
+  >     (fun mj mn mc _sep _rest -> Printf.sprintf "%d.%d.%d" mj mn mc)
+  > EOF
+
+  $ cp gen_lifecycle.ml gen.ml
+  $ cp gen_lifecycle.ml genb.ml
+  $ cat >gen1.ml <<EOF
+  > let ver_$i = Gen.current_version
+  > let () = prerr_endline "some string"
+  > EOF
+  $ cat >gen2.ml <<EOF
+  > let ver_$i = Genb.current_version
+  > let () = prerr_endline "some string2"
+  > EOF
+
+  $ rm -f gen_lifecycle.bc gen_lifecycle.exe && dune clean && dune build && ./gen_lifecycle.exe >/dev/null
+  $ cp _build/default/gen_lifecycle.exe gen_lifecycle.old
+
+  $ dune install -j16 --prefix=./_install 2>/dev/null
+  $ ./compare.sh _build/default/gen1.exe _install/bin/gen1
+  100
+
+  $ ./compare.sh _build/default/gen2.bc _install/bin/gen2
+  100
+
+  $ dune build --debug-artifact-substitution
+  Found placeholder in _build/default/gen_lifecycle.exe:
+  - placeholder: Vcs_describe "."
+  - evaluates to: "v0.0.1"
+  Found placeholder in _build/default/gen_lifecycle.bc:
+  - placeholder: Vcs_describe "."
+  - evaluates to: "v0.0.1"
+
+  $ ./compare.sh gen_lifecycle.old ./gen_lifecycle.exe
+  100
+
+  $ ./gen_lifecycle.exe
+  0.0.1
+  0.0.1
+  0.0.1
+  0.0.1