diff --git a/test.sml b/test.sml index 57bacab..d6adadd 100644 --- a/test.sml +++ b/test.sml @@ -34,23 +34,13 @@ * 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. + * * Anything else will result in a test that only expects to be compilable. + * Such a file will never be 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_`. * @@ -80,10 +70,6 @@ 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; @@ -121,10 +107,6 @@ datatype testType = IgnoreTest (* Generic run test *) | RunableTest of int option * string option - (* Specialized tests *) - | LlvmBlockTest of (ll.prog * int) - | AstCompareTest of string * string; - (* I/O utility -------------------------------------------------------------- *) @@ -186,12 +168,6 @@ fun files_in_folder (foldername: string) : string list = 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" ----------------------------------------------------------- *) @@ -234,40 +210,12 @@ fun framework_error s = 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 + val _ = displ_current_test "test" testname in case (testT, compiled = 0, compiled = 7 orelse compiled = 0) of (_, _, false) => ( num_errors := !num_errors + 1 @@ -308,8 +256,6 @@ fun runTest (testname:string) (IgnoreTest) : bool = false 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) @@ -388,64 +334,6 @@ fun determine_expected_result filename : testType = 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 () = @@ -459,34 +347,6 @@ fun sigint_handler (signal, times_signaled, continue) = ; 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 *) @@ -501,36 +361,19 @@ fun find_all_tests (required_prefix: string) = ~> 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) + 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; ()))) + ; 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() ) @@ -540,79 +383,3 @@ 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 *) -