 gforth/test/ttester.fs 2007/10/26 12:47:41 1.6
+++ gforth/test/ttester.fs 2007/11/03 09:25:35 1.10
@@ 1,63 +1,63 @@
\ FOR THE ORIGINAL TESTER
\ FROM: JOHN HAYES S1I
\ SUBJECT: TESTER.FR
\ DATE: MON, 27 NOV 95 13:10:09 PST
+\ for the original tester
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
\ VERSION 1.1
\ FOR THE FNEARLY= STUFF:
\ FROM FTESTER.FS WRITTEN BY DAVID N. WILLIAMS, BASED ON THE IDEA OF
\ APPROXIMATE EQUALITY IN DIRK ZOLLER'S FLOAT.4TH
\ PUBLIC DOMAIN

\ 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.
+\ for the FNEARLY= stuff:
+\ from ftester.fs written by David N. Williams, based on the idea of
+\ approximate equality in Dirk Zoller's float.4th
+\ public domain
+
+\ 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
@@ 174,13 +174,13 @@ HASFLOATINGSTACK [IF]
: F> ( ...  ... )
FDEPTH DUP ACTUALFDEPTH !
STARTFDEPTH @ > IF
 FDEPTH STARTFDEPTH @ DO ACTUALFRESULTS I FLOATS + F! LOOP
+ FDEPTH STARTFDEPTH @  0 DO ACTUALFRESULTS I FLOATS + F! LOOP
THEN ;
: F} ( ...  ... )
FDEPTH ACTUALFDEPTH @ = IF
FDEPTH STARTFDEPTH @ > IF
 FDEPTH STARTFDEPTH @ DO
+ FDEPTH STARTFDEPTH @  0 DO
ACTUALFRESULTS I FLOATS + F@ FCONF= INVERT IF
S" INCORRECT FP RESULT: " ERROR LEAVE
THEN
@@ 191,20 +191,19 @@ HASFLOATINGSTACK [IF]
THEN ;
: F...}T (  )
 FDEPTH STARTFDEPTH @ = 0= IF
 S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR
 THEN
FCURSOR @ STARTFDEPTH @ + ACTUALFDEPTH @ <> IF
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  )
FDEPTH 0= ACTUALFDEPTH @ FCURSOR @ STARTFDEPTH @ + 1+ < OR IF
 S" NUMBER OF FLOAT RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT
 THEN
 ACTUALFRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
+ S" NUMBER OF FLOAT RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR
+ ELSE ACTUALFRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
 THEN
+ THEN THEN
1 FCURSOR +! ;
[ELSE]
@@ 224,10 +223,9 @@ HASFLOATINGSTACK [IF]
: FTESTER ( R  )
DEPTH CELLSPERFP < ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + CELLSPERFP + < OR IF
S" NUMBER OF RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT
 THEN
 ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
+ ELSE ACTUALRESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
 THEN
+ THEN THEN
CELLSPERFP XCURSOR +! ;
[THEN]
@@ 254,7 +252,7 @@ HASFLOATINGSTACK [IF]
: > \ ( ...  ) RECORD DEPTH AND CONTENT OF STACK.
DEPTH DUP ACTUALDEPTH ! \ RECORD DEPTH
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
F> ;
@@ 262,7 +260,7 @@ HASFLOATINGSTACK [IF]
\ (ACTUAL) CONTENTS.
DEPTH ACTUALDEPTH @ = IF \ IF DEPTHS MATCH
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
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
LOOP
@@ 273,21 +271,19 @@ HASFLOATINGSTACK [IF]
F} ;
: ...}T (  )
 DEPTH STARTDEPTH @ = 0= IF
 S" NUMBER OF CELL RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR
 THEN
XCURSOR @ STARTDEPTH @ + ACTUALDEPTH @ <> IF
 S" NUMBER OF CELL RESULTS BEFORE '>' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR
 THEN
+ S" NUMBER OF CELL RESULTS BEFORE '>' DOES NOT MATCH ...}T SPECIFICATION: " ERROR
+ ELSE DEPTH STARTDEPTH @ = 0= IF
+ S" NUMBER OF CELL RESULTS BEFORE AND AFTER '>' DOES NOT MATCH: " ERROR
+ THEN THEN
F...}T ;
: XTESTER ( X  )
DEPTH 0= ACTUALDEPTH @ XCURSOR @ STARTDEPTH @ + 1+ < OR IF
S" NUMBER OF CELL RESULTS AFTER '>' BELOW ...}T SPECIFICATION: " ERROR EXIT
 THEN
 ACTUALRESULTS XCURSOR @ CELLS + @ <> IF
+ ELSE ACTUALRESULTS XCURSOR @ CELLS + @ <> IF
S" INCORRECT CELL RESULT: " ERROR
 THEN
+ THEN THEN
1 XCURSOR +! ;
: X}T XTESTER ...}T ;