( Title: A utility for testing Forth data and floating-point stack effects File: ttester-xf.fs Test file: xftester-test.fs Log file: xftester.log License: John Hayes, Public Domain Version: 1.4.3 Revised: January 26, 2021 For any code derived from John Hayes' tester program: ) \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. ( The rest is public domain. This file revises the code for ttester, a utility for testing Forth words, as developed by several authors [see below]. The following is a quote from ttester. ) \ ttester is based on the original tester suite by Hayes: \ 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 \ All the subsequent changes have been placed in the public \ domain. 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 approximate equality in Dirk Zoller's float.4th. \ Further revisions were provided by Anton Ertl, including the \ ability to handle either integrated or separate floating point \ stacks. Revision history and possibly newer versions can be \ found at \ \ http://www.complang.tuwien.ac.at/cvsweb/cgi-bin/cvsweb/gforth/test/ttester.fs \ \ Explanatory material and minor reformatting (no code changes) \ by C. G. Montgomery March 2009, with helpful comments from \ David Williams and Krishna Myneni. ( This file is a consolidation of three files: xftester.fs, xtester.fs, and ftester.fs. Here ftester.fs is different from the file in the quote above. The designation "x" stands for the generic ANS/ISO Forth "unspecified cell" data type. The following revision of the ttester explanatory material, by David N. Williams, takes into account ttester-xf restrictions and extras. Versions 1.2.0 and later and 1.3.0 and later add new fp comparisons, based on suggestions by Krishna Myneni in comp.lang.forth. The basic restriction is that an integrated floating-point stack is no longer allowed. A number of words in ttester could be classified as implicitly private, although a specific user interface was never declared. In this file the designations PUBLIC and PRIVATE indicate word sets expected to be supported or not necessarily supported in future versions. This is purely a textual affectation, without actual wordlist management such as that provided by the FSL PUBLIC: and PRIVATE: words. Users of ttester who restrict themselves to a separate floating-point stack, and who use only the following words, can use ttester-xf as a drop-in replacement: T{ -> }T VERBOSE TESTING HAS-FLOATING ABS-NEAR REL-NEAR SET-EXACT SET-NEAR The ttester words ERROR-XT and ERROR1 are not available, having been replaced by stack-specific words, XT-ERROR-XT and FT-ERROR-XT, respectively, XT-ERROR-DEFAULT and FT-ERROR-DEFAULT. The ttester words ABS-NEAR, REL-NEAR, SET-EXACT, and SET-NEAR are deprecated in ttester-xf, and absent in xftester. Beginning with version 1.4.0, the order in which comparison mismatches between stack results and goals are found is deepest first, corresponding to the order of execution of the code that produces them. That is the same as the usual left to right order of stack pictures. The original Hayes tester and its ttester successor implemented topmost first. The following files contain enhancements over default error reporting: tester-display.fs, xtester-errors.fs, and ftester-errors.fs. See xftester-test.fs for examples of their use. These words are currently declared to be the ttester-xf user interface: PUBLIC INTERFACE WORDS tests: T{ -> }T VERBOSE TESTING HAS-FLOATING X{ X-> }X F{ F-> }F FT-ABS-TOLERANCE FT-REL-TOLERANCE FT-AREL-TOLERANCE SET-FT-MODE-EXACT SET-FT-MODE-ABS SET-FT-MODE-REL SET-FT-MODE-AREL SET-FT-MODE-REL0 for ttester compatibiity [deprecated] ABS-NEAR REL-NEAR SET-EXACT SET-NEAR config: MAX-XT-INITIALS MAX-XT-RESULTS MAX-FT-INITIALS MAX-FT-RESULTS PUBLIC AUXILIARY WORDS tests: FT-TEST=-XT FT-DATUM= FT-ABS= FT-REL= FT-AREL= FT-REL0= errors: XT-ERROR-XT XT-ERROR-DEFAULT XT-ERROR-INDEX FT-ERROR-XT FT-ERROR-DEFAULT FT-ERROR-INDEX arrays: XT-INITIALS XT-RESULTS XT-GOALS FT-INITIALS FT-RESULTS FT-GOALS XT-A@ XT-A! XT-A= FT-A@ FT-A! FT-A= The public interface words are all that are needed for normal testing, including using the built-in fp comparisons and changing their tolerances. The public auxiliary words are made available for users who want to add fp comparisons, or to implement more elaborate error reporting, such as counting errors, or dumping fp results and goals when something is wrong, or reporting a particular fp error with the help of FT-ERROR-INDEX. The file ftester-errors.fs does that, and is loaded by xftester-test.fs. NOTE: Starting with version 1.4.0, the words XT-A<> and FT-A<>, which expected data for one array and a buffer address for another as stack inputs, have been replaced by XT-A= and FT-A=, which take two array buffer addresses as stack inputs. Basic usage takes the form: ) \ ( xfinitials) T{ -> }T ( xfinitials) ( Angle brackets around a stack data designation indicate code that produces the data. Here xfinitials stands for possibly nonempty data and fp stack contents at the start of the test. The sequence starting with T{ saves the xfinitials and removes them from the stacks, executes the code that produces the data and fp stack xfresults, saves and removes the xfresults from the stacks, executes the code that produces the data and fp stack xfgoals, saves and removes them, compares the saved xfresults and xfgoals, reports when there is a discrepancy between the two, and restores the saved xfinitials. For example: T{ 1 2 3 swap -> 1 3 2 }T ok T{ 1 2 3 swap -> 1 2 2 }T INCORRECT XRESULT: T{ 1 2 3 swap -> 1 2 2 }T ok T{ 1 2 3 swap -> 1 2 }T WRONG NUMBER OF XRESULTS: T{ 1 2 3 swap -> 1 2 }T ok More examples can be found in the file xftester-test.fs. In addition to the T{..->..}T and F{..F->..}F tests in ttester [where "}F" was formerly named "F}"], ttester-xf makes X{..X->..}X tests available. The X and F tests act only on the data and fp stacks, respectively. Floating-point testing can involve further complications. The code attempts to determine whether floating-point support is present, and behaves accordingly. The constant HAS-FLOATING contains the results of its efforts, so the behavior of the test code can be modified by the user if necessary. Floating-point testing can involve further complications. There are the perennial issues of floating-point value comparisons. Exact equality is specified by SET-FT-MODE-EXACT [the default]. If one of the included approximate equality tests is desired, execute SET-FT-MODE-ABS, SET-FT-MODE-REL, SET-FT-MODE-AREL, or SET-FT-MODE-REL0. Corresponding to these, the public fvariables FT-ABS-TOLERANCE, FT-REL-TOLERANCE, and FT-AREL-TOLERANCE contain the values to be used in comparisons by the words FT-ABS=, FT-REL=, and FT-AREL=. FT-REL0= conditionally executes both FT-ABS= and FT-REL=. Here is an example which uses FT-REL=: SET-FT-MODE-REL 1E-6 FT-REL-TOLERANCE F! F{ S" 1.414214" >FLOAT F-> 2E FSQRT TRUE }F Note that comparisons in this mode are not symmetric. Measured values must be in the fresults, and reference values in the fgoals. The user may supply a different equality test by storing his own xt in the public variable FT-TEST=-XT. Storage of initial, result, and goal data includes overflow checking. The user can change the default storage allocation by defining any of the following constants *before* loading this file: MAX-XT-INITIALS MAX-XT-RESULTS MAX-FT-INITIALS MAX-FT-RESULTS The default xt's and tolerances can be changed after loading this file. As with ttester, loading ttester-xf does not change BASE. Remember that floating-point input is ambiguous if the base is not decimal. Here is the complete list of non-CORE words used by ttester-xf: TOOLS EXT: [IF] [ELSE] [THEN] [UNDEFINED] CORE EXT: 2>R 2R> ?DO TO VALUE [ftester deprecated section only] FILE: ( FLOATING EXT: F~ Among these, only the following are used by ttester: TOOLS EXT: [IF] [ELSE] [THEN] URL's for ttester-xf with tests and enhanced error reporting: http://www.umich.edu/~williams/archive/forth/utilities/#ttester http://www.umich.edu/~williams/archive/forth/utilities/xftester.zip TABLE OF CONTENTS XTESTER X.1 ERROR REPORTING X.2 ARRAYS X.3 TESTS FTESTER F.1 ERROR REPORTING F.2 COMPARISONS F.3 LEGACY COMPARISONS [DEPRECATED] F.4 ARRAYS F.5 TESTS TTESTER T.1 COMMENTS T.2 TESTS ) BASE @ decimal \ *** XTESTER \ *** X.1 ERRORS \ PUBLIC VARIABLE XT-ERROR-XT VARIABLE XT-ERROR-INDEX \ set to zero after unequal array size \ comparison, or [index+1] after deepest \ unequal element comparison at index : XT-ERROR-DEFAULT ( c-addr u -- ) ( Display an error message followed by the line that had the error. ) TYPE SOURCE TYPE CR ; ' XT-ERROR-DEFAULT XT-ERROR-XT ! \ PRIVATE : XT-ERROR ( c-addr u -- ) XT-ERROR-XT @ EXECUTE ; \ *** X.2 ARRAYS ( The arrays used for stack xinitials, xgoals, and xresults are one- dimensional, with cell-sized elements. The first cell contains the count, followed by the array elements. We call this collection the array buffer. Array indices, referred to as "index" in stack specifications, are zero-based. A tick prefix in stack comments means "address". ) \ PUBLIC \ USER CONFIG DEFAULTS [UNDEFINED] MAX-XT-INITIALS [IF] 32 CONSTANT MAX-XT-INITIALS [THEN] [UNDEFINED] MAX-XT-RESULTS [IF] 32 CONSTANT MAX-XT-RESULTS [THEN] \ ARRAY BUFFERS CREATE XT-INITIALS MAX-XT-INITIALS 1+ CELLS ALLOT CREATE XT-RESULTS MAX-XT-RESULTS 1+ CELLS ALLOT CREATE XT-GOALS MAX-XT-RESULTS 1+ CELLS ALLOT \ Overflow checking to be done elsewhere. : XT-A! ( x_[n-1] ... x_0 +n addr -- ) OVER 1+ CELLS OVER + SWAP DO I ! 1 CELLS +LOOP ; : XT-A@ ( 'buf -- x_[n-1] ... x_0 +n ) DUP @ CELLS OVER + DO I @ -1 CELLS +LOOP ; [UNDEFINED] CELL- [IF] : CELL- ( addr -- addr-cell ) [ 1 CELLS ] LITERAL - ; [THEN] : XT-A= ( 'buf1 'buf2 -- 0 true | 0 false | index+1 false ) ( Returns: 0 true: equal size and elements 0 false: sizes unequal index+1 false: sizes equal, deepest unequal elements at index ) 2DUP @ SWAP @ <> IF 2DROP 0 FALSE EXIT THEN \ unequal size 2>R 0 TRUE 2R> ( 0 true 'buf1 'buf2) DUP @ ( count) >R \ count = last+1 R@ CELLS + SWAP R@ CELLS + 0 R> ( 0 true 'elems2_last 'elems1_last 0 last+1) ?DO ( 0 true 'x_index 'y_index) \ i = index+1 2DUP @ SWAP @ <> IF \ unequal elements 2DROP ( 0 true) 2DROP I FALSE 0 0 LEAVE THEN CELL- SWAP CELL- ( 'y_[index-1] 'x_[index-1]) -1 +LOOP ( [0 true | i false] x1 x2) 2DROP ; \ *** X.3 TESTS \ PUBLIC : X{ ( xinitials -- ) ( Save the data stack xinitials for restoration by }X, leaving the data stack empty. Clear results and goals storage. ) DEPTH DUP MAX-XT-INITIALS > ABORT" TOO MANY XINITIALS" XT-INITIALS XT-A! 0 XT-RESULTS ! 0 XT-GOALS ! ; : X-> ( xresults -- ) ( Save the data stack xresults, leaving the data stack empty. ) DEPTH DUP MAX-XT-RESULTS > ABORT" TOO MANY XRESULTS" XT-RESULTS XT-A! ; : }X ( xgoals -- xinitials ) ( Save the data stack xgoals, compare them with the saved xresults, and restore the xinitials. If the number of xresults is not the same as the number of xgoals, store zero in XT-ERROR-INDEX and execute the XT-ERROR vector. Else, if the numbers are the same but there is a deepest comparison failure at the index-th element, store index+1 in XT-ERROR-INDEX and execute the XT-ERROR vector. ) DEPTH DUP MAX-XT-RESULTS > ABORT" TOO MANY XGOALS" XT-GOALS XT-A! XT-RESULTS XT-GOALS XT-A= ( 0 true | 0 false | index+1 false) IF ( 0) DROP ELSE DUP XT-ERROR-INDEX ! IF S" INCORRECT XRESULT: " ELSE S" WRONG NUMBER OF XRESULTS: " THEN XT-ERROR THEN XT-INITIALS XT-A@ ( len) DROP ; \ *** FTESTER \ PUBLIC \ From Bruce McFarling and others in c.l.f.: s" [UNDEFINED]" pad c! pad char+ pad c@ move pad find nip 0= [IF] : [UNDEFINED] ( "name" -- flag ) ( Leave true if name is not in the search order, else leave false. ) bl word find nip 0= ; immediate [THEN] [UNDEFINED] F+ 0= CONSTANT HAS-FLOATING HAS-FLOATING [IF] DEPTH 1E DEPTH 1- FDROP = 0= [IF] .( FLOATING-STACK REQUIRED) ABORT [THEN] \ *** F.1 ERRORS ( Error reporting in xftester is unavoidably different from that in ttester, because xftester does not use a common execution vector for data and fp stack reports. That of course does not affect compatibility as long as no errors occur. ) \ PUBLIC \ vectored error reporting VARIABLE FT-ERROR-XT VARIABLE FT-ERROR-INDEX \ set to zero after unequal array size \ comparison, or [index+1] after deepest \ unequal element comparison at index : FT-ERROR-DEFAULT ( c-addr u -- ) ( Display an error message followed by the line that had the error. ) TYPE SOURCE TYPE CR ; ' FT-ERROR-DEFAULT FT-ERROR-XT ! \ PRIVATE : FT-ERROR ( c-addr u -- ) FT-ERROR-XT @ EXECUTE ; \ *** F.2 COMPARISONS ( The public words in this section provide an alternative to the ttester fp equality tests. The xftester default is the same exact equality as that of ttester. ) \ PUBLIC VARIABLE FT-TEST=-XT \ PRIVATE : FT-TEST= ( f: x y -- ) ( -- flag ) FT-TEST=-XT @ EXECUTE ; \ PUBLIC \ The sign of these tolerances must be plus. FVARIABLE FT-ABS-TOLERANCE 0E FT-ABS-TOLERANCE F! FVARIABLE FT-REL-TOLERANCE 1E-12 FT-REL-TOLERANCE F! FVARIABLE FT-AREL-TOLERANCE 1E-12 FT-AREL-TOLERANCE F! \ This key word is a candidate for alternate definition. [UNDEFINED] FT-DATUM= [IF] : FT-DATUM= ( f: x y -- ) ( -- flag ) ( Leave TRUE if the two floats have the same internal representation, including the IEEE-FP 2008 special data, signed NAN with load, and signed zero and infinity. Else leave FALSE. Whether the specials work with F~ is implementation dependent, according to DPANS94. ) 0e F~ ; [THEN] \ |x - y| < eps : FT-ABS= ( f: x y -- ) ( -- flag ) FT-ABS-TOLERANCE F@ F~ ; \ |m - r| < eps * |r| : FT-REL= ( f: meas ref -- ) ( -- flag ) FSWAP FOVER F- FSWAP F/ FABS FT-REL-TOLERANCE F@ F< ; \ |x - y| < eps * (|x| + |y|)/2 : FT-AREL= ( f: x y -- ) ( -- flag ) FT-AREL-TOLERANCE F@ FNEGATE 2E F/ F~ ; : FT-REL0= ( f: meas ref -- ) ( -- flag ) \ Krishna Myneni FDUP F0= IF FT-ABS= ELSE FT-REL= THEN ; : SET-FT-MODE-EXACT ( -- ) ['] FT-DATUM= FT-TEST=-XT ! ; : SET-FT-MODE-ABS ( -- ) ['] FT-ABS= FT-TEST=-XT ! ; : SET-FT-MODE-REL ( -- ) ['] FT-REL= FT-TEST=-XT ! ; : SET-FT-MODE-AREL ( -- ) ['] FT-AREL= FT-TEST=-XT ! ; : SET-FT-MODE-REL0 ( -- ) ['] FT-REL0= FT-TEST=-XT ! ; SET-FT-MODE-EXACT \ *** F.3 LEGACY COMPARISONS (DEPRECATED) ( Exact and approximate fp equality in ttester-xf remain compatible with ttester, if the public words in this section are used instead of the newer ttester-xf words. ) \ PUBLIC ( Set the following to the relative and absolute tolerances you want for approximate float equality, to be used with F~ in FT-NEARLY=. Keep the signs, because F~ needs them. ) FVARIABLE REL-NEAR 1E-12 REL-NEAR F! FVARIABLE ABS-NEAR 0E ABS-NEAR F! \ PRIVATE ( When FT-EXACT? is TRUE, FT-CONF= uses FT-FDATUM=, otherwise FT-NEARLY=. ) TRUE VALUE FT-EXACT? : FT~ABS= ( f: x y -- ) ( -- flag ) ( Leave TRUE if the two floats are equal within the tolerance stored in FT-ABS-NEAR , else FALSE. ) ABS-NEAR F@ F~ ; : FT~REL= ( f: x y -- ) ( -- flag ) ( Leave TRUE if the two floats are relatively equal based on the tolerance stored in FT-REL-NEAR , else FALSE. ) REL-NEAR F@ FNEGATE F~ ; [UNDEFINED] F2DUP [IF] : F2DUP FOVER FOVER ; [THEN] [UNDEFINED] F2DROP [IF] : F2DROP FDROP FDROP ; [THEN] : FT-NEARLY= ( f: x y -- ) ( -- flag ) ( Leave TRUE if the two floats are nearly equal, else FALSE. This is a refinement of Dirk Zoller's FEQ to also allow x = y, including both zero, or to allow approximately equality when x and y are too small to satisfy the relative approximation mode in the F~ specification. ) F2DUP FT-DATUM= IF F2DROP TRUE EXIT THEN F2DUP FT~REL= IF F2DROP TRUE EXIT THEN FT~ABS= ; : FT-CONF= ( f: x y -- ) ( -- flag ) FT-EXACT? IF FT-DATUM= ELSE FT-NEARLY= THEN ; \ PUBLIC : SET-EXACT ( -- ) TRUE TO FT-EXACT? ['] FT-CONF= FT-TEST=-XT ! ; : SET-NEAR ( -- ) FALSE TO FT-EXACT? ['] FT-CONF= FT-TEST=-XT ! ; \ *** F.4 ARRAYS ( The arrays used for fp stack finitials, fgoals, and fresults are one- dimensional, with float-sized elements. The first cell contains the count, followed by the array elements, starting at the next FALIGNED address. We call this collection the array buffer. Array indices, referred to as "index" in stack specifications, are zero-based. A tick prefix in stack comments means "address". ) \ PUBLIC \ USER CONFIG DEFAULTS [UNDEFINED] MAX-FT-INITIALS [IF] 32 CONSTANT MAX-FT-INITIALS [THEN] [UNDEFINED] MAX-FT-RESULTS [IF] 32 CONSTANT MAX-FT-RESULTS [THEN] \ ARRAY BUFFERS CREATE FT-INITIALS 1 CELLS ALLOT FALIGN MAX-FT-INITIALS FLOATS ALLOT CREATE FT-RESULTS 1 CELLS ALLOT FALIGN MAX-FT-RESULTS FLOATS ALLOT CREATE FT-GOALS 1 CELLS ALLOT FALIGN MAX-FT-RESULTS FLOATS ALLOT \ Overflow checking to be done elsewhere. : FT-A! ( +n 'buf -- ) ( f: r_[n-1] ... r_0 -- ) 2DUP ! CELL+ FALIGNED SWAP ( 'elems n) DUP IF FLOATS OVER + SWAP DO I F! 1 FLOATS +LOOP ELSE 2DROP THEN ; : FT-A@ ( 'buf -- +n ) ( f: -- r_[n-1] ... r_0 ) DUP @ DUP >R ( 'buf n r: n) IF CELL+ FALIGNED R@ 1- FLOATS OVER + DO I F@ -1 FLOATS +LOOP ELSE DROP THEN R> ; [UNDEFINED] FLOAT- [IF] : FLOAT- ( addr -- addr-float ) [ 1 FLOATS ] LITERAL - ; [THEN] : FT-A= ( 'buf1 'buf2 -- 0 true | 0 false | index+1 false ) ( Note that when FT-TEST=-XT is set to FT-REL=, the comparison is not symmetric; so the elements of the measured and reference array buffers at 'buf1 and 'buf2, respectively, must be fetched to the fp stack in proper order. In the stack comments below, "m" and "r" stand for "measured" and "reference", to keep track in case the comparison xt is FT-REL=. Returns: 0 true: equal size and elements 0 false: sizes unequal index+1 false: sizes equal, deepest unequal elements at index ) 2DUP @ SWAP @ <> IF 2DROP 0 FALSE EXIT THEN \ unequal size DUP @ 0= IF 2DROP 0 TRUE EXIT THEN \ equal size and empty 2>R 0 TRUE 2R> ( 0 true 'buf1 'buf2) DUP @ ( count) 1- >R \ last index = count - 1 CELL+ FALIGNED R@ FLOATS + SWAP CELL+ FALIGNED R@ FLOATS + 0 R> ( 0 true 'r_last 'm_last 0 last) DO ( 0 true 'r_i 'm_i) \ i = index 2DUP F@ F@ FT-TEST= 0= IF \ unequal elements 2DROP ( 0 true) 2DROP I 1+ FALSE 0 0 LEAVE THEN FLOAT- SWAP FLOAT- SWAP ( 'r_[i-1] 'm_[i-1]) -1 +LOOP ( [0 true | i+1 false] x1 x2) 2DROP ; \ *** F.5 TESTS \ PUBLIC : F{ ( f: finitials -- ) ( Save the fp stack finitials for restoration by }F, leaving the fp stack empty. Clear fresults and fgoals storage. ) FDEPTH DUP MAX-FT-INITIALS > ABORT" TOO MANY FINITIALS" FT-INITIALS FT-A! 0 FT-RESULTS ! 0 FT-GOALS ! ; : F-> ( f: fresults -- ) ( Save the fp stack fresults, leaving the fp stack empty. ) FDEPTH DUP MAX-FT-RESULTS > ABORT" TOO MANY FRESULTS" FT-RESULTS FT-A! ; : }F ( f: fgoals -- finitials ) ( Save the fp stack fgoals, compare them with the saved fresults, and restore the finitials. If the number of fresults is not the same as the number of fgoals, store zero in FT-ERROR-INDEX and execute the FT-ERROR vector. If the numbers are the same but there is a deepest comparison failure at the index-th element, store index+1 in FT-ERROR-INDEX and execute the FT-ERROR vector. ) FDEPTH DUP MAX-FT-RESULTS > ABORT" TOO MANY FGOALS" FT-GOALS FT-A! FT-RESULTS FT-GOALS FT-A= ( 0 true | 0 false | index+1 false) IF ( 0) DROP ELSE DUP FT-ERROR-INDEX ! IF S" INCORRECT FRESULT: " ELSE S" WRONG NUMBER OF FRESULTS: " THEN FT-ERROR THEN FT-INITIALS FT-A@ ( len) DROP ; [THEN] \ HAS-FLOATING \ *** TTESTER \ *** T.1 COMMENTS \ PUBLIC \ Set the following flag to TRUE for more verbose output; this may allow \ you to tell which test caused your system to hang. [UNDEFINED] VERBOSE [IF] VARIABLE VERBOSE FALSE VERBOSE ! [THEN] : TESTING \ ( -- ) TALKING COMMENT. SOURCE VERBOSE @ IF DUP >R TYPE CR R> >IN ! ELSE >IN ! DROP THEN ; \ *** T.2 TESTS ( In the following specifications, references to the fp stack apply when HAS-FLOATING is true. ) \ PUBLIC : T{ ( xfinitials -- ) ( Save the data and fp stack xfinitials for restoration by }T. Clear xfresults and xfgoals storage. ) X{ [ HAS-FLOATING ] [IF] F{ [THEN] ; : -> ( xfresults -- ) ( Record the depth and contents of the data and fp stacks. ) X-> [ HAS-FLOATING ] [IF] F-> [THEN] ; : }T ( xfgoals -- xfinitials ) ( Save the data and fp stack xfgoals, compare them with the saved xfresults, and restore the xfinitials. ) }X [ HAS-FLOATING ] [IF] }F [THEN] ; BASE ! \ END of ttester-xf.fs