version 1.6, 2007/10/26 12:47:41

version 1.10, 2007/11/03 09:25:35

Line 1

Line 1

\ FOR THE ORIGINAL TESTER 
\ for the original tester 
\ 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 


\ FOR THE FNEARLY= STUFF: 
\ for the FNEARLY= stuff: 
\ 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 
\ public domain 


\ FOR THE REST: 
\ for the rest: 
\ REVISED BY ANTON ERTL 20070812, 20070819, 20070828 
\ revised by Anton Ertl 20070812, 20070819, 20070828 
\ PUBLIC DOMAIN 
\ public domain 


\ THE ORIGINAL HAS THE FOLLOWING SHORTCOMINGS: 
\ The original has the following shortcomings: 


\  IT DOES NOT WORK AS EXPECTED IF THE STACK IS NONEMPTY BEFORE THE {. 
\  It does not work as expected if the stack is nonempty before the {. 


\  IT DOES NOT CHECK FP RESULTS IF THE SYSTEM HAS A SEPARATE FP STACK. 
\  It does not check FP results if the system has a separate FP stack. 


\  THERE IS A CONFLICT WITH THE USE OF } FOR FSL ARRAYS AND { FOR LOCALS. 
\  There is a conflict with the use of } for FSL arrays and { for locals. 


\ I HAVE REVISED IT TO ADDRESS THESE SHORTCOMINGS. YOU CAN FIND THE 
\ I have revised it to address these shortcomings. You can find the 
\ RESULT AT 
\ result at 


\ HTTP://WWW.FORTH200X.ORG/TESTS/TESTER.FS 
\ http://www.forth200x.org/tests/tester.fs 
\ HTTP://WWW.FORTH200X.ORG/TESTS/TTESTER.FS 
\ http://www.forth200x.org/tests/ttester.fs 


\ TESTER.FS IS INTENDED TO BE A DROPIN REPLACEMENT OF THE ORIGINAL. 
\ tester.fs is intended to be a dropin replacement of the original. 


\ TTESTER.FS IS A VERSION THAT USES T{ AND }T INSTEAD OF { AND } AND 
\ ttester.fs is a version that uses T{ and }T instead of { and } and 
\ KEEPS THE BASE AS IT WAS BEFORE LOADING TTESTER.FS 
\ keeps the BASE as it was before loading ttester.fs 


\ IN SPIRIT OF THE ORIGINAL, I HAVE STRIVED TO AVOID ANY POTENTIAL 
\ In spirit of the original, I have strived to avoid any potential 
\ NONPORTABILITIES AND STAYED AS MUCH WITHIN THE CORE WORDS AS 
\ nonportabilities and stayed as much within the CORE words as 
\ POSSIBLE; E.G., FLOATING WORDS ARE USED ONLY IF THE FLOATING WORDSET 
\ possible; e.g., FLOATING words are used only if the FLOATING wordset 
\ IS PRESENT 
\ is present 


\ THERE ARE A FEW THINGS TO BE NOTED: 
\ There are a few things to be noted: 


\  LOADING TTESTER.FS DOES NOT CHANGE BASE. LOADING TESTER.FS 
\  Loading ttester.fs does not change BASE. Loading tester.fs 
\ CHANGES BASE TO HEX (LIKE THE ORIGINAL TESTER). FLOATINGPOINT 
\ changes BASE to HEX (like the original tester). Floatingpoint 
\ INPUT IS AMBIGUOUS WHEN THE BASE IS NOT DECIMAL, SO YOU HAVE TO SET 
\ 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. 
\ it to decimal yourself when you want to deal with decimal numbers. 


\  FOR FP IT IS OFTEN USEFUL TO USE APPROXIMATE EQUALITY FOR CHECKING 
\  For FP it is often useful to use approximate equality for checking 
\ THE RESULTS. YOU CAN TURN ON APPROXIMATE MATCHING WITH SETNEAR 
\ the results. You can turn on approximate matching with SETNEAR 
\ (AND TURN IT OFF (DEFAULT) WITH SETEXACT, AND YOU CAN TUNE IT BY 
\ (and turn it off (default) with SETEXACT, and you can tune it by 
\ SETTING THE VARIABLES RELNEAR AND ABSNEAR. IF YOU WANT YOUR TESTS 
\ setting the variables RELNEAR and ABSNEAR. If you want your tests 
\ TO WORK WITH A SHARED STACK, YOU HAVE TO SPECIFY THE TYPES OF THE 
\ 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 
\ 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 ). 
\ 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 
\ 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 
\ stack items, and defining more if you need them is straightforward 
\ (SEE SOURCE). IF YOUR TESTS ARE ONLY INTENDED FOR A SEPARATESTACK 
\ (see source). If your tests are only intended for a separatestack 
\ SYSTEM OR IF YOU NEED ONLY EXACT MATCHING, YOU CAN USE THE PLAIN }T 
\ system or if you need only exact matching, you can use the plain }T 
\ INSTEAD. 
\ instead. 


BASE @ 
BASE @ 
HEX 
HEX 
Line 174 HASFLOATINGSTACK [IF]

Line 174 HASFLOATINGSTACK [IF]

: F> ( ...  ... ) 
: F> ( ...  ... ) 
FDEPTH DUP ACTUALFDEPTH ! 
FDEPTH DUP ACTUALFDEPTH ! 
STARTFDEPTH @ > IF 
STARTFDEPTH @ > IF 
FDEPTH STARTFDEPTH @ DO ACTUALFRESULTS I FLOATS + F! LOOP 
FDEPTH STARTFDEPTH @  0 DO ACTUALFRESULTS I FLOATS + F! LOOP 
THEN ; 
THEN ; 


: F} ( ...  ... ) 
: F} ( ...  ... ) 
FDEPTH ACTUALFDEPTH @ = IF 
FDEPTH ACTUALFDEPTH @ = IF 
FDEPTH STARTFDEPTH @ > IF 
FDEPTH STARTFDEPTH @ > IF 
FDEPTH STARTFDEPTH @ DO 
FDEPTH STARTFDEPTH @  0 DO 
ACTUALFRESULTS I FLOATS + F@ FCONF= INVERT IF 
ACTUALFRESULTS I FLOATS + F@ FCONF= INVERT IF 
S" INCORRECT FP RESULT: " ERROR LEAVE 
S" INCORRECT FP RESULT: " ERROR LEAVE 
THEN 
THEN 
Line 191 HASFLOATINGSTACK [IF]

