Removed very specialized tests, and some redundant code.
This commit is contained in:
parent
148b8e29b5
commit
30f2d86aab
243
test.sml
243
test.sml
|
|
@ -34,23 +34,13 @@
|
||||||
* and must print the string `x`. `x` must not contain `|`, newlines, or
|
* and must print the string `x`. `x` must not contain `|`, newlines, or
|
||||||
* certain other characters.
|
* certain other characters.
|
||||||
* * `/* nothing */` will indicate that the program must compile and run.
|
* * `/* 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
|
* - *Counterexample tests*: Sometimes you might want to test that something
|
||||||
* is caught by the compiler. Of the format `test_x_*.tig`. Useful for
|
* is caught by the compiler. Of the format `test_x_*.tig`. Useful for
|
||||||
* Lexing, Parsing and Semant stages.
|
* 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.
|
* The framework ignores any file not matching any of the above requirements.
|
||||||
* NOTE: All files must start with `test_`.
|
* NOTE: All files must start with `test_`.
|
||||||
*
|
*
|
||||||
|
|
@ -80,10 +70,6 @@
|
||||||
signature TESTING =
|
signature TESTING =
|
||||||
sig
|
sig
|
||||||
|
|
||||||
(* SML-based test declarations *)
|
|
||||||
|
|
||||||
val llvm_block_test : ll.block -> unit;
|
|
||||||
|
|
||||||
(* Running tests *)
|
(* Running tests *)
|
||||||
val perform_tests : string -> unit;
|
val perform_tests : string -> unit;
|
||||||
val perform_all_tests : unit -> unit;
|
val perform_all_tests : unit -> unit;
|
||||||
|
|
@ -121,10 +107,6 @@ datatype testType = IgnoreTest
|
||||||
(* Generic run test *)
|
(* Generic run test *)
|
||||||
| RunableTest of int option * string option
|
| RunableTest of int option * string option
|
||||||
|
|
||||||
(* Specialized tests *)
|
|
||||||
| LlvmBlockTest of (ll.prog * int)
|
|
||||||
| AstCompareTest of string * string;
|
|
||||||
|
|
||||||
|
|
||||||
(* I/O utility -------------------------------------------------------------- *)
|
(* I/O utility -------------------------------------------------------------- *)
|
||||||
|
|
||||||
|
|
@ -186,12 +168,6 @@ fun files_in_folder (foldername: string) : string list =
|
||||||
in helper (OS.FileSys.openDir foldername) []
|
in helper (OS.FileSys.openDir foldername) []
|
||||||
end;
|
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" ----------------------------------------------------------- *)
|
(* User "display" ----------------------------------------------------------- *)
|
||||||
|
|
||||||
|
|
@ -234,34 +210,6 @@ fun framework_error s =
|
||||||
|
|
||||||
fun runTest (testname:string) (IgnoreTest) : bool = false
|
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)) =
|
| runTest testname (testT as (RunableTest _ | FailingTest | CompileTest)) =
|
||||||
let val _ = displ_current_test "comp" testname
|
let val _ = displ_current_test "comp" testname
|
||||||
val tmpfile = OS.FileSys.tmpName ()
|
val tmpfile = OS.FileSys.tmpName ()
|
||||||
|
|
@ -308,8 +256,6 @@ fun runTest (testname:string) (IgnoreTest) : bool = false
|
||||||
|
|
||||||
val is_tig_file = String.isSuffix ".tig"
|
val is_tig_file = String.isSuffix ".tig"
|
||||||
val is_failing_test_file = String.isPrefix (TEST_DIR^"test_x_")
|
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)
|
fun skip_ws (SOME (#" " ::ls)) = skip_ws (SOME ls)
|
||||||
| skip_ws (SOME (#"\n"::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
|
else parse_test_info_comment filename chars
|
||||||
end;
|
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 -------------------------------------------------------- *)
|
(* Application stuff -------------------------------------------------------- *)
|
||||||
|
|
||||||
fun stop_running_tests () =
|
fun stop_running_tests () =
|
||||||
|
|
@ -459,34 +347,6 @@ fun sigint_handler (signal, times_signaled, continue) =
|
||||||
; stop_running_tests ()
|
; stop_running_tests ()
|
||||||
; continue );
|
; 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) =
|
fun find_all_tests (required_prefix: string) =
|
||||||
let
|
let
|
||||||
(* Find all test files *)
|
(* 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")))
|
~> map (fn f => (f, determine_expected_result (TEST_DIR ^ f ^ ".tig")))
|
||||||
~> List.filter (fn (_, r) => r <> IgnoreTest)
|
~> 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)
|
in List.filter (String.isPrefix required_prefix o #1)
|
||||||
(testlist_llvm @ testlist_comp @ testlist_tig)
|
testlist_tig
|
||||||
end
|
end
|
||||||
|
|
||||||
fun perform_tests (required_prefix: string) =
|
fun perform_tests (required_prefix: string) =
|
||||||
let fun run_test (filename, expected_result): unit =
|
let fun run_test (filename, expected_result): unit =
|
||||||
( ErrorMsg.reset
|
( ErrorMsg.reset
|
||||||
; batch_process_fun (fn () => (runTest filename expected_result; ())))
|
; runTest filename expected_result
|
||||||
|
; () )
|
||||||
|
|
||||||
in ( print "\n## Custom Tests ##\n\n"
|
in ( print "\n## Custom Tests ##\n\n"
|
||||||
; Signals.setHandler (Signals.sigINT, Signals.HANDLER sigint_handler)
|
; Signals.setHandler (Signals.sigINT, Signals.HANDLER sigint_handler)
|
||||||
; required_prefix ~> find_all_tests
|
; required_prefix ~> find_all_tests
|
||||||
~> map (fn (name, t) => (name, t) before print(" - "^name^"\n"))
|
|
||||||
~> map run_test
|
~> map run_test
|
||||||
; print "\n\n"
|
; print "\n\n"
|
||||||
; stop_running_tests() )
|
; stop_running_tests() )
|
||||||
|
|
@ -540,79 +383,3 @@ fun perform_all_tests () = perform_tests ""
|
||||||
|
|
||||||
end
|
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 *)
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user