Thanks to Josh, I have some test cases to show some flaws in my
logic. Here's another attempt:
diff -b -B -u ttester.fs ttesterOld.fs
--- ttester.fs 2008-03-01 11:12:16.000000000 -0700
+++ ttesterOld.fs 2008-03-01 11:11:12.000000000 -0700
@@ -67,8 +67,8 @@
VARIABLE VERBOSE
FALSE VERBOSE !
-CREATE ACTUAL-RESULTS 21 CELLS ALLOT
-CREATE EXPECT-RESULTS 21 CELLS ALLOT
+VARIABLE ACTUAL-DEPTH \ STACK RECORD
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
VARIABLE START-DEPTH
VARIABLE XCURSOR \ FOR ...}T
VARIABLE ERROR-XT
@@ -155,8 +155,8 @@
[THEN]
HAS-FLOATING-STACK [IF]
- CREATE ACTUAL-FRESULTS 21 FLOATS ALLOT
- CREATE EXPECT-FRESULTS 21 FLOATS ALLOT
+ VARIABLE ACTUAL-FDEPTH
+ CREATE ACTUAL-FRESULTS 20 FLOATS ALLOT
VARIABLE START-FDEPTH
VARIABLE FCURSOR
@@ -168,56 +168,40 @@
FDEPTH START-FDEPTH @ DO FDROP LOOP
THEN ;
- : SAVE-FSTACK ( ... addr -- ... ) \ Save stack contents (up to
20 items) at addr.
- DUP >R FDEPTH DUP S>D D>F R> F! \ Record depth
- DUP 0 20 WITHIN 0= ABORT" Invalid DEPTH"
- ?DUP IF \ If something is on stack
- 0 DO \ For each stack item
- FLOAT+ DUP >R F! R> \ Save them
- LOOP THEN START-FDEPTH @
- ?DUP IF \ If something is left
on stack
- 0 DO \ For each stack item
- DUP >R F@ R> 1 FLOATS - \ Restore them
- LOOP THEN DROP ;
-
- : SHOW-FSTACK ( addr -- ... ) \ Display saved stack contents.
- ." -> " DUP @ \ Get depth
- DUP 0 20 WITHIN 0= ABORT" Invalid DEPTH"
- ?DUP IF \ If something was on
stack
- SWAP OVER FLOATS +
- SWAP 0 DO \ For each stack item
- DUP F@ F. 1 FLOATS - \ Display them
- LOOP THEN DROP ." <- Top " CR ;
-
: F{ ( -- )
FDEPTH START-FDEPTH ! 0 FCURSOR ! ;
- : F-> ( ... -- ... ) ACTUAL-FRESULTS SAVE-FSTACK ;
+ : F-> ( ... -- ... )
+ FDEPTH DUP ACTUAL-FDEPTH !
+ START-FDEPTH @ > IF
+ FDEPTH START-FDEPTH @ - 0 DO ACTUAL-FRESULTS I FLOATS +
F! LOOP
+ THEN ;
: F} ( ... -- ... )
- EXPECT-FRESULTS FDEPTH >R SAVE-FSTACK
- EXPECT-FRESULTS ACTUAL-FRESULTS
- R> 0 ?DO
- OVER I FLOATS + F@
- OVER I FLOATS + F@ FCONF= INVERT IF \ If not the same
- S" INCORRECT FP RESULT: " ERROR
- ." ACTUAL: " ACTUAL-FRESULTS SHOW-FSTACK
- ." EXPECT: " EXPECT-FRESULTS SHOW-FSTACK
- 0 0 LEAVE
- THEN LOOP 2DROP ;
+ FDEPTH ACTUAL-FDEPTH @ = IF
+ FDEPTH START-FDEPTH @ > IF
+ FDEPTH START-FDEPTH @ - 0 DO
+ ACTUAL-FRESULTS I FLOATS + F@ FCONF= INVERT IF
+ S" INCORRECT FP RESULT: " ERROR LEAVE
+ THEN
+ LOOP
+ THEN
+ ELSE
+ S" WRONG NUMBER OF FP RESULTS: " ERROR
+ THEN ;
: F...}T ( -- )
- FCURSOR @ START-FDEPTH @ + ACTUAL-FRESULTS F@ F>D D>S <> IF
- S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT
MATCH ...}T SPECIFICATION: " ERROR
+ FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF
+ S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT
MATCH ...}T SPRECIFICATION: " ERROR
ELSE FDEPTH START-FDEPTH @ = 0= IF
S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES
NOT MATCH: " ERROR
THEN THEN ;
: FTESTER ( R -- )
- FDEPTH 0= ACTUAL-FRESULTS F@ F>D D>S FCURSOR @ START-FDEPTH
@ + 1+ < OR IF
+ FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ START-FDEPTH @ + 1+ < OR IF
S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T
SPECIFICATION: " ERROR
- ELSE ACTUAL-FRESULTS FCURSOR @ 1+ FLOATS + F@ FCONF= 0= IF
+ ELSE ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
THEN THEN
1 FCURSOR +! ;
@@ -237,9 +221,9 @@
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP
: FTESTER ( R -- )
- DEPTH CELLS-PER-FP < ACTUAL-RESULTS @ XCURSOR @ START-DEPTH
@ + CELLS-PER-FP + < OR IF
+ DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @
+ CELLS-PER-FP + < OR IF
S" NUMBER OF RESULTS AFTER '->' BELOW ...}T
SPECIFICATION: " ERROR EXIT
- ELSE ACTUAL-RESULTS XCURSOR @ 1+ CELLS + F@ FCONF= 0= IF
+ ELSE ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
THEN THEN
CELLS-PER-FP XCURSOR +! ;
@@ -254,27 +238,6 @@
THEN
EMPTY-FSTACK ;
-: SAVE-STACK ( ... addr -- ... ) \ Save stack contents (up to 20
items) at addr.
- DEPTH 1- 2DUP SWAP ! \ Record depth
- DUP 0 20 WITHIN 0= ABORT" Invalid DEPTH"
- ?DUP IF \ If something is on stack
- 0 DO \ For each stack item
- CELL+ TUCK ! \ Save them
- LOOP THEN START-DEPTH @
- ?DUP IF \ If something is left on stack
- 0 DO \ For each stack item
- DUP @ SWAP 1 CELLS - \ Restore them
- LOOP THEN DROP ;
-
-: SHOW-STACK ( addr -- ... ) \ Display saved stack contents.
- ." -> " DUP @ \ Get depth
- DUP 0 20 WITHIN 0= 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 " CR ;
-
: ERROR1 \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
\ THE LINE THAT HAD THE ERROR.
TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING
TO ERROR
@@ -287,24 +250,28 @@
DEPTH START-DEPTH ! 0 XCURSOR ! F{ ;
: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
- ACTUAL-RESULTS SAVE-STACK
+ DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH
+ START-DEPTH @ > IF \ IF THERE IS SOMETHING ON STACK
+ DEPTH START-DEPTH @ - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \
SAVE THEM
+ THEN
F-> ;
: }T \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH
SAVED
- EXPECT-RESULTS DEPTH >R SAVE-STACK
- EXPECT-RESULTS ACTUAL-RESULTS
- R> 0 DO
- OVER I CELLS + @
- OVER I CELLS + @ - IF \ If not the same
- S" INCORRECT RESULT: " ERROR
- ." ACTUAL: " ACTUAL-RESULTS SHOW-STACK
- ." EXPECT: " EXPECT-RESULTS SHOW-STACK
- 0 0 LEAVE
- THEN LOOP 2DROP
+ \ (ACTUAL) CONTENTS.
+ DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH
+ DEPTH START-DEPTH @ > IF \ IF THERE IS SOMETHING ON
THE STACK
+ DEPTH START-DEPTH @ - 0 DO \ FOR EACH STACK ITEM
+ ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED
+ <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
+ LOOP
+ THEN
+ ELSE \ DEPTH MISMATCH
+ S" WRONG NUMBER OF RESULTS: " ERROR
+ THEN
F} ;
: ...}T ( -- )
- XCURSOR @ START-DEPTH @ + ACTUAL-RESULTS @ <> IF
+ XCURSOR @ START-DEPTH @ + ACTUAL-DEPTH @ <> IF
S" NUMBER OF CELL RESULTS BEFORE '->' DOES NOT MATCH ...}T
SPECIFICATION: " ERROR
ELSE DEPTH START-DEPTH @ = 0= IF
S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT
MATCH: " ERROR
@@ -312,9 +279,9 @@
F...}T ;
: XTESTER ( X -- )
- DEPTH 0= ACTUAL-RESULTS @ XCURSOR @ START-DEPTH @ + 1+ < OR IF
+ DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + 1+ < OR IF
S" NUMBER OF CELL RESULTS AFTER '->' BELOW ...}T
SPECIFICATION: " ERROR EXIT
- ELSE ACTUAL-RESULTS XCURSOR @ 1+ CELLS + @ <> IF
+ ELSE ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF
S" INCORRECT CELL RESULT: " ERROR
THEN THEN
1 XCURSOR +! ;
DaR
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
