2004-07-16 02:26:21 -04:00
|
|
|
! Factor test suite.
|
|
|
|
|
|
|
|
! Some of these words should be moved to the standard library.
|
|
|
|
|
|
|
|
IN: test
|
|
|
|
USE: errors
|
|
|
|
USE: kernel
|
|
|
|
USE: lists
|
2004-08-26 22:21:17 -04:00
|
|
|
USE: math
|
2004-07-16 02:26:21 -04:00
|
|
|
USE: namespaces
|
|
|
|
USE: parser
|
2004-07-21 19:26:41 -04:00
|
|
|
USE: prettyprint
|
2004-07-16 02:26:21 -04:00
|
|
|
USE: stdio
|
|
|
|
USE: strings
|
|
|
|
USE: words
|
2004-12-15 16:57:29 -05:00
|
|
|
USE: vectors
|
2004-07-16 02:26:21 -04:00
|
|
|
USE: unparser
|
|
|
|
|
|
|
|
: assert ( t -- )
|
|
|
|
[ "Assertion failed!" throw ] unless ;
|
|
|
|
|
2004-08-04 03:12:55 -04:00
|
|
|
: print-test ( input output -- )
|
2004-08-26 22:21:17 -04:00
|
|
|
"TESTING: " write 2list . flush ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-08-10 23:48:08 -04:00
|
|
|
: keep-datastack ( quot -- )
|
|
|
|
datastack >r call r> set-datastack drop ;
|
|
|
|
|
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> -
|
|
|
|
unparse write " milliseconds run time" print
|
|
|
|
unparse write " milliseconds GC time" 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
|
|
|
|
swap >r >r clear r> call datastack vector>list r>
|
|
|
|
= assert
|
|
|
|
] 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 ;
|
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
: test-word ( output input word -- )
|
2004-08-04 03:12:55 -04:00
|
|
|
#! Old-style test.
|
|
|
|
append unit-test ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
: do-not-test-word ( output input word -- )
|
|
|
|
#! Flag for tests that are known not to work.
|
|
|
|
3drop ;
|
|
|
|
|
|
|
|
: test ( name -- )
|
|
|
|
! Run the given test.
|
2004-08-10 23:48:08 -04:00
|
|
|
depth pred >r
|
2004-08-08 17:20:54 -04:00
|
|
|
"Testing " write dup write "..." print
|
2004-08-10 23:48:08 -04:00
|
|
|
"/library/test/" swap ".factor" cat3 run-resource
|
|
|
|
"Checking before/after depth..." print
|
2004-10-17 19:01:16 -04:00
|
|
|
depth r> = assert ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
: all-tests ( -- )
|
|
|
|
"Running Factor test suite..." print
|
2004-12-15 16:57:29 -05:00
|
|
|
vocabularies get [ "scratchpad" off ] bind
|
2004-07-16 02:26:21 -04:00
|
|
|
[
|
2004-08-08 17:20:54 -04:00
|
|
|
"lists/cons"
|
|
|
|
"lists/lists"
|
|
|
|
"lists/assoc"
|
|
|
|
"lists/namespaces"
|
2004-11-17 20:59:28 -05:00
|
|
|
"lists/combinators"
|
2004-07-16 02:26:21 -04:00
|
|
|
"combinators"
|
|
|
|
"continuations"
|
2004-08-10 23:48:08 -04:00
|
|
|
"errors"
|
2004-07-16 02:26:21 -04:00
|
|
|
"hashtables"
|
2004-08-04 03:12:55 -04:00
|
|
|
"strings"
|
2004-11-16 23:09:34 -05:00
|
|
|
"namespaces"
|
2004-11-28 19:07:24 -05:00
|
|
|
"generic"
|
2004-08-28 16:43:43 -04:00
|
|
|
"files"
|
2004-08-04 18:25:29 -04:00
|
|
|
"parser"
|
2004-08-06 18:40:44 -04:00
|
|
|
"parse-number"
|
2004-08-04 03:12:55 -04:00
|
|
|
"prettyprint"
|
2004-09-05 00:06:09 -04:00
|
|
|
"image"
|
2004-10-03 16:39:32 -04:00
|
|
|
"init"
|
2004-08-04 18:25:29 -04:00
|
|
|
"inspector"
|
2004-08-22 21:56:06 -04:00
|
|
|
"io/io"
|
2004-11-03 23:35:36 -05:00
|
|
|
"listener"
|
2004-08-04 18:25:29 -04:00
|
|
|
"vectors"
|
2004-08-19 19:36:28 -04:00
|
|
|
"words"
|
2004-08-04 18:25:29 -04:00
|
|
|
"unparser"
|
|
|
|
"random"
|
2004-10-03 16:39:32 -04:00
|
|
|
"stream"
|
2004-10-13 23:06:40 -04:00
|
|
|
"styles"
|
2004-08-25 20:51:19 -04:00
|
|
|
"math/bignum"
|
2004-08-17 23:42:10 -04:00
|
|
|
"math/bitops"
|
2004-08-25 20:51:19 -04:00
|
|
|
"math/gcd"
|
2004-10-03 16:07:48 -04:00
|
|
|
"math/math-combinators"
|
2004-08-06 18:40:44 -04:00
|
|
|
"math/rational"
|
|
|
|
"math/float"
|
|
|
|
"math/complex"
|
|
|
|
"math/irrational"
|
2004-08-08 17:20:54 -04:00
|
|
|
"httpd/url-encoding"
|
|
|
|
"httpd/html"
|
|
|
|
"httpd/httpd"
|
2004-11-17 20:59:28 -05:00
|
|
|
"crashes"
|
|
|
|
"sbuf"
|
|
|
|
"threads"
|
|
|
|
"parsing-word"
|
|
|
|
"inference"
|
2004-11-28 19:07:24 -05:00
|
|
|
"dataflow"
|
2004-11-17 20:59:28 -05:00
|
|
|
"interpreter"
|
2004-12-05 21:17:09 -05:00
|
|
|
"hsv"
|
2004-11-16 23:09:34 -05:00
|
|
|
] [
|
|
|
|
test
|
|
|
|
] each
|
|
|
|
|
|
|
|
cpu "x86" = [
|
2004-08-08 17:20:54 -04:00
|
|
|
[
|
2004-12-05 21:17:09 -05:00
|
|
|
"compiler/optimizer"
|
2004-12-17 19:27:42 -05:00
|
|
|
"compiler/simplifier"
|
2004-12-05 21:17:09 -05:00
|
|
|
"compiler/simple"
|
|
|
|
"compiler/stack"
|
|
|
|
"compiler/ifte"
|
|
|
|
"compiler/generic"
|
|
|
|
"compiler/bail-out"
|
2004-08-08 17:20:54 -04:00
|
|
|
] [
|
|
|
|
test
|
|
|
|
] each
|
2004-10-17 19:01:16 -04:00
|
|
|
] when
|
|
|
|
|
2004-11-17 20:59:28 -05:00
|
|
|
[
|
|
|
|
"benchmark/empty-loop"
|
|
|
|
"benchmark/fac"
|
|
|
|
"benchmark/fib"
|
|
|
|
"benchmark/sort"
|
|
|
|
"benchmark/continuations"
|
|
|
|
"benchmark/ack"
|
|
|
|
"benchmark/hashtables"
|
|
|
|
"benchmark/strings"
|
|
|
|
"benchmark/vectors"
|
|
|
|
] [
|
|
|
|
test
|
|
|
|
] each ;
|