restructure testing pipeline

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
 

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))

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)

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

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"] *)

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

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))

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")

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"] *)

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