From b8d8c2f7c17fe316d480fbe4025f309a418a1226 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fabi=C3=A1n=20D=C3=ADaz?= Date: Mon, 27 Mar 2023 00:55:58 -0300 Subject: [PATCH 01/28] Update README.md --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index a5ed11c..65e3bf1 100644 --- a/README.md +++ b/README.md @@ -3,6 +3,9 @@ Black-Box Compiler Tester A simple library for black-box testing of compilers from the [Compiler Design and Implementation course at UChile](https://users.dcc.uchile.cl/~etanter/CC5116/). +## Fork goals +Original BBCTester runs a complete pipeline for an compiler to assembler and assembler execution. This fork will add the possibility to configure or modify the steps that will be executed in the pipeline to be able to use BBCTester in compiler tests for other languages. + ## Dependencies - dune (>= 2.9) - ocaml (>= 4.08.0) From 1e188ae4ab7ca18eda0413dc4a5059d92787cc2e Mon Sep 17 00:00:00 2001 From: fabaindaiz Date: Mon, 27 Mar 2023 20:56:30 +0100 Subject: [PATCH 02/28] add types to represent stage options --- dune | 4 ++-- dune-project | 4 ++-- test.ml | 51 ++++++++++++++++++++++++++++++++++++--------------- test.mli | 19 +++++++++++++++---- 4 files changed, 55 insertions(+), 23 deletions(-) diff --git a/dune b/dune index 6a58d6d..0076dcb 100644 --- a/dune +++ b/dune @@ -1,4 +1,4 @@ (library - (name bbctester) ; Black-Box Compiler Tester - (public_name bbctester) + (name bbcsteptester) ; Black-Box Compiler Tester + (public_name bbcsteptester) (libraries str alcotest containers containers.unix)) diff --git a/dune-project b/dune-project index 5370068..828e751 100644 --- a/dune-project +++ b/dune-project @@ -1,7 +1,7 @@ (lang dune 2.9) -(name bbctester) +(name bbcsteptester) ; Not using opam because of not understood bug with generated `dune subst --root` ; (generate_opam_files true) @@ -10,7 +10,7 @@ (maintainers "kenji@maillard.blue") (package - (name bbctester) + (name bbcsteptester) (version 0.1) (synopsis "Black-box compiler tester") (description "Tester for the compilation lecture CC5116") diff --git a/test.ml b/test.ml index 59db150..6738220 100644 --- a/test.ml +++ b/test.ml @@ -128,15 +128,29 @@ let nasm basefile = wrap_result @@ CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile +let read_whole_file filename = + let ch = open_in filename in + let s = really_input_string ch (in_channel_length ch) in + close_in ch; + s -type compiler = string -> out_channel -> unit +type runtime = +| CRuntime of string +| CompileOut + +type compiler = +| Compiler of (string -> out_channel -> unit) + +type oracle = +| Interp of (string -> status * string) +| Expected let make_test ~compile_flags - runtime + (runtime:runtime) ~(compiler:compiler) - ~oracle + ~(oracle:oracle) filename = match read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename @@ -147,15 +161,22 @@ let make_test let res = let* () = - try Ok (CCIO.with_out (base ^ ".s") (compiler test.src)) - with e -> Error (CTError, Printexc.to_string e) + match compiler with + | Compiler compiler -> + try Ok (CCIO.with_out (base ^ ".s") (compiler test.src)) + with e -> Error (CTError, Printexc.to_string e) in - let* () = nasm base in - let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then + match runtime with + | CRuntime runtime -> + let* () = nasm base in + let* () = clang ~compile_flags runtime base in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + | CompileOut -> + let out = (read_whole_file (base ^ ".s")) in Ok (process_output out) - else Error (RTError, out ^ err) in let res = match res with @@ -164,11 +185,11 @@ let make_test in let expected = - let i_oracle = CCString.find ~sub:"|ORACLE" test.expected in + let i_interp = CCString.find ~sub:"|INTERP" test.expected in match oracle with - | Some interp when test.status = NoError && i_oracle <> -1 -> - let prefix = CCString.sub test.expected 0 (max (i_oracle - 1) 0) in - let status , output = interp test.src in + | Interp oracle when test.status = NoError && i_interp <> -1 -> + let prefix = CCString.sub test.expected 0 (max (i_interp - 1) 0) in + let status , output = oracle test.src in status , prefix ^ output | _ -> test.status, test.expected in @@ -187,7 +208,7 @@ let name_from_file filename = let open Filename in dirname filename ^ "::" ^ basename (chop_extension filename) -let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ?oracle dir = +let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ~oracle dir = let open Alcotest in let to_test testfile = let testname, exec_test = make_test ~compile_flags runtime ~compiler ~oracle testfile in diff --git a/test.mli b/test.mli index f1bf916..910d4f7 100644 --- a/test.mli +++ b/test.mli @@ -50,9 +50,20 @@ type t = *) val read_test : string -> t option +val read_whole_file : string -> string + +type runtime = + | CRuntime of string + | CompileOut + (** A compiler is a function that takes a source program as a string, and an output channel as a sink to output the compiled program *) -type compiler = string -> out_channel -> unit +type compiler = + | Compiler of (string -> out_channel -> unit) + +type oracle = + | Interp of (string -> status * string) + | Expected (** [testfiles_in_dir path] collects the content of all thet `*.bbc` files found at [path]; uses `find` (GNU findutils) *) @@ -67,9 +78,9 @@ val testfiles_in_dir : string -> string list The optional [oracle] parameter is an oracle (eg. an interpreter, reference compiler) to be invoked on source files. It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) -val tests_from_dir : + val tests_from_dir : ?compile_flags:string -> - runtime:string -> + runtime:runtime -> compiler:compiler -> - ?oracle:(string -> status * string) -> + oracle:oracle -> string -> (string * unit Alcotest.test_case list) list From 26c28b83fa6ade2e86e242bd98d6fd0587054ca1 Mon Sep 17 00:00:00 2001 From: Docker Date: Wed, 23 Aug 2023 05:16:56 +0000 Subject: [PATCH 03/28] feat: some types changed & separates into multiple files --- dune | 1 + dune-project | 4 +- runtime.ml | 69 ++++++++++++++++++++++++ test.ml | 145 ++++----------------------------------------------- test.mli | 55 +------------------ type.ml | 40 ++++++++++++++ type.mli | 52 ++++++++++++++++++ util.ml | 43 +++++++++++++++ 8 files changed, 220 insertions(+), 189 deletions(-) create mode 100644 runtime.ml create mode 100644 type.ml create mode 100644 type.mli create mode 100644 util.ml diff --git a/dune b/dune index 0076dcb..7965e18 100644 --- a/dune +++ b/dune @@ -1,4 +1,5 @@ (library (name bbcsteptester) ; Black-Box Compiler Tester (public_name bbcsteptester) + (modules type runtime test util) (libraries str alcotest containers containers.unix)) diff --git a/dune-project b/dune-project index 828e751..aba0399 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.9) +(lang dune 3.10) (name bbcsteptester) @@ -11,7 +11,7 @@ (package (name bbcsteptester) - (version 0.1) + (version 0.2) (synopsis "Black-box compiler tester") (description "Tester for the compilation lecture CC5116") (depends diff --git a/runtime.ml b/runtime.ml new file mode 100644 index 0000000..9d89930 --- /dev/null +++ b/runtime.ml @@ -0,0 +1,69 @@ +open Type +open Util + + +(** Calling the compiler (clang) and assembler (nasm) *) + +(* Produce a result out of the return data from the compiler/assembler *) +let wrap_result (out, err, retcode) = + if retcode = 0 && String.equal "" err + then (print_string out ; Ok ()) + else Error (CTError, out ^ err) + +(* Find out current architecture (only supporting Linux/OS X for now) *) +let bin_format = + let out, _ , _ = CCUnix.call "uname -s" in + let arch = String.trim out in + match arch with + | "Linux" -> "elf64" + | "Darwin" -> "macho64" + | _ -> Fmt.failwith "Unknown architecture %s" arch + +let clang ~compile_flags runtime basefile = + wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile + +let nasm basefile = + wrap_result @@ CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile + + +let (let*) = Result.bind + + +let cruntime + ?(compile_flags: string ="-g") + (runtime : string) = + fun + (test : t) + (filename : string) -> + let base = Filename.chop_extension filename in + let exe = base ^ ".run" in + + let* () = nasm base in + let* () = clang ~compile_flags runtime base in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + + +let compileout = + fun + (_ : t) + (filename : string) -> + let base = Filename.chop_extension filename in + + let out = CCIO.(with_in (base ^ ".s") read_all) in + Ok (process_output out) + + +let unixcommand + (command : string -> string * string * int) = + fun + (_ : t) + (filename : string) -> + let base = Filename.chop_extension filename in + + let out, err, retcode = command (base ^ ".s") in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) diff --git a/test.ml b/test.ml index 6738220..9973416 100644 --- a/test.ml +++ b/test.ml @@ -1,35 +1,10 @@ +open Type +open Util -type status = - | CTError - | RTError - | NoError - -let status_of_string = function - | "fail" - | "RT error" -> RTError - | "CT error" -> CTError - | _ -> NoError - -let string_of_status = function - | RTError -> "RT error" - | CTError -> "CT error" - | NoError -> "No error" - -(** Ocaml representation of test files *) -(* All strings are enforced to be trimmed. *) -(* The expected string *) -type t = - { name : string - ; description : string - ; params : string list - ; status : status - ; src : string - ; expected : string } let test_regexp = Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" - let read_test filename = if Sys.file_exists filename then @@ -54,129 +29,34 @@ let read_test filename = Some { name ; description ; params ; status = status_of_string status ; src ; expected = String.trim expected } | _ -> - Printf.fprintf stderr "Wrong format in test file %s" filename; - None + (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) else (Printf.fprintf stderr "Test file %s not found." filename ; None) let (let*) = Result.bind -let string_match = - let open Alcotest in - let matches pat s = - try let _ = Str.(search_forward (regexp pat) s 0) in true - with Not_found -> false - in - testable (pp string) matches - -let status = - let open Alcotest in - testable Fmt.(using string_of_status string) (=) - - -(** Test pairs giving access to the first component when testing the second component *) -let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a * b) Alcotest.testable = - fun cmp1 cmp2 -> - let open Alcotest in - let cmp_pair (x1, x2) (y1, y2) = equal cmp1 x1 y1 && equal (cmp2 x1) x2 y2 in - testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair - -(* Testing the result of running a test *) -let compare_results = - let cmp_res = function - | NoError -> Alcotest.string - | _ -> string_match - in - dep_pair status cmp_res - -(** Helper functions on strings and processes *) -let filter_lines pred s = - CCString.split ~by:"\n" s - |> List.filter pred - |> String.concat "\n" - -let is_comment_line s = - not (CCString.prefix ~pre:"|" s) - -let process_output out = - String.trim out |> filter_lines is_comment_line - - - -(** Calling the compiler (clang) and assembler (nasm) *) - -(* Produce a result out of the return data from the compiler/assembler *) -let wrap_result (out, err, retcode) = - if retcode = 0 && String.equal "" err - then (print_string out ; Ok ()) - else Error (CTError, out ^ err) - -(* Find out current architecture (only supporting Linux/OS X for now) *) -let bin_format = - let out, _ , _ = CCUnix.call "uname -s" in - let arch = String.trim out in - match arch with - | "Linux" -> "elf64" - | "Darwin" -> "macho64" - | _ -> Fmt.failwith "Unknown architecture %s" arch - -let clang ~compile_flags runtime basefile = - wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile - -let nasm basefile = - wrap_result @@ CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile - - -let read_whole_file filename = - let ch = open_in filename in - let s = really_input_string ch (in_channel_length ch) in - close_in ch; - s - - -type runtime = -| CRuntime of string -| CompileOut - -type compiler = -| Compiler of (string -> out_channel -> unit) - -type oracle = -| Interp of (string -> status * string) -| Expected let make_test - ~compile_flags - (runtime:runtime) - ~(compiler:compiler) - ~(oracle:oracle) - filename = + ~(compiler : compiler) + ~(oracle : oracle) + ~(runtime : runtime) + (filename : string) = match read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename | Some test -> let exec () = let base = Filename.chop_extension filename in - let exe = base ^ ".run" in let res = let* () = match compiler with - | Compiler compiler -> + | CCompiler compiler -> try Ok (CCIO.with_out (base ^ ".s") (compiler test.src)) with e -> Error (CTError, Printexc.to_string e) in match runtime with - | CRuntime runtime -> - let* () = nasm base in - let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) - | CompileOut -> - let out = (read_whole_file (base ^ ".s")) in - Ok (process_output out) + | CRuntime runtime -> (runtime test filename) in let res = match res with @@ -200,7 +80,6 @@ let make_test in test.name, exec - let testfiles_in_dir dir = CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f:CCIO.read_lines_l @@ -208,10 +87,10 @@ let name_from_file filename = let open Filename in dirname filename ^ "::" ^ basename (chop_extension filename) -let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ~oracle dir = +let tests_from_dir ~compiler ~oracle ~runtime dir = let open Alcotest in let to_test testfile = - let testname, exec_test = make_test ~compile_flags runtime ~compiler ~oracle testfile in + let testname, exec_test = make_test ~compiler ~oracle ~runtime testfile in name_from_file testfile, [test_case testname `Quick exec_test] in List.map to_test @@ testfiles_in_dir dir @@ -219,5 +98,3 @@ let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ~oracle dir = (* Use as follow: *) (* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) - - diff --git a/test.mli b/test.mli index 910d4f7..dc724a4 100644 --- a/test.mli +++ b/test.mli @@ -1,41 +1,5 @@ +open Type -(** Expected status of a test *) -type status = - | CTError - (** Compile-time error *) - | RTError - (** Run-time error *) - | NoError - (** No error *) - - -(** Conversion functions between string and status *) - -(** [status_of_string s] accepts the following strings s : - - "fail", "RT error" <-> RTError - - "CT error" <-> CTError - - anything else correspond to NoError *) -val status_of_string : string -> status - -val string_of_status : status -> string - - -(** Ocaml representation of test files - All strings are enforced to be trimmed. - *) -type t = - { name : string - (** Name of the test *) - ; description : string - (** Description of the test *) - ; params : string list - (** Parameters passed to the test as environment variables *) - ; status : status - (** Expected status of the result *) - ; src : string - (** Source program for the test *) - ; expected : string - (** expected result of the test *) } (** [read_test s] parses the content of a test file provided in the string s returns None if any error occurred while reading the file (prints to stderr) @@ -50,20 +14,6 @@ type t = *) val read_test : string -> t option -val read_whole_file : string -> string - -type runtime = - | CRuntime of string - | CompileOut - -(** A compiler is a function that takes a source program as a string, and - an output channel as a sink to output the compiled program *) -type compiler = - | Compiler of (string -> out_channel -> unit) - -type oracle = - | Interp of (string -> status * string) - | Expected (** [testfiles_in_dir path] collects the content of all thet `*.bbc` files found at [path]; uses `find` (GNU findutils) *) @@ -79,8 +29,7 @@ val testfiles_in_dir : string -> string list It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) val tests_from_dir : - ?compile_flags:string -> - runtime:runtime -> compiler:compiler -> oracle:oracle -> + runtime:runtime -> string -> (string * unit Alcotest.test_case list) list diff --git a/type.ml b/type.ml new file mode 100644 index 0000000..d44ef42 --- /dev/null +++ b/type.ml @@ -0,0 +1,40 @@ + + +type status = + | CTError + | RTError + | NoError + +let status_of_string = function + | "fail" + | "RT error" -> RTError + | "CT error" -> CTError + | _ -> NoError + +let string_of_status = function + | RTError -> "RT error" + | CTError -> "CT error" + | NoError -> "No error" + + +(** Ocaml representation of test files *) +(* All strings are enforced to be trimmed. *) +(* The expected string *) +type t = + { name : string + ; description : string + ; params : string list + ; status : status + ; src : string + ; expected : string } + + +type runtime = +| CRuntime of (t -> string -> (string, status * string) result) + +type compiler = +| CCompiler of (string -> out_channel -> unit) + +type oracle = +| Interp of (string -> status * string) +| Expected diff --git a/type.mli b/type.mli new file mode 100644 index 0000000..985dcc0 --- /dev/null +++ b/type.mli @@ -0,0 +1,52 @@ + + +(** Expected status of a test *) +type status = + | CTError + (** Compile-time error *) + | RTError + (** Run-time error *) + | NoError + (** No error *) + + +(** Conversion functions between string and status *) + +(** [status_of_string s] accepts the following strings s : + - "fail", "RT error" <-> RTError + - "CT error" <-> CTError + - anything else correspond to NoError *) +val status_of_string : string -> status + +val string_of_status : status -> string + + +(** Ocaml representation of test files + All strings are enforced to be trimmed. + *) +type t = + { name : string + (** Name of the test *) + ; description : string + (** Description of the test *) + ; params : string list + (** Parameters passed to the test as environment variables *) + ; status : status + (** Expected status of the result *) + ; src : string + (** Source program for the test *) + ; expected : string + (** expected result of the test *) } + + +type runtime = +| CRuntime of (t -> string -> (string, status * string) result) + +(** A compiler is a function that takes a source program as a string, and + an output channel as a sink to output the compiled program *) +type compiler = +| CCompiler of (string -> out_channel -> unit) + +type oracle = +| Interp of (string -> status * string) +| Expected diff --git a/util.ml b/util.ml new file mode 100644 index 0000000..0609c5a --- /dev/null +++ b/util.ml @@ -0,0 +1,43 @@ +open Type + + +(** Helper functions on strings and processes *) +let filter_lines pred s = + CCString.split ~by:"\n" s + |> List.filter pred + |> String.concat "\n" + +let is_comment_line s = + not (CCString.prefix ~pre:"|" s) + +let process_output out = + String.trim out |> filter_lines is_comment_line + + +let string_match = + let open Alcotest in + let matches pat s = + try let _ = Str.(search_forward (regexp pat) s 0) in true + with Not_found -> false + in + testable (pp string) matches + +let status = + let open Alcotest in + testable Fmt.(using string_of_status string) (=) + + +(** Test pairs giving access to the first component when testing the second component *) +let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a * b) Alcotest.testable = + fun cmp1 cmp2 -> + let open Alcotest in + let cmp_pair (x1, x2) (y1, y2) = equal cmp1 x1 y1 && equal (cmp2 x1) x2 y2 in + testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair + +(* Testing the result of running a test *) +let compare_results = + let cmp_res = function + | NoError -> Alcotest.string + | _ -> string_match + in + dep_pair status cmp_res From 9cda2c6b0659cad06b27c37cd5753ada28d8d7bd Mon Sep 17 00:00:00 2001 From: Docker Date: Wed, 23 Aug 2023 05:26:34 +0000 Subject: [PATCH 04/28] fix: change types constructor name --- dune | 2 +- runtime.ml | 20 +++++++++++--------- test.ml | 4 ++-- type.ml | 4 ++-- type.mli | 4 ++-- 5 files changed, 18 insertions(+), 16 deletions(-) diff --git a/dune b/dune index 7965e18..ad5730e 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library (name bbcsteptester) ; Black-Box Compiler Tester (public_name bbcsteptester) - (modules type runtime test util) + (modules type test runtime util) (libraries str alcotest containers containers.unix)) diff --git a/runtime.ml b/runtime.ml index 9d89930..eaf2555 100644 --- a/runtime.ml +++ b/runtime.ml @@ -46,24 +46,26 @@ let cruntime else Error (RTError, out ^ err) -let compileout = +let unixcommand + (command : string -> string * string * int) = fun (_ : t) (filename : string) -> let base = Filename.chop_extension filename in + let file = base ^ ".s" in - let out = CCIO.(with_in (base ^ ".s") read_all) in - Ok (process_output out) + let out, err, retcode = command file in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) -let unixcommand - (command : string -> string * string * int) = +let compileout = fun (_ : t) (filename : string) -> let base = Filename.chop_extension filename in + let file = base ^ ".s" in - let out, err, retcode = command (base ^ ".s") in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) + let out = CCIO.(with_in file read_all) in + Ok (process_output out) diff --git a/test.ml b/test.ml index 9973416..a8e441e 100644 --- a/test.ml +++ b/test.ml @@ -51,12 +51,12 @@ let make_test let res = let* () = match compiler with - | CCompiler compiler -> + | Compiler compiler -> try Ok (CCIO.with_out (base ^ ".s") (compiler test.src)) with e -> Error (CTError, Printexc.to_string e) in match runtime with - | CRuntime runtime -> (runtime test filename) + | Runtime runtime -> (runtime test filename) in let res = match res with diff --git a/type.ml b/type.ml index d44ef42..4dd2035 100644 --- a/type.ml +++ b/type.ml @@ -30,10 +30,10 @@ type t = type runtime = -| CRuntime of (t -> string -> (string, status * string) result) +| Runtime of (t -> string -> (string, status * string) result) type compiler = -| CCompiler of (string -> out_channel -> unit) +| Compiler of (string -> out_channel -> unit) type oracle = | Interp of (string -> status * string) diff --git a/type.mli b/type.mli index 985dcc0..e2387b6 100644 --- a/type.mli +++ b/type.mli @@ -40,12 +40,12 @@ type t = type runtime = -| CRuntime of (t -> string -> (string, status * string) result) +| Runtime of (t -> string -> (string, status * string) result) (** A compiler is a function that takes a source program as a string, and an output channel as a sink to output the compiled program *) type compiler = -| CCompiler of (string -> out_channel -> unit) +| Compiler of (string -> out_channel -> unit) type oracle = | Interp of (string -> status * string) From ed131e9c9b4e2a6691c75c6027a08d3cd97124a2 Mon Sep 17 00:00:00 2001 From: Docker Date: Thu, 19 Oct 2023 21:53:44 +0100 Subject: [PATCH 05/28] feat: add action --- runtime.ml | 6 ++++-- test.ml | 17 +++++++++++++---- test.mli | 3 ++- type.ml | 6 +++++- type.mli | 4 ++++ util.ml | 13 +++++++++++++ 6 files changed, 41 insertions(+), 8 deletions(-) diff --git a/runtime.ml b/runtime.ml index eaf2555..84beb3c 100644 --- a/runtime.ml +++ b/runtime.ml @@ -10,6 +10,7 @@ let wrap_result (out, err, retcode) = then (print_string out ; Ok ()) else Error (CTError, out ^ err) + (* Find out current architecture (only supporting Linux/OS X for now) *) let bin_format = let out, _ , _ = CCUnix.call "uname -s" in @@ -19,12 +20,13 @@ let bin_format = | "Darwin" -> "macho64" | _ -> Fmt.failwith "Unknown architecture %s" arch -let clang ~compile_flags runtime basefile = - wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile let nasm basefile = wrap_result @@ CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile +let clang ~compile_flags runtime basefile = + wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile + let (let*) = Result.bind diff --git a/test.ml b/test.ml index a8e441e..d68baad 100644 --- a/test.ml +++ b/test.ml @@ -41,6 +41,7 @@ let make_test ~(compiler : compiler) ~(oracle : oracle) ~(runtime : runtime) + ~(action : action) (filename : string) = match read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename @@ -59,7 +60,8 @@ let make_test | Runtime runtime -> (runtime test filename) in - let res = match res with + let res = + match res with | Ok out -> NoError, out | Error err -> err in @@ -74,8 +76,14 @@ let make_test | _ -> test.status, test.expected in + let check_fun = + match action with + | Compare -> compare_results + | Execute -> execute_results + in + let open Alcotest in - check compare_results test.name expected res + check check_fun test.name expected res in test.name, exec @@ -87,10 +95,11 @@ let name_from_file filename = let open Filename in dirname filename ^ "::" ^ basename (chop_extension filename) -let tests_from_dir ~compiler ~oracle ~runtime dir = + +let tests_from_dir ~compiler ~oracle ~runtime ~action dir = let open Alcotest in let to_test testfile = - let testname, exec_test = make_test ~compiler ~oracle ~runtime testfile in + let testname, exec_test = make_test ~compiler ~oracle ~runtime testfile ~action in name_from_file testfile, [test_case testname `Quick exec_test] in List.map to_test @@ testfiles_in_dir dir diff --git a/test.mli b/test.mli index dc724a4..f122eae 100644 --- a/test.mli +++ b/test.mli @@ -28,8 +28,9 @@ val testfiles_in_dir : string -> string list The optional [oracle] parameter is an oracle (eg. an interpreter, reference compiler) to be invoked on source files. It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) - val tests_from_dir : +val tests_from_dir : compiler:compiler -> oracle:oracle -> runtime:runtime -> + action : action -> string -> (string * unit Alcotest.test_case list) list diff --git a/type.ml b/type.ml index 4dd2035..a573efe 100644 --- a/type.ml +++ b/type.ml @@ -30,7 +30,7 @@ type t = type runtime = -| Runtime of (t -> string -> (string, status * string) result) +| Runtime of (t -> string -> (string, status * string) result) type compiler = | Compiler of (string -> out_channel -> unit) @@ -38,3 +38,7 @@ type compiler = type oracle = | Interp of (string -> status * string) | Expected + +type action = +| Compare +| Execute diff --git a/type.mli b/type.mli index e2387b6..124ccd0 100644 --- a/type.mli +++ b/type.mli @@ -50,3 +50,7 @@ type compiler = type oracle = | Interp of (string -> status * string) | Expected + +type action = +| Compare +| Execute \ No newline at end of file diff --git a/util.ml b/util.ml index 0609c5a..3f0dd68 100644 --- a/util.ml +++ b/util.ml @@ -22,6 +22,12 @@ let string_match = in testable (pp string) matches +let status_match = + let open Alcotest in + let matches _ _ = true in + testable (pp string) matches + + let status = let open Alcotest in testable Fmt.(using string_of_status string) (=) @@ -34,6 +40,7 @@ let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a let cmp_pair (x1, x2) (y1, y2) = equal cmp1 x1 y1 && equal (cmp2 x1) x2 y2 in testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair + (* Testing the result of running a test *) let compare_results = let cmp_res = function @@ -41,3 +48,9 @@ let compare_results = | _ -> string_match in dep_pair status cmp_res + +let execute_results = + let exe_res = function + | _ -> status_match +in + dep_pair status exe_res From 0e3ce14f8587aafdcc6f64c07de0c2e3c2fde838 Mon Sep 17 00:00:00 2001 From: Docker Date: Thu, 19 Oct 2023 22:23:44 +0100 Subject: [PATCH 06/28] fix: add test names --- test.ml | 6 +++--- test.mli | 3 ++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/test.ml b/test.ml index d68baad..3f69466 100644 --- a/test.ml +++ b/test.ml @@ -96,11 +96,11 @@ let name_from_file filename = dirname filename ^ "::" ^ basename (chop_extension filename) -let tests_from_dir ~compiler ~oracle ~runtime ~action dir = +let tests_from_dir ~name ~compiler ~oracle ~runtime ~action dir = let open Alcotest in let to_test testfile = - let testname, exec_test = make_test ~compiler ~oracle ~runtime testfile ~action in - name_from_file testfile, [test_case testname `Quick exec_test] + let testname, exec_test = make_test ~compiler ~oracle ~runtime ~action testfile in + name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] in List.map to_test @@ testfiles_in_dir dir |> CCList.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) diff --git a/test.mli b/test.mli index f122eae..fa4bfb6 100644 --- a/test.mli +++ b/test.mli @@ -29,8 +29,9 @@ val testfiles_in_dir : string -> string list It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) val tests_from_dir : + name:string -> compiler:compiler -> oracle:oracle -> runtime:runtime -> - action : action -> + action:action -> string -> (string * unit Alcotest.test_case list) list From 0b79f25325830f4a886d26d2b101275b02edb824 Mon Sep 17 00:00:00 2001 From: Docker Date: Fri, 20 Oct 2023 19:55:22 +0100 Subject: [PATCH 07/28] docs: update readme --- README.md | 99 +++++++++++++++++++++++++++++++++++++++---------------- test.ml | 6 ++-- test.mli | 2 +- type.ml | 6 ++-- type.mli | 8 ++--- 5 files changed, 81 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index 65e3bf1..4505bea 100644 --- a/README.md +++ b/README.md @@ -17,19 +17,23 @@ Original BBCTester runs a complete pipeline for an compiler to assembler and ass Download the sources as a zip archive, unzip and install the package ```bash -$ unzip BBCTester-main.zip -Archive: BBCTester-main.zip -002d4d44e78e9655eff48580f1820961fd2ec520 - creating: BBCTester-main/ - inflating: BBCTester-main/.gitignore - inflating: BBCTester-main/Makefile - inflating: BBCTester-main/README.md - inflating: BBCTester-main/dune - inflating: BBCTester-main/dune-project - inflating: BBCTester-main/test.ml - inflating: BBCTester-main/test.mli - -$ cd BBCTester-main +$ unzip BBCStepTester-main.zip +Archive: BBCStepTester-main.zip +0e3ce14f8587aafdcc6f64c07de0c2e3c2fde838 + creating: BBCStepTester-main/ + inflating: BBCStepTester-main/.gitignore + inflating: BBCStepTester-main/Makefile + inflating: BBCStepTester-main/README.md + inflating: BBCStepTester-main/dune + inflating: BBCStepTester-main/dune-project + inflating: BBCStepTester-main/runtime.ml + inflating: BBCStepTester-main/test.ml + inflating: BBCStepTester-main/test.mli + inflating: BBCStepTester-main/type.ml + inflating: BBCStepTester-main/type.mli + inflating: BBCStepTester-main/util.ml + +$ cd BBCStepTester-main $ make install dune build @@ -39,16 +43,16 @@ Installing ... Alternatively, you can clone the repository and install ```bash -$ git clone https://github.com/pleiad/BBCTester.git -Cloning into 'BBCTester'... -remote: Enumerating objects: 19, done. -remote: Counting objects: 100% (19/19), done. -remote: Compressing objects: 100% (15/15), done. -remote: Total 19 (delta 3), reused 12 (delta 3), pack-reused 0 -Receiving objects: 100% (19/19), 7.10 KiB | 7.10 MiB/s, done. -Resolving deltas: 100% (3/3), done. +$ git clone https://github.com/fabaindaiz/BBCStepTester +Cloning into 'BBCStepTester'... +remote: Enumerating objects: 81, done. +remote: Counting objects: 100% (81/81), done. +remote: Compressing objects: 100% (55/55), done. +remote: Total 81 (delta 48), reused 51 (delta 25), pack-reused 0 +Receiving objects: 100% (81/81), 17.79 KiB | 17.79 MiB/s, done. +Resolving deltas: 100% (48/48), done. -$ cd BBCTester +$ cd BBCStepTester $ make install dune build @@ -65,19 +69,56 @@ Installing ... This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest in a single module `Test`. The main entrypoint of the library is the following function (from `test.mli`). ```ocaml -(* Given the path of a C runtime file [runtime], a [compiler] and +(* Given a [name], a [compiler], a [runtime], a [oracle], a [action] and the path [dir] of a directory containing tests files, produces - unit tests for each test files in [dir]. - [compile_flags] are passed to the C compiler (clang), - defaults to "-g". *) + unit tests for each test files in [dir]. *) val tests_from_dir : - ?compile_flags:string -> - runtime:string -> + name:string -> compiler:compiler -> - ?oracle:(string -> status * string) -> + runtime:runtime -> + oracle:oracle -> + action:action -> string -> (string * unit Alcotest.test_case list) list ``` +```ocaml +(* Example of using tests_from_dir *) +open Bbcsteptester.Type +open Bbcsteptester.Test +open Bbcsteptester.Runtime + +(* .......... *) + +let () = + let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default:"-g" in + + let compiler : compiler = + Compiler (fun s o -> fprintf o "%s" (compile_prog (parse_prog (sexp_from_string s))) ) in + + let runtime : runtime = + Runtime (cruntime ~compile_flags "rt/sys.c") in + + let oracle : oracle = + Interp ( + fun s -> ( + try + NoError, string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env) + with + | RTError msg -> RTError, msg + | CTError msg -> CTError, msg + | e -> RTError, "Oracle raised an unknown error :"^ Printexc.to_string e + ) + ) + in + + let bbc_tests = + let name : string = "bbc" in + let action : action = Compare in + tests_from_dir ~name ~compiler ~runtime ~oracle ~action "bbctests" in + + run "Tests MiniCompiler" (ocaml_tests @ bbc_tests) +``` + ## Tests files (*.bbc) diff --git a/test.ml b/test.ml index 3f69466..4fd262b 100644 --- a/test.ml +++ b/test.ml @@ -67,7 +67,7 @@ let make_test in let expected = - let i_interp = CCString.find ~sub:"|INTERP" test.expected in + let i_interp = CCString.find ~sub:"|ORACLE" test.expected in match oracle with | Interp oracle when test.status = NoError && i_interp <> -1 -> let prefix = CCString.sub test.expected 0 (max (i_interp - 1) 0) in @@ -96,10 +96,10 @@ let name_from_file filename = dirname filename ^ "::" ^ basename (chop_extension filename) -let tests_from_dir ~name ~compiler ~oracle ~runtime ~action dir = +let tests_from_dir ~name ~compiler ~runtime ~oracle ~action dir = let open Alcotest in let to_test testfile = - let testname, exec_test = make_test ~compiler ~oracle ~runtime ~action testfile in + let testname, exec_test = make_test ~compiler ~runtime ~oracle ~action testfile in name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] in List.map to_test @@ testfiles_in_dir dir diff --git a/test.mli b/test.mli index fa4bfb6..10247b8 100644 --- a/test.mli +++ b/test.mli @@ -31,7 +31,7 @@ val testfiles_in_dir : string -> string list val tests_from_dir : name:string -> compiler:compiler -> - oracle:oracle -> runtime:runtime -> + oracle:oracle -> action:action -> string -> (string * unit Alcotest.test_case list) list diff --git a/type.ml b/type.ml index a573efe..e13a928 100644 --- a/type.ml +++ b/type.ml @@ -29,12 +29,12 @@ type t = ; expected : string } -type runtime = -| Runtime of (t -> string -> (string, status * string) result) - type compiler = | Compiler of (string -> out_channel -> unit) +type runtime = +| Runtime of (t -> string -> (string, status * string) result) + type oracle = | Interp of (string -> status * string) | Expected diff --git a/type.mli b/type.mli index 124ccd0..0299dd1 100644 --- a/type.mli +++ b/type.mli @@ -39,14 +39,14 @@ type t = (** expected result of the test *) } -type runtime = -| Runtime of (t -> string -> (string, status * string) result) - (** A compiler is a function that takes a source program as a string, and - an output channel as a sink to output the compiled program *) +an output channel as a sink to output the compiled program *) type compiler = | Compiler of (string -> out_channel -> unit) +type runtime = +| Runtime of (t -> string -> (string, status * string) result) + type oracle = | Interp of (string -> status * string) | Expected From ea67cee81924bab8bbe94bc9aa53c3a8815d26b0 Mon Sep 17 00:00:00 2001 From: Docker Date: Fri, 20 Oct 2023 21:23:35 +0100 Subject: [PATCH 08/28] feat: update runtime --- README.md | 5 ++--- runtime.ml | 64 +++++++++++++++++++++++++++++------------------------- 2 files changed, 37 insertions(+), 32 deletions(-) diff --git a/README.md b/README.md index 4505bea..8ef89e0 100644 --- a/README.md +++ b/README.md @@ -90,13 +90,12 @@ open Bbcsteptester.Runtime (* .......... *) let () = - let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default:"-g" in let compiler : compiler = Compiler (fun s o -> fprintf o "%s" (compile_prog (parse_prog (sexp_from_string s))) ) in - let runtime : runtime = - Runtime (cruntime ~compile_flags "rt/sys.c") in + let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default:"-g" in + let runtime : runtime = (cruntime ~compile_flags "rt/sys.c") in let oracle : oracle = Interp ( diff --git a/runtime.ml b/runtime.ml index 84beb3c..734a55f 100644 --- a/runtime.ml +++ b/runtime.ml @@ -34,40 +34,46 @@ let (let*) = Result.bind let cruntime ?(compile_flags: string ="-g") (runtime : string) = - fun - (test : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let exe = base ^ ".run" in - - let* () = nasm base in - let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) + Runtime ( + fun + (test : t) + (filename : string) -> + let base = Filename.chop_extension filename in + let exe = base ^ ".run" in + + let* () = nasm base in + let* () = clang ~compile_flags runtime base in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + ) let unixcommand (command : string -> string * string * int) = - fun - (_ : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let file = base ^ ".s" in + Runtime ( + fun + (_ : t) + (filename : string) -> + let base = Filename.chop_extension filename in + let file = base ^ ".s" in - let out, err, retcode = command file in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) + let out, err, retcode = command file in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + ) let compileout = - fun - (_ : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let file = base ^ ".s" in - - let out = CCIO.(with_in file read_all) in - Ok (process_output out) + Runtime ( + fun + (_ : t) + (filename : string) -> + let base = Filename.chop_extension filename in + let file = base ^ ".s" in + + let out = CCIO.(with_in file read_all) in + Ok (process_output out) + ) From 231a21fd7033f9a615e168c3766289da54e5a046 Mon Sep 17 00:00:00 2001 From: Docker Date: Fri, 20 Oct 2023 21:32:55 +0100 Subject: [PATCH 09/28] fix: more descriptive types --- README.md | 4 ++-- test.ml | 6 +++--- type.ml | 6 +++--- type.mli | 6 +++--- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 8ef89e0..d09e172 100644 --- a/README.md +++ b/README.md @@ -98,7 +98,7 @@ let () = let runtime : runtime = (cruntime ~compile_flags "rt/sys.c") in let oracle : oracle = - Interp ( + Interpreter ( fun s -> ( try NoError, string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env) @@ -112,7 +112,7 @@ let () = let bbc_tests = let name : string = "bbc" in - let action : action = Compare in + let action : action = CompareOutput in tests_from_dir ~name ~compiler ~runtime ~oracle ~action "bbctests" in run "Tests MiniCompiler" (ocaml_tests @ bbc_tests) diff --git a/test.ml b/test.ml index 4fd262b..c0e4f11 100644 --- a/test.ml +++ b/test.ml @@ -69,7 +69,7 @@ let make_test let expected = let i_interp = CCString.find ~sub:"|ORACLE" test.expected in match oracle with - | Interp oracle when test.status = NoError && i_interp <> -1 -> + | Interpreter oracle when test.status = NoError && i_interp <> -1 -> let prefix = CCString.sub test.expected 0 (max (i_interp - 1) 0) in let status , output = oracle test.src in status , prefix ^ output @@ -78,8 +78,8 @@ let make_test let check_fun = match action with - | Compare -> compare_results - | Execute -> execute_results + | CompareOutput -> compare_results + | IgnoreOutput -> execute_results in let open Alcotest in diff --git a/type.ml b/type.ml index e13a928..f0b58cc 100644 --- a/type.ml +++ b/type.ml @@ -36,9 +36,9 @@ type runtime = | Runtime of (t -> string -> (string, status * string) result) type oracle = -| Interp of (string -> status * string) +| Interpreter of (string -> status * string) | Expected type action = -| Compare -| Execute +| CompareOutput +| IgnoreOutput diff --git a/type.mli b/type.mli index 0299dd1..20fa067 100644 --- a/type.mli +++ b/type.mli @@ -48,9 +48,9 @@ type runtime = | Runtime of (t -> string -> (string, status * string) result) type oracle = -| Interp of (string -> status * string) +| Interpreter of (string -> status * string) | Expected type action = -| Compare -| Execute \ No newline at end of file +| CompareOutput +| IgnoreOutput \ No newline at end of file From 3c0febbbe40abcbd98fb42a451735091decf0e11 Mon Sep 17 00:00:00 2001 From: Docker Date: Mon, 1 Jan 2024 18:38:12 +0000 Subject: [PATCH 10/28] wip: restructure testing pipeline --- dune | 2 +- main.ml | 53 ++++++++++++++++++++++++++++++++ main.mli | 23 ++++++++++++++ pipeline.ml | 33 ++++++++++++++++++++ runtime.ml | 87 ++++++++++++++++++++++++++-------------------------- test.ml | 80 ++--------------------------------------------- test.mli | 22 ------------- testeable.ml | 31 +++++++++++++++++++ type.ml | 23 ++++++-------- type.mli | 19 ++++++------ util.ml | 50 ++++++------------------------ 11 files changed, 216 insertions(+), 207 deletions(-) create mode 100644 main.ml create mode 100644 main.mli create mode 100644 pipeline.ml create mode 100644 testeable.ml diff --git a/dune b/dune index ad5730e..4319746 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library (name bbcsteptester) ; Black-Box Compiler Tester (public_name bbcsteptester) - (modules type test runtime util) + (modules main runtime testeable pipeline type test util) (libraries str alcotest containers containers.unix)) diff --git a/main.ml b/main.ml new file mode 100644 index 0000000..c4e369c --- /dev/null +++ b/main.ml @@ -0,0 +1,53 @@ +open Type + + +let make_test + ~(compiler : compiler) + ~(runtime : runtime) + ~(oracle : runtime) + ~(testeable : testeable) + (filename : string) = + match Test.read_test filename with + | None -> Alcotest.failf "Could not open or parse test %s" filename + | Some test -> + let exec () = + let res = + Util.handle_result @@ + let* out = Pipeline.compile compiler test in + let* out = Pipeline.runtime runtime test out in + Ok out + in + + let exp = + Util.handle_result @@ + let* out = Pipeline.oracle oracle test in + Ok out + in + + let testing = Pipeline.test testeable test in + + let open Alcotest in + check testing test.name exp res + + in test.name, exec + + + let testfiles_in_dir dir = + CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f:CCIO.read_lines_l + + let name_from_file filename = + let open Filename in + dirname filename ^ "::" ^ basename (chop_extension filename) + + + let tests_from_dir ~name ~compiler ~runtime ~oracle ~testeable dir = + let open Alcotest in + let to_test testfile = + let testname, exec_test = make_test ~compiler ~runtime ~oracle ~testeable testfile in + name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] + in + List.map to_test @@ testfiles_in_dir dir + |> CCList.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) + + (* Use as follow: *) + (* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) diff --git a/main.mli b/main.mli new file mode 100644 index 0000000..2a593e6 --- /dev/null +++ b/main.mli @@ -0,0 +1,23 @@ +open Type + + +(** [testfiles_in_dir path] collects the content of all thet `*.bbc` files + found at [path]; uses `find` (GNU findutils) *) +val testfiles_in_dir : string -> string list + +(** [test_from_dir ~runtime ~compiler dir] generates alcotest tests + for each test file present in [dir] and its subdirectories using + [runtime] as path to a C runtime to be linked against and [compiler] + to process the sources. + [compile_flags] are passed to the C compiler (clang), + defaulting to "-g". + The optional [oracle] parameter is an oracle (eg. an interpreter, reference compiler) to be invoked on source files. + It should return a result status together with the expected output of the corresponding program, + that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) +val tests_from_dir : + name:string -> + compiler:compiler -> + runtime:runtime -> + oracle:runtime -> + testeable:testeable -> + string -> (string * unit Alcotest.test_case list) list diff --git a/pipeline.ml b/pipeline.ml new file mode 100644 index 0000000..375f708 --- /dev/null +++ b/pipeline.ml @@ -0,0 +1,33 @@ +open Type + + +let compile compiler test = + match compiler with + | Compiler compiler -> + compiler test test.src + | SCompiler compiler -> + try Ok (compiler test test.src) + with e -> Error (CTError, Printexc.to_string e) + + +let runtime runtime test input = + match runtime with + | Runtime runtime -> runtime test input + + +let oracle runtime test = + let interp = CCString.find ~sub:"|ORACLE" test.expected in + match runtime with + | Runtime oracle when test.status = NoError && interp <> -1 -> + let prefix = CCString.sub test.expected 0 (max (interp - 1) 0) in + let* out = (oracle test test.src) in + Ok (prefix ^ out) + | _ -> + (match test.status with + | NoError -> Ok test.expected + | _ -> Error (test.status, test.expected)) + + +let test testeable test = + match testeable with + | Testeable testeable -> testeable test diff --git a/runtime.ml b/runtime.ml index 734a55f..1b2df36 100644 --- a/runtime.ml +++ b/runtime.ml @@ -2,15 +2,12 @@ open Type open Util -(** Calling the compiler (clang) and assembler (nasm) *) - (* Produce a result out of the return data from the compiler/assembler *) let wrap_result (out, err, retcode) = if retcode = 0 && String.equal "" err then (print_string out ; Ok ()) else Error (CTError, out ^ err) - (* Find out current architecture (only supporting Linux/OS X for now) *) let bin_format = let out, _ , _ = CCUnix.call "uname -s" in @@ -28,52 +25,54 @@ let clang ~compile_flags runtime basefile = wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile -let (let*) = Result.bind - - -let cruntime +(** Calling the compiler (clang) and assembler (nasm) *) +let clangruntime ?(compile_flags: string ="-g") (runtime : string) = - Runtime ( - fun - (test : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let exe = base ^ ".run" in - - let* () = nasm base in - let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) - ) + Runtime ( + fun + (test : t) + (input : string) -> + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in + let exe = base ^ ".run" in + + let* () = write_file file input RTError in + let* () = nasm base in + let* () = clang ~compile_flags runtime base in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + ) + (** Calling a unix command *) let unixcommand - (command : string -> string * string * int) = - Runtime ( - fun - (_ : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let file = base ^ ".s" in - - let out, err, retcode = command file in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) - ) + (command) = + Runtime ( + fun + (test : t) + (input : string) -> + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in + + let* () = write_file file input RTError in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) command file in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) + ) let compileout = - Runtime ( - fun - (_ : t) - (filename : string) -> - let base = Filename.chop_extension filename in - let file = base ^ ".s" in - - let out = CCIO.(with_in file read_all) in - Ok (process_output out) - ) + Runtime ( + fun + (test : t) + (input : string) -> + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in + + let* () = write_file file input RTError in + Ok input + ) diff --git a/test.ml b/test.ml index c0e4f11..b2fcec3 100644 --- a/test.ml +++ b/test.ml @@ -1,9 +1,8 @@ open Type -open Util let test_regexp = - Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" + Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|END" let read_test filename = if Sys.file_exists filename @@ -26,84 +25,9 @@ let read_test filename = match toks with | Delim "SRC:" :: Text src :: Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> - Some { name ; description ; params ; status = status_of_string status ; + Some { file=filename ; name ; description ; params ; status = status_of_string status ; src ; expected = String.trim expected } | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) else (Printf.fprintf stderr "Test file %s not found." filename ; None) - - -let (let*) = Result.bind - - -let make_test - ~(compiler : compiler) - ~(oracle : oracle) - ~(runtime : runtime) - ~(action : action) - (filename : string) = - match read_test filename with - | None -> Alcotest.failf "Could not open or parse test %s" filename - | Some test -> - let exec () = - let base = Filename.chop_extension filename in - - let res = - let* () = - match compiler with - | Compiler compiler -> - try Ok (CCIO.with_out (base ^ ".s") (compiler test.src)) - with e -> Error (CTError, Printexc.to_string e) - in - match runtime with - | Runtime runtime -> (runtime test filename) - in - - let res = - match res with - | Ok out -> NoError, out - | Error err -> err - in - - let expected = - let i_interp = CCString.find ~sub:"|ORACLE" test.expected in - match oracle with - | Interpreter oracle when test.status = NoError && i_interp <> -1 -> - let prefix = CCString.sub test.expected 0 (max (i_interp - 1) 0) in - let status , output = oracle test.src in - status , prefix ^ output - | _ -> test.status, test.expected - in - - let check_fun = - match action with - | CompareOutput -> compare_results - | IgnoreOutput -> execute_results - in - - let open Alcotest in - check check_fun test.name expected res - - in test.name, exec - - -let testfiles_in_dir dir = - CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f:CCIO.read_lines_l - -let name_from_file filename = - let open Filename in - dirname filename ^ "::" ^ basename (chop_extension filename) - - -let tests_from_dir ~name ~compiler ~runtime ~oracle ~action dir = - let open Alcotest in - let to_test testfile = - let testname, exec_test = make_test ~compiler ~runtime ~oracle ~action testfile in - name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] - in - List.map to_test @@ testfiles_in_dir dir - |> CCList.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) - -(* Use as follow: *) -(* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) diff --git a/test.mli b/test.mli index 10247b8..7d619c9 100644 --- a/test.mli +++ b/test.mli @@ -13,25 +13,3 @@ open Type - `EXPECTED:` : the expected result of the program (note that debugging messages starting by `|` are ignored and shouldn't be part of the expected result). If the expected result ends with the message `|INTERPRET` then the expected result is obtained by subsituting `|INTERPRET` with the result of evaluating the interpreter on the source code. *) val read_test : string -> t option - - -(** [testfiles_in_dir path] collects the content of all thet `*.bbc` files - found at [path]; uses `find` (GNU findutils) *) -val testfiles_in_dir : string -> string list - -(** [test_from_dir ~runtime ~compiler dir] generates alcotest tests - for each test file present in [dir] and its subdirectories using - [runtime] as path to a C runtime to be linked against and [compiler] - to process the sources. - [compile_flags] are passed to the C compiler (clang), - defaulting to "-g". - The optional [oracle] parameter is an oracle (eg. an interpreter, reference compiler) to be invoked on source files. - It should return a result status together with the expected output of the corresponding program, - that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) -val tests_from_dir : - name:string -> - compiler:compiler -> - runtime:runtime -> - oracle:oracle -> - action:action -> - string -> (string * unit Alcotest.test_case list) list diff --git a/testeable.ml b/testeable.ml new file mode 100644 index 0000000..8117385 --- /dev/null +++ b/testeable.ml @@ -0,0 +1,31 @@ +open Type + + +let string_match = + let open Alcotest in + let matches pat s = + try let _ = Str.(search_forward (regexp pat) s 0) in true + with Not_found -> false + in + testable (pp string) matches + +let status_match = + let open Alcotest in + testable Fmt.(using string_of_status string) (=) + + +(** Test pairs giving access to the first component when testing the second component *) +let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a * b) Alcotest.testable = + fun cmp1 cmp2 -> + let open Alcotest in + let cmp_pair (x1, x2) (y1, y2) = equal cmp1 x1 y1 && equal (cmp2 x1) x2 y2 in + testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair + + +(* Testing the result of running a test *) +let compare_results = + let result_match = function + | NoError -> Alcotest.string + | _ -> string_match + in + dep_pair status_match result_match diff --git a/type.ml b/type.ml index f0b58cc..fa6dfe9 100644 --- a/type.ml +++ b/type.ml @@ -1,5 +1,3 @@ - - type status = | CTError | RTError @@ -7,13 +5,13 @@ type status = let status_of_string = function | "fail" - | "RT error" -> RTError | "CT error" -> CTError + | "RT error" -> RTError | _ -> NoError let string_of_status = function - | RTError -> "RT error" | CTError -> "CT error" + | RTError -> "RT error" | NoError -> "No error" @@ -21,7 +19,8 @@ let string_of_status = function (* All strings are enforced to be trimmed. *) (* The expected string *) type t = - { name : string + { file : string + ; name : string ; description : string ; params : string list ; status : status @@ -29,16 +28,14 @@ type t = ; expected : string } +let (let*) = Result.bind + type compiler = -| Compiler of (string -> out_channel -> unit) +| Compiler of (t -> string -> (string, status * string) result) +| SCompiler of (t -> string -> string) type runtime = | Runtime of (t -> string -> (string, status * string) result) -type oracle = -| Interpreter of (string -> status * string) -| Expected - -type action = -| CompareOutput -| IgnoreOutput +type testeable = +| Testeable of (t -> (status * string) Alcotest.testable) diff --git a/type.mli b/type.mli index 20fa067..9adbaad 100644 --- a/type.mli +++ b/type.mli @@ -25,7 +25,9 @@ val string_of_status : status -> string All strings are enforced to be trimmed. *) type t = - { name : string + { file : string + (** Name of the test file *) + ; name : string (** Name of the test *) ; description : string (** Description of the test *) @@ -39,18 +41,17 @@ type t = (** expected result of the test *) } +val ( let* ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result + + (** A compiler is a function that takes a source program as a string, and an output channel as a sink to output the compiled program *) type compiler = -| Compiler of (string -> out_channel -> unit) +| Compiler of (t -> string -> (string, status * string) result) +| SCompiler of (t -> string -> string) type runtime = | Runtime of (t -> string -> (string, status * string) result) -type oracle = -| Interpreter of (string -> status * string) -| Expected - -type action = -| CompareOutput -| IgnoreOutput \ No newline at end of file +type testeable = +| Testeable of (t -> (status * string) Alcotest.testable) diff --git a/util.ml b/util.ml index 3f0dd68..f63f8e5 100644 --- a/util.ml +++ b/util.ml @@ -1,4 +1,7 @@ -open Type +let handle_result result = + match result with + | Ok out -> Type.NoError, out + | Error err -> err (** Helper functions on strings and processes *) @@ -14,43 +17,10 @@ let process_output out = String.trim out |> filter_lines is_comment_line -let string_match = - let open Alcotest in - let matches pat s = - try let _ = Str.(search_forward (regexp pat) s 0) in true - with Not_found -> false - in - testable (pp string) matches +let write_file file string error = + try Ok (CCIO.with_out file (fun o -> output_string o string)) + with e -> Error (error, Printexc.to_string e) -let status_match = - let open Alcotest in - let matches _ _ = true in - testable (pp string) matches - - -let status = - let open Alcotest in - testable Fmt.(using string_of_status string) (=) - - -(** Test pairs giving access to the first component when testing the second component *) -let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a * b) Alcotest.testable = - fun cmp1 cmp2 -> - let open Alcotest in - let cmp_pair (x1, x2) (y1, y2) = equal cmp1 x1 y1 && equal (cmp2 x1) x2 y2 in - testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair - - -(* Testing the result of running a test *) -let compare_results = - let cmp_res = function - | NoError -> Alcotest.string - | _ -> string_match - in - dep_pair status cmp_res - -let execute_results = - let exe_res = function - | _ -> status_match -in - dep_pair status exe_res +let read_file file error = + try Ok (process_output (CCIO.with_in file CCIO.read_all)) + with e -> Error (error, Printexc.to_string e) From 894897596e694b2574f6690113a28355c6e62584 Mon Sep 17 00:00:00 2001 From: Docker Date: Mon, 1 Jan 2024 19:32:02 +0000 Subject: [PATCH 11/28] docs: update readme & some fixes --- README.md | 43 +++++++++++++++++++++++-------------------- runtime.ml | 3 ++- test.ml | 2 +- testeable.ml | 14 +++++++++----- type.ml | 3 +-- 5 files changed, 36 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index d09e172..746c68b 100644 --- a/README.md +++ b/README.md @@ -26,9 +26,13 @@ Archive: BBCStepTester-main.zip inflating: BBCStepTester-main/README.md inflating: BBCStepTester-main/dune inflating: BBCStepTester-main/dune-project + inflating: BBCStepTester-main/main.ml + inflating: BBCStepTester-main/main.mli + inflating: BBCStepTester-main/pipeline.ml inflating: BBCStepTester-main/runtime.ml inflating: BBCStepTester-main/test.ml inflating: BBCStepTester-main/test.mli + inflating: BBCStepTester-main/testeable.ml inflating: BBCStepTester-main/type.ml inflating: BBCStepTester-main/type.mli inflating: BBCStepTester-main/util.ml @@ -66,7 +70,7 @@ Installing ... ## Entrypoint -This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest in a single module `Test`. The main entrypoint of the library is the following function (from `test.mli`). +This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest. The main entrypoint of the library is the following function (from `main.mli`). ```ocaml (* Given a [name], a [compiler], a [runtime], a [oracle], a [action] and @@ -76,44 +80,43 @@ val tests_from_dir : name:string -> compiler:compiler -> runtime:runtime -> - oracle:oracle -> - action:action -> + oracle:runtime -> + testeable:testeable -> string -> (string * unit Alcotest.test_case list) list ``` ```ocaml (* Example of using tests_from_dir *) open Bbcsteptester.Type -open Bbcsteptester.Test +open Bbcsteptester.Main open Bbcsteptester.Runtime +open Bbcsteptester.Testeable (* .......... *) +(* Entry point of tester *) let () = let compiler : compiler = - Compiler (fun s o -> fprintf o "%s" (compile_prog (parse_prog (sexp_from_string s))) ) in + SCompiler ( fun _ s -> (compile_prog (parse_prog (sexp_from_string s))) ) in - let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default:"-g" in - let runtime : runtime = (cruntime ~compile_flags "rt/sys.c") in + let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default: "-z noexecstack -g -m64 -fPIE -pie" in + let runtime : runtime = (clangruntime ~compile_flags "rt/sys.c") in - let oracle : oracle = - Interpreter ( - fun s -> ( - try - NoError, string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env) - with - | RTError msg -> RTError, msg - | CTError msg -> CTError, msg - | e -> RTError, "Oracle raised an unknown error :"^ Printexc.to_string e - ) - ) + let oracle : runtime = + Runtime ( fun _ s -> ( + try Ok (string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env)) + with + | RTError msg -> Error (RTError, msg) + | CTError msg -> Error (CTError, msg) + | e -> Error (RTError, "Oracle raised an unknown error :" ^ Printexc.to_string e) + )) in let bbc_tests = let name : string = "bbc" in - let action : action = CompareOutput in - tests_from_dir ~name ~compiler ~runtime ~oracle ~action "bbctests" in + let testeable = compare_results in + tests_from_dir ~name ~compiler ~runtime ~oracle ~testeable "bbctests" in run "Tests MiniCompiler" (ocaml_tests @ bbc_tests) ``` diff --git a/runtime.ml b/runtime.ml index 1b2df36..b9d3c37 100644 --- a/runtime.ml +++ b/runtime.ml @@ -47,7 +47,7 @@ let clangruntime ) - (** Calling a unix command *) +(** Calling a unix command *) let unixcommand (command) = Runtime ( @@ -65,6 +65,7 @@ let unixcommand ) +(** Directly passing the compiled code *) let compileout = Runtime ( fun diff --git a/test.ml b/test.ml index b2fcec3..d67adde 100644 --- a/test.ml +++ b/test.ml @@ -2,7 +2,7 @@ open Type let test_regexp = - Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|END" + Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" let read_test filename = if Sys.file_exists filename diff --git a/testeable.ml b/testeable.ml index 8117385..a7d933e 100644 --- a/testeable.ml +++ b/testeable.ml @@ -24,8 +24,12 @@ let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a (* Testing the result of running a test *) let compare_results = - let result_match = function - | NoError -> Alcotest.string - | _ -> string_match - in - dep_pair status_match result_match + Testeable ( + fun + (_ : t) -> + let result_match = function + | NoError -> Alcotest.string + | _ -> string_match + in + dep_pair status_match result_match + ) diff --git a/type.ml b/type.ml index fa6dfe9..ddfc949 100644 --- a/type.ml +++ b/type.ml @@ -4,9 +4,8 @@ type status = | NoError let status_of_string = function - | "fail" | "CT error" -> CTError - | "RT error" -> RTError + | "fail" | "RT error" -> RTError | _ -> NoError let string_of_status = function From 01b34b979f2a64f0ed199e0989d77c872ea89f89 Mon Sep 17 00:00:00 2001 From: Docker Date: Mon, 1 Jan 2024 20:46:59 +0000 Subject: [PATCH 12/28] feat: add default runtime, oracle & testeable --- README.md | 4 +--- dune | 2 +- main.ml | 10 +++++----- main.mli | 6 +++--- oracle.ml | 10 ++++++++++ runtime.ml | 2 +- testeable.ml | 12 ++++++++++++ 7 files changed, 33 insertions(+), 13 deletions(-) create mode 100644 oracle.ml diff --git a/README.md b/README.md index 746c68b..cc1bb0e 100644 --- a/README.md +++ b/README.md @@ -90,7 +90,6 @@ val tests_from_dir : open Bbcsteptester.Type open Bbcsteptester.Main open Bbcsteptester.Runtime -open Bbcsteptester.Testeable (* .......... *) @@ -115,8 +114,7 @@ let () = let bbc_tests = let name : string = "bbc" in - let testeable = compare_results in - tests_from_dir ~name ~compiler ~runtime ~oracle ~testeable "bbctests" in + tests_from_dir ~name ~compiler ~runtime ~oracle "bbctests" in run "Tests MiniCompiler" (ocaml_tests @ bbc_tests) ``` diff --git a/dune b/dune index 4319746..3a54280 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library (name bbcsteptester) ; Black-Box Compiler Tester (public_name bbcsteptester) - (modules main runtime testeable pipeline type test util) + (modules main runtime oracle testeable pipeline type test util) (libraries str alcotest containers containers.unix)) diff --git a/main.ml b/main.ml index c4e369c..d29d39e 100644 --- a/main.ml +++ b/main.ml @@ -3,9 +3,9 @@ open Type let make_test ~(compiler : compiler) - ~(runtime : runtime) - ~(oracle : runtime) - ~(testeable : testeable) + ?(runtime : runtime = Runtime.compileout) + ?(oracle : runtime = Oracle.notimplemented) + ?(testeable : testeable = Testeable.compare_results) (filename : string) = match Test.read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename @@ -40,10 +40,10 @@ let make_test dirname filename ^ "::" ^ basename (chop_extension filename) - let tests_from_dir ~name ~compiler ~runtime ~oracle ~testeable dir = + let tests_from_dir ~name ~compiler ?runtime ?oracle ?testeable dir = let open Alcotest in let to_test testfile = - let testname, exec_test = make_test ~compiler ~runtime ~oracle ~testeable testfile in + let testname, exec_test = make_test ~compiler ?runtime ?oracle ?testeable testfile in name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] in List.map to_test @@ testfiles_in_dir dir diff --git a/main.mli b/main.mli index 2a593e6..9498b93 100644 --- a/main.mli +++ b/main.mli @@ -17,7 +17,7 @@ val testfiles_in_dir : string -> string list val tests_from_dir : name:string -> compiler:compiler -> - runtime:runtime -> - oracle:runtime -> - testeable:testeable -> + ?runtime:runtime -> + ?oracle:runtime -> + ?testeable:testeable -> string -> (string * unit Alcotest.test_case list) list diff --git a/oracle.ml b/oracle.ml new file mode 100644 index 0000000..ae18f94 --- /dev/null +++ b/oracle.ml @@ -0,0 +1,10 @@ +open Type + + +let notimplemented = + Runtime ( + fun + (_ : t) + (_ : string) -> + Error (RTError, "Not implemented") + ) \ No newline at end of file diff --git a/runtime.ml b/runtime.ml index b9d3c37..15b64c6 100644 --- a/runtime.ml +++ b/runtime.ml @@ -75,5 +75,5 @@ let compileout = let file = base ^ ".s" in let* () = write_file file input RTError in - Ok input + Ok (process_output input) ) diff --git a/testeable.ml b/testeable.ml index a7d933e..a9fa1f3 100644 --- a/testeable.ml +++ b/testeable.ml @@ -1,6 +1,10 @@ open Type +let string_ignore = + let open Alcotest in + testable (pp string) (fun _ _ -> true) + let string_match = let open Alcotest in let matches pat s = @@ -22,6 +26,14 @@ let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a testable (fun fmt p -> pp (pair cmp1 (cmp2 (fst p))) fmt p) cmp_pair +(* Testing the status of running a test *) +let compare_status = + Testeable ( + fun + (_ : t) -> + dep_pair status_match (fun _ -> string_ignore) + ) + (* Testing the result of running a test *) let compare_results = Testeable ( From 598237557edb7b584e62aff7e61f9b13735896b7 Mon Sep 17 00:00:00 2001 From: Docker Date: Mon, 1 Jan 2024 23:57:28 +0000 Subject: [PATCH 13/28] feat: optimize main --- README.md | 14 +++++++++----- dune | 4 ++-- main.ml | 42 +++++++++++++++++++++--------------------- oracle.ml | 10 ---------- runtime.ml | 11 +++++++++-- test.ml | 48 ++++++++++++++++++++++++++---------------------- testeable.ml | 4 +++- type.ml | 1 + 8 files changed, 71 insertions(+), 63 deletions(-) delete mode 100644 oracle.ml diff --git a/README.md b/README.md index cc1bb0e..6118519 100644 --- a/README.md +++ b/README.md @@ -4,10 +4,14 @@ Black-Box Compiler Tester A simple library for black-box testing of compilers from the [Compiler Design and Implementation course at UChile](https://users.dcc.uchile.cl/~etanter/CC5116/). ## Fork goals -Original BBCTester runs a complete pipeline for an compiler to assembler and assembler execution. This fork will add the possibility to configure or modify the steps that will be executed in the pipeline to be able to use BBCTester in compiler tests for other languages. +Original BBCTester runs a complete pipeline for an x86 assembly compiler and execution with a c runtime. This fork adds the possibility to configure or modify the steps that will be executed in the pipeline to be able to use BBCTester in other test pipelines for ocaml compilers. + +## Future goals +- Improve pipeline & test configurations +- Add benchmarking capabilities to tests ## Dependencies -- dune (>= 2.9) +- dune (>= 3.10) - ocaml (>= 4.08.0) - alcotest (>= 1.2.2) - containers (>= 3.0.1) @@ -79,9 +83,9 @@ This package contains a few helper functions to parse test files (see below for val tests_from_dir : name:string -> compiler:compiler -> - runtime:runtime -> - oracle:runtime -> - testeable:testeable -> + ?runtime:runtime -> + ?oracle:runtime -> + ?testeable:testeable -> string -> (string * unit Alcotest.test_case list) list ``` diff --git a/dune b/dune index 3a54280..21f33fd 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library (name bbcsteptester) ; Black-Box Compiler Tester (public_name bbcsteptester) - (modules main runtime oracle testeable pipeline type test util) - (libraries str alcotest containers containers.unix)) + (modules main pipeline runtime testeable test type util) + (libraries alcotest containers containers.unix str)) diff --git a/main.ml b/main.ml index d29d39e..25e0cce 100644 --- a/main.ml +++ b/main.ml @@ -4,13 +4,14 @@ open Type let make_test ~(compiler : compiler) ?(runtime : runtime = Runtime.compileout) - ?(oracle : runtime = Oracle.notimplemented) + ?(oracle : runtime = Runtime.notimplemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = match Test.read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename | Some test -> let exec () = + let res = Util.handle_result @@ let* out = Pipeline.compile compiler test in @@ -25,29 +26,28 @@ let make_test in let testing = Pipeline.test testeable test in - - let open Alcotest in - check testing test.name exp res + Alcotest.check testing test.name exp res in test.name, exec - let testfiles_in_dir dir = - CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f:CCIO.read_lines_l - - let name_from_file filename = - let open Filename in - dirname filename ^ "::" ^ basename (chop_extension filename) - +let testfiles_in_dir dir = + CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f: CCIO.read_lines_l + +let name_from_file testname filename = + let open Filename in + testname ^ "::" ^ dirname filename ^ "::" ^ basename (chop_extension filename) - let tests_from_dir ~name ~compiler ?runtime ?oracle ?testeable dir = - let open Alcotest in - let to_test testfile = - let testname, exec_test = make_test ~compiler ?runtime ?oracle ?testeable testfile in - name_from_file (name ^ "::" ^ testfile), [test_case testname `Quick exec_test] - in - List.map to_test @@ testfiles_in_dir dir - |> CCList.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) - (* Use as follow: *) - (* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) +let tests_from_dir ~name ~compiler ?runtime ?oracle ?testeable dir = + let open Alcotest in + let to_test testfile = + let testname, exec_test = make_test ~compiler ?runtime ?oracle ?testeable testfile in + name_from_file name testfile, [test_case testname `Quick exec_test] + in + testfiles_in_dir dir + |> List.map to_test + |> List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) + +(* Use as follow: *) +(* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) diff --git a/oracle.ml b/oracle.ml deleted file mode 100644 index ae18f94..0000000 --- a/oracle.ml +++ /dev/null @@ -1,10 +0,0 @@ -open Type - - -let notimplemented = - Runtime ( - fun - (_ : t) - (_ : string) -> - Error (RTError, "Not implemented") - ) \ No newline at end of file diff --git a/runtime.ml b/runtime.ml index 15b64c6..a22c820 100644 --- a/runtime.ml +++ b/runtime.ml @@ -46,7 +46,6 @@ let clangruntime else Error (RTError, out ^ err) ) - (** Calling a unix command *) let unixcommand (command) = @@ -64,7 +63,6 @@ let unixcommand else Error (RTError, out ^ err) ) - (** Directly passing the compiled code *) let compileout = Runtime ( @@ -77,3 +75,12 @@ let compileout = let* () = write_file file input RTError in Ok (process_output input) ) + +(** Not implemented runtime *) +let notimplemented = + Runtime ( + fun + (_ : t) + (_ : string) -> + Error (RTError, "Not implemented") + ) diff --git a/test.ml b/test.ml index d67adde..a9d3609 100644 --- a/test.ml +++ b/test.ml @@ -4,30 +4,34 @@ open Type let test_regexp = Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" +let get_opt s dflt tokens = + let open Str in + match tokens with + | Delim s' :: Text content :: rest when s = s' -> + String.trim content, rest + | all -> dflt, all + +let parse_content filename content = + let open Str in + let toks = full_split test_regexp content in + let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in + let description, toks = get_opt "DESCRIPTION:" "" toks in + let params_string, toks = get_opt "PARAMS:" "" toks in + let params = List.map String.trim (String.split_on_char ',' params_string) in + let status, toks = get_opt "STATUS:" "ok" toks in + match toks with + | Delim "SRC:" :: Text src :: + Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> + Some { file = filename; name; description; params; status = status_of_string status; + src; expected = String.trim expected } + | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) + + let read_test filename = if Sys.file_exists filename then - let content = CCIO.(with_in filename read_all) in - let open Str in - let get_opt s dflt = function - | Delim s' :: Text content :: rest when s = s' -> - String.trim content, rest - | all -> dflt, all - in - let toks = full_split test_regexp content in - let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in - let description, toks = get_opt "DESCRIPTION:" "" toks in - let params, toks = - let params_string, toks = get_opt "PARAMS:" "" toks in - String.(List.map trim @@ split_on_char ',' params_string), toks - in - let status, toks = get_opt "STATUS:" "ok" toks in - match toks with - | Delim "SRC:" :: Text src :: - Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> - Some { file=filename ; name ; description ; params ; status = status_of_string status ; - src ; expected = String.trim expected } - | _ -> - (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) + CCIO.(with_in filename read_all) + |> String.trim + |> parse_content filename else (Printf.fprintf stderr "Test file %s not found." filename ; None) diff --git a/testeable.ml b/testeable.ml index a9fa1f3..5d88dbd 100644 --- a/testeable.ml +++ b/testeable.ml @@ -3,7 +3,8 @@ open Type let string_ignore = let open Alcotest in - testable (pp string) (fun _ _ -> true) + let matches _ _ = true in + testable (pp string) matches let string_match = let open Alcotest in @@ -34,6 +35,7 @@ let compare_status = dep_pair status_match (fun _ -> string_ignore) ) + (* Testing the result of running a test *) let compare_results = Testeable ( diff --git a/type.ml b/type.ml index ddfc949..c4c5d6e 100644 --- a/type.ml +++ b/type.ml @@ -29,6 +29,7 @@ type t = let (let*) = Result.bind + type compiler = | Compiler of (t -> string -> (string, status * string) result) | SCompiler of (t -> string -> string) From 26676f511f54fb68b029cf71a8ded509d4cb0bdb Mon Sep 17 00:00:00 2001 From: Docker Date: Tue, 2 Jan 2024 00:44:43 +0000 Subject: [PATCH 14/28] feat: legacy compatibility with out_channel compiler --- main.ml | 4 ++-- pipeline.ml | 8 ++++++++ runtime.ml | 22 ++++++++++------------ type.ml | 2 ++ type.mli | 8 ++++++-- util.ml | 17 ++++++++++++++--- 6 files changed, 42 insertions(+), 19 deletions(-) diff --git a/main.ml b/main.ml index 25e0cce..b6721e9 100644 --- a/main.ml +++ b/main.ml @@ -3,8 +3,8 @@ open Type let make_test ~(compiler : compiler) - ?(runtime : runtime = Runtime.compileout) - ?(oracle : runtime = Runtime.notimplemented) + ?(runtime : runtime = Runtime.compile_output) + ?(oracle : runtime = Runtime.not_implemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = match Test.read_test filename with diff --git a/pipeline.ml b/pipeline.ml index 375f708..fb0b428 100644 --- a/pipeline.ml +++ b/pipeline.ml @@ -1,10 +1,17 @@ open Type +open Util let compile compiler test = match compiler with | Compiler compiler -> compiler test test.src + | OCompiler compiler -> + let file = Filename.chop_extension test.file ^ ".s" in + + let* () = process_out_channel CTError file (compiler test test.src) in + let* out = read_file CTError file in + Ok out | SCompiler compiler -> try Ok (compiler test test.src) with e -> Error (CTError, Printexc.to_string e) @@ -20,6 +27,7 @@ let oracle runtime test = match runtime with | Runtime oracle when test.status = NoError && interp <> -1 -> let prefix = CCString.sub test.expected 0 (max (interp - 1) 0) in + let* out = (oracle test test.src) in Ok (prefix ^ out) | _ -> diff --git a/runtime.ml b/runtime.ml index a22c820..97890dc 100644 --- a/runtime.ml +++ b/runtime.ml @@ -26,7 +26,7 @@ let clang ~compile_flags runtime basefile = (** Calling the compiler (clang) and assembler (nasm) *) -let clangruntime +let clang_runtime ?(compile_flags: string ="-g") (runtime : string) = Runtime ( @@ -37,7 +37,7 @@ let clangruntime let file = base ^ ".s" in let exe = base ^ ".run" in - let* () = write_file file input RTError in + let* () = write_file RTError file input in let* () = nasm base in let* () = clang ~compile_flags runtime base in let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in @@ -47,16 +47,15 @@ let clangruntime ) (** Calling a unix command *) -let unixcommand +let unix_command (command) = Runtime ( fun (test : t) (input : string) -> - let base = Filename.chop_extension test.file in - let file = base ^ ".s" in + let file = Filename.chop_extension test.file ^ ".s" in - let* () = write_file file input RTError in + let* () = write_file RTError file input in let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) command file in if retcode = 0 then Ok (process_output out) @@ -64,20 +63,19 @@ let unixcommand ) (** Directly passing the compiled code *) -let compileout = +let compile_output = Runtime ( fun (test : t) (input : string) -> - let base = Filename.chop_extension test.file in - let file = base ^ ".s" in - - let* () = write_file file input RTError in + let file = Filename.chop_extension test.file ^ ".s" in + + let* () = write_file RTError file input in Ok (process_output input) ) (** Not implemented runtime *) -let notimplemented = +let not_implemented = Runtime ( fun (_ : t) diff --git a/type.ml b/type.ml index c4c5d6e..bba1110 100644 --- a/type.ml +++ b/type.ml @@ -27,11 +27,13 @@ type t = ; expected : string } +(** Bind operator for results *) let (let*) = Result.bind type compiler = | Compiler of (t -> string -> (string, status * string) result) +| OCompiler of (t -> string -> out_channel -> unit) | SCompiler of (t -> string -> string) type runtime = diff --git a/type.mli b/type.mli index 9adbaad..695310b 100644 --- a/type.mli +++ b/type.mli @@ -41,15 +41,19 @@ type t = (** expected result of the test *) } +(** Bind operator for results *) val ( let* ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result -(** A compiler is a function that takes a source program as a string, and -an output channel as a sink to output the compiled program *) +(** A compiler is a function that takes a source program as a string, +and return a string containing the result of the compilation. *) type compiler = | Compiler of (t -> string -> (string, status * string) result) +| OCompiler of (t -> string -> out_channel -> unit) | SCompiler of (t -> string -> string) +(** A runtime is a function that takes a source program as a string, +and return a string containing the result of the execution. *) type runtime = | Runtime of (t -> string -> (string, status * string) result) diff --git a/util.ml b/util.ml index f63f8e5..f32f4d2 100644 --- a/util.ml +++ b/util.ml @@ -1,6 +1,13 @@ +open Type + + +let handle_exception error func = + try Ok (func ()) + with e -> Error (error, Printexc.to_string e) + let handle_result result = match result with - | Ok out -> Type.NoError, out + | Ok out -> NoError, out | Error err -> err @@ -17,10 +24,14 @@ let process_output out = String.trim out |> filter_lines is_comment_line -let write_file file string error = +let process_out_channel error file channel = + try Ok (CCIO.with_out file channel) + with e -> Error (error, Printexc.to_string e) + +let write_file error file string = try Ok (CCIO.with_out file (fun o -> output_string o string)) with e -> Error (error, Printexc.to_string e) -let read_file file error = +let read_file error file = try Ok (process_output (CCIO.with_in file CCIO.read_all)) with e -> Error (error, Printexc.to_string e) From 73b8082195444bdcd23043837c3ba10f520b2ac7 Mon Sep 17 00:00:00 2001 From: Docker Date: Tue, 2 Jan 2024 01:22:34 +0000 Subject: [PATCH 15/28] feat: update README.md --- README.md | 3 ++- pipeline.ml | 2 -- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 6118519..0ab1261 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,7 @@ Original BBCTester runs a complete pipeline for an x86 assembly compiler and exe ## Future goals - Improve pipeline & test configurations - Add benchmarking capabilities to tests +- Add examples with different settings ## Dependencies - dune (>= 3.10) @@ -104,7 +105,7 @@ let () = SCompiler ( fun _ s -> (compile_prog (parse_prog (sexp_from_string s))) ) in let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default: "-z noexecstack -g -m64 -fPIE -pie" in - let runtime : runtime = (clangruntime ~compile_flags "rt/sys.c") in + let runtime : runtime = (clang_runtime ~compile_flags "rt/sys.c") in let oracle : runtime = Runtime ( fun _ s -> ( diff --git a/pipeline.ml b/pipeline.ml index fb0b428..c898707 100644 --- a/pipeline.ml +++ b/pipeline.ml @@ -8,7 +8,6 @@ let compile compiler test = compiler test test.src | OCompiler compiler -> let file = Filename.chop_extension test.file ^ ".s" in - let* () = process_out_channel CTError file (compiler test test.src) in let* out = read_file CTError file in Ok out @@ -27,7 +26,6 @@ let oracle runtime test = match runtime with | Runtime oracle when test.status = NoError && interp <> -1 -> let prefix = CCString.sub test.expected 0 (max (interp - 1) 0) in - let* out = (oracle test test.src) in Ok (prefix ^ out) | _ -> From 2b4d2cab138c97f36afed353048fa7b14d26579b Mon Sep 17 00:00:00 2001 From: Docker Date: Tue, 2 Jan 2024 19:26:01 +0000 Subject: [PATCH 16/28] wip: ensure composability for runtime functions --- main.ml | 4 +-- pipeline.ml | 18 +++---------- runtime.ml | 76 +++++++++++++++++++++++----------------------------- testeable.ml | 33 ++++++++++------------- type.ml | 8 +++--- type.mli | 6 ++--- 6 files changed, 58 insertions(+), 87 deletions(-) diff --git a/main.ml b/main.ml index b6721e9..9391d79 100644 --- a/main.ml +++ b/main.ml @@ -15,7 +15,7 @@ let make_test let res = Util.handle_result @@ let* out = Pipeline.compile compiler test in - let* out = Pipeline.runtime runtime test out in + let* out = runtime test out in Ok out in @@ -25,7 +25,7 @@ let make_test Ok out in - let testing = Pipeline.test testeable test in + let testing = testeable test in Alcotest.check testing test.name exp res in test.name, exec diff --git a/pipeline.ml b/pipeline.ml index c898707..c6f0e2e 100644 --- a/pipeline.ml +++ b/pipeline.ml @@ -15,25 +15,13 @@ let compile compiler test = try Ok (compiler test test.src) with e -> Error (CTError, Printexc.to_string e) - -let runtime runtime test input = - match runtime with - | Runtime runtime -> runtime test input - - let oracle runtime test = let interp = CCString.find ~sub:"|ORACLE" test.expected in - match runtime with - | Runtime oracle when test.status = NoError && interp <> -1 -> + if test.status = NoError && interp <> -1 then let prefix = CCString.sub test.expected 0 (max (interp - 1) 0) in - let* out = (oracle test test.src) in + let* out = (runtime test test.src) in Ok (prefix ^ out) - | _ -> + else (match test.status with | NoError -> Ok test.expected | _ -> Error (test.status, test.expected)) - - -let test testeable test = - match testeable with - | Testeable testeable -> testeable test diff --git a/runtime.ml b/runtime.ml index 97890dc..57ed106 100644 --- a/runtime.ml +++ b/runtime.ml @@ -29,56 +29,48 @@ let clang ~compile_flags runtime basefile = let clang_runtime ?(compile_flags: string ="-g") (runtime : string) = - Runtime ( - fun - (test : t) - (input : string) -> - let base = Filename.chop_extension test.file in - let file = base ^ ".s" in - let exe = base ^ ".run" in - - let* () = write_file RTError file input in - let* () = nasm base in - let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) - ) + fun + (test : t) + (input : string) -> + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in + let exe = base ^ ".run" in + + let* () = write_file RTError file input in + let* () = nasm base in + let* () = clang ~compile_flags runtime base in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) (** Calling a unix command *) let unix_command (command) = - Runtime ( - fun - (test : t) - (input : string) -> - let file = Filename.chop_extension test.file ^ ".s" in + fun + (test : t) + (input : string) -> + let file = Filename.chop_extension test.file ^ ".s" in - let* () = write_file RTError file input in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) command file in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) - ) + let* () = write_file RTError file input in + let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) command file in + if retcode = 0 then + Ok (process_output out) + else Error (RTError, out ^ err) (** Directly passing the compiled code *) let compile_output = - Runtime ( - fun - (test : t) - (input : string) -> - let file = Filename.chop_extension test.file ^ ".s" in - - let* () = write_file RTError file input in - Ok (process_output input) - ) + fun + (test : t) + (input : string) -> + let file = Filename.chop_extension test.file ^ ".s" in + + let* () = write_file RTError file input in + Ok (process_output input) (** Not implemented runtime *) let not_implemented = - Runtime ( - fun - (_ : t) - (_ : string) -> - Error (RTError, "Not implemented") - ) + fun + (_ : t) + (_ : string) -> + Error (RTError, "Not implemented") diff --git a/testeable.ml b/testeable.ml index 5d88dbd..c15ce36 100644 --- a/testeable.ml +++ b/testeable.ml @@ -1,12 +1,21 @@ open Type +let status_match = + let open Alcotest in + testable Fmt.(using string_of_status string) (=) + let string_ignore = + function + | _ -> let open Alcotest in let matches _ _ = true in testable (pp string) matches let string_match = + function + | NoError -> Alcotest.string + | _ -> let open Alcotest in let matches pat s = try let _ = Str.(search_forward (regexp pat) s 0) in true @@ -14,10 +23,6 @@ let string_match = in testable (pp string) matches -let status_match = - let open Alcotest in - testable Fmt.(using string_of_status string) (=) - (** Test pairs giving access to the first component when testing the second component *) let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a * b) Alcotest.testable = @@ -29,21 +34,11 @@ let dep_pair : type a b. a Alcotest.testable -> (a -> b Alcotest.testable) -> (a (* Testing the status of running a test *) let compare_status = - Testeable ( - fun - (_ : t) -> - dep_pair status_match (fun _ -> string_ignore) - ) + fun (_ : t) -> + dep_pair status_match string_ignore (* Testing the result of running a test *) -let compare_results = - Testeable ( - fun - (_ : t) -> - let result_match = function - | NoError -> Alcotest.string - | _ -> string_match - in - dep_pair status_match result_match - ) +let compare_results = + fun (_ : t) -> + dep_pair status_match string_match diff --git a/type.ml b/type.ml index bba1110..7e9a871 100644 --- a/type.ml +++ b/type.ml @@ -5,7 +5,7 @@ type status = let status_of_string = function | "CT error" -> CTError - | "fail" | "RT error" -> RTError + | "RT error" -> RTError | _ -> NoError let string_of_status = function @@ -36,8 +36,6 @@ type compiler = | OCompiler of (t -> string -> out_channel -> unit) | SCompiler of (t -> string -> string) -type runtime = -| Runtime of (t -> string -> (string, status * string) result) +type runtime = (t -> string -> (string, status * string) result) -type testeable = -| Testeable of (t -> (status * string) Alcotest.testable) +type testeable = (t -> (status * string) Alcotest.testable) diff --git a/type.mli b/type.mli index 695310b..cd22528 100644 --- a/type.mli +++ b/type.mli @@ -54,8 +54,6 @@ type compiler = (** A runtime is a function that takes a source program as a string, and return a string containing the result of the execution. *) -type runtime = -| Runtime of (t -> string -> (string, status * string) result) +type runtime = (t -> string -> (string, status * string) result) -type testeable = -| Testeable of (t -> (status * string) Alcotest.testable) +type testeable = (t -> (status * string) Alcotest.testable) From bf1d061e4c8e1661b6c41dc99cd39411f59546a0 Mon Sep 17 00:00:00 2001 From: Docker Date: Wed, 3 Jan 2024 03:24:25 +0000 Subject: [PATCH 17/28] feat: ensure composability for runtime functions --- main.ml | 2 +- runtime.ml | 39 +++++++++++++++++++-------------------- util.ml | 36 ++++++++++++++++++++++++------------ 3 files changed, 44 insertions(+), 33 deletions(-) diff --git a/main.ml b/main.ml index 9391d79..14f29bf 100644 --- a/main.ml +++ b/main.ml @@ -3,7 +3,7 @@ open Type let make_test ~(compiler : compiler) - ?(runtime : runtime = Runtime.compile_output) + ?(runtime : runtime = Runtime.direct_output) ?(oracle : runtime = Runtime.not_implemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = diff --git a/runtime.ml b/runtime.ml index 57ed106..de106a3 100644 --- a/runtime.ml +++ b/runtime.ml @@ -2,12 +2,6 @@ open Type open Util -(* Produce a result out of the return data from the compiler/assembler *) -let wrap_result (out, err, retcode) = - if retcode = 0 && String.equal "" err - then (print_string out ; Ok ()) - else Error (CTError, out ^ err) - (* Find out current architecture (only supporting Linux/OS X for now) *) let bin_format = let out, _ , _ = CCUnix.call "uname -s" in @@ -19,10 +13,17 @@ let bin_format = let nasm basefile = - wrap_result @@ CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile + print_output @@ (wrap_result RTError) @@ + CCUnix.call "nasm -f %s -o %s.o %s.s" bin_format basefile basefile let clang ~compile_flags runtime basefile = - wrap_result @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile + print_output @@ (wrap_result RTError) @@ + CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile + +let call command params file = + let warning = true in + process_output @@ (wrap_result ~warning RTError) @@ + CCUnix.call ~env:(Array.of_list params) command file (** Calling the compiler (clang) and assembler (nasm) *) @@ -39,10 +40,8 @@ let clang_runtime let* () = write_file RTError file input in let* () = nasm base in let* () = clang ~compile_flags runtime base in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) "./%s" exe in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) + let* out = call "./%s" test.params exe in + Ok out (** Calling a unix command *) let unix_command @@ -50,23 +49,23 @@ let unix_command fun (test : t) (input : string) -> - let file = Filename.chop_extension test.file ^ ".s" in + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in let* () = write_file RTError file input in - let out, err, retcode = CCUnix.call ~env:(Array.of_list test.params) command file in - if retcode = 0 then - Ok (process_output out) - else Error (RTError, out ^ err) + let* out = call command test.params file in + Ok out (** Directly passing the compiled code *) -let compile_output = +let direct_output = fun (test : t) (input : string) -> - let file = Filename.chop_extension test.file ^ ".s" in + let base = Filename.chop_extension test.file in + let file = base ^ ".s" in let* () = write_file RTError file input in - Ok (process_output input) + Ok (process_string input) (** Not implemented runtime *) let not_implemented = diff --git a/util.ml b/util.ml index f32f4d2..450119f 100644 --- a/util.ml +++ b/util.ml @@ -1,16 +1,6 @@ open Type -let handle_exception error func = - try Ok (func ()) - with e -> Error (error, Printexc.to_string e) - -let handle_result result = - match result with - | Ok out -> NoError, out - | Error err -> err - - (** Helper functions on strings and processes *) let filter_lines pred s = CCString.split ~by:"\n" s @@ -20,10 +10,32 @@ let filter_lines pred s = let is_comment_line s = not (CCString.prefix ~pre:"|" s) -let process_output out = +let process_string out = String.trim out |> filter_lines is_comment_line +(* Produce a result out of the return data from the compiler/assembler *) +let wrap_result ?(warning = false) error (out, err, retcode) = + if retcode = 0 && (warning || String.equal "" err) + then Ok out + else Error (error, out ^ err) + +let print_output out = + let* out = out in + print_string out; Ok () + +let process_output out = + let* out = out in + Ok (process_string out) + + +(** extract values from result *) +let handle_result result = + match result with + | Ok out -> NoError, out + | Error err -> err + + let process_out_channel error file channel = try Ok (CCIO.with_out file channel) with e -> Error (error, Printexc.to_string e) @@ -33,5 +45,5 @@ let write_file error file string = with e -> Error (error, Printexc.to_string e) let read_file error file = - try Ok (process_output (CCIO.with_in file CCIO.read_all)) + try Ok (process_string @@ (CCIO.with_in file CCIO.read_all)) with e -> Error (error, Printexc.to_string e) From 6cd9dc7c0a7698721865b309b5a560121e2a26db Mon Sep 17 00:00:00 2001 From: Docker Date: Tue, 6 Aug 2024 19:39:45 +0100 Subject: [PATCH 18/28] rename to bbctester --- README.md | 54 ++++++++++++++++++++++++++-------------------------- dune | 4 ++-- dune-project | 4 ++-- 3 files changed, 31 insertions(+), 31 deletions(-) diff --git a/README.md b/README.md index 0ab1261..6d524be 100644 --- a/README.md +++ b/README.md @@ -22,27 +22,27 @@ Original BBCTester runs a complete pipeline for an x86 assembly compiler and exe Download the sources as a zip archive, unzip and install the package ```bash -$ unzip BBCStepTester-main.zip -Archive: BBCStepTester-main.zip +$ unzip BBCTester-main.zip +Archive: BBCTester-main.zip 0e3ce14f8587aafdcc6f64c07de0c2e3c2fde838 - creating: BBCStepTester-main/ - inflating: BBCStepTester-main/.gitignore - inflating: BBCStepTester-main/Makefile - inflating: BBCStepTester-main/README.md - inflating: BBCStepTester-main/dune - inflating: BBCStepTester-main/dune-project - inflating: BBCStepTester-main/main.ml - inflating: BBCStepTester-main/main.mli - inflating: BBCStepTester-main/pipeline.ml - inflating: BBCStepTester-main/runtime.ml - inflating: BBCStepTester-main/test.ml - inflating: BBCStepTester-main/test.mli - inflating: BBCStepTester-main/testeable.ml - inflating: BBCStepTester-main/type.ml - inflating: BBCStepTester-main/type.mli - inflating: BBCStepTester-main/util.ml - -$ cd BBCStepTester-main + creating: BBCTester-main/ + inflating: BBCTester-main/.gitignore + inflating: BBCTester-main/Makefile + inflating: BBCTester-main/README.md + inflating: BBCTester-main/dune + inflating: BBCTester-main/dune-project + inflating: BBCTester-main/main.ml + inflating: BBCTester-main/main.mli + inflating: BBCTester-main/pipeline.ml + inflating: BBCTester-main/runtime.ml + inflating: BBCTester-main/test.ml + inflating: BBCTester-main/test.mli + inflating: BBCTester-main/testeable.ml + inflating: BBCTester-main/type.ml + inflating: BBCTester-main/type.mli + inflating: BBCTester-main/util.ml + +$ cd BBCTester-main $ make install dune build @@ -52,8 +52,8 @@ Installing ... Alternatively, you can clone the repository and install ```bash -$ git clone https://github.com/fabaindaiz/BBCStepTester -Cloning into 'BBCStepTester'... +$ git clone https://github.com/pleiad/BBCTester.git +Cloning into 'BBCTester'... remote: Enumerating objects: 81, done. remote: Counting objects: 100% (81/81), done. remote: Compressing objects: 100% (55/55), done. @@ -61,7 +61,7 @@ remote: Total 81 (delta 48), reused 51 (delta 25), pack-reused 0 Receiving objects: 100% (81/81), 17.79 KiB | 17.79 MiB/s, done. Resolving deltas: 100% (48/48), done. -$ cd BBCStepTester +$ cd BBCTester $ make install dune build @@ -92,9 +92,9 @@ val tests_from_dir : ```ocaml (* Example of using tests_from_dir *) -open Bbcsteptester.Type -open Bbcsteptester.Main -open Bbcsteptester.Runtime +open Bbctester.Type +open Bbctester.Main +open Bbctester.Runtime (* .......... *) @@ -121,7 +121,7 @@ let () = let name : string = "bbc" in tests_from_dir ~name ~compiler ~runtime ~oracle "bbctests" in - run "Tests MiniCompiler" (ocaml_tests @ bbc_tests) + run "Tests CC5116 Compiler" (ocaml_tests @ bbc_tests) ``` diff --git a/dune b/dune index 21f33fd..542d0fe 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library - (name bbcsteptester) ; Black-Box Compiler Tester - (public_name bbcsteptester) + (name bbctester) ; Black-Box Compiler Tester + (public_name bbctester) (modules main pipeline runtime testeable test type util) (libraries alcotest containers containers.unix str)) diff --git a/dune-project b/dune-project index aba0399..8d83e2a 100644 --- a/dune-project +++ b/dune-project @@ -1,7 +1,7 @@ (lang dune 3.10) -(name bbcsteptester) +(name bbctester) ; Not using opam because of not understood bug with generated `dune subst --root` ; (generate_opam_files true) @@ -10,7 +10,7 @@ (maintainers "kenji@maillard.blue") (package - (name bbcsteptester) + (name bbctester) (version 0.2) (synopsis "Black-box compiler tester") (description "Tester for the compilation lecture CC5116") From e2c3223c7f84bc8346f447487a93f33bf2d991dd Mon Sep 17 00:00:00 2001 From: fabaindaiz Date: Tue, 6 Aug 2024 20:46:51 +0100 Subject: [PATCH 19/28] feat: add compiler flags --- main.ml | 2 +- test.ml | 6 ++++-- type.ml | 1 + type.mli | 2 ++ 4 files changed, 8 insertions(+), 3 deletions(-) diff --git a/main.ml b/main.ml index 14f29bf..ba7b4ab 100644 --- a/main.ml +++ b/main.ml @@ -3,7 +3,7 @@ open Type let make_test ~(compiler : compiler) - ?(runtime : runtime = Runtime.direct_output) + ?(runtime : runtime = Runtime.not_implemented) ?(oracle : runtime = Runtime.not_implemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = diff --git a/test.ml b/test.ml index a9d3609..ce1cece 100644 --- a/test.ml +++ b/test.ml @@ -2,7 +2,7 @@ open Type let test_regexp = - Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" + Str.regexp "NAME:\\|DESCRIPTION:\\|FLAGS:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" let get_opt s dflt tokens = let open Str in @@ -16,13 +16,15 @@ let parse_content filename content = let toks = full_split test_regexp content in let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in let description, toks = get_opt "DESCRIPTION:" "" toks in + let flags_string, toks = get_opt "FLAGS:" "" toks in + let flags = List.map String.trim (String.split_on_char ',' flags_string) in let params_string, toks = get_opt "PARAMS:" "" toks in let params = List.map String.trim (String.split_on_char ',' params_string) in let status, toks = get_opt "STATUS:" "ok" toks in match toks with | Delim "SRC:" :: Text src :: Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> - Some { file = filename; name; description; params; status = status_of_string status; + Some { file = filename; name; description; flags; params; status = status_of_string status; src; expected = String.trim expected } | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) diff --git a/type.ml b/type.ml index 7e9a871..2e761af 100644 --- a/type.ml +++ b/type.ml @@ -21,6 +21,7 @@ type t = { file : string ; name : string ; description : string + ; flags : string list ; params : string list ; status : status ; src : string diff --git a/type.mli b/type.mli index cd22528..96cd095 100644 --- a/type.mli +++ b/type.mli @@ -31,6 +31,8 @@ type t = (** Name of the test *) ; description : string (** Description of the test *) + ; flags : string list + (** Compilation flags passed to the compiler *) ; params : string list (** Parameters passed to the test as environment variables *) ; status : status From 3bdb8a6ddfa4ca2586a456fa0ea051dadf5695ba Mon Sep 17 00:00:00 2001 From: fabaindaiz Date: Tue, 6 Aug 2024 22:37:40 +0100 Subject: [PATCH 20/28] Revert "feat: add compiler flags" This reverts commit e2c3223c7f84bc8346f447487a93f33bf2d991dd. --- main.ml | 2 +- test.ml | 6 ++---- type.ml | 1 - type.mli | 2 -- 4 files changed, 3 insertions(+), 8 deletions(-) diff --git a/main.ml b/main.ml index ba7b4ab..14f29bf 100644 --- a/main.ml +++ b/main.ml @@ -3,7 +3,7 @@ open Type let make_test ~(compiler : compiler) - ?(runtime : runtime = Runtime.not_implemented) + ?(runtime : runtime = Runtime.direct_output) ?(oracle : runtime = Runtime.not_implemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = diff --git a/test.ml b/test.ml index ce1cece..a9d3609 100644 --- a/test.ml +++ b/test.ml @@ -2,7 +2,7 @@ open Type let test_regexp = - Str.regexp "NAME:\\|DESCRIPTION:\\|FLAGS:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" + Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" let get_opt s dflt tokens = let open Str in @@ -16,15 +16,13 @@ let parse_content filename content = let toks = full_split test_regexp content in let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in let description, toks = get_opt "DESCRIPTION:" "" toks in - let flags_string, toks = get_opt "FLAGS:" "" toks in - let flags = List.map String.trim (String.split_on_char ',' flags_string) in let params_string, toks = get_opt "PARAMS:" "" toks in let params = List.map String.trim (String.split_on_char ',' params_string) in let status, toks = get_opt "STATUS:" "ok" toks in match toks with | Delim "SRC:" :: Text src :: Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> - Some { file = filename; name; description; flags; params; status = status_of_string status; + Some { file = filename; name; description; params; status = status_of_string status; src; expected = String.trim expected } | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) diff --git a/type.ml b/type.ml index 2e761af..7e9a871 100644 --- a/type.ml +++ b/type.ml @@ -21,7 +21,6 @@ type t = { file : string ; name : string ; description : string - ; flags : string list ; params : string list ; status : status ; src : string diff --git a/type.mli b/type.mli index 96cd095..cd22528 100644 --- a/type.mli +++ b/type.mli @@ -31,8 +31,6 @@ type t = (** Name of the test *) ; description : string (** Description of the test *) - ; flags : string list - (** Compilation flags passed to the compiler *) ; params : string list (** Parameters passed to the test as environment variables *) ; status : status From 2ca61ddf7eb6f3e874b4c3ce852b698c616b7aa0 Mon Sep 17 00:00:00 2001 From: Docker Date: Wed, 7 Aug 2024 18:18:36 +0100 Subject: [PATCH 21/28] fix: add fail as RTError --- type.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/type.ml b/type.ml index 7e9a871..155353c 100644 --- a/type.ml +++ b/type.ml @@ -4,8 +4,9 @@ type status = | NoError let status_of_string = function - | "CT error" -> CTError + | "fail" | "RT error" -> RTError + | "CT error" -> CTError | _ -> NoError let string_of_status = function From 10d9357092efa7cc8df23d6d5cc594cb120cc0c2 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Fri, 29 Nov 2024 19:32:51 +0000 Subject: [PATCH 22/28] feat add suport for legacy format --- dune | 2 +- file.ml | 37 ++++++++++++++++++++++++++++++++++ file.mli | 15 ++++++++++++++ main.ml | 2 +- main.mli | 8 ++++++++ runtime.ml | 21 ++++++++++++++++++++ test.ml | 58 +++++++++++++++++++++++++----------------------------- test.mli | 31 ++++++++++++++++++----------- type.ml | 1 + type.mli | 1 - 10 files changed, 130 insertions(+), 46 deletions(-) create mode 100644 file.ml create mode 100644 file.mli diff --git a/dune b/dune index 542d0fe..424f351 100644 --- a/dune +++ b/dune @@ -1,5 +1,5 @@ (library (name bbctester) ; Black-Box Compiler Tester (public_name bbctester) - (modules main pipeline runtime testeable test type util) + (modules main test pipeline runtime testeable file type util) (libraries alcotest containers containers.unix str)) diff --git a/file.ml b/file.ml new file mode 100644 index 0000000..a9d3609 --- /dev/null +++ b/file.ml @@ -0,0 +1,37 @@ +open Type + + +let test_regexp = + Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" + +let get_opt s dflt tokens = + let open Str in + match tokens with + | Delim s' :: Text content :: rest when s = s' -> + String.trim content, rest + | all -> dflt, all + +let parse_content filename content = + let open Str in + let toks = full_split test_regexp content in + let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in + let description, toks = get_opt "DESCRIPTION:" "" toks in + let params_string, toks = get_opt "PARAMS:" "" toks in + let params = List.map String.trim (String.split_on_char ',' params_string) in + let status, toks = get_opt "STATUS:" "ok" toks in + match toks with + | Delim "SRC:" :: Text src :: + Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> + Some { file = filename; name; description; params; status = status_of_string status; + src; expected = String.trim expected } + | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) + + +let read_test filename = + if Sys.file_exists filename + then + CCIO.(with_in filename read_all) + |> String.trim + |> parse_content filename + else + (Printf.fprintf stderr "Test file %s not found." filename ; None) diff --git a/file.mli b/file.mli new file mode 100644 index 0000000..7d619c9 --- /dev/null +++ b/file.mli @@ -0,0 +1,15 @@ +open Type + + +(** [read_test s] parses the content of a test file provided in the string s + returns None if any error occurred while reading the file (prints to stderr) + + The file format is composed of a few sections that appear in the following order: + - `NAME:` [optional, default empty] : the name of the test + - `DESCRIPTION:` [optional, default empty] : a longer description of the content of the test + - `PARAMS:` [optional, default empty] : a `,`-separated list of pairs `VAR=VAL` that are adde to the environment variables of the compiled executable + - `STATUS:` [optional, default `No error`] : either `CT error` (compile time error), `RT error` (runtime error) or `No error`/ Needs to be set to the appropriate error if the program is expected to fail either at compile time or at runtime. In that case the content of `EXPECTED:` is interpreted as a pattern (see [Str](https://caml.inria.fr/pub/docs/manual-ocaml/libref/Str.html)) matched against the output of the failing phase. + - `SRC:` : the source of the program def to the compiler + - `EXPECTED:` : the expected result of the program (note that debugging messages starting by `|` are ignored and shouldn't be part of the expected result). If the expected result ends with the message `|INTERPRET` then the expected result is obtained by subsituting `|INTERPRET` with the result of evaluating the interpreter on the source code. + *) +val read_test : string -> t option diff --git a/main.ml b/main.ml index 14f29bf..bba6e04 100644 --- a/main.ml +++ b/main.ml @@ -7,7 +7,7 @@ let make_test ?(oracle : runtime = Runtime.not_implemented) ?(testeable : testeable = Testeable.compare_results) (filename : string) = - match Test.read_test filename with + match File.read_test filename with | None -> Alcotest.failf "Could not open or parse test %s" filename | Some test -> let exec () = diff --git a/main.mli b/main.mli index 9498b93..8d6ac9e 100644 --- a/main.mli +++ b/main.mli @@ -1,5 +1,13 @@ open Type +val make_test : + compiler:compiler -> + ?runtime:runtime -> + ?oracle:runtime -> + ?testeable:testeable -> + string -> string * (unit -> unit) + +val name_from_file : string -> string -> string (** [testfiles_in_dir path] collects the content of all thet `*.bbc` files found at [path]; uses `find` (GNU findutils) *) diff --git a/runtime.ml b/runtime.ml index de106a3..9064297 100644 --- a/runtime.ml +++ b/runtime.ml @@ -20,6 +20,10 @@ let clang ~compile_flags runtime basefile = print_output @@ (wrap_result RTError) @@ CCUnix.call "clang %s -o %s.run %s %s.o" compile_flags basefile runtime basefile +let gcc ~compile_flags runtime basefile = + print_output @@ (wrap_result RTError) @@ + CCUnix.call "gcc %s -o %s.run %s %s.o" compile_flags basefile runtime basefile + let call command params file = let warning = true in process_output @@ (wrap_result ~warning RTError) @@ @@ -43,6 +47,23 @@ let clang_runtime let* out = call "./%s" test.params exe in Ok out +(** Calling the compiler (gcc) and assembler (nasm) *) +let gcc_runtime +?(compile_flags: string ="-g") +(runtime : string) = +fun +(test : t) +(input : string) -> +let base = Filename.chop_extension test.file in +let file = base ^ ".s" in +let exe = base ^ ".run" in + +let* () = write_file RTError file input in +let* () = nasm base in +let* () = gcc ~compile_flags runtime base in +let* out = call "./%s" test.params exe in +Ok out + (** Calling a unix command *) let unix_command (command) = diff --git a/test.ml b/test.ml index a9d3609..e31ea61 100644 --- a/test.ml +++ b/test.ml @@ -1,37 +1,33 @@ -open Type +include Type -let test_regexp = - Str.regexp "NAME:\\|DESCRIPTION:\\|PARAMS:\\|STATUS:\\|SRC:\\|EXPECTED:\\|END" +let testfiles_in_dir dir = + CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f: CCIO.read_lines_l -let get_opt s dflt tokens = - let open Str in - match tokens with - | Delim s' :: Text content :: rest when s = s' -> - String.trim content, rest - | all -> dflt, all -let parse_content filename content = - let open Str in - let toks = full_split test_regexp content in - let name, toks = get_opt "NAME:" Filename.(chop_extension @@ basename filename) toks in - let description, toks = get_opt "DESCRIPTION:" "" toks in - let params_string, toks = get_opt "PARAMS:" "" toks in - let params = List.map String.trim (String.split_on_char ',' params_string) in - let status, toks = get_opt "STATUS:" "ok" toks in - match toks with - | Delim "SRC:" :: Text src :: - Delim "EXPECTED:" :: Text expected :: ( [] | Delim "END" :: _ ) -> - Some { file = filename; name; description; params; status = status_of_string status; - src; expected = String.trim expected } - | _ -> (Printf.fprintf stderr "Wrong format in test file %s" filename ; None) +let oracle_from_legacy (oracle : (string -> status * string) option) : runtime option = + match oracle with + | Some runtime -> + Some (fun _ s -> + (match runtime s with + | NoError, value -> Ok (value) + | error, value -> Error (error, value))) + | None -> None +let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ?oracle dir = + let name = "legacy" in + let compiler = OCompiler (fun _ -> compiler) in + let runtime = Runtime.clang_runtime ~compile_flags runtime in + let oracle = oracle_from_legacy oracle in -let read_test filename = - if Sys.file_exists filename - then - CCIO.(with_in filename read_all) - |> String.trim - |> parse_content filename - else - (Printf.fprintf stderr "Test file %s not found." filename ; None) + let open Alcotest in + let to_test testfile = + let testname, exec_test = Main.make_test ~compiler ~runtime ?oracle testfile in + Main.name_from_file name testfile, [test_case testname `Quick exec_test] + in + testfiles_in_dir dir + |> List.map to_test + |> List.sort (fun (s1,_) (s2,_) -> String.compare s1 s2) + +(* Use as follow: *) +(* run "Tests" @@ List.map tests_from_dir [ "failing"; "tests"] *) diff --git a/test.mli b/test.mli index 7d619c9..68121b8 100644 --- a/test.mli +++ b/test.mli @@ -1,15 +1,22 @@ -open Type +include module type of Type -(** [read_test s] parses the content of a test file provided in the string s - returns None if any error occurred while reading the file (prints to stderr) +(** [testfiles_in_dir path] collects the content of all thet `*.bbc` files + found at [path]; uses `find` (GNU findutils) *) +val testfiles_in_dir : string -> string list - The file format is composed of a few sections that appear in the following order: - - `NAME:` [optional, default empty] : the name of the test - - `DESCRIPTION:` [optional, default empty] : a longer description of the content of the test - - `PARAMS:` [optional, default empty] : a `,`-separated list of pairs `VAR=VAL` that are adde to the environment variables of the compiled executable - - `STATUS:` [optional, default `No error`] : either `CT error` (compile time error), `RT error` (runtime error) or `No error`/ Needs to be set to the appropriate error if the program is expected to fail either at compile time or at runtime. In that case the content of `EXPECTED:` is interpreted as a pattern (see [Str](https://caml.inria.fr/pub/docs/manual-ocaml/libref/Str.html)) matched against the output of the failing phase. - - `SRC:` : the source of the program def to the compiler - - `EXPECTED:` : the expected result of the program (note that debugging messages starting by `|` are ignored and shouldn't be part of the expected result). If the expected result ends with the message `|INTERPRET` then the expected result is obtained by subsituting `|INTERPRET` with the result of evaluating the interpreter on the source code. - *) -val read_test : string -> t option +(** [test_from_dir ~runtime ~compiler dir] generates alcotest tests + for each test file present in [dir] and its subdirectories using + [runtime] as path to a C runtime to be linked against and [compiler] + to process the sources. + [compile_flags] are passed to the C compiler (clang), + defaulting to "-g". + The optional [oracle] parameter is an oracle (eg. an interpreter, reference compiler) to be invoked on source files. + It should return a result status together with the expected output of the corresponding program, + that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) +val tests_from_dir : + ?compile_flags:string -> + runtime:string -> + compiler:(string -> out_channel -> unit) -> + ?oracle:(string -> status * string) -> + string -> (string * unit Alcotest.test_case list) list diff --git a/type.ml b/type.ml index 155353c..30b9c87 100644 --- a/type.ml +++ b/type.ml @@ -1,3 +1,4 @@ + type status = | CTError | RTError diff --git a/type.mli b/type.mli index cd22528..1d4da27 100644 --- a/type.mli +++ b/type.mli @@ -1,5 +1,4 @@ - (** Expected status of a test *) type status = | CTError From 3bdf6f5dbf38156d45bbe4e6371e059e17bc7485 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Fri, 29 Nov 2024 19:44:15 +0000 Subject: [PATCH 23/28] feat move code into folder --- README.md | 49 +++++-------------------------- dune => dev/dune | 0 file.ml => dev/file.ml | 0 file.mli => dev/file.mli | 0 main.ml => dev/main.ml | 0 main.mli => dev/main.mli | 0 pipeline.ml => dev/pipeline.ml | 0 runtime.ml => dev/runtime.ml | 0 test.ml => dev/test.ml | 0 test.mli => dev/test.mli | 0 testeable.ml => dev/testeable.ml | 0 type.ml => dev/type.ml | 0 type.mli => dev/type.mli | 0 util.ml => dev/util.ml | 0 docs/legacy.md | 46 +++++++++++++++++++++++++++++ docs/update.md | 50 ++++++++++++++++++++++++++++++++ dune-project | 2 +- 17 files changed, 105 insertions(+), 42 deletions(-) rename dune => dev/dune (100%) rename file.ml => dev/file.ml (100%) rename file.mli => dev/file.mli (100%) rename main.ml => dev/main.ml (100%) rename main.mli => dev/main.mli (100%) rename pipeline.ml => dev/pipeline.ml (100%) rename runtime.ml => dev/runtime.ml (100%) rename test.ml => dev/test.ml (100%) rename test.mli => dev/test.mli (100%) rename testeable.ml => dev/testeable.ml (100%) rename type.ml => dev/type.ml (100%) rename type.mli => dev/type.mli (100%) rename util.ml => dev/util.ml (100%) create mode 100644 docs/legacy.md create mode 100644 docs/update.md diff --git a/README.md b/README.md index 6d524be..94f1d4e 100644 --- a/README.md +++ b/README.md @@ -75,55 +75,22 @@ Installing ... ## Entrypoint -This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest. The main entrypoint of the library is the following function (from `main.mli`). +This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest in a single module `Test`. The main entrypoint of the library is the following function (from `test.mli`). ```ocaml -(* Given a [name], a [compiler], a [runtime], a [oracle], a [action] and +(* Given the path of a C runtime file [runtime], a [compiler] and the path [dir] of a directory containing tests files, produces - unit tests for each test files in [dir]. *) + unit tests for each test files in [dir]. + [compile_flags] are passed to the C compiler (clang), + defaults to "-g". *) val tests_from_dir : - name:string -> + ?compile_flags:string -> + runtime:string -> compiler:compiler -> - ?runtime:runtime -> - ?oracle:runtime -> - ?testeable:testeable -> + ?oracle:(string -> status * string) -> string -> (string * unit Alcotest.test_case list) list ``` -```ocaml -(* Example of using tests_from_dir *) -open Bbctester.Type -open Bbctester.Main -open Bbctester.Runtime - -(* .......... *) - -(* Entry point of tester *) -let () = - - let compiler : compiler = - SCompiler ( fun _ s -> (compile_prog (parse_prog (sexp_from_string s))) ) in - - let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default: "-z noexecstack -g -m64 -fPIE -pie" in - let runtime : runtime = (clang_runtime ~compile_flags "rt/sys.c") in - - let oracle : runtime = - Runtime ( fun _ s -> ( - try Ok (string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env)) - with - | RTError msg -> Error (RTError, msg) - | CTError msg -> Error (CTError, msg) - | e -> Error (RTError, "Oracle raised an unknown error :" ^ Printexc.to_string e) - )) - in - - let bbc_tests = - let name : string = "bbc" in - tests_from_dir ~name ~compiler ~runtime ~oracle "bbctests" in - - run "Tests CC5116 Compiler" (ocaml_tests @ bbc_tests) -``` - ## Tests files (*.bbc) diff --git a/dune b/dev/dune similarity index 100% rename from dune rename to dev/dune diff --git a/file.ml b/dev/file.ml similarity index 100% rename from file.ml rename to dev/file.ml diff --git a/file.mli b/dev/file.mli similarity index 100% rename from file.mli rename to dev/file.mli diff --git a/main.ml b/dev/main.ml similarity index 100% rename from main.ml rename to dev/main.ml diff --git a/main.mli b/dev/main.mli similarity index 100% rename from main.mli rename to dev/main.mli diff --git a/pipeline.ml b/dev/pipeline.ml similarity index 100% rename from pipeline.ml rename to dev/pipeline.ml diff --git a/runtime.ml b/dev/runtime.ml similarity index 100% rename from runtime.ml rename to dev/runtime.ml diff --git a/test.ml b/dev/test.ml similarity index 100% rename from test.ml rename to dev/test.ml diff --git a/test.mli b/dev/test.mli similarity index 100% rename from test.mli rename to dev/test.mli diff --git a/testeable.ml b/dev/testeable.ml similarity index 100% rename from testeable.ml rename to dev/testeable.ml diff --git a/type.ml b/dev/type.ml similarity index 100% rename from type.ml rename to dev/type.ml diff --git a/type.mli b/dev/type.mli similarity index 100% rename from type.mli rename to dev/type.mli diff --git a/util.ml b/dev/util.ml similarity index 100% rename from util.ml rename to dev/util.ml diff --git a/docs/legacy.md b/docs/legacy.md new file mode 100644 index 0000000..42429ca --- /dev/null +++ b/docs/legacy.md @@ -0,0 +1,46 @@ +## Entrypoint + +This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest. The main entrypoint of the library is the following function (from `test.mli`). + +```ocaml +(* Given the path of a C runtime file [runtime], a [compiler] and + the path [dir] of a directory containing tests files, produces + unit tests for each test files in [dir]. + [compile_flags] are passed to the C compiler (clang), + defaults to "-g". *) +val tests_from_dir : + ?compile_flags:string -> + runtime:string -> + compiler:compiler -> + ?oracle:(string -> status * string) -> + string -> (string * unit Alcotest.test_case list) list +``` + +```ocaml +(* Example of using tests_from_dir *) +open Bbctester.Test + +(* .......... *) + +(* Entry point of tester *) +let () = + let bbc_tests = + + let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default:"-g" in + let compiler : string -> out_channel -> unit = + fun s o -> fprintf o "%s" (compile_prog (parse_prog (sexp_from_string s))) in + + let oracle : string -> status * string = ( + fun s -> ( + try + NoError, program_output (interp_prog (parse_prog (sexp_from_string s)) empty_env) + with + | RTError msg -> RTError, msg + | CTError msg -> CTError, msg + | e -> RTError, "Oracle raised an unknown error :"^ Printexc.to_string e + ) + ) in + tests_from_dir ~compile_flags ~compiler ~oracle ~runtime:"rt/sys.c" "bbctests" in + + run "Tests CC5116 Compiler" (ocaml_tests @ bbc_tests) +``` \ No newline at end of file diff --git a/docs/update.md b/docs/update.md new file mode 100644 index 0000000..932cf4c --- /dev/null +++ b/docs/update.md @@ -0,0 +1,50 @@ +## Entrypoint + +This package contains a few helper functions to parse test files (see below for the format) and generate unit-tests for alcotest. The main entrypoint of the library is the following function (from `main.mli`). + +```ocaml +(* Given a [name], a [compiler], a [runtime], a [oracle], a [action] and + the path [dir] of a directory containing tests files, produces + unit tests for each test files in [dir]. *) +val tests_from_dir : + name:string -> + compiler:compiler -> + ?runtime:runtime -> + ?oracle:runtime -> + ?testeable:testeable -> + string -> (string * unit Alcotest.test_case list) list +``` + +```ocaml +(* Example of using tests_from_dir *) +open Bbctester.Type +open Bbctester.Main +open Bbctester.Runtime + +(* .......... *) + +(* Entry point of tester *) +let () = + + let compiler : compiler = + SCompiler ( fun _ s -> (compile_prog (parse_prog (sexp_from_string s))) ) in + + let compile_flags = Option.value (Sys.getenv_opt "CFLAGS") ~default: "-z noexecstack -g -m64 -fPIE -pie" in + let runtime : runtime = (clang_runtime ~compile_flags "rt/sys.c") in + + let oracle : runtime = + Runtime ( fun _ s -> ( + try Ok (string_of_val (interp_prog (parse_prog (sexp_from_string s)) empty_env)) + with + | RTError msg -> Error (RTError, msg) + | CTError msg -> Error (CTError, msg) + | e -> Error (RTError, "Oracle raised an unknown error :" ^ Printexc.to_string e) + )) + in + + let bbc_tests = + let name : string = "bbc" in + tests_from_dir ~name ~compiler ~runtime ~oracle "bbctests" in + + run "Tests CC5116 Compiler" (ocaml_tests @ bbc_tests) +``` \ No newline at end of file diff --git a/dune-project b/dune-project index 8d83e2a..8315b5a 100644 --- a/dune-project +++ b/dune-project @@ -11,7 +11,7 @@ (package (name bbctester) - (version 0.2) + (version 0.3) (synopsis "Black-box compiler tester") (description "Tester for the compilation lecture CC5116") (depends From cf768c4b55c28143c0c22b0e2ad9f215f9f90d8d Mon Sep 17 00:00:00 2001 From: fadiaz Date: Fri, 29 Nov 2024 20:11:39 +0000 Subject: [PATCH 24/28] feat capture stdout from oracle --- dev/pipeline.ml | 63 +++++++++++++++++++++++++++++++++++++++++++++++-- dev/util.ml | 48 +++++++++++++++++++++++++++++++++++++ 2 files changed, 109 insertions(+), 2 deletions(-) diff --git a/dev/pipeline.ml b/dev/pipeline.ml index c6f0e2e..726dca0 100644 --- a/dev/pipeline.ml +++ b/dev/pipeline.ml @@ -2,6 +2,59 @@ open Type open Util +let has_pending_data fd = + try + let ready_fds, _, _ = Unix.select [fd] [] [] 0.0 in + List.length ready_fds > 0 + with _ -> false + +(* Función mejorada de captura que lee hasta completar *) +let capture_stdout_until_done (f : unit -> 'a) : string * 'a = + (* Guardamos el stdout original y creamos el pipe *) + let stdout_original = Unix.dup Unix.stdout in + let (pipe_read, pipe_write) = Unix.pipe () in + + (* Configuramos el pipe como no bloqueante para lecturas seguras *) + Unix.set_nonblock pipe_read; + Unix.dup2 pipe_write Unix.stdout; + Unix.close pipe_write; + + let buffer = Buffer.create 4096 in + let string_buffer = Bytes.create 4096 in + + let result = + try + (* Ejecutamos la función principal *) + let r = f () in + flush stdout; + + (* Leemos datos mientras haya disponibles *) + let rec read_remaining () = + if has_pending_data pipe_read then + match Unix.read pipe_read string_buffer 0 4096 with + | 0 -> () (* EOF - terminamos *) + | bytes_read -> + Buffer.add_subbytes buffer string_buffer 0 bytes_read; + read_remaining () + | exception Unix.Unix_error(Unix.EAGAIN, _, _) -> + Unix.sleepf 0.001; (* Pequeña pausa si el pipe está temporalmente vacío *) + if has_pending_data pipe_read then read_remaining () + in + read_remaining (); + Ok r + with e -> Error e + in + + (* Limpieza y restauración *) + Unix.dup2 stdout_original Unix.stdout; + Unix.close stdout_original; + Unix.close pipe_read; + + match result with + | Ok v -> (Buffer.contents buffer, v) + | Error e -> raise e + + let compile compiler test = match compiler with | Compiler compiler -> @@ -19,8 +72,14 @@ let oracle runtime test = let interp = CCString.find ~sub:"|ORACLE" test.expected in if test.status = NoError && interp <> -1 then let prefix = CCString.sub test.expected 0 (max (interp - 1) 0) in - let* out = (runtime test test.src) in - Ok (prefix ^ out) + try + (* Usamos la nueva función que lee hasta completar *) + let (stdout_output, runtime_result) = + capture_stdout_until_done (fun () -> runtime test test.src) in + let* out = runtime_result in + Ok (prefix ^ stdout_output ^ out) + with e -> + Error (RTError, "Runtime error: " ^ Printexc.to_string e) else (match test.status with | NoError -> Ok test.expected diff --git a/dev/util.ml b/dev/util.ml index 450119f..77a4dd1 100644 --- a/dev/util.ml +++ b/dev/util.ml @@ -47,3 +47,51 @@ let write_file error file string = let read_file error file = try Ok (process_string @@ (CCIO.with_in file CCIO.read_all)) with e -> Error (error, Printexc.to_string e) + + +let has_pending_data fd = + try + let ready_fds, _, _ = Unix.select [fd] [] [] 0.0 in + List.length ready_fds > 0 + with _ -> false + +let capture_stdout_until_done (f : unit -> 'a) : string * 'a = + let stdout_original = Unix.dup Unix.stdout in + let (pipe_read, pipe_write) = Unix.pipe () in + + (* pipe no bloqueante para lecturas seguras *) + Unix.set_nonblock pipe_read; + Unix.dup2 pipe_write Unix.stdout; + Unix.close pipe_write; + + let buffer = Buffer.create 4096 in + let string_buffer = Bytes.create 4096 in + + let result = + try + let r = f () in + flush stdout; + + let rec read_remaining () = + if has_pending_data pipe_read then + match Unix.read pipe_read string_buffer 0 4096 with + | 0 -> () (* EOF *) + | bytes_read -> + Buffer.add_subbytes buffer string_buffer 0 bytes_read; + read_remaining () + | exception Unix.Unix_error(Unix.EAGAIN, _, _) -> + Unix.sleepf 0.001; (* Pequeña pausa si el pipe está temporalmente vacío *) + if has_pending_data pipe_read then read_remaining () + in + read_remaining (); + Ok r + with e -> Error e + in + + Unix.dup2 stdout_original Unix.stdout; + Unix.close stdout_original; + Unix.close pipe_read; + + match result with + | Ok v -> (Buffer.contents buffer, v) + | Error e -> raise e From 691882214af7ecc5831829707a73b27124a6c9d1 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Sat, 30 Nov 2024 15:31:19 +0000 Subject: [PATCH 25/28] format test output --- dev/main.ml | 3 ++- dev/main.mli | 4 ++-- dev/pipeline.ml | 2 +- dev/test.ml | 2 +- dev/util.ml | 6 +++--- 5 files changed, 9 insertions(+), 8 deletions(-) diff --git a/dev/main.ml b/dev/main.ml index bba6e04..9de0f0c 100644 --- a/dev/main.ml +++ b/dev/main.ml @@ -36,7 +36,8 @@ let testfiles_in_dir dir = let name_from_file testname filename = let open Filename in - testname ^ "::" ^ dirname filename ^ "::" ^ basename (chop_extension filename) + (match testname with Some t -> t ^ "::" | None -> "") ^ + dirname filename ^ "::" ^ basename (chop_extension filename) let tests_from_dir ~name ~compiler ?runtime ?oracle ?testeable dir = diff --git a/dev/main.mli b/dev/main.mli index 8d6ac9e..de001ff 100644 --- a/dev/main.mli +++ b/dev/main.mli @@ -7,7 +7,7 @@ val make_test : ?testeable:testeable -> string -> string * (unit -> unit) -val name_from_file : string -> string -> string +val name_from_file : string option -> string -> string (** [testfiles_in_dir path] collects the content of all thet `*.bbc` files found at [path]; uses `find` (GNU findutils) *) @@ -23,7 +23,7 @@ val testfiles_in_dir : string -> string list It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) val tests_from_dir : - name:string -> + name:string option -> compiler:compiler -> ?runtime:runtime -> ?oracle:runtime -> diff --git a/dev/pipeline.ml b/dev/pipeline.ml index 726dca0..716a0b0 100644 --- a/dev/pipeline.ml +++ b/dev/pipeline.ml @@ -75,7 +75,7 @@ let oracle runtime test = try (* Usamos la nueva función que lee hasta completar *) let (stdout_output, runtime_result) = - capture_stdout_until_done (fun () -> runtime test test.src) in + capture_stdout (fun () -> runtime test test.src) in let* out = runtime_result in Ok (prefix ^ stdout_output ^ out) with e -> diff --git a/dev/test.ml b/dev/test.ml index e31ea61..5c5b1b2 100644 --- a/dev/test.ml +++ b/dev/test.ml @@ -15,7 +15,7 @@ let oracle_from_legacy (oracle : (string -> status * string) option) : runtime o | None -> None let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ?oracle dir = - let name = "legacy" in + let name = None in let compiler = OCompiler (fun _ -> compiler) in let runtime = Runtime.clang_runtime ~compile_flags runtime in let oracle = oracle_from_legacy oracle in diff --git a/dev/util.ml b/dev/util.ml index 77a4dd1..3a9f28d 100644 --- a/dev/util.ml +++ b/dev/util.ml @@ -49,17 +49,17 @@ let read_file error file = with e -> Error (error, Printexc.to_string e) +(* Capture stdout from a function *) let has_pending_data fd = try let ready_fds, _, _ = Unix.select [fd] [] [] 0.0 in List.length ready_fds > 0 with _ -> false -let capture_stdout_until_done (f : unit -> 'a) : string * 'a = +let capture_stdout (f : unit -> 'a) : string * 'a = let stdout_original = Unix.dup Unix.stdout in let (pipe_read, pipe_write) = Unix.pipe () in - - (* pipe no bloqueante para lecturas seguras *) + Unix.set_nonblock pipe_read; Unix.dup2 pipe_write Unix.stdout; Unix.close pipe_write; From 5e6e256e09785e8498c8e698fca2543a01f4e221 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Sat, 30 Nov 2024 15:37:55 +0000 Subject: [PATCH 26/28] remove duplicate code --- dev/main.ml | 2 +- dev/main.mli | 4 ++-- dev/pipeline.ml | 53 ------------------------------------------------- dev/test.ml | 3 +-- 4 files changed, 4 insertions(+), 58 deletions(-) diff --git a/dev/main.ml b/dev/main.ml index 9de0f0c..3edd08b 100644 --- a/dev/main.ml +++ b/dev/main.ml @@ -36,7 +36,7 @@ let testfiles_in_dir dir = let name_from_file testname filename = let open Filename in - (match testname with Some t -> t ^ "::" | None -> "") ^ + (if testname = "" then "" else testname ^ "::") ^ dirname filename ^ "::" ^ basename (chop_extension filename) diff --git a/dev/main.mli b/dev/main.mli index de001ff..8d6ac9e 100644 --- a/dev/main.mli +++ b/dev/main.mli @@ -7,7 +7,7 @@ val make_test : ?testeable:testeable -> string -> string * (unit -> unit) -val name_from_file : string option -> string -> string +val name_from_file : string -> string -> string (** [testfiles_in_dir path] collects the content of all thet `*.bbc` files found at [path]; uses `find` (GNU findutils) *) @@ -23,7 +23,7 @@ val testfiles_in_dir : string -> string list It should return a result status together with the expected output of the corresponding program, that will be substituted in the first mention of `|ORACLE` in a test file, if any. *) val tests_from_dir : - name:string option -> + name:string -> compiler:compiler -> ?runtime:runtime -> ?oracle:runtime -> diff --git a/dev/pipeline.ml b/dev/pipeline.ml index 716a0b0..5caabff 100644 --- a/dev/pipeline.ml +++ b/dev/pipeline.ml @@ -2,59 +2,6 @@ open Type open Util -let has_pending_data fd = - try - let ready_fds, _, _ = Unix.select [fd] [] [] 0.0 in - List.length ready_fds > 0 - with _ -> false - -(* Función mejorada de captura que lee hasta completar *) -let capture_stdout_until_done (f : unit -> 'a) : string * 'a = - (* Guardamos el stdout original y creamos el pipe *) - let stdout_original = Unix.dup Unix.stdout in - let (pipe_read, pipe_write) = Unix.pipe () in - - (* Configuramos el pipe como no bloqueante para lecturas seguras *) - Unix.set_nonblock pipe_read; - Unix.dup2 pipe_write Unix.stdout; - Unix.close pipe_write; - - let buffer = Buffer.create 4096 in - let string_buffer = Bytes.create 4096 in - - let result = - try - (* Ejecutamos la función principal *) - let r = f () in - flush stdout; - - (* Leemos datos mientras haya disponibles *) - let rec read_remaining () = - if has_pending_data pipe_read then - match Unix.read pipe_read string_buffer 0 4096 with - | 0 -> () (* EOF - terminamos *) - | bytes_read -> - Buffer.add_subbytes buffer string_buffer 0 bytes_read; - read_remaining () - | exception Unix.Unix_error(Unix.EAGAIN, _, _) -> - Unix.sleepf 0.001; (* Pequeña pausa si el pipe está temporalmente vacío *) - if has_pending_data pipe_read then read_remaining () - in - read_remaining (); - Ok r - with e -> Error e - in - - (* Limpieza y restauración *) - Unix.dup2 stdout_original Unix.stdout; - Unix.close stdout_original; - Unix.close pipe_read; - - match result with - | Ok v -> (Buffer.contents buffer, v) - | Error e -> raise e - - let compile compiler test = match compiler with | Compiler compiler -> diff --git a/dev/test.ml b/dev/test.ml index 5c5b1b2..1d98027 100644 --- a/dev/test.ml +++ b/dev/test.ml @@ -15,7 +15,6 @@ let oracle_from_legacy (oracle : (string -> status * string) option) : runtime o | None -> None let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ?oracle dir = - let name = None in let compiler = OCompiler (fun _ -> compiler) in let runtime = Runtime.clang_runtime ~compile_flags runtime in let oracle = oracle_from_legacy oracle in @@ -23,7 +22,7 @@ let tests_from_dir ?(compile_flags="-g") ~runtime ~compiler ?oracle dir = let open Alcotest in let to_test testfile = let testname, exec_test = Main.make_test ~compiler ~runtime ?oracle testfile in - Main.name_from_file name testfile, [test_case testname `Quick exec_test] + Main.name_from_file "" testfile, [test_case testname `Quick exec_test] in testfiles_in_dir dir |> List.map to_test From b157106087e0c8202d8bb44abc9c4642a367ffc0 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Sat, 30 Nov 2024 16:41:24 +0000 Subject: [PATCH 27/28] docs update readme --- README.md | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/README.md b/README.md index 94f1d4e..0883914 100644 --- a/README.md +++ b/README.md @@ -3,22 +3,14 @@ Black-Box Compiler Tester A simple library for black-box testing of compilers from the [Compiler Design and Implementation course at UChile](https://users.dcc.uchile.cl/~etanter/CC5116/). -## Fork goals -Original BBCTester runs a complete pipeline for an x86 assembly compiler and execution with a c runtime. This fork adds the possibility to configure or modify the steps that will be executed in the pipeline to be able to use BBCTester in other test pipelines for ocaml compilers. - -## Future goals -- Improve pipeline & test configurations -- Add benchmarking capabilities to tests -- Add examples with different settings - ## Dependencies - dune (>= 3.10) - ocaml (>= 4.08.0) - alcotest (>= 1.2.2) - containers (>= 3.0.1) -## Installation +## Installation Download the sources as a zip archive, unzip and install the package ```bash From 2cb3669a560cfef4ea618ce709418e645f273862 Mon Sep 17 00:00:00 2001 From: fadiaz Date: Tue, 20 May 2025 17:13:15 +0100 Subject: [PATCH 28/28] chore test file on output & runtime update --- dev/main.ml | 6 ++---- dev/runtime.ml | 8 ++++++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/dev/main.ml b/dev/main.ml index 3edd08b..f65e5e1 100644 --- a/dev/main.ml +++ b/dev/main.ml @@ -35,11 +35,9 @@ let testfiles_in_dir dir = CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f: CCIO.read_lines_l let name_from_file testname filename = - let open Filename in - (if testname = "" then "" else testname ^ "::") ^ - dirname filename ^ "::" ^ basename (chop_extension filename) - + (if testname = "" then "" else testname ^ "::") ^ filename + let tests_from_dir ~name ~compiler ?runtime ?oracle ?testeable dir = let open Alcotest in let to_test testfile = diff --git a/dev/runtime.ml b/dev/runtime.ml index 9064297..9a2039e 100644 --- a/dev/runtime.ml +++ b/dev/runtime.ml @@ -78,14 +78,18 @@ let unix_command Ok out (** Directly passing the compiled code *) -let direct_output = +let direct_output + ?(save_file: bool =false) = fun (test : t) (input : string) -> let base = Filename.chop_extension test.file in let file = base ^ ".s" in - let* () = write_file RTError file input in + let* () = + if save_file then + write_file RTError file input + else Ok () in Ok (process_string input) (** Not implemented runtime *)