steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools.test: store file in a variable while tests are running

db4
Slava Pestov 2009-04-10 08:11:46 -05:00
parent 8290624733
commit a0ad6bda39
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
basis/tools/test/test.factor
View File

@ -32,8 +32,10 @@ test-failures [ V{ } clone ] initialize
"--> test failed!" print "--> test failed!" print
<test-failure> test-failures get push ; <test-failure> test-failures get push ;
: file-failure ( error file -- ) SYMBOL: file
[ f ] [ f ] bi* failure ;
: file-failure ( error -- )
f file get f failure ;
:: (unit-test) ( output input -- error ? ) :: (unit-test) ( output input -- error ? )
[ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; inline [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; inline
@ -71,14 +73,17 @@ MACRO: <experiment> ( word -- )
: experiment. ( seq -- ) : experiment. ( seq -- )
[ first write ": " write ] [ rest . ] bi ; [ first write ": " write ] [ rest . ] bi ;
:: experiment ( word: ( -- error ? ) file line# -- ) :: experiment ( word: ( -- error ? ) line# -- )
word <experiment> :> e word <experiment> :> e
e experiment. e experiment.
word execute [ e file line# failure ] [ drop ] if ; inline word execute [
file get [
e file get line# failure
] [ rethrow ] if
] [ drop ] if ; inline
: parse-test ( accum word -- accum ) : parse-test ( accum word -- accum )
literalize parsed literalize parsed
file get dup [ path>> ] when parsed
lexer get line>> parsed lexer get line>> parsed
\ experiment parsed ; inline \ experiment parsed ; inline
@ -93,8 +98,10 @@ SYNTAX: TEST:
>> >>
: run-test-file ( path -- ) : run-test-file ( path -- )
[ [ test-failures get ] dip '[ file>> _ = not ] filter-here ] dup file [
[ [ run-file ] [ swap file-failure ] recover ] bi ; test-failures get [ file>> file get = not ] filter-here
'[ _ run-file ] [ file-failure ] recover
] with-variable ;
: run-vocab-tests ( vocab -- ) : run-vocab-tests ( vocab -- )
dup vocab source-loaded?>> [ dup vocab source-loaded?>> [
@ -113,7 +120,7 @@ TEST: must-fail-with
TEST: must-fail TEST: must-fail
M: test-failure summary M: test-failure summary
[ asset>> experiment. ] with-string-writer ; asset>> [ [ experiment. ] with-string-writer ] [ "Top-level form" ] if* ;
M: test-failure error. ( error -- ) M: test-failure error. ( error -- )
[ call-next-method ] [ call-next-method ]