--- gforth/test/ttester.fs 2007/10/26 12:47:41 1.6 +++ gforth/test/ttester.fs 2007/11/03 08:27:14 1.9 @@ -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 2007-08-12, 2007-08-19, 2007-08-28 -\ PUBLIC DOMAIN - -\ THE ORIGINAL HAS THE FOLLOWING SHORTCOMINGS: - -\ - IT DOES NOT WORK AS EXPECTED IF THE STACK IS NON-EMPTY 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 DROP-IN 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 -\ NON-PORTABILITIES 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). FLOATING-POINT -\ 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. +\ 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 2007-08-12, 2007-08-19, 2007-08-28 +\ public domain + +\ The original has the following shortcomings: + +\ - It does not work as expected if the stack is non-empty 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 drop-in 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 +\ non-portabilities 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). Floating-point +\ 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 @ HEX @@ -174,7 +174,7 @@ HAS-FLOATING-STACK [IF] : F-> ( ... -- ... ) FDEPTH DUP ACTUAL-FDEPTH ! 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 ; : F} ( ... -- ... ) @@ -191,20 +191,19 @@ HAS-FLOATING-STACK [IF] THEN ; : F...}T ( -- ) - FDEPTH START-FDEPTH @ = 0= IF - S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR - THEN FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR - THEN ; + 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-FDEPTH @ FCURSOR @ START-FDEPTH @ + 1+ < OR IF - S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT - THEN - ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF + S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR + ELSE ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF S" INCORRECT FP RESULT: " ERROR - THEN + THEN THEN 1 FCURSOR +! ; [ELSE] @@ -224,10 +223,9 @@ HAS-FLOATING-STACK [IF] : FTESTER ( R -- ) DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + < OR IF S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT - THEN - ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF + ELSE ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF S" INCORRECT FP RESULT: " ERROR - THEN + THEN THEN CELLS-PER-FP XCURSOR +! ; [THEN] @@ -254,7 +252,7 @@ HAS-FLOATING-STACK [IF] : -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH START-DEPTH @ > IF \ IF THERE IS SOMETHING ON 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 F-> ; @@ -273,21 +271,19 @@ HAS-FLOATING-STACK [IF] F} ; : ...}T ( -- ) - DEPTH START-DEPTH @ = 0= IF - S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR - THEN XCURSOR @ START-DEPTH @ + ACTUAL-DEPTH @ <> 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 START-DEPTH @ = 0= IF + S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR + THEN THEN F...}T ; : XTESTER ( X -- ) DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + 1+ < OR IF S" NUMBER OF CELL RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT - THEN - ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF + ELSE ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF S" INCORRECT CELL RESULT: " ERROR - THEN + THEN THEN 1 XCURSOR +! ; : X}T XTESTER ...}T ;