unikernel/duniverse/dune_/test/blackbox-tests/utils/curl

@@ -0,0 +1,83 @@
+#!/usr/bin/env bash
+
+# our tiny drop in fake version of curl
+# needs to support
+# curl -V
+# curl -L -s  --user-agent foo --write-out "%{http_code}" -o <path> -- uri
+
+SOURCE_FILE=fake-curls
+REPEAT_FILE=already-served
+
+POSITIONAL_ARGS=()
+
+while [[ $# -gt 0 ]]; do
+  case $1 in
+    -V)
+      VERSIONINFO=YES
+      shift # past argument
+      ;;
+    -L|-s|--)
+      shift # past argument
+      ;;
+    -o|--extension)
+      OUTPUT="$2"
+      shift # past argument
+      shift # past value
+      ;;
+    --user-agent|--write-out)
+      shift # past argument
+      shift # past value
+      ;;
+    -*|--*)
+      echo "Unknown option $1"
+      exit 1
+      ;;
+    *)
+      POSITIONAL_ARGS+=("$1") # save positional arg
+      shift # past argument
+      ;;
+  esac
+done
+
+set -- "${POSITIONAL_ARGS[@]}" # restore positional parameters
+
+if [ "$VERSIONINFO" = "YES" ]; then
+  echo "curl 0.0.0 (dune-fake)"
+  exit 0
+fi
+
+# read the offset from the URL
+PORT_OFFSET=$(echo "$POSITIONAL_ARGS" | grep -Eo ':[0-9]+' | grep -o '[0-9]*')
+
+POSSIBLE_FILES=$(wc -l < "$SOURCE_FILE")
+
+write_out() {
+  # --write_out "${http_code}" does not write a newline
+  echo -n \"$1\"
+}
+
+>&2 echo '$POSSIBLE_FILES' \""$POSSIBLE_FILES"\" '$PORT_OFFSET' \""$PORT_OFFSET"\"
+
+if [ ! -f "$REPEAT_FILE" ]; then
+  file_already_served=false
+else
+  if grep "^$PORT_OFFSET\$" "$REPEAT_FILE" 2>/dev/null 1>&2 ; then
+    file_already_served=true
+  else
+    file_already_served=false
+  fi
+fi
+
+>&2 echo File already served: $file_already_served
+
+if [ $PORT_OFFSET -gt $POSSIBLE_FILES ] || [ $file_already_served = true ]; then
+  >&2 echo "Failing the download"
+  write_out 404
+else
+  >&2 echo "Succeeding the download"
+  # read the line signified by the port from the file
+  INPUT=$(head -n "$PORT_OFFSET" "$SOURCE_FILE" | tail -n 1)
+  echo "$PORT_OFFSET" >> "$REPEAT_FILE"
+  cp "$INPUT" "$OUTPUT"
+  write_out 200
+fi

unikernel/duniverse/dune_/test/blackbox-tests/utils/dune

@@ -0,0 +1,39 @@
+(executable
+ (name dune_cmd)
+ (modules dune_cmd)
+ (libraries
+  stdune
+  dune-private-libs.dune_re
+  dune-configurator
+  build_path_prefix_map
+  str
+  unix))
+
+(ocamllex dunepp)
+
+(executable
+ (modules dunepp)
+ (name dunepp))
+
+(executable
+ (modules melc_stdlib_prefix)
+ (name melc_stdlib_prefix)
+ (libraries stdune unix))
+
+(executable
+ (name refmt)
+ (modules refmt))
+
+(executable
+ (name sherlodoc)
+ (modules sherlodoc)
+ (libraries stdune))
+
+(executable
+ (modules ocaml_index)
+ (name ocaml_index)
+ (libraries cmdliner))
+
+(executable
+ (modules ocamlformat)
+ (name ocamlformat))

unikernel/duniverse/dune_/test/blackbox-tests/utils/dune_cmd.ml

@@ -0,0 +1,352 @@
+open Stdune
+module Re = Dune_re
+
+let commands = Table.create (module String) 10
+
+let register name of_args run =
+  Table.add_exn commands name (fun args ->
+    let t = of_args args in
+    run t)
+;;
+
+(* Doesn't follow the symlinks! *)
+module Stat = struct
+  type data =
+    | Hardlinks
+    | Permissions
+    | Size
+    | Kind
+
+  type t =
+    { file : Path.t
+    ; data : data
+    }
+
+  let data_of_string = function
+    | "size" -> Size
+    | "hardlinks" -> Hardlinks
+    | "permissions" -> Permissions
+    | "kind" -> Kind
+    | s ->
+      raise
+        (Arg.Bad
+           (sprintf "%s is invalid. hardlinks, permissions are only valid options" s))
+  ;;
+
+  let pp_stats data (stats : Unix.stats) =
+    match data with
+    | Size -> Int.to_string stats.st_size
+    | Hardlinks -> Int.to_string stats.st_nlink
+    | Permissions -> sprintf "%o" stats.st_perm
+    | Kind -> sprintf "%s" (File_kind.to_string_hum stats.st_kind)
+  ;;
+
+  let name = "stat"
+
+  let of_args = function
+    | [ data; file ] ->
+      let data = data_of_string data in
+      let file = Path.of_filename_relative_to_initial_cwd file in
+      { file; data }
+    | _ -> raise (Arg.Bad (sprintf "2 arguments must be provided"))
+  ;;
+
+  let run { file; data } =
+    let stats = Path.lstat_exn file in
+    print_endline (pp_stats data stats)
+  ;;
+
+  let () = register name of_args run
+end
+
+module Wait_for_fs_clock_to_advance = struct
+  let name = "wait-for-fs-clock-to-advance"
+
+  let of_args = function
+    | [] -> ()
+    | _ -> raise (Arg.Bad ("Usage: dune_cmd " ^ name))
+  ;;
+
+  let run () =
+    let fn = "." ^ name ^ ".tmp" in
+    let fstime () =
+      Unix.close (Unix.openfile fn [ O_WRONLY; O_CREAT; O_TRUNC ] 0o644);
+      let t = (Unix.stat fn).st_ctime in
+      Unix.unlink fn;
+      t
+    in
+    let t = fstime () in
+    while fstime () <= t do
+      Unix.sleepf 0.01
+    done
+  ;;
+
+  let () = register name of_args run
+end
+
+module Cat = struct
+  let name = "cat"
+
+  let of_args = function
+    | [ file ] -> file
+    | _ -> raise (Arg.Bad "Usage: dune_cmd cat <file>")
+  ;;
+
+  let run p = print_string (Io.String_path.read_file p)
+  let () = register name of_args run
+end
+
+module Exists = struct
+  type t = Path of Path.t
+
+  let name = "exists"
+
+  let of_args = function
+    | [ path ] -> Path (Path.of_filename_relative_to_initial_cwd path)
+    | _ -> raise (Arg.Bad "Usage: dune_cmd exists <path>")
+  ;;
+
+  let run (Path path) = print_string (Path.exists path |> Bool.to_string)
+  let () = register name of_args run
+end
+
+module Expand_lines = struct
+  let name = "expand_lines"
+
+  let of_args = function
+    | [] -> ()
+    | _ -> raise (Arg.Bad ("Usage: dune_cmd " ^ name))
+  ;;
+
+  let run () =
+    let re = Re.compile (Re.str "\\n") in
+    set_binary_mode_in stdin true;
+    set_binary_mode_out stdout true;
+    let rec loop () =
+      match input_line stdin with
+      | exception End_of_file -> ()
+      | s ->
+        print_endline (Re.replace_string ~all:true re s ~by:"\n");
+        loop ()
+    in
+    loop ()
+  ;;
+
+  let () = register name of_args run
+end
+
+module Sanitizer = struct
+  module Configurator = Configurator.V1
+
+  let make_ext_replace config =
+    let tbl =
+      List.filter_map
+        [ "ext_exe"; "ext_dll"; "ext_asm"; "ext_lib"; "ext_obj" ]
+        ~f:(fun var ->
+          match Configurator.ocaml_config_var config var with
+          | Some "" -> None
+          | Some s -> Some (s, "$" ^ var)
+          | None ->
+            (match var, Configurator.ocaml_config_var config "system" with
+             | "ext_exe", Some "Win32" -> Some (".exe", var)
+             | _ -> None))
+    in
+    let re =
+      Re.(
+        compile
+          (seq [ diff any (char '/'); alt (List.map tbl ~f:(fun (s, _) -> str s)); eow ]))
+    in
+    let map = String.Map.of_list_reduce tbl ~f:(fun _ x -> x) in
+    fun s ->
+      Re.replace re s ~f:(fun g ->
+        let s = Re.Group.get g 0 in
+        sprintf "%c%s" s.[0] (String.Map.find_exn map (String.drop s 1)))
+  ;;
+
+  let name = "sanitize"
+
+  let of_args = function
+    | [] -> ()
+    | _ -> raise (Arg.Bad "Usage: dune_cmd sanitize takes no arguments")
+  ;;
+
+  let run () =
+    let config = Configurator.create "sanitizer" in
+    let sanitize = make_ext_replace config in
+    let rec loop () =
+      match input_line stdin with
+      | exception End_of_file -> ()
+      | line ->
+        print_endline (sanitize line);
+        loop ()
+    in
+    loop ()
+  ;;
+
+  let () = register name of_args run
+end
+
+module Count_lines = struct
+  type t =
+    | Stdin
+    | File of Path.t
+
+  let name = "count-lines"
+
+  let count_lines ic =
+    let rec loop n =
+      match input_line ic with
+      | exception End_of_file -> n
+      | _line -> loop (n + 1)
+    in
+    loop 0
+  ;;
+
+  let of_args = function
+    | [] -> Stdin
+    | [ file ] -> File (Path.of_filename_relative_to_initial_cwd file)
+    | _ -> raise (Arg.Bad "Usage: dune_cmd count-lines <file>")
+  ;;
+
+  let run t =
+    let n =
+      match t with
+      | Stdin -> count_lines stdin
+      | File p -> Io.with_file_in p ~binary:false ~f:count_lines
+    in
+    Printf.printf "%d\n%!" n
+  ;;
+
+  let () = register name of_args run
+end
+
+module Override_on = struct
+  module Configurator = Configurator.V1
+
+  type t =
+    { system_to_override_on : string
+    ; desired_output : string
+    }
+
+  let name = "override-on"
+
+  let copy_stdin () =
+    let rec loop () =
+      match input_line stdin with
+      | exception End_of_file -> ()
+      | line ->
+        print_endline line;
+        loop ()
+    in
+    loop ()
+  ;;
+
+  let of_args = function
+    | [ system_to_override_on; desired_output ] ->
+      { system_to_override_on; desired_output }
+    | _ ->
+      raise
+        (Arg.Bad "Usage: dune_cmd override-on <system-to-override-on> <desired-output>")
+  ;;
+
+  let run { system_to_override_on; desired_output } =
+    let config = Configurator.create "override-on" in
+    match Configurator.ocaml_config_var config "system" with
+    | Some system when String.equal system system_to_override_on ->
+      print_endline desired_output
+    | _ -> copy_stdin ()
+  ;;
+
+  let () = register name of_args run
+end
+
+module Rewrite_path = struct
+  let name = "rewrite-path"
+
+  let of_args = function
+    | [ path ] -> path
+    | _ -> raise (Arg.Bad "Usage: dune_cmd rewrite-path <path>")
+  ;;
+
+  let run path =
+    match Build_path_prefix_map.decode_map (Sys.getenv "BUILD_PATH_PREFIX_MAP") with
+    | Error msg -> failwith msg
+    | Ok map -> print_string (Build_path_prefix_map.rewrite map path)
+  ;;
+
+  let () = register name of_args run
+end
+
+module Find_by_contents = struct
+  let name = "find-file-by-contents-regexp"
+
+  let of_args = function
+    | [ path; contents_regexp ] -> path, Str.regexp contents_regexp
+    | _ -> raise (Arg.Bad "Usage: dune_cmd find-files-by-contents-regexp <path> <regexp>")
+  ;;
+
+  let rec find_files ~dir regexp : _ list =
+    List.concat_map
+      (List.sort (Sys.readdir dir |> Array.to_list) ~compare:String.compare)
+      ~f:(fun name ->
+        let path = Filename.concat dir name in
+        let stats = Unix.stat path in
+        match stats.st_kind with
+        | S_DIR -> find_files ~dir:path regexp
+        | S_REG ->
+          let s = Io.String_path.read_file path in
+          if Str.string_match regexp s 0 then [ Printf.sprintf "%s\n" path ] else []
+        | _other -> [])
+  ;;
+
+  let run (dir, regexp) =
+    match find_files ~dir regexp with
+    | [] ->
+      Format.eprintf "No files found matching pattern@.%!";
+      exit 1
+    | [ res ] -> Printf.printf "%s\n" res
+    | _ :: _ as files ->
+      Format.eprintf "Multiple files found matching pattern@.%!";
+      List.iter files ~f:(fun file -> Printf.printf "%s\n%!" file);
+      exit 1
+  ;;
+
+  let () = register name of_args run
+end
+
+module Wait_for_file_to_appear = struct
+  type t = { file : Path.t }
+
+  let name = "wait-for-file-to-appear"
+
+  let of_args = function
+    | [ file ] ->
+      let file = Path.of_filename_relative_to_initial_cwd file in
+      { file }
+    | _ -> raise (Arg.Bad (sprintf "1 argument must be provided"))
+  ;;
+
+  let run { file } =
+    while not (Path.exists file) do
+      Unix.sleepf 0.01
+    done
+  ;;
+
+  let () = register name of_args run
+end
+
+let () =
+  let name, args =
+    match Array.to_list Sys.argv with
+    | _ :: name :: args -> name, args
+    | [] -> assert false
+    | [ _ ] ->
+      Format.eprintf "No arguments passed@.%!";
+      exit 1
+  in
+  match Table.find commands name with
+  | None ->
+    Format.eprintf "No command %S name found" name;
+    exit 1
+  | Some run -> run args
+;;

unikernel/duniverse/dune_/test/blackbox-tests/utils/dune_cmd.mli

@@ -0,0 +1,6 @@
+(** This command line utility is used to implement portable commands used in the
+    cram test. For example, it's used to implement a portable version of stat.
+
+    This command is invoked like this:
+
+    [$ dune_cmd <subcommand> arguments] *)

unikernel/duniverse/dune_/test/blackbox-tests/utils/dunepp.mll

@@ -0,0 +1,29 @@
+rule main = parse
+  | eof { () }
+  | "_STRING_" { Printf.printf "%S" "Hello, world!"; main lexbuf }
+  | _ as c { print_char c; main lexbuf }
+
+{
+  let () =
+    set_binary_mode_out stdout true;
+    let (input, pp_cwd, deps) =
+      match Array.to_list Sys.argv with
+      | _ :: input :: pp_cwd :: deps -> (input, Some pp_cwd, deps)
+      | _ :: [input] -> (input, None, [])
+      | _ -> assert false
+    in
+    begin match pp_cwd with
+    | None -> ()
+    | Some _ -> Printf.eprintf "running preprocessor in %s\n" (Sys.getcwd ())
+    end;
+    ListLabels.iter deps ~f:(fun f ->
+      Printf.eprintf "dep %s exists = %b\n" f (Sys.file_exists f);
+      begin match pp_cwd with
+      | None -> ()
+      | Some pp_cwd ->
+        let f = Filename.concat pp_cwd f in
+        Printf.eprintf "dep %s exists = %b\n" f (Sys.file_exists f)
+      end
+    );
+    main (Lexing.from_channel (open_in_bin input))
+}

unikernel/duniverse/dune_/test/blackbox-tests/utils/melc_stdlib_prefix.ml

@@ -0,0 +1,28 @@
+open Stdune
+
+let command cmd args =
+  let p = Unix.open_process_args_in cmd (Array.of_list (cmd :: args)) in
+  let output =
+    match Io.read_all_unless_large p with
+    | Ok x -> x
+    | Error () -> assert false
+  in
+  match Unix.close_process_in p with
+  | WEXITED 0 -> Ok output
+  | WEXITED n -> Error n
+  | WSIGNALED _ | WSTOPPED _ -> assert false
+;;
+
+let () =
+  let where = command "melc" [ "--where" ] in
+  match where with
+  | Error n ->
+    Format.eprintf "error: %d@." n;
+    exit 2
+  | Ok where ->
+    let parts =
+      List.map (Bin.parse_path where) ~f:(fun part ->
+        Format.asprintf "/MELC_STDLIB=%s" (part |> Path.parent_exn |> Path.to_string))
+    in
+    Format.printf "%s" (String.concat parts ~sep:":")
+;;

unikernel/duniverse/dune_/test/blackbox-tests/utils/ocaml_index.ml

@@ -0,0 +1,107 @@
+(** Mock ocaml-index real CLI *)
+
+open Cmdliner
+
+let touch file =
+  let chan = open_out file in
+  close_out chan
+;;
+
+module Common = struct
+  let set_log_level _ _ = ()
+
+  let verbose =
+    let doc = "increase log verbosity" in
+    Arg.(value & flag & info [ "v"; "verbose" ] ~doc)
+  ;;
+
+  let debug =
+    let doc = "set maximum log verbosity" in
+    Arg.(value & flag & info [ "debug" ] ~doc)
+  ;;
+
+  let with_log = Term.(const set_log_level $ debug $ verbose)
+
+  let output_file =
+    let doc = "name of the generated index" in
+    Arg.(value & opt string "project.ocaml-index" & info [ "o"; "output-file" ] ~doc)
+  ;;
+end
+
+module Aggregate = struct
+  let from_files _ _ output_file _ _ _ () = touch output_file
+
+  let root =
+    let doc = "if provided all locations will be appended to that path" in
+    Arg.(value & opt (some string) None & info [ "root" ] ~doc)
+  ;;
+
+  let files =
+    let doc = "the files to index" in
+    Arg.(value & pos_all string [] & info [] ~doc)
+  ;;
+
+  let build_path =
+    let doc = "an extra directory to add to the load path" in
+    Arg.(value & opt_all string [] & info [ "I" ] ~doc)
+  ;;
+
+  let store_shapes =
+    let doc = "aggregate input-indexes shapes and store them in the new index" in
+    Arg.(value & flag & info [ "store-shapes" ] ~doc)
+  ;;
+
+  let no_cmt =
+    let doc = "" in
+    Arg.(value & flag & info [ "no-cmt-load-path" ] ~doc)
+  ;;
+
+  let term =
+    Term.(
+      const from_files
+      $ store_shapes
+      $ root
+      $ Common.output_file
+      $ build_path
+      $ no_cmt
+      $ files
+      $ Common.with_log)
+  ;;
+
+  let cmd =
+    let info =
+      let doc = "builds the index for a single $(i, .cmt) file" in
+      Cmd.info "aggregate" ~doc
+    in
+    Cmd.v info term
+  ;;
+end
+
+module Dump = struct
+  let dump file () = Printf.printf "Dump %s" file
+
+  let file =
+    let doc = "the file to dump" in
+    Arg.(required & pos 0 (some string) None & info [] ~doc)
+  ;;
+
+  let term = Term.(const dump $ file $ Common.with_log)
+
+  let cmd =
+    let info =
+      let doc = "print the content of an index file to stdout" in
+      Cmd.info "dump" ~doc
+    in
+    Cmd.v info term
+  ;;
+end
+
+let subcommands =
+  let info =
+    let doc = "An indexer for OCaml's artifacts" in
+    Cmd.info "ocaml-index" ~doc
+  in
+  Cmd.group info ~default:Aggregate.term [ Aggregate.cmd; Dump.cmd ]
+;;
+
+let () = exit (Cmd.eval subcommands)

unikernel/duniverse/dune_/test/blackbox-tests/utils/ocamlformat.ml

@@ -0,0 +1,16 @@
+(* This can be used when testing formatting rules instead of calling the real
+   ocamlformat binary. But when doing so, be careful not to expose it to too
+   many tests because it will be also be used by `@fmt` in dune itself.
+*)
+
+let () =
+  let args =
+    Sys.argv
+    |> Array.to_list
+    |> List.tl
+    |> List.map (fun s -> Printf.sprintf "%S" s)
+    |> String.concat " "
+  in
+  Printf.eprintf "fake ocamlformat is running: %s\n" args;
+  Printf.printf "(* fake ocamlformat output *)"
+;;

unikernel/duniverse/dune_/test/blackbox-tests/utils/refmt.ml

@@ -0,0 +1,57 @@
+let sprintf = Printf.sprintf
+
+type ('impl, 'intf) intf_or_impl =
+  | Impl of 'impl
+  | Intf of 'intf
+
+module File = struct
+  let of_filename s = if Filename.check_suffix s ".rei" then Intf s else Impl s
+
+  let output_fn = function
+    | Impl fn -> fn ^ ".ml"
+    | Intf fn -> fn ^ ".mli"
+  ;;
+end
+
+let () =
+  let set_binary = function
+    | "binary" -> ()
+    | _ -> failwith "Only the value 'binary' is allowed for --parse / --print"
+  in
+  let args =
+    [ "--print", Arg.String set_binary, ""
+    ; "--parse", Arg.String set_binary, ""
+    ; "-i", Arg.Bool ignore, ""
+    ]
+  in
+  let source = ref None in
+  let anon s =
+    match !source with
+    | None -> source := Some s
+    | Some _ -> failwith "source may be set only once"
+  in
+  Arg.parse args anon "";
+  let source =
+    match !source with
+    | None -> failwith "source file isn't set"
+    | Some s -> s
+  in
+  let ic = open_in source in
+  let source_file = File.of_filename source in
+  let out_fn = File.output_fn source_file in
+  let out = open_out_bin out_fn in
+  output_string out (sprintf "# 1 %S\n" source);
+  let rec loop () =
+    match input_char ic with
+    | exception End_of_file -> ()
+    | s ->
+      output_char out s;
+      loop ()
+  in
+  loop ();
+  close_out_noerr out;
+  let inch = open_in_bin out_fn in
+  let contents = really_input_string inch (in_channel_length inch) in
+  close_in inch;
+  Printf.printf "%s" contents
+;;

unikernel/duniverse/dune_/test/blackbox-tests/utils/sherlodoc.ml

@@ -0,0 +1,44 @@
+(** Test double for sherlodoc: it understands `js` and `index` commands, and
+    creates their output files. *)
+
+open Stdune
+
+let arg_db = ref ""
+let args_favored = ref []
+
+let args_index =
+  [ "--format", Arg.String ignore, ""
+  ; "--favoured-prefixes", Arg.String ignore, ""
+  ; ( "--favoured"
+    , Arg.String (fun fav_odocl -> args_favored := fav_odocl :: !args_favored)
+    , "" )
+  ; "--db", Arg.Set_string arg_db, ""
+  ]
+;;
+
+let parse_index_args args =
+  let inputs = ref [] in
+  Arg.parse_argv
+    (Array.of_list args)
+    args_index
+    (fun input -> inputs := input :: !inputs)
+    "";
+  !inputs, !arg_db
+;;
+
+let () =
+  match Array.to_list Sys.argv with
+  | [] -> assert false
+  | [ _; "js"; output ] ->
+    Out_channel.with_open_bin output (fun oc ->
+      Out_channel.output_string oc "/* Output of sherlodoc js */\n")
+  | _ :: "index" :: index_args ->
+    let deps, target = parse_index_args index_args in
+    Out_channel.with_open_bin target (fun oc ->
+      Out_channel.output_string oc "/* Sherlodoc DB for: */\n";
+      List.iter deps ~f:(fun dep -> Printf.fprintf oc "/*   - %s */\n" dep);
+      List.iter !args_favored ~f:(fun dep ->
+        Printf.fprintf oc "/*   - --favored %s */\n" dep))
+  | _ :: args ->
+    Printf.ksprintf failwith "sherlodoc(fake): %s" (String.concat ~sep:"," args)
+;;