Line 191 HASFLOATINGSTACK [IF]

THEN ; 
THEN ; 


: F...}T (  ) 
: F...}T (  ) 
FDEPTH STARTFDEPTH @ = 0= IF 

S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 

THEN 

FCURSOR @ STARTFDEPTH @ + ACTUALFDEPTH @ <> IF 
FCURSOR @ STARTFDEPTH @ + ACTUALFDEPTH @ <> IF 
S" NUMBER OF FLOAT RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR 
S" NUMBER OF FLOAT RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR 
THEN ; 
ELSE FDEPTH STARTFDEPTH @ = 0= IF 

S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 

THEN THEN ; 




: FTESTER ( R  ) 
: FTESTER ( R  ) 
FDEPTH 0= ACTUALFDEPTH @ FCURSOR @ STARTFDEPTH @ + 1+ < OR IF 
FDEPTH 0= ACTUALFDEPTH @ FCURSOR @ STARTFDEPTH @ + 1+ < OR IF 
S" NUMBER OF FLOAT RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
S" NUMBER OF FLOAT RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR 
THEN 
ELSE ACTUALFRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF 
ACTUALFRESULTS 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 224 HASFLOATINGSTACK [IF]

Line 223 HASFLOATINGSTACK [IF]

: FTESTER ( R  ) 
: FTESTER ( R  ) 
DEPTH CELLSPERFP < ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + CELLSPERFP + < OR IF 
DEPTH CELLSPERFP < ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + CELLSPERFP + < OR IF 
S" NUMBER OF RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
S" NUMBER OF RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
THEN 
ELSE ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF 
ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF 

S" INCORRECT FP RESULT: " ERROR 
S" INCORRECT FP RESULT: " ERROR 
THEN 
THEN THEN 
CELLSPERFP XCURSOR +! ; 
CELLSPERFP XCURSOR +! ; 
[THEN] 
[THEN] 


Line 254 HASFLOATINGSTACK [IF]

Line 252 HASFLOATINGSTACK [IF]

: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK. 
: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK. 
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH 
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH 
STARTDEPTH @ > IF \ IF THERE IS SOMETHING ON STACK 
STARTDEPTH @ > IF \ IF THERE IS SOMETHING ON STACK 
DEPTH STARTDEPTH @ DO ACTUALRESULTS I CELLS + ! LOOP \ SAVE THEM 
DEPTH STARTDEPTH @  0 DO ACTUALRESULTS I CELLS + ! LOOP \ SAVE THEM 
THEN 
THEN 
F> ; 
F> ; 


Line 262 HASFLOATINGSTACK [IF]

Line 260 HASFLOATINGSTACK [IF]

\ (ACTUAL) CONTENTS. 
\ (ACTUAL) CONTENTS. 
DEPTH ACTUALDEPTH @ = IF \ IF DEPTHS MATCH 
DEPTH ACTUALDEPTH @ = IF \ IF DEPTHS MATCH 
DEPTH STARTDEPTH @ > IF \ IF THERE IS SOMETHING ON THE STACK 
DEPTH STARTDEPTH @ > IF \ IF THERE IS SOMETHING ON THE STACK 
DEPTH STARTDEPTH @ DO \ FOR EACH STACK ITEM 
DEPTH STARTDEPTH @  0 DO \ FOR EACH STACK ITEM 
ACTUALRESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 
ACTUALRESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED 
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN 
LOOP 
LOOP 
Line 273 HASFLOATINGSTACK [IF]

Line 271 HASFLOATINGSTACK [IF]

F} ; 
F} ; 


: ...}T (  ) 
: ...}T (  ) 
DEPTH STARTDEPTH @ = 0= IF 

S" NUMBER OF CELL RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 

THEN 

XCURSOR @ STARTDEPTH @ + ACTUALDEPTH @ <> IF 
XCURSOR @ STARTDEPTH @ + ACTUALDEPTH @ <> IF 
S" NUMBER OF CELL RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR 
S" NUMBER OF CELL RESULTS BEFORE '>' DOES NOT MATCH ...}T SPECIFICATION: " ERROR 
THEN 
ELSE DEPTH STARTDEPTH @ = 0= IF 

S" NUMBER OF CELL RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 

THEN THEN 
F...}T ; 
F...}T ; 


: XTESTER ( X  ) 
: XTESTER ( X  ) 
DEPTH 0= ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + 1+ < OR IF 
DEPTH 0= ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + 1+ < OR IF 
S" NUMBER OF CELL RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
S" NUMBER OF CELL RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
THEN 
ELSE ACTUALRESULTS XCURSOR @ CELLS + @ <> IF 
ACTUALRESULTS 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 ; 