commit 148b8e29b574f06275a0623cdd23c080ab706adf Author: Jon Michael Aanes Date: Thu Aug 30 22:04:35 2018 +0200 Initial commit diff --git a/README.md b/README.md new file mode 100644 index 0000000..73393fa --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ + +# Simba Test # + +See `test.sml` for everything. + diff --git a/test.sml b/test.sml new file mode 100644 index 0000000..57bacab --- /dev/null +++ b/test.sml @@ -0,0 +1,618 @@ + +(* * * * test.sml * * * * + * + * Small testing framework especially made for the Compiler course at Aarhus + * University. + * + * Should work on must systems where the compiler itself works. The VM should + * work, so should macOS and Arch Linux. TODO investigate. + * + * * Instructions * * + * + * 0. Copy this file into the compiler source directory. + * 1. Add any test files to the test directory. + * 2. Compile the compiler using `make sa ia` or similar. + * 3. Load the test framework with `use "test.sml";` in the interactive prompt. + * 4. Run tests with `Testing.perform_all_tests();` in the interactive prompt. + * + * Alternatively to `Testing.perform_all_tests: unit -> unit`, one can use + * `Testing.perform_tests: string -> unit`, which will only run tests with the + * given prefix. + * + * * Test types * * + * + * Must be located in the source directory of the relevant assignment. There + * must be a subdirectory with the name of `tests`, with the relevant files. + * The framework supports a large variety of test types: + * + * - *Basic Tiger tests*: Anything of the format `test_*.tig`. First line must + * indicate what the expected output is: + * + * * `/* output: x */` will indicate that the status code returned by the + * Tiger program must be `x`. These values must be in the range [0, 255]! + * * `/* print: |x| */` will indicate that the program must return errno 0, + * and must print the string `x`. `x` must not contain `|`, newlines, or + * certain other characters. + * * `/* nothing */` will indicate that the program must compile and run. + * + * - *Counterexample tests*: Sometimes you might want to test that something + * is caught by the compiler. Of the format `test_x_*.tig`. Useful for + * Lexing, Parsing and Semant stages. + * + * - *AST comparison tests*: When you want to ensure that precedence is parsed + * correctly, by comparing the AST of two distinct programs. Require twin + * files, one `test_*_implicit.tig`, another `test_*_explicit.tig`, obviously + * with the same `*`. + * + * - *LLVM tests*: For testing whether the LLVM-to-X86 backend works. Filenames + * must be of the format `test_llvm_*.sml`. These are SML files that are + * loaded by the test framework, and can perform whatever computations. Must + * use the `Testing.llvm_block_test: ll.block -> unit` function once and only + * once during the execution. This will register the block and compile it + * using the backend. + * + * The framework ignores any file not matching any of the above requirements. + * NOTE: All files must start with `test_`. + * + * Any slow tests can be renamed to `test_z_*`, and it'll be sorted last in the + * list. + * + * Please note that tests without any specified status codes are assumed to + * exit with a status of `0`. + * + * * Advanced usage * * + * + * TODO: Error numbers + * + * * Bugs * * + * + * Hard to escape SML once the testing has begun, as sigINT failes to trigger. + * + * * License * * + * + * Originally made by Jon Michael Aanes + * You are free to do whatever you want with it. + * + *) + +(* API *) + +signature TESTING = +sig + + (* SML-based test declarations *) + + val llvm_block_test : ll.block -> unit; + + (* Running tests *) + val perform_tests : string -> unit; + val perform_all_tests : unit -> unit; + +end + +(* Structure *) + +structure Testing :> TESTING = +struct + +(* Option constants *) + +val TEST_DIR = "./tests/" +val TIGERC_PREFIX = "" (*TEST_DIR*) +val TIGERC_POSTFIX = "" (*".tig"*) + +(* Error constant *) + +val num_errors = ref 0 + +(* General utility *) + +infix ~>; + +fun (input: 'a) ~> (func : 'a -> 'b) = + func input; + +(* Test Types *) + +datatype testType = IgnoreTest + | FailingTest + | CompileTest + + (* Generic run test *) + | RunableTest of int option * string option + + (* Specialized tests *) + | LlvmBlockTest of (ll.prog * int) + | AstCompareTest of string * string; + + +(* I/O utility -------------------------------------------------------------- *) + +fun escape_command command = command + ~> explode + ~> map (valOf o String.fromString o Char.toString) + ~> map (fn s => if s = "\"" then "\\\"" else s) + ~> String.concat + +fun sys_run command = OS.Process.system ( "/bin/bash -c \"" + ^ escape_command command + ^ "\"") + +fun read_entire_file filename : string = + let val ins = TextIO.openIn filename + val entire_str = (String.toString o TextIO.inputAll) ins + in + (TextIO.closeIn ins; entire_str) + end; + +fun write_file filename (content : string) = + let val fd = TextIO.openOut filename + val _ = TextIO.output (fd, content) + handle e => (TextIO.closeOut fd; raise e) + val _ = TextIO.closeOut fd + in () end + +fun compile_test (testname:string) (test_bin_file:string) (tmpfile:string) = + let val compile_result = sys_run ( "./tigerc " + ^ TIGERC_PREFIX + ^ testname + ^ TIGERC_POSTFIX(*" --out " + ^ test_bin_file*) + ^ " &> " + ^ tmpfile) + + (* Ensure file was actually compiled, clang is cheaty *) + in if compile_result <> 0 + then compile_result + else if (not o OS.FileSys.access) (test_bin_file, []) + then 8 + else 0 + end + +fun run_test binfile tmpfile = + sys_run ( "ulimit -v 1086373952; " + ^ binfile + ^ " &> " + ^ tmpfile ) + +fun files_in_folder (foldername: string) : string list = + let fun helper stream a = + let val filename = OS.FileSys.readDir stream + in case filename + of NONE => ( OS.FileSys.closeDir + ; ListMergeSort.sort String.> a ) + | SOME(b) => helper stream (b::a) + end + in helper (OS.FileSys.openDir foldername) [] + end; + +fun compile_llvm (prog : ll.prog) tmpfile = + let val tmpfile' = tmpfile ^ ".s" + val _ = write_file tmpfile' ((X86.string_of_prog o X86Backend.compile_prog) prog) + in OS.Process.success = sys_run ("clang -o "^tmpfile^".bin "^tmpfile'^" ./runtime.c"(*^" ./debug.c ./garbage_collection_none.c"*)) + end + + +(* User "display" ----------------------------------------------------------- *) + +fun repeat_str str amount = + (String.concat (List.tabulate (amount, fn _ => str))) + +fun displ_current_test (status:string) (testname:string) = + let val whitespace = Int.max(0, 5 - String.size status) + in print ("\r["^status^"]"^repeat_str " " whitespace^"Test `" ^ testname ^ "`") + end + +fun displ_result (testname:string) (expect_gotten_type_ls: (string * string * string) list) : bool = + case List.filter (fn (a, b, _) => a <> b) expect_gotten_type_ls + of [] => ( print ("\r[\027[32;1mOK\027[0m] Test `" ^ testname ^ "`\n") + ; true ) + | ls => let fun display_error (expected, gotten, type_of_expect) = + type_of_expect + ^ " should be " + ^ (case expected of "" => "empty string" | _ => "\027[35m" ^ expected) + ^ "\027[0m but was " + ^ (case gotten of "" => "empty string" | _ => "\027[35m" ^ gotten) + ^ "\027[0m" + val test_prefix = "\r[\027[31;1mFAIL\027[0m] Test `" + ^ testname + ^ "` " + val indent_amount = 7+4+2+2+String.size testname + in ( num_errors := !num_errors + 1 + ; print ( test_prefix + ^ String.concatWith ("\n"^repeat_str " " indent_amount) + (map display_error ls) + ^ "\n") + ; false ) + end + + +fun framework_error s = + print ("[\027[31;1m[TESTING FRAMEWORK]: Error, "^s^"\027[0m\n"); + +(* Perform testing ---------------------------------------------------------- *) + +fun runTest (testname:string) (IgnoreTest) : bool = false + + | runTest (testname:string) (LlvmBlockTest (prog, expected)) = + let val _ = displ_current_test "comp" testname + val tmpfile = OS.FileSys.tmpName () + val compiled = compile_llvm prog tmpfile + val _ = displ_current_test "test" testname + + in displ_result testname + [ (Int.toString expected + , (Int.toString o Int.toInt o sys_run) + ( tmpfile ^ ".bin &> /dev/null" ) + , "status" )] + end + + | runTest testname (AstCompareTest (suffix_baseline, suffix_other)) = + let val _ = displ_current_test "parse" testname + fun parse_file filename = TEST_DIR^filename^".tig" + ~> Parse.parse + ~> PrintAbsyn.asString + + val ast1 = parse_file (testname^suffix_baseline) + val ast2 = parse_file (testname^suffix_other) + + in displ_result testname + [ ( ast1 + , ast2 + , "abstract syntax tree" )] + end + + | runTest testname (testT as (RunableTest _ | FailingTest | CompileTest)) = + let val _ = displ_current_test "comp" testname + val tmpfile = OS.FileSys.tmpName () + val binfile = "./out/"^testname^".bin" (*OS.FileSys.tmpName ()*) + val compiled = compile_test testname binfile tmpfile + val _ = displ_current_test "test" testname + + in case (testT, compiled = 0, compiled = 7 orelse compiled = 0) + of (_, _, false) => ( num_errors := !num_errors + 1 + ; print ("\r[\027[31;1mFATA\027[0m] Test `" ^ testname ^ "` produced error code \027[35m"^Int.toString compiled^"\027[0m, which means that something terrible has happended:\n"^(valOf o String.fromString o read_entire_file) tmpfile^"\n") + ; false ) + | (FailingTest, true, _) => ( num_errors := !num_errors + 1 + ; print ("\r[\027[31;1mFAIL\027[0m] Test `" ^ testname ^ "`. \027[31mTest successedede when it should not have.\027[0m\n") + ; false ) + | (FailingTest, false, _) => displ_result testname [("","", "correct")] + | (_, false, _) => ( num_errors := !num_errors + 1 + ; print ("\r[\027[31;1mFAIL\027[0m] Test `" ^ testname ^ "`. \027[31mTest did not compile!\027[0m\n\n"^(valOf o String.fromString o read_entire_file) tmpfile^"\n") + ; false ) + + | (RunableTest(status_expected, output_expected), true, _) => + let val status = run_test binfile tmpfile + + val expect_gotten_status = + case status_expected + of NONE => [] + | SOME status_e => [(Int.toString status_e, Int.toString status, "status")] + + val expect_gotten_output = + case output_expected + of NONE => [] + | SOME output_e => [(output_e, read_entire_file tmpfile, "print output")] + + in displ_result testname (expect_gotten_status@expect_gotten_output) + end + + | (CompileTest, true, _) => displ_result testname [("","", "correct")] + | _ => + ( num_errors := !num_errors + 1 + ; print ("\r[\027[31;1mFAIL\027[0m] Test `" ^ testname ^ "`. \027[31mTest had an unknown type!\n") + ; false ) + end + +(* File parsing util -------------------------------------------------------- *) + +val is_tig_file = String.isSuffix ".tig" +val is_failing_test_file = String.isPrefix (TEST_DIR^"test_x_") +fun is_llvm_test_file fname = String.isPrefix "test_llvm" fname + andalso String.isSuffix ".sml" fname + +fun skip_ws (SOME (#" " ::ls)) = skip_ws (SOME ls) + | skip_ws (SOME (#"\n"::ls)) = skip_ws (SOME ls) + | skip_ws (SOME (#"\t"::ls)) = skip_ws (SOME ls) + | skip_ws no_matched = no_matched + +fun skip_chars (ac::als) (SOME (bc::bls)) = + if ac = bc + then skip_chars als (SOME bls) + else NONE + | skip_chars ls (SOME []) = NONE + | skip_chars [] (SOME ls) = SOME ls + | skip_chars skip_chars NONE = NONE + +fun skip_string str chars = + skip_chars (String.explode str) chars + +fun parse_integer NONE: int option = NONE + | parse_integer (SOME chars) = + let fun recu (chars,rev_output) = + case chars + of (digit as ((#"0")|(#"1")|(#"2")|(#"3")|(#"4")|(#"5")|(#"6")|(#"7")|(#"8")|(#"9")))::chars => + recu (chars, digit::rev_output) + | _ => List.rev rev_output + in (Int.fromString o String.implode o recu) (chars, []) + end; + +fun parse_until_char c NONE: string option = NONE + | parse_until_char c (SOME chars) = + let fun recu (head::chars, rev_output) = + if head = c + then rev_output + else recu(chars, head::rev_output) + | recu ([], rev_output) = rev_output + in (SOME o String.implode o List.rev o recu) (chars, []) + end; + +fun parse_test_info_comment filename (chars: char list) = + case (chars + ~> SOME + ~> skip_ws + ~> skip_string "/*" + ~> skip_ws) + + of SOME ((#"o")::(#"u")::(#"t")::(#"p")::(#"u")::(#"t")::(#":")::chars) => + (case ( parse_integer + o skip_ws + o SOME) chars + + of SOME a => if 0 <= a andalso a < 256 + then RunableTest(SOME a, NONE) + else ( framework_error ("Status test "^filename^" wanted status code "^Int.toString a^", but only integers from 0 to 255 are allowed; ignoring.") + ; IgnoreTest) + | _ => ( framework_error ("Could not find expected status code for test "^filename^"; ignoring.") + ; IgnoreTest )) + + | SOME ((#"p")::(#"r")::(#"i")::(#"n")::(#"t")::(#":")::chars) => + (case (parse_until_char #"|" + o skip_chars [#"|"] + o skip_ws + o SOME) chars + of SOME s => RunableTest(SOME 0, SOME s) + | NONE => ( framework_error ("Could not determine expected string output for "^filename^"; ignoring.") + ; IgnoreTest)) + + | SOME((#"n")::(#"o")::(#"t")::(#"h")::(#"i")::(#"n")::(#"g")::_) => + RunableTest (NONE, NONE) + + | _ => CompileTest + +fun determine_expected_result filename : testType = + let val ins = TextIO.openIn filename + val chars = (String.explode o String.toString o TextIO.inputAll) ins before TextIO.closeIn ins + in if is_failing_test_file filename + then FailingTest + else parse_test_info_comment filename chars + end; + +(* LLVM test subsystem *) + +val CONSTRUCTING_LLVM_BLOCK_TEST_BLOCK = ref NONE: ll.block option ref; + +fun llvm_block_test (blk:ll.block): unit = + case !CONSTRUCTING_LLVM_BLOCK_TEST_BLOCK + of NONE => CONSTRUCTING_LLVM_BLOCK_TEST_BLOCK := SOME blk + | SOME _ => framework_error "Attempting to declare new `llvm_block_test`, while a previous one is unfinished." + +fun determine_llvm_test filename : testType = + let + + (* What do we expect from the test? *) + val ins = TextIO.openIn (TEST_DIR^filename) + val chars = ( String.explode + o String.toString + o TextIO.inputAll) ins + before TextIO.closeIn ins; + + val expected = + case chars + ~> SOME + ~> skip_ws + ~> skip_string "(*" + ~> skip_ws + + of SOME ((#"o")::(#"u")::(#"t")::(#"p")::(#"u")::(#"t")::(#":")::chars) => + (case ( parse_integer + o skip_ws + o SOME) chars + + of SOME a => if 0 <= a andalso a < 256 + then SOME a + else ( framework_error ("Status test "^filename^" wanted status code "^Int.toString a^", but only integers from 0 to 255 are allowed; ignoring.") + ; NONE) + | _ => NONE) + | _ => (framework_error ("Couldn't find expected output for LLVM test "^filename^"\n"); NONE) + + + (* Load test *) + val _ = use (TEST_DIR^filename) + val blk = !CONSTRUCTING_LLVM_BLOCK_TEST_BLOCK before CONSTRUCTING_LLVM_BLOCK_TEST_BLOCK := NONE + + (* Construct test datastructure *) + in case (expected, blk) + of (NONE, _) => IgnoreTest + | (_, NONE) => ( framework_error ("Couldn't find block from test "^filename^"; ignoring.") + ; IgnoreTest ) + | (SOME expected, SOME blk) => + LlvmBlockTest ( { tdecls = [] + , gdecls = [] + , fdecls = [ ( Symbol.symbol "tigermain" + , { fty = ([], ll.I64) + , param = [] + , cfg = ( blk, [])})]} + , expected) + end + +(* Application stuff -------------------------------------------------------- *) + +fun stop_running_tests () = + if !num_errors = 0 then + (print "\n\n[\027[32;1mSuccess, well done!\027[0m]") + else + (print ("\n\n[\027[31;1mFound "^Int.toString (!num_errors)^" failing tests\027[0m]")) + +fun sigint_handler (signal, times_signaled, continue) = + ( print ("\n[TESTING FRAMEWORK]: Got SIGINT, will attempt exit!\n") + ; stop_running_tests () + ; continue ); + + (* +val number_threads = ref 0 +val max_threads = 3 + +fun batch_process_fun (f: unit -> unit): unit = + if max_threads = 1 + then f() + else + case Posix.Process.fork() + of NONE => (f (); OS.Process.exit 0) + | SOME _ => if !number_threads >= max_threads + then (Posix.Process.wait (); ()) + else number_threads := !number_threads + 1 + +fun wait_for_remaining_batch_processes (): unit = + if !number_threads = 0 + then () + else ( Posix.Process.wait () + ; number_threads := !number_threads - 1 + ; wait_for_remaining_batch_processes() ) + +fun kill_remaining_batch_processes (): unit = + ( Posix.Process.kill (Posix.Process.K_SAME_GROUP, Posix.Signal.int) + ; number_threads := 0 ) + *) + +fun batch_process_fun (f: unit -> unit): unit = f(); + +fun find_all_tests (required_prefix: string) = + let + (* Find all test files *) + val files_in_test_folder = (files_in_folder TEST_DIR) + ~> List.filter (String.isPrefix "test_") + + (* Find .tig tests: `test_*.tig` *) + val testlist_tig = files_in_test_folder + ~> List.filter is_tig_file + ~> map (fn f => (substring (f, 0, (size f - 4)))) + + ~> map (fn f => (f, determine_expected_result (TEST_DIR ^ f ^ ".tig"))) + ~> List.filter (fn (_, r) => r <> IgnoreTest) + + (* Find .tig AST comparison tests: + * Twin files of format `test_*_explicit.tig` and `test_*_implicit.tig` *) + val testlist_comp = files_in_test_folder + ~> List.filter is_tig_file + ~> map (fn f => (substring (f, 0, (size f - 4)))) + + ~> List.filter (String.isSuffix "_explicit") + ~> List.map (fn s => substring(s, 0, size s - size "_explicit")) + ~> List.filter (fn s => OS.FileSys.access(TEST_DIR^s^"_implicit.tig", [])) + ~> map (fn s => (s, AstCompareTest ("_explicit", "_implicit"))) + + (* Find llvm sml tests: `test_llvm_*.sml` *) + val testlist_llvm = files_in_test_folder + ~> List.filter is_llvm_test_file + ~> List.map (fn f => (f, determine_llvm_test f)) + + (* LLVM and AST compare goes first, as these are very quick *) + in List.filter (String.isPrefix required_prefix o #1) + (testlist_llvm @ testlist_comp @ testlist_tig) + end + +fun perform_tests (required_prefix: string) = + let fun run_test (filename, expected_result): unit = + ( ErrorMsg.reset + ; batch_process_fun (fn () => (runTest filename expected_result; ()))) + + in ( print "\n## Custom Tests ##\n\n" + ; Signals.setHandler (Signals.sigINT, Signals.HANDLER sigint_handler) + ; required_prefix ~> find_all_tests + ~> map (fn (name, t) => (name, t) before print(" - "^name^"\n")) + ~> map run_test + ; print "\n\n" + ; stop_running_tests() ) + end; + +fun perform_all_tests () = perform_tests "" + +end + + (* +type optimizeOptions = { miscOptimize : bool + , semantRound : bool + , variableInlining : bool + , performTailReturn : bool + , llRound : bool + , x86Round : bool } +fun set_optimize_options (options:optimizeOptions) = + ( TigerConfig.Optimize.miscOptimize := #miscOptimize options + ; TigerConfig.Optimize.semantRound := #semantRound options + ; TigerConfig.Optimize.variableInlining := #variableInlining options + ; TigerConfig.Optimize.performTailReturn := #performTailReturn options + ; TigerConfig.Optimize.llRound := #llRound options + ; TigerConfig.Optimize.x86Round := #x86Round options + ) + +val randBool = + let val state = ref (Random.rand ( 411241 + , ( Int.fromLarge + o (fn a => case Int.maxInt of SOME(maxint) => #2 (IntInf.divMod (a, Int.toLarge maxint)) | NONE => a) + o Time.toSeconds + o Time.now) ())) + in (fn () => (Random.randReal (!state) < 0.5)) + end + +fun generate_random_optimize_options (): optimizeOptions = + { miscOptimize = randBool() + , semantRound = randBool() + , variableInlining = randBool() + , performTailReturn = randBool() + , llRound = randBool() + , x86Round = randBool() } + +fun optimize_options_to_string(options: optimizeOptions): string = + "OPTIONS { " + ^ "miscOptimize=" ^ Bool.toString (#miscOptimize options) ^ ", " + ^ "semantRound=" ^ Bool.toString (#semantRound options) ^ ", " + ^ "variableInlining=" ^ Bool.toString (#variableInlining options) ^ ", " + ^ "performTailReturn=" ^ Bool.toString (#performTailReturn options) ^ ", " + ^ "llRound=" ^ Bool.toString (#llRound options) ^ ", " + ^ "x86Round=" ^ Bool.toString (#x86Round options) + ^ " }" + +fun perform_extensive_tests () = + let fun run_test_with_different_options (filename, expected_result, options::rest): unit = + ( ErrorMsg.reset + ; set_optimize_options(options) + ; if runTest filename expected_result + then () + else displ_current_test ( "Failed for options: " + ^ optimize_options_to_string options ) + filename; ()) + | run_test_with_different_options (_, _, []) = () + + fun run_test tup: unit = + batch_process_fun (fn () => run_test_with_different_options tup) + + fun populate_with_options (filename, expected_result) = + ( filename + , expected_result + , [ generate_random_optimize_options() + , generate_random_optimize_options() + , generate_random_optimize_options() ]) + + in ( print "\n## Tests ##\n\n" + ; Signals.setHandler (Signals.sigINT, Signals.HANDLER sigint_handler) + ; "" ~> find_all_tests + ~> map populate_with_options + ~> map run_test + ; print "\n\n" + ; stop_running_tests() ) + end; + *) + +(* Exit *) +