On 2008-02-24 14:10:47 -0700, anton@[EMAIL PROTECTED]
(Anton
Ertl) said:
> Josh Grams <josh@[EMAIL PROTECTED]
> writes:
>> I want something that (at least) displays the actual and expected
>> stack
>> contents, and preferably something that can be extended to deal with
>> strings or other data. I'd love to be able to do:
>>
>> T{ 1 2 3 => 1 5 }T
>> T{ s" abcdef" 2 /string => s" def" }( string )T
>>
>> And see:
>>
>> T{ 1 2 3 => 1 5 }T
>> Returned: <3> 1 2 3
>> Expected: <2> 1 5
>>
>> T{ s" abcdef" 2 /string => s" def" }( string )T
>> Returned: <2> $8070938 4 ("cdef")
>> Expected: <2> $8070948 3 ("def")
>>
>> Anybody have something like that, or should I roll my own?
>
> I'll add something like this to ttester.fs when I get around to it
> (not sure if I'll do the string thing, though). Of course, you could
> roll your own and might get the result sooner (and maybe submit it for
> inclusion in my release:-).
>
> - anton
I have done this on the version of the Hayes suite that I did at Apple.
I had taken the test suite in a little bit of a side direction, so I
would have to bring it back in line with what you are doing now, but
here is the code. I'll look at what it will take to get it onto the
gforth TOT if this is something others are interested in.
VARIABLE DETAILS \ DETAILS ON displays every test
\ INITIAL-DEPTH records the depth of the stack at compile time and uses
\ this to redefine DEPTH. This prevents invalid failures when there are
\ values on the stack before this test suite is loaded. This value is set
\ back to 0 after the test suite is completed.
DEPTH VALUE INITIAL-DEPTH \ Allow stack values before testing.
: DEPTH ( -- n ) DEPTH INITIAL-DEPTH - ;
\ Empty the data stack: handles underflowed stack too.
: EMPTY-STACK ( ... -- )
DEPTH ?DUP IF DUP 0< IF
NEGATE 0 DO 0 LOOP
ELSE 0 DO DROP LOOP
THEN THEN ;
: BEGIN-LINE ( limit current -- beginning )
BEGIN 1- DUP C@[EMAIL PROTECTED]
DUP H# 0D = SWAP H# 0A =
OR NOT WHILE
2DUP < NOT IF NIP EXIT THEN
REPEAT NIP 1+ ;
: END-LINE ( limit current -- ending )
BEGIN DUP C@[EMAIL PROTECTED]
DUP H# 0D = SWAP H# 0A =
OR NOT WHILE
2DUP > NOT IF NIP EXIT THEN 1+
REPEAT NIP ;
: SOURCE-LINE ( -- c-addr u ) \ Get current source line
SOURCE OVER + \ Address limits
SWAP DUP >IN @[EMAIL PROTECTED]
1- + \ Where we are
DUP >R BEGIN-LINE
SWAP R> END-LINE
OVER - ;
: ttype ( str len -- ) DETAILS @[EMAIL PROTECTED]
IF TYPE ELSE 2DROP THEN ;
: tcr ( -- ) DETAILS @[EMAIL PROTECTED]
IF CR THEN ;
\ Display an error message followed by the line that had the error.
: ERROR ( c-addr u -- )
CR TYPE SOURCE-LINE TYPE SPACE \ Display line corresponding to error
EMPTY-STACK ; \ Throw away every thing else
: ((> ( -- ) \ byp***** the test with a message, treating it as a comment.
DETAILS @[EMAIL PROTECTED]
IF
" BYPASSED: " ERROR
THEN [CHAR] ) PARSE 2DROP ;
: (> ( -- ) \ Start a test, syntactic sugar.
DETAILS @[EMAIL PROTECTED]
IF
" TESTING: " ERROR
THEN ;
CREATE ACTUAL-RESULTS 65 CELLS ALLOT
CREATE EXPECT-RESULTS 65 CELLS ALLOT
: SAVE-STACK ( ... addr -- ) \ Save stack contents (up to 64 items) at
addr.
DEPTH 1- 2DUP SWAP ! \ Record depth
DUP 0 64 WITHIN NOT ABORT" Invalid DEPTH"
?DUP IF \ If something is on stack
0 DO \ For each stack item
CELL+ TUCK ! \ Save them
LOOP THEN DROP ;
: SHOW-STACK ( addr -- ... ) \ Display saved stack contents.
." -> " DUP @[EMAIL PROTECTED]
\ Get depth
DUP 0 64 WITHIN NOT ABORT" Invalid DEPTH"
?DUP IF \ If something was on stack
SWAP OVER CELLS +
SWAP 0 DO \ For each stack item
DUP ? 1 CELLS - \ Display them
LOOP THEN DROP ." <- Top " ;
: => ( ... -- ) \ record actual depth.
" check-stacks" find-def if execute then
ACTUAL-RESULTS SAVE-STACK ;
: <) ( ... -- ) \ Compare expected stack contents with saved contents.
EXPECT-RESULTS DEPTH >R SAVE-STACK
EXPECT-RESULTS ACTUAL-RESULTS
R> 0 DO
OVER I CELLS + @[EMAIL PROTECTED]
OVER I CELLS + @[EMAIL PROTECTED]
- IF \ If not the same
" INCORRECT RESULT: " ERROR
CR ." ACTUAL: " ACTUAL-RESULTS SHOW-STACK
CR ." EXPECT: " EXPECT-RESULTS SHOW-STACK
0 0 LEAVE
THEN LOOP 2DROP ;
DaR
|
