version 1.2, 2007/08/21 09:22:28

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

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 
\ 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 
\ This library is free software; you can redistribute it and/or 

\ modify it under the terms of the GNU Lesser General Public 

\ License as published by the Free Software Foundation; either 

\ version 2.1 of the License, or at your option any later version. 



\ This library is distributed in the hope that it will be useful, 

\ but WITHOUT ANY WARRANTY; without even the implied warranty of 

\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 

\ Lesser General Public License for more details. 



\ You should have received a copy of the GNU Lesser General Public 

\ License along with this library; if not, write to the Free 

\ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, 

\ MA 021111307 USA. 



\ for the rest: 

\ revised by Anton Ertl 20070812, 20070819 

\ public domain 



\ The original has the following shortcomings: 



\  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. 



\  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 

\ result at 



\ http://www.forth200x.org/tests/tester.fs 

\ http://www.forth200x.org/tests/ttester.fs 



\ 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 }. 



\ In spirit of the original, I have strived to avoid any potential 

\ nonportabilities and stayed as much within the CORE words as 

\ possible; e.g., FLOATING words are used only if the FLOATING wordset 

\ is present 



\ There are a few things to be noted: 



\  Following the despicable practice of the original, this version 

\ sets the base to HEX for everything that gets loaded later. 

\ Floatingpoint 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 SETNEAR 

\ (and turn it off (default) with SETEXACT, and you can tune it by 

\ 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 

\ 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 separatestack 

\ system or if you need only exact matching, you can use the plain }T 

\ instead. 




\ FOR THE REST: 

\ REVISED BY ANTON ERTL 20070812, 20070819, 20070828 

\ PUBLIC DOMAIN 



\ THE ORIGINAL HAS THE FOLLOWING SHORTCOMINGS: 



\  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. 



\  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 

\ RESULT AT 



\ HTTP://WWW.FORTH200X.ORG/TESTS/TESTER.FS 

\ HTTP://WWW.FORTH200X.ORG/TESTS/TTESTER.FS 



\ 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 

\ KEEPS THE BASE AS IT WAS BEFORE LOADING TTESTER.FS 



\ IN SPIRIT OF THE ORIGINAL, I HAVE STRIVED TO AVOID ANY POTENTIAL 

\ NONPORTABILITIES AND STAYED AS MUCH WITHIN THE CORE WORDS AS 

\ POSSIBLE; E.G., FLOATING WORDS ARE USED ONLY IF THE FLOATING WORDSET 

\ IS PRESENT 



\ THERE ARE A FEW THINGS TO BE NOTED: 



\  LOADING TTESTER.FS DOES NOT CHANGE BASE. LOADING TESTER.FS 

\ CHANGES BASE TO HEX (LIKE THE ORIGINAL TESTER). FLOATINGPOINT 

\ 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 SETNEAR 

\ (AND TURN IT OFF (DEFAULT) WITH SETEXACT, AND YOU CAN TUNE IT BY 

\ 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 

\ 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 SEPARATESTACK 

\ SYSTEM OR IF YOU NEED ONLY EXACT MATCHING, YOU CAN USE THE PLAIN }T 

\ INSTEAD. 



BASE @ 
HEX 
HEX 


\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 
\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY 
Line 112 HASFLOATING [IF]

Line 100 HASFLOATING [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 FSENSITIVITY DECIMAL 1E12 HEX FSENSITIVITY F! 
FVARIABLE RELNEAR DECIMAL 1E12 HEX RELNEAR F! 
: RELNEAR FSENSITIVITY ; 

FVARIABLE ABSNEAR DECIMAL 0E HEX ABSNEAR F! 
FVARIABLE ABSNEAR DECIMAL 0E HEX ABSNEAR F! 


\ WHEN EXACT? IS TRUE, }F USES FEXACTLY=, OTHERWISE FNEARLY=. 
\ WHEN EXACT? IS TRUE, }F USES FEXACTLY=, OTHERWISE FNEARLY=. 
Line 205 HASFLOATINGSTACK [IF]

Line 192 HASFLOATINGSTACK [IF]



: F...}T (  ) 
: F...}T (  ) 
FDEPTH STARTFDEPTH @ = 0= IF 
FDEPTH STARTFDEPTH @ = 0= IF 
S" WRONG NUMBER OF FP RESULTS" ERROR 
S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 
THEN 
THEN 
FCURSOR @ ACTUALFDEPTH @ <> IF 
FCURSOR @ STARTFDEPTH @ + ACTUALFDEPTH @ <> IF 
S" WRONG NUMBER OF FP RESULTS" ERROR 
S" NUMBER OF FLOAT RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR 
THEN ; 
THEN ; 


: FTESTER ( R  ) 
: FTESTER ( R  ) 
FDEPTH 0= ACTUALFDEPTH @ FCURSOR @ 1+ < OR IF 
FDEPTH 0= ACTUALFDEPTH @ FCURSOR @ STARTFDEPTH @ + 1+ < OR IF 
S" WRONG NUMBER OF FP RESULTS: " ERROR EXIT 
S" NUMBER OF FLOAT RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
THEN 
THEN 
ACTUALFRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF 
ACTUALFRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF 
S" INCORRECT FP RESULT: " ERROR 
S" INCORRECT FP RESULT: " ERROR 
Line 227 HASFLOATINGSTACK [IF]

Line 214 HASFLOATINGSTACK [IF]

: F} ; 
: F} ; 
: F...}T ; 
: F...}T ; 



DECIMAL 
: COMPUTECELLSPERFP (  U ) 
: COMPUTECELLSPERFP (  U ) 
DEPTH 0E DEPTH >R FDROP R> SWAP  ; 
DEPTH 0E DEPTH 1 >R FDROP R> SWAP  ; 

HEX 


COMPUTECELLSPERFP CONSTANT CELLSPERFP 
COMPUTECELLSPERFP CONSTANT CELLSPERFP 


: FTESTER ( R  ) 
: FTESTER ( R  ) 
DEPTH CELLSPERFP < ACTUALDEPTH @ XCURSOR @ CELLSPERFP + < OR IF 
DEPTH CELLSPERFP < ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + CELLSPERFP + < OR IF 
S" WRONG NUMBER OF RESULTS: " ERROR EXIT 
S" NUMBER OF RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
THEN 
THEN 
ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF 
ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF 
S" INCORRECT FP RESULT: " ERROR 
S" INCORRECT FP RESULT: " ERROR 
Line 260 HASFLOATINGSTACK [IF]

Line 249 HASFLOATINGSTACK [IF]

' ERROR1 ERRORXT ! 
' ERROR1 ERRORXT ! 


: T{ \ (  ) SYNTACTIC SUGAR. 
: T{ \ (  ) SYNTACTIC SUGAR. 
DEPTH STARTDEPTH ! F{ ; 
DEPTH STARTDEPTH ! 0 XCURSOR ! F{ ; 


: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK. 
: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK. 
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH 
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH 
Line 285 HASFLOATINGSTACK [IF]

Line 274 HASFLOATINGSTACK [IF]



: ...}T (  ) 
: ...}T (  ) 
DEPTH STARTDEPTH @ = 0= IF 
DEPTH STARTDEPTH @ = 0= IF 
S" WRONG NUMBER OF RESULTS" ERROR 
S" NUMBER OF CELL RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR 
THEN 
THEN 
XCURSOR @ ACTUALDEPTH @ <> IF 
XCURSOR @ STARTDEPTH @ + ACTUALDEPTH @ <> IF 
S" WRONG NUMBER OF RESULTS" ERROR 
S" NUMBER OF CELL RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR 
THEN 
THEN 
F...}T ; 
F...}T ; 


: XTESTER ( X  ) 
: XTESTER ( X  ) 
DEPTH 0= ACTUALDEPTH @ XCURSOR @ 1+ < OR IF 
DEPTH 0= ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + 1+ < OR IF 
S" WRONG NUMBER OF RESULTS: " ERROR EXIT 
S" NUMBER OF CELL RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT 
THEN 
THEN 
ACTUALRESULTS XCURSOR @ CELLS + @ <> IF 
ACTUALRESULTS XCURSOR @ CELLS + @ <> IF 
S" INCORRECT CELL RESULT: " ERROR 
S" INCORRECT CELL RESULT: " ERROR 
Line 337 HASFLOATINGSTACK [IF]

Line 326 HASFLOATINGSTACK [IF]

IF DUP >R TYPE CR R> >IN ! 
IF DUP >R TYPE CR R> >IN ! 
ELSE >IN ! DROP 
ELSE >IN ! DROP 
THEN ; 
THEN ; 



BASE ! 