2004-07-16 02:26:21 -04:00
|
|
|
! Factor test suite.
|
|
|
|
|
|
|
|
IN: test
|
2005-02-14 21:58:07 -05:00
|
|
|
USING: errors kernel lists math memory namespaces parser
|
2005-06-19 17:50:35 -04:00
|
|
|
prettyprint sequences io strings unparser vectors words ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-05-09 22:34:47 -04:00
|
|
|
TUPLE: assert got expect ;
|
2005-06-19 00:23:01 -04:00
|
|
|
|
2005-05-07 22:53:01 -04:00
|
|
|
M: assert error.
|
|
|
|
"Assertion failed" print
|
|
|
|
"Expected: " write dup assert-expect .
|
|
|
|
"Got: " write assert-got . ;
|
|
|
|
|
|
|
|
: assert= ( a b -- )
|
2005-05-10 22:30:58 -04:00
|
|
|
2dup = [ 2drop ] [ <assert> throw ] ifte ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-08-04 03:12:55 -04:00
|
|
|
: print-test ( input output -- )
|
2005-04-07 18:54:02 -04:00
|
|
|
"--> " write 2list . flush ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-22 02:24:38 -04:00
|
|
|
: keep-datastack ( quot -- ) datastack slip set-datastack drop ;
|
2004-08-10 23:48:08 -04:00
|
|
|
|
2004-10-17 19:01:16 -04:00
|
|
|
: time ( code -- )
|
|
|
|
#! Evaluates the given code and prints the time taken to
|
|
|
|
#! execute it.
|
2004-11-22 19:15:14 -05:00
|
|
|
millis >r gc-time >r call gc-time r> - millis r> -
|
2005-04-07 18:54:02 -04:00
|
|
|
[
|
|
|
|
unparse , " ms run / " , unparse , " ms GC time" ,
|
|
|
|
] make-string print ;
|
2004-10-17 19:01:16 -04:00
|
|
|
|
2004-08-04 03:12:55 -04:00
|
|
|
: unit-test ( output input -- )
|
2004-08-10 23:48:08 -04:00
|
|
|
[
|
2004-10-17 19:01:16 -04:00
|
|
|
[
|
|
|
|
2dup print-test
|
2005-04-07 18:54:02 -04:00
|
|
|
swap >r >r clear r> call
|
2005-05-07 22:53:01 -04:00
|
|
|
datastack >list r> assert=
|
2004-10-17 19:01:16 -04:00
|
|
|
] keep-datastack 2drop
|
|
|
|
] time ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-10-10 14:28:56 -04:00
|
|
|
: unit-test-fails ( quot -- )
|
|
|
|
#! Assert that the quotation throws an error.
|
|
|
|
[ [ not ] catch ] cons [ f ] swap unit-test ;
|
|
|
|
|
2005-04-07 18:54:02 -04:00
|
|
|
: assert-depth ( quot -- )
|
2005-05-07 22:53:01 -04:00
|
|
|
depth slip depth assert= ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-07 18:54:02 -04:00
|
|
|
SYMBOL: failures
|
2005-02-12 02:23:38 -05:00
|
|
|
|
2005-04-16 00:23:27 -04:00
|
|
|
: failure failures [ cons ] change ;
|
|
|
|
|
2005-04-07 18:54:02 -04:00
|
|
|
: test-handler ( name quot -- ? )
|
2005-04-16 00:23:27 -04:00
|
|
|
[ [ dup error. cons failure f ] [ t ] ifte* ] catch ;
|
2005-04-07 18:54:02 -04:00
|
|
|
|
|
|
|
: test-path ( name -- path )
|
2005-05-18 16:26:22 -04:00
|
|
|
"/library/test/" swap ".factor" append3 ;
|
2004-10-17 19:01:16 -04:00
|
|
|
|
2005-04-07 18:54:02 -04:00
|
|
|
: test ( name -- ? )
|
2004-11-17 20:59:28 -05:00
|
|
|
[
|
2005-04-07 18:54:02 -04:00
|
|
|
"=====> " write dup write "..." print
|
|
|
|
test-path [ [ run-resource ] keep ] assert-depth drop
|
|
|
|
] test-handler ;
|
|
|
|
|
|
|
|
: prepare-tests ( -- )
|
|
|
|
failures off
|
|
|
|
vocabularies get [ "temporary" off ] bind ;
|
|
|
|
|
|
|
|
: passed.
|
|
|
|
"Tests passed:" print . ;
|
|
|
|
|
|
|
|
: failed.
|
|
|
|
"Tests failed:" print
|
|
|
|
failures get [ unswons write ": " write error. ] each ;
|
|
|
|
|
2005-06-08 18:11:53 -04:00
|
|
|
: run-tests ( list -- )
|
|
|
|
prepare-tests [ test ] subset terpri passed. failed. ;
|
|
|
|
|
|
|
|
: tests
|
|
|
|
[
|
|
|
|
"lists/cons" "lists/lists" "lists/assoc"
|
|
|
|
"lists/namespaces" "lists/combinators" "combinators"
|
|
|
|
"continuations" "errors" "hashtables" "strings"
|
|
|
|
"namespaces" "generic" "tuple" "files" "parser"
|
|
|
|
"parse-number" "image" "init" "io/io"
|
|
|
|
"listener" "vectors" "words" "unparser" "random"
|
|
|
|
"stream" "math/bitops"
|
|
|
|
"math/math-combinators" "math/rational" "math/float"
|
|
|
|
"math/complex" "math/irrational" "math/integer"
|
|
|
|
"math/matrices"
|
|
|
|
"httpd/url-encoding" "httpd/html" "httpd/httpd"
|
|
|
|
"httpd/http-client"
|
|
|
|
"crashes" "sbuf" "threads" "parsing-word"
|
2005-06-14 05:01:07 -04:00
|
|
|
"inference" "interpreter"
|
|
|
|
"alien"
|
2005-06-08 18:11:53 -04:00
|
|
|
"line-editor" "gadgets" "memory" "redefine"
|
2005-07-06 01:27:59 -04:00
|
|
|
"annotate" "sequences" "binary" "inspector"
|
2005-06-08 18:11:53 -04:00
|
|
|
] run-tests ;
|
|
|
|
|
|
|
|
: benchmarks
|
|
|
|
[
|
|
|
|
"benchmark/empty-loop" "benchmark/fac"
|
|
|
|
"benchmark/fib" "benchmark/sort"
|
|
|
|
"benchmark/continuations" "benchmark/ack"
|
|
|
|
"benchmark/hashtables" "benchmark/strings"
|
|
|
|
"benchmark/vectors" "benchmark/prettyprint"
|
|
|
|
] run-tests ;
|
|
|
|
|
|
|
|
: compiler-tests
|
|
|
|
[
|
|
|
|
"io/buffer" "compiler/optimizer"
|
|
|
|
"compiler/simple"
|
|
|
|
"compiler/stack" "compiler/ifte"
|
|
|
|
"compiler/generic" "compiler/bail-out"
|
|
|
|
"compiler/linearizer" "compiler/intrinsics"
|
|
|
|
] run-tests ;
|
|
|
|
|
|
|
|
: all-tests tests compiler-tests benchmarks ;
|