619 lines
24 KiB
Standard ML
619 lines
24 KiB
Standard ML
|
|
||
|
|
(* * * * 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 *)
|
||
|
|
|