Merge pull request #233 from AeneasVerif/son/borrow-check

Add a `-borrow-check` option

3 files changed, 50 insertions, 16 deletions

diff --git a/tests/test_runner/Backend.ml b/tests/test_runner/Backend.ml
index d21a46fc..819081a2 100644
--- a/tests/test_runner/Backend.ml
+++ b/tests/test_runner/Backend.ml
@@ -1,15 +1,24 @@
 (*** Define the backends we support as an enum *)
 
-type t = Coq | Lean | FStar | HOL4 [@@deriving ord, sexp]
+type t =
+  | Coq
+  | Lean
+  | FStar
+  | HOL4
+  | BorrowCheck
+      (** Borrow check: no backend.
+          We use this when we only want to borrow-check the program *)
+[@@deriving ord, sexp]
 
 (* TODO: reactivate HOL4 once traits are parameterized by their associated types *)
-let all = [ Coq; Lean; FStar ]
+let all = [ Coq; Lean; FStar; BorrowCheck ]
 
 let of_string = function
   | "coq" -> Coq
   | "lean" -> Lean
   | "fstar" -> FStar
   | "hol4" -> HOL4
+  | "borrow-check" -> BorrowCheck
   | backend -> failwith ("Unknown backend: `" ^ backend ^ "`")
 
 let to_string = function
@@ -17,6 +26,11 @@ let to_string = function
   | Lean -> "lean"
   | FStar -> "fstar"
   | HOL4 -> "hol4"
+  | BorrowCheck -> "borrow-check"
+
+let to_command = function
+  | BorrowCheck -> [ "-borrow-check" ]
+  | x -> [ "-backend"; to_string x ]
 
 module Map = struct
   (* Hack to be able to include things from the parent module with the same names *)
diff --git a/tests/test_runner/Input.ml b/tests/test_runner/Input.ml
index 960ffe8d..e35be96f 100644
--- a/tests/test_runner/Input.ml
+++ b/tests/test_runner/Input.ml
@@ -7,7 +7,7 @@ type action = Normal | Skip | KnownFailure
 type per_backend = {
   action : action;
   aeneas_options : string list;
-  subdir : string;
+  subdir : string option;
   (* Whether to store the command output to a file. Only available for known-failure tests. *)
   check_output : bool;
 }
@@ -22,8 +22,11 @@ type t = {
 }
 
 (* The default subdirectory in which to store the outputs. *)
-let default_subdir backend test_name =
-  match backend with Backend.Lean -> "." | _ -> test_name
+let default_subdir backend test_name : string option =
+  match backend with
+  | Backend.Lean -> Some "."
+  | Backend.BorrowCheck -> None
+  | _ -> Some test_name
 
 (* Parse lines that start `//@`. Each of them modifies the options we use for the test.
    Supported comments:
@@ -39,14 +42,21 @@ let default_subdir backend test_name =
 let apply_special_comment comment input =
   let comment = String.trim comment in
   (* Parse the backends if any *)
-  let re = Re.compile (Re.Pcre.re "^\\[([a-zA-Z,]+)\\](.*)$") in
+  let re = Re.compile (Re.Pcre.re "^\\[(!)?([a-zA-Z,-]+)\\](.*)$") in
   let comment, (backends : Backend.t list) =
     match Re.exec_opt re comment with
     | Some groups ->
-        let backends = Re.Group.get groups 1 in
+        let exclude = Re.Group.get_opt groups 1 <> None in
+        let backends = Re.Group.get groups 2 in
         let backends = String.split_on_char ',' backends in
         let backends = List.map Backend.of_string backends in
-        let rest = Re.Group.get groups 2 in
+        let rest = Re.Group.get groups 3 in
+        (* If [exclude]: we take all the backends *but* the list provided. *)
+        let backends =
+          if exclude then
+            List.filter (fun x -> not (List.mem x backends)) Backend.all
+          else backends
+        in
         (String.trim rest, backends)
     | None -> (comment, Backend.all)
   in
@@ -83,9 +93,9 @@ let apply_special_comment comment input =
     let args = String.split_on_char ' ' args in
     per_backend (fun x ->
         { x with aeneas_options = List.append x.aeneas_options args })
-  else if Option.is_some subdir then
-    let subdir = Option.get subdir in
-    per_backend (fun x -> { x with subdir })
+  else if Option.is_some subdir then (
+    assert (not (List.mem Backend.BorrowCheck backends));
+    per_backend (fun x -> { x with subdir }))
   else failwith ("Unrecognized special comment: `" ^ comment ^ "`")
 
 (* Given a path to a rust file or crate, gather the details and options about how to build the test. *)
diff --git a/tests/test_runner/run_test.ml b/tests/test_runner/run_test.ml
index c17c17be..0c3426c5 100644
--- a/tests/test_runner/run_test.ml
+++ b/tests/test_runner/run_test.ml
@@ -50,25 +50,35 @@ end
 (* Run Aeneas on a specific input with the given options *)
 let run_aeneas (env : runner_env) (case : Input.t) (backend : Backend.t) =
   let backend_str = Backend.to_string backend in
+  let backend_command = Backend.to_command backend in
   let input_file = concat_path [ env.llbc_dir; case.name ] ^ ".llbc" in
   let output_file =
     Filename.remove_extension case.path ^ "." ^ backend_str ^ ".out"
   in
+
   let per_backend = Backend.Map.find backend case.per_backend in
   let subdir = per_backend.subdir in
   let check_output = per_backend.check_output in
   let aeneas_options = per_backend.aeneas_options in
   let action = per_backend.action in
-  let dest_dir = concat_path [ env.dest_dir; backend_str; subdir ] in
+  (* No destination directory if we borrow-check *)
+  let dest_command =
+    match backend with
+    | Backend.BorrowCheck -> []
+    | _ ->
+        let subdir = match subdir with None -> [] | Some x -> [ x ] in
+        [ "-dest"; concat_path ([ env.dest_dir; backend_str ] @ subdir) ]
+  in
 
   (* Build the command *)
-  let args =
-    [ env.aeneas_path; input_file; "-dest"; dest_dir; "-backend"; backend_str ]
-  in
+  let args = [ env.aeneas_path; input_file ] @ dest_command @ backend_command in
+  (* If we target a specific backend and the test is known to fail, we abort
+     on error so as not to generate any files *)
   let abort_on_error =
     match action with
     | Skip | Normal -> []
-    | KnownFailure -> [ "-abort-on-error" ]
+    | KnownFailure ->
+        if backend = Backend.BorrowCheck then [] else [ "-abort-on-error" ]
   in
   let args = List.concat [ args; aeneas_options; abort_on_error ] in
   let cmd = Command.make args in