diff --git a/README.md b/README.md index a5ed11c..0883914 100644 --- a/README.md +++ b/README.md @@ -4,27 +4,35 @@ 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/). ## Dependencies -- dune (>= 2.9) +- 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 $ unzip BBCTester-main.zip Archive: BBCTester-main.zip -002d4d44e78e9655eff48580f1820961fd2ec520 +0e3ce14f8587aafdcc6f64c07de0c2e3c2fde838 creating: BBCTester-main/ inflating: BBCTester-main/.gitignore inflating: BBCTester-main/Makefile inflating: BBCTester-main/README.md - inflating: BBCTester-main/dune + 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/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 @@ -38,12 +46,12 @@ 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. +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 diff --git a/dev/dune b/dev/dune new file mode 100644 index 0000000..424f351 --- /dev/null +++ b/dev/dune @@ -0,0 +1,5 @@ +(library + (name bbctester) ; Black-Box Compiler Tester + (public_name bbctester) + (modules main test pipeline runtime testeable file type util) + (libraries alcotest containers containers.unix str)) diff --git a/dev/file.ml b/dev/file.ml new file mode 100644 index 0000000..a9d3609 --- /dev/null +++ b/dev/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/dev/file.mli b/dev/file.mli new file mode 100644 index 0000000..7d619c9 --- /dev/null +++ b/dev/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/dev/main.ml b/dev/main.ml new file mode 100644 index 0000000..f65e5e1 --- /dev/null +++ b/dev/main.ml @@ -0,0 +1,52 @@ +open Type + + +let make_test + ~(compiler : compiler) + ?(runtime : runtime = Runtime.direct_output) + ?(oracle : runtime = Runtime.not_implemented) + ?(testeable : testeable = Testeable.compare_results) + (filename : string) = + match File.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 = runtime test out in + Ok out + in + + let exp = + Util.handle_result @@ + let* out = Pipeline.oracle oracle test in + Ok out + in + + let testing = testeable test in + 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 testname 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 = + 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/dev/main.mli b/dev/main.mli new file mode 100644 index 0000000..8d6ac9e --- /dev/null +++ b/dev/main.mli @@ -0,0 +1,31 @@ +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) *) +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/dev/pipeline.ml b/dev/pipeline.ml new file mode 100644 index 0000000..5caabff --- /dev/null +++ b/dev/pipeline.ml @@ -0,0 +1,33 @@ +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) + +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 + try + (* Usamos la nueva función que lee hasta completar *) + let (stdout_output, runtime_result) = + capture_stdout (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 + | _ -> Error (test.status, test.expected)) diff --git a/dev/runtime.ml b/dev/runtime.ml new file mode 100644 index 0000000..9a2039e --- /dev/null +++ b/dev/runtime.ml @@ -0,0 +1,100 @@ +open Type +open Util + + +(* 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 nasm 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 = + 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) @@ + CCUnix.call ~env:(Array.of_list params) command file + + +(** Calling the compiler (clang) and assembler (nasm) *) +let clang_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* () = clang ~compile_flags runtime base in + 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) = + 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* out = call command test.params file in + Ok out + +(** Directly passing the compiled code *) +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* () = + if save_file then + write_file RTError file input + else Ok () in + Ok (process_string input) + +(** Not implemented runtime *) +let not_implemented = + fun + (_ : t) + (_ : string) -> + Error (RTError, "Not implemented") diff --git a/dev/test.ml b/dev/test.ml new file mode 100644 index 0000000..1d98027 --- /dev/null +++ b/dev/test.ml @@ -0,0 +1,32 @@ +include Type + + +let testfiles_in_dir dir = + CCUnix.with_process_in ("find " ^ dir ^ " -name '*.bbc'") ~f: CCIO.read_lines_l + + +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 compiler = OCompiler (fun _ -> compiler) in + let runtime = Runtime.clang_runtime ~compile_flags runtime in + let oracle = oracle_from_legacy oracle in + + let open Alcotest in + let to_test testfile = + let testname, exec_test = Main.make_test ~compiler ~runtime ?oracle testfile in + Main.name_from_file "" 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/dev/test.mli b/dev/test.mli new file mode 100644 index 0000000..68121b8 --- /dev/null +++ b/dev/test.mli @@ -0,0 +1,22 @@ +include module type of 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 : + ?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/dev/testeable.ml b/dev/testeable.ml new file mode 100644 index 0000000..c15ce36 --- /dev/null +++ b/dev/testeable.ml @@ -0,0 +1,44 @@ +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 + with Not_found -> false + in + testable (pp string) matches + + +(** 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 status of running a test *) +let compare_status = + fun (_ : t) -> + dep_pair status_match string_ignore + + +(* Testing the result of running a test *) +let compare_results = + fun (_ : t) -> + dep_pair status_match string_match diff --git a/dev/type.ml b/dev/type.ml new file mode 100644 index 0000000..30b9c87 --- /dev/null +++ b/dev/type.ml @@ -0,0 +1,43 @@ + +type status = + | CTError + | RTError + | NoError + +let status_of_string = function + | "fail" + | "RT error" -> RTError + | "CT error" -> CTError + | _ -> NoError + +let string_of_status = function + | CTError -> "CT error" + | RTError -> "RT error" + | NoError -> "No error" + + +(** Ocaml representation of test files *) +(* All strings are enforced to be trimmed. *) +(* The expected string *) +type t = + { file : string + ; name : string + ; description : string + ; params : string list + ; status : status + ; src : string + ; 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 = (t -> string -> (string, status * string) result) + +type testeable = (t -> (status * string) Alcotest.testable) diff --git a/dev/type.mli b/dev/type.mli new file mode 100644 index 0000000..1d4da27 --- /dev/null +++ b/dev/type.mli @@ -0,0 +1,58 @@ + +(** 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 = + { file : string + (** Name of the test file *) + ; 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 *) } + + +(** 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 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 = (t -> string -> (string, status * string) result) + +type testeable = (t -> (status * string) Alcotest.testable) diff --git a/dev/util.ml b/dev/util.ml new file mode 100644 index 0000000..3a9f28d --- /dev/null +++ b/dev/util.ml @@ -0,0 +1,97 @@ +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_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) + +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 error file = + try Ok (process_string @@ (CCIO.with_in file CCIO.read_all)) + 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 (f : unit -> 'a) : string * 'a = + let stdout_original = Unix.dup Unix.stdout in + let (pipe_read, pipe_write) = Unix.pipe () in + + 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 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 b/dune deleted file mode 100644 index 6a58d6d..0000000 --- a/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name bbctester) ; Black-Box Compiler Tester - (public_name bbctester) - (libraries str alcotest containers containers.unix)) diff --git a/dune-project b/dune-project index 5370068..8315b5a 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 2.9) +(lang dune 3.10) (name bbctester) @@ -11,7 +11,7 @@ (package (name bbctester) - (version 0.1) + (version 0.3) (synopsis "Black-box compiler tester") (description "Tester for the compilation lecture CC5116") (depends diff --git a/test.ml b/test.ml deleted file mode 100644 index 59db150..0000000 --- a/test.ml +++ /dev/null @@ -1,202 +0,0 @@ - -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 - 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 { 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 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 - - - - -type compiler = string -> out_channel -> unit - -let make_test - ~compile_flags - runtime - ~(compiler:compiler) - ~oracle - filename = - 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* () = - 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 - Ok (process_output out) - else Error (RTError, out ^ err) - in - - let res = match res with - | Ok out -> NoError, out - | Error err -> err - in - - let expected = - let i_oracle = CCString.find ~sub:"|ORACLE" 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 - status , prefix ^ output - | _ -> test.status, test.expected - in - - let open Alcotest in - check compare_results 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 ?(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 - name_from_file 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 deleted file mode 100644 index f1bf916..0000000 --- a/test.mli +++ /dev/null @@ -1,75 +0,0 @@ - -(** 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) - - 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 - -(** 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 - -(** [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 : - ?compile_flags:string -> - runtime:string -> - compiler:compiler -> - ?oracle:(string -> status * string) -> - string -> (string * unit Alcotest.test_case list) list