version 1.5, 2007/08/28 19:26:11
|
version 1.15, 2009/09/21 15:17:03
|
Line 1
|
Line 1
|
\ for the original tester |
\ This file contains the code for ttester, a utility for testing Forth words, |
|
\ as developed by several authors (see below), together with some explanations |
|
\ of its use. |
|
|
|
\ ttester is based on the original tester suite by Hayes: |
\ From: John Hayes S1I |
\ From: John Hayes S1I |
\ Subject: tester.fr |
\ Subject: tester.fr |
\ Date: Mon, 27 Nov 95 13:10:09 PST |
\ Date: Mon, 27 Nov 95 13:10:09 PST |
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY |
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY |
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. |
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. |
\ VERSION 1.1 |
\ VERSION 1.1 |
|
\ All the subsequent changes have been placed in the public domain. |
\ for the FNEARLY= stuff: |
\ The primary changes from the original are the replacement of "{" by "T{" |
|
\ and "}" by "}T" (to avoid conflicts with the uses of { for locals and } |
|
\ for FSL arrays), modifications so that the stack is allowed to be non-empty |
|
\ before T{, and extensions for the handling of floating point tests. |
|
\ Code for testing equality of floating point values comes |
\ from ftester.fs written by David N. Williams, based on the idea of |
\ from ftester.fs written by David N. Williams, based on the idea of |
\ approximate equality in Dirk Zoller's float.4th |
\ approximate equality in Dirk Zoller's float.4th. |
\ public domain |
\ Further revisions were provided by Anton Ertl, including the ability |
|
\ to handle either integrated or separate floating point stacks. |
\ for the rest: |
\ Revision history and possibly newer versions can be found at |
\ revised by Anton Ertl 2007-08-12, 2007-08-19, 2007-08-28 |
\ http://www.complang.tuwien.ac.at/cvsweb/cgi-bin/cvsweb/gforth/test/ttester.fs |
\ public domain |
\ Explanatory material and minor reformatting (no code changes) by |
|
\ C. G. Montgomery March 2009, with helpful comments from David Williams |
\ The original has the following shortcomings: |
\ and Krishna Myneni. |
|
|
\ - It does not work as expected if the stack is non-empty before the {. |
\ Usage: |
|
|
\ - It does not check FP results if the system has a separate FP stack. |
\ The basic usage takes the form T{ <code> -> <expected stack> }T . |
|
\ This executes <code> and compares the resulting stack contents with |
\ - There is a conflict with the use of } for FSL arrays and { for locals. |
\ the <expected stack> values, and reports any discrepancy between the |
|
\ two sets of values. |
\ I have revised it to address these shortcomings. You can find the |
\ For example: |
\ result at |
\ T{ 1 2 3 swap -> 1 3 2 }T ok |
|
\ T{ 1 2 3 swap -> 1 2 2 }T INCORRECT RESULT: T{ 1 2 3 swap -> 1 2 2 }T ok |
\ http://www.forth200x.org/tests/tester.fs |
\ T{ 1 2 3 swap -> 1 2 }T WRONG NUMBER OF RESULTS: T{ 1 2 3 swap -> 1 2 }T ok |
\ http://www.forth200x.org/tests/ttester.fs |
|
|
\ Floating point testing can involve further complications. The code |
\ tester.fs is intended to be a drop-in replacement of the original. |
\ attempts to determine whether floating-point support is present, and |
|
\ if so, whether there is a separate floating-point stack, and behave |
\ ttester.fs is a version that uses T{ and }T instead of { and } and |
\ accordingly. The CONSTANTs HAS-FLOATING and HAS-FLOATING-STACK |
\ keeps the BASE as it was before loading ttester.fs |
\ contain the results of its efforts, so the behavior of the code can |
|
\ be modified by the user if necessary. |
\ In spirit of the original, I have strived to avoid any potential |
|
\ non-portabilities and stayed as much within the CORE words as |
\ Then there are the perennial issues of floating point value |
\ possible; e.g., FLOATING words are used only if the FLOATING wordset |
\ comparisons. Exact equality is specified by SET-EXACT (the |
\ is present |
\ default). If approximate equality tests are desired, execute |
|
\ SET-NEAR . Then the FVARIABLEs REL-NEAR (default 1E-12) and |
|
\ ABS-NEAR (default 0E) contain the values to be used in comparisons |
|
\ by the (internal) word FNEARLY= . |
|
|
|
\ When there is not a separate floating point stack and you want to |
|
\ use approximate equality for FP values, it is necessary to identify |
|
\ which stack items are floating point quantities. This can be done |
|
\ by replacing the closing }T with a version that specifies this, such |
|
\ as RRXR}T which identifies the stack picture ( r r x r ). The code |
|
\ provides such words for all combinations of R and X with up to four |
|
\ stack items. They can be used with either an integrated or separate |
|
\ floating point stacks. Adding more if you need them is |
|
\ straightforward; see the examples in the source. Here is an example |
|
\ which also illustrates controlling the precision of comparisons: |
|
|
|
\ SET-NEAR |
|
\ 1E-6 REL-NEAR F! |
|
\ T{ S" 3.14159E" >FLOAT -> -1E FACOS TRUE RX}T |
|
|
|
\ The word ERROR is now vectored, so that its action can be changed by |
|
\ the user (for example, to add a counter for the number of errors). |
|
\ The default action ERROR1 can be used as a factor in the display of |
|
\ error reports. |
|
|
\ There are a few things to be noted: |
\ Loading ttester.fs does not change BASE. Remember that floating point input |
|
\ is ambiguous if the base is not decimal. |
|
|
\ - Loading ttester.fs does not change BASE. Loading tester.fs |
\ The file defines some 70 words in all, but in most cases only the |
\ changes BASE to HEX (like the original tester). Floating-point |
\ ones mentioned above will be needed for successful testing. |
\ input is ambiguous when the base is not decimal, so you have to set |
|
\ it to decimal yourself when you want to deal with decimal numbers. |
|
|
|
\ - For FP it is often useful to use approximate equality for checking |
|
\ the results. You can turn on approximate matching with SET-NEAR |
|
\ (and turn it off (default) with SET-EXACT, and you can tune it by |
|
\ setting the variables REL-NEAR and ABS-NEAR. If you want your tests |
|
\ to work with a shared stack, you have to specify the types of the |
|
\ elements on the stack by using one of the closing words that specify |
|
\ types, e.g. RRRX}T for checking the stack picture ( r r r x ). |
|
\ There are such words for all combination of R and X with up to 4 |
|
\ stack items, and defining more if you need them is straightforward |
|
\ (see source). If your tests are only intended for a separate-stack |
|
\ system or if you need only exact matching, you can use the plain }T |
|
\ instead. |
|
|
|
BASE @ |
BASE @ |
HEX |
HEX |
|
|
\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY |
VARIABLE ACTUAL-DEPTH \ stack record |
\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. |
|
VARIABLE VERBOSE |
|
FALSE VERBOSE ! |
|
|
|
VARIABLE ACTUAL-DEPTH \ STACK RECORD |
|
CREATE ACTUAL-RESULTS 20 CELLS ALLOT |
CREATE ACTUAL-RESULTS 20 CELLS ALLOT |
VARIABLE START-DEPTH |
VARIABLE START-DEPTH |
VARIABLE XCURSOR \ FOR ...}T |
VARIABLE XCURSOR \ for ...}T |
VARIABLE ERROR-XT |
VARIABLE ERROR-XT |
|
|
: ERROR ERROR-XT @ EXECUTE ; |
: ERROR ERROR-XT @ EXECUTE ; \ for vectoring of error reporting |
|
|
: "FLOATING" S" FLOATING" ; \ ONLY COMPILED S" IN CORE |
: "FLOATING" S" FLOATING" ; \ only compiled S" in CORE |
: "FLOATING-STACK" S" FLOATING-STACK" ; |
: "FLOATING-STACK" S" FLOATING-STACK" ; |
"FLOATING" ENVIRONMENT? [IF] |
"FLOATING" ENVIRONMENT? [IF] |
[IF] |
[IF] |
Line 92 VARIABLE ERROR-XT
|
Line 104 VARIABLE ERROR-XT
|
[ELSE] |
[ELSE] |
FALSE |
FALSE |
[THEN] |
[THEN] |
[ELSE] \ WE DON'T KNOW WHETHER THE FP STACK IS SEPARATE |
[ELSE] \ We don't know whether the FP stack is separate. |
HAS-FLOATING \ IF WE HAVE FLOATING, WE ASSUME IT IS |
HAS-FLOATING \ If we have FLOATING, we assume it is. |
[THEN] CONSTANT HAS-FLOATING-STACK |
[THEN] CONSTANT HAS-FLOATING-STACK |
|
|
HAS-FLOATING [IF] |
HAS-FLOATING [IF] |
\ SET THE FOLLOWING TO THE RELATIVE AND ABSOLUTE TOLERANCES YOU |
\ Set the following to the relative and absolute tolerances you |
\ WANT FOR APPROXIMATE FLOAT EQUALITY, TO BE USED WITH F~ IN |
\ want for approximate float equality, to be used with F~ in |
\ FNEARLY=. KEEP THE SIGNS, BECAUSE F~ NEEDS THEM. |
\ FNEARLY=. Keep the signs, because F~ needs them. |
FVARIABLE REL-NEAR DECIMAL 1E-12 HEX REL-NEAR F! |
FVARIABLE REL-NEAR DECIMAL 1E-12 HEX REL-NEAR F! |
FVARIABLE ABS-NEAR DECIMAL 0E HEX ABS-NEAR F! |
FVARIABLE ABS-NEAR DECIMAL 0E HEX ABS-NEAR F! |
|
|
\ WHEN EXACT? IS TRUE, }F USES FEXACTLY=, OTHERWISE FNEARLY=. |
\ When EXACT? is TRUE, }F uses FEXACTLY=, otherwise FNEARLY=. |
|
|
TRUE VALUE EXACT? |
TRUE VALUE EXACT? |
: SET-EXACT ( -- ) TRUE TO EXACT? ; |
: SET-EXACT ( -- ) TRUE TO EXACT? ; |
Line 112 HAS-FLOATING [IF]
|
Line 124 HAS-FLOATING [IF]
|
DECIMAL |
DECIMAL |
: FEXACTLY= ( F: X Y -- S: FLAG ) |
: FEXACTLY= ( F: X Y -- S: FLAG ) |
( |
( |
LEAVE TRUE IF THE TWO FLOATS ARE IDENTICAL. |
Leave TRUE if the two floats are identical. |
) |
) |
0E F~ ; |
0E F~ ; |
HEX |
HEX |
|
|
: FABS= ( F: X Y -- S: FLAG ) |
: FABS= ( F: X Y -- S: FLAG ) |
( |
( |
LEAVE TRUE IF THE TWO FLOATS ARE EQUAL WITHIN THE TOLERANCE |
Leave TRUE if the two floats are equal within the tolerance |
STORED IN ABS-NEAR. |
stored in ABS-NEAR. |
) |
) |
ABS-NEAR F@ F~ ; |
ABS-NEAR F@ F~ ; |
|
|
: FREL= ( F: X Y -- S: FLAG ) |
: FREL= ( F: X Y -- S: FLAG ) |
( |
( |
LEAVE TRUE IF THE TWO FLOATS ARE RELATIVELY EQUAL BASED ON THE |
Leave TRUE if the two floats are relatively equal based on the |
TOLERANCE STORED IN ABS-NEAR. |
tolerance stored in ABS-NEAR. |
) |
) |
REL-NEAR F@ FNEGATE F~ ; |
REL-NEAR F@ FNEGATE F~ ; |
|
|
Line 136 HAS-FLOATING [IF]
|
Line 148 HAS-FLOATING [IF]
|
|
|
: FNEARLY= ( F: X Y -- S: FLAG ) |
: FNEARLY= ( F: X Y -- S: FLAG ) |
( |
( |
LEAVE TRUE IF THE TWO FLOATS ARE NEARLY EQUAL. THIS IS A |
Leave TRUE if the two floats are nearly equal. This is a |
REFINEMENT OF DIRK ZOLLER'S FEQ TO ALSO ALLOW X = Y, INCLUDING |
refinement of Dirk Zoller's FEQ to also allow X = Y, including |
BOTH ZERO, OR TO ALLOW APPROXIMATE EQUALITY WHEN X AND Y ARE TOO |
both zero, or to allow approximately equality when X and Y are too |
SMALL TO SATISFY THE RELATIVE APPROXIMATION MODE IN THE F~ |
small to satisfy the relative approximation mode in the F~ |
SPECIFICATION. |
specification. |
) |
) |
F2DUP FEXACTLY= IF F2DROP TRUE EXIT THEN |
F2DUP FEXACTLY= IF F2DROP TRUE EXIT THEN |
F2DUP FREL= IF F2DROP TRUE EXIT THEN |
F2DUP FREL= IF F2DROP TRUE EXIT THEN |
Line 160 HAS-FLOATING-STACK [IF]
|
Line 172 HAS-FLOATING-STACK [IF]
|
VARIABLE START-FDEPTH |
VARIABLE START-FDEPTH |
VARIABLE FCURSOR |
VARIABLE FCURSOR |
|
|
|
DECIMAL |
: EMPTY-FSTACK ( ... -- ... ) |
: EMPTY-FSTACK ( ... -- ... ) |
FDEPTH START-FDEPTH @ < IF |
FDEPTH START-FDEPTH @ < IF |
FDEPTH START-FDEPTH @ SWAP DO 0E LOOP |
FDEPTH START-FDEPTH @ SWAP DO 0E LOOP |
Line 167 HAS-FLOATING-STACK [IF]
|
Line 180 HAS-FLOATING-STACK [IF]
|
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ DO FDROP LOOP |
FDEPTH START-FDEPTH @ DO FDROP LOOP |
THEN ; |
THEN ; |
|
HEX |
|
|
: F{ ( -- ) |
: F{ ( -- ) |
FDEPTH START-FDEPTH ! 0 FCURSOR ! ; |
FDEPTH START-FDEPTH ! 0 FCURSOR ! ; |
|
|
: F-> ( ... -- ... ) |
: F-> ( ... -- ... ) |
FDEPTH DUP ACTUAL-FDEPTH ! |
FDEPTH DUP ACTUAL-FDEPTH ! |
START-FDEPTH @ > IF |
START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ DO ACTUAL-FRESULTS I FLOATS + F! LOOP |
FDEPTH START-FDEPTH @ - 0 DO ACTUAL-FRESULTS I FLOATS + F! LOOP |
THEN ; |
THEN ; |
|
|
: F} ( ... -- ... ) |
: F} ( ... -- ... ) |
FDEPTH ACTUAL-FDEPTH @ = IF |
FDEPTH ACTUAL-FDEPTH @ = IF |
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ > IF |
FDEPTH START-FDEPTH @ DO |
FDEPTH START-FDEPTH @ - 0 DO |
ACTUAL-FRESULTS I FLOATS + F@ FCONF= INVERT IF |
ACTUAL-FRESULTS I FLOATS + F@ FCONF= INVERT IF |
S" INCORRECT FP RESULT: " ERROR LEAVE |
S" INCORRECT FP RESULT: " ERROR LEAVE |
THEN |
THEN |
Line 191 HAS-FLOATING-STACK [IF]
|
Line 205 HAS-FLOATING-STACK [IF]
|
THEN ; |
THEN ; |
|
|
: F...}T ( -- ) |
: F...}T ( -- ) |
FDEPTH START-FDEPTH @ = 0= IF |
FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF |
S" WRONG NUMBER OF FP RESULTS" ERROR |
S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T SPECIFICATION: " ERROR |
THEN |
ELSE FDEPTH START-FDEPTH @ = 0= IF |
FCURSOR @ ACTUAL-FDEPTH @ <> IF |
S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR |
S" WRONG NUMBER OF FP RESULTS" ERROR |
THEN THEN ; |
THEN ; |
|
|
|
: FTESTER ( R -- ) |
: FTESTER ( R -- ) |
FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ 1+ < OR IF |
FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ START-FDEPTH @ + 1+ < OR IF |
S" WRONG NUMBER OF FP RESULTS: " ERROR EXIT |
S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR |
THEN |
ELSE ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF |
ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF |
|
S" INCORRECT FP RESULT: " ERROR |
S" INCORRECT FP RESULT: " ERROR |
THEN |
THEN THEN |
1 FCURSOR +! ; |
1 FCURSOR +! ; |
|
|
[ELSE] |
[ELSE] |
Line 214 HAS-FLOATING-STACK [IF]
|
Line 227 HAS-FLOATING-STACK [IF]
|
: F} ; |
: F} ; |
: F...}T ; |
: F...}T ; |
|
|
|
HAS-FLOATING [IF] |
DECIMAL |
DECIMAL |
: COMPUTE-CELLS-PER-FP ( -- U ) |
: COMPUTE-CELLS-PER-FP ( -- U ) |
DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ; |
DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ; |
HEX |
HEX |
|
|
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP |
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP |
|
|
: FTESTER ( R -- ) |
: FTESTER ( R -- ) |
DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ CELLS-PER-FP + < OR IF |
DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + < OR IF |
S" WRONG NUMBER OF RESULTS: " ERROR EXIT |
S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT |
THEN |
ELSE ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF |
ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF |
|
S" INCORRECT FP RESULT: " ERROR |
S" INCORRECT FP RESULT: " ERROR |
THEN |
THEN THEN |
CELLS-PER-FP XCURSOR +! ; |
CELLS-PER-FP XCURSOR +! ; |
[THEN] |
[THEN] |
|
[THEN] |
|
|
: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. |
: EMPTY-STACK \ ( ... -- ) empty stack; handles underflowed stack too. |
DEPTH START-DEPTH @ < IF |
DEPTH START-DEPTH @ < IF |
DEPTH START-DEPTH @ SWAP DO 0 LOOP |
DEPTH START-DEPTH @ SWAP DO 0 LOOP |
THEN |
THEN |
Line 240 HAS-FLOATING-STACK [IF]
|
Line 254 HAS-FLOATING-STACK [IF]
|
THEN |
THEN |
EMPTY-FSTACK ; |
EMPTY-FSTACK ; |
|
|
: ERROR1 \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY |
: ERROR1 \ ( C-ADDR U -- ) display an error message |
\ THE LINE THAT HAD THE ERROR. |
\ followed by the line that had the error. |
TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR |
TYPE SOURCE TYPE CR \ display line corresponding to error |
EMPTY-STACK \ THROW AWAY EVERY THING ELSE |
EMPTY-STACK \ throw away everything else |
; |
; |
|
|
' ERROR1 ERROR-XT ! |
' ERROR1 ERROR-XT ! |
|
|
: T{ \ ( -- ) SYNTACTIC SUGAR. |
: T{ \ ( -- ) syntactic sugar. |
DEPTH START-DEPTH ! 0 XCURSOR ! F{ ; |
DEPTH START-DEPTH ! 0 XCURSOR ! F{ ; |
|
|
: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. |
: -> \ ( ... -- ) record depth and contents of stack. |
DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH |
DEPTH DUP ACTUAL-DEPTH ! \ record depth |
START-DEPTH @ > IF \ IF THERE IS SOMETHING ON STACK |
START-DEPTH @ > IF \ if there is something on the stack |
DEPTH START-DEPTH @ DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM |
DEPTH START-DEPTH @ - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ save them |
THEN |
THEN |
F-> ; |
F-> ; |
|
|
: }T \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED |
: }T \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED |
\ (ACTUAL) CONTENTS. |
\ (ACTUAL) CONTENTS. |
DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH |
DEPTH ACTUAL-DEPTH @ = IF \ if depths match |
DEPTH START-DEPTH @ > IF \ IF THERE IS SOMETHING ON THE STACK |
DEPTH START-DEPTH @ > IF \ if there is something on the stack |
DEPTH START-DEPTH @ DO \ FOR EACH STACK ITEM |
DEPTH START-DEPTH @ - 0 DO \ for each stack item |
ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED |
ACTUAL-RESULTS I CELLS + @ \ compare actual with expected |
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN |
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN |
LOOP |
LOOP |
THEN |
THEN |
ELSE \ DEPTH MISMATCH |
ELSE \ depth mismatch |
S" WRONG NUMBER OF RESULTS: " ERROR |
S" WRONG NUMBER OF RESULTS: " ERROR |
THEN |
THEN |
F} ; |
F} ; |
|
|
: ...}T ( -- ) |
: ...}T ( -- ) |
DEPTH START-DEPTH @ = 0= IF |
XCURSOR @ START-DEPTH @ + ACTUAL-DEPTH @ <> IF |
S" WRONG NUMBER OF RESULTS" ERROR |
S" NUMBER OF CELL RESULTS BEFORE '->' DOES NOT MATCH ...}T SPECIFICATION: " ERROR |
THEN |
ELSE DEPTH START-DEPTH @ = 0= IF |
XCURSOR @ ACTUAL-DEPTH @ <> IF |
S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR |
S" WRONG NUMBER OF RESULTS" ERROR |
THEN THEN |
THEN |
|
F...}T ; |
F...}T ; |
|
|
: XTESTER ( X -- ) |
: XTESTER ( X -- ) |
DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ 1+ < OR IF |
DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + 1+ < OR IF |
S" WRONG NUMBER OF RESULTS: " ERROR EXIT |
S" NUMBER OF CELL RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT |
THEN |
ELSE ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF |
ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF |
|
S" INCORRECT CELL RESULT: " ERROR |
S" INCORRECT CELL RESULT: " ERROR |
THEN |
THEN THEN |
1 XCURSOR +! ; |
1 XCURSOR +! ; |
|
|
: X}T XTESTER ...}T ; |
: X}T XTESTER ...}T ; |
: R}T FTESTER ...}T ; |
|
: XX}T XTESTER XTESTER ...}T ; |
: XX}T XTESTER XTESTER ...}T ; |
|
: XXX}T XTESTER XTESTER XTESTER ...}T ; |
|
: XXXX}T XTESTER XTESTER XTESTER XTESTER ...}T ; |
|
|
|
HAS-FLOATING [IF] |
|
: R}T FTESTER ...}T ; |
: XR}T FTESTER XTESTER ...}T ; |
: XR}T FTESTER XTESTER ...}T ; |
: RX}T XTESTER FTESTER ...}T ; |
: RX}T XTESTER FTESTER ...}T ; |
: RR}T FTESTER FTESTER ...}T ; |
: RR}T FTESTER FTESTER ...}T ; |
: XXX}T XTESTER XTESTER XTESTER ...}T ; |
|
: XXR}T FTESTER XTESTER XTESTER ...}T ; |
: XXR}T FTESTER XTESTER XTESTER ...}T ; |
: XRX}T XTESTER FTESTER XTESTER ...}T ; |
: XRX}T XTESTER FTESTER XTESTER ...}T ; |
: XRR}T FTESTER FTESTER XTESTER ...}T ; |
: XRR}T FTESTER FTESTER XTESTER ...}T ; |
Line 304 HAS-FLOATING-STACK [IF]
|
Line 319 HAS-FLOATING-STACK [IF]
|
: RXR}T FTESTER XTESTER FTESTER ...}T ; |
: RXR}T FTESTER XTESTER FTESTER ...}T ; |
: RRX}T XTESTER FTESTER FTESTER ...}T ; |
: RRX}T XTESTER FTESTER FTESTER ...}T ; |
: RRR}T FTESTER FTESTER FTESTER ...}T ; |
: RRR}T FTESTER FTESTER FTESTER ...}T ; |
: XXXX}T XTESTER XTESTER XTESTER XTESTER ...}T ; |
|
: XXXR}T FTESTER XTESTER XTESTER XTESTER ...}T ; |
: XXXR}T FTESTER XTESTER XTESTER XTESTER ...}T ; |
: XXRX}T XTESTER FTESTER XTESTER XTESTER ...}T ; |
: XXRX}T XTESTER FTESTER XTESTER XTESTER ...}T ; |
: XXRR}T FTESTER FTESTER XTESTER XTESTER ...}T ; |
: XXRR}T FTESTER FTESTER XTESTER XTESTER ...}T ; |
Line 320 HAS-FLOATING-STACK [IF]
|
Line 334 HAS-FLOATING-STACK [IF]
|
: RRXR}T FTESTER XTESTER FTESTER FTESTER ...}T ; |
: RRXR}T FTESTER XTESTER FTESTER FTESTER ...}T ; |
: RRRX}T XTESTER FTESTER FTESTER FTESTER ...}T ; |
: RRRX}T XTESTER FTESTER FTESTER FTESTER ...}T ; |
: RRRR}T FTESTER FTESTER FTESTER FTESTER ...}T ; |
: RRRR}T FTESTER FTESTER FTESTER FTESTER ...}T ; |
|
[THEN] |
|
|
|
\ Set the following flag to TRUE for more verbose output; this may |
|
\ allow you to tell which test caused your system to hang. |
|
VARIABLE VERBOSE |
|
FALSE VERBOSE ! |
|
|
: TESTING \ ( -- ) TALKING COMMENT. |
: TESTING \ ( -- ) TALKING COMMENT. |
SOURCE VERBOSE @ |
SOURCE VERBOSE @ |
Line 327 HAS-FLOATING-STACK [IF]
|
Line 347 HAS-FLOATING-STACK [IF]
|
ELSE >IN ! DROP |
ELSE >IN ! DROP |
THEN ; |
THEN ; |
|
|
BASE ! |
|
|
|
|
BASE ! |
|
\ end of ttester.fs |