Diff for /gforth/test/ttester.fs between versions 1.10 and 1.13

version 1.10, 2007/11/03 09:25:35 version 1.13, 2008/11/08 18:34:18
Line 12 Line 12
 \ public domain  \ public domain
   
 \ for the rest:  \ for the rest:
 \ revised by Anton Ertl 2007-08-12, 2007-08-19, 2007-08-28  \ revised by Anton Ertl
 \ public domain  \ public domain
   
 \ The original has the following shortcomings:  \ The original has the following shortcomings:
Line 29 Line 29
 \ 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
   
   \ for history and possibly newer versions you can also look at
   \ http://www.complang.tuwien.ac.at/cvsweb/cgi-bin/cvsweb/gforth/test/ttester.fs
   
 \ tester.fs is intended to be a drop-in replacement of the original.  \ 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  \ ttester.fs is a version that uses T{ and }T instead of { and } and
Line 192  HAS-FLOATING-STACK [IF] Line 195  HAS-FLOATING-STACK [IF]
   
     : F...}T ( -- )      : F...}T ( -- )
         FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF          FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF
             S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T SPRECIFICATION: " ERROR              S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T SPECIFICATION: " ERROR
         ELSE FDEPTH START-FDEPTH @ = 0= IF          ELSE FDEPTH START-FDEPTH @ = 0= IF
             S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR              S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: " ERROR
         THEN THEN ;          THEN THEN ;
Line 213  HAS-FLOATING-STACK [IF] Line 216  HAS-FLOATING-STACK [IF]
     : F} ;      : F} ;
     : F...}T ;      : F...}T ;
   
       HAS-FLOATING [IF]
     DECIMAL      DECIMAL
     : COMPUTE-CELLS-PER-FP ( -- U )      : COMPUTE-CELLS-PER-FP ( -- U )
         DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ;          DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ;
     HEX      HEX
   
     COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP      COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP
       
     : FTESTER ( R -- )      : FTESTER ( R -- )
         DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + < OR IF          DEPTH CELLS-PER-FP < ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + < OR IF
             S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT              S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: " ERROR EXIT
Line 227  HAS-FLOATING-STACK [IF] Line 231  HAS-FLOATING-STACK [IF]
             S" INCORRECT FP RESULT: " ERROR              S" INCORRECT FP RESULT: " ERROR
         THEN THEN          THEN THEN
         CELLS-PER-FP XCURSOR +! ;          CELLS-PER-FP XCURSOR +! ;
  [THEN]          [THEN]
   [THEN]    
   
 : EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.  : EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
     DEPTH START-DEPTH @ < IF      DEPTH START-DEPTH @ < IF
Line 287  HAS-FLOATING-STACK [IF] Line 292  HAS-FLOATING-STACK [IF]
     1 XCURSOR +! ;      1 XCURSOR +! ;
   
 : X}T XTESTER ...}T ;  : X}T XTESTER ...}T ;
 : R}T FTESTER ...}T ;  
 : XX}T XTESTER XTESTER ...}T ;  : XX}T XTESTER XTESTER ...}T ;
   : XXX}T XTESTER XTESTER XTESTER ...}T ;
   : XXXX}T XTESTER XTESTER XTESTER XTESTER ...}T ;
   
   HAS-FLOATING [IF]
   : R}T FTESTER ...}T ;
 : XR}T FTESTER XTESTER ...}T ;  : XR}T FTESTER XTESTER ...}T ;
 : RX}T XTESTER FTESTER ...}T ;  : RX}T XTESTER FTESTER ...}T ;
 : RR}T FTESTER FTESTER ...}T ;  : RR}T FTESTER FTESTER ...}T ;
 : XXX}T XTESTER XTESTER XTESTER ...}T ;  
 : XXR}T FTESTER XTESTER XTESTER ...}T ;  : XXR}T FTESTER XTESTER XTESTER ...}T ;
 : XRX}T XTESTER FTESTER XTESTER ...}T ;  : XRX}T XTESTER FTESTER XTESTER ...}T ;
 : XRR}T FTESTER FTESTER XTESTER ...}T ;  : XRR}T FTESTER FTESTER XTESTER ...}T ;
Line 300  HAS-FLOATING-STACK [IF] Line 308  HAS-FLOATING-STACK [IF]
 : RXR}T FTESTER XTESTER FTESTER ...}T ;  : RXR}T FTESTER XTESTER FTESTER ...}T ;
 : RRX}T XTESTER FTESTER FTESTER ...}T ;  : RRX}T XTESTER FTESTER FTESTER ...}T ;
 : RRR}T FTESTER FTESTER FTESTER ...}T ;  : RRR}T FTESTER FTESTER FTESTER ...}T ;
 : XXXX}T XTESTER XTESTER XTESTER XTESTER ...}T ;  
 : XXXR}T FTESTER XTESTER XTESTER XTESTER ...}T ;  : XXXR}T FTESTER XTESTER XTESTER XTESTER ...}T ;
 : XXRX}T XTESTER FTESTER XTESTER XTESTER ...}T ;  : XXRX}T XTESTER FTESTER XTESTER XTESTER ...}T ;
 : XXRR}T FTESTER FTESTER XTESTER XTESTER ...}T ;  : XXRR}T FTESTER FTESTER XTESTER XTESTER ...}T ;
Line 316  HAS-FLOATING-STACK [IF] Line 323  HAS-FLOATING-STACK [IF]
 : RRXR}T FTESTER XTESTER FTESTER FTESTER ...}T ;  : RRXR}T FTESTER XTESTER FTESTER FTESTER ...}T ;
 : RRRX}T XTESTER FTESTER FTESTER FTESTER ...}T ;  : RRRX}T XTESTER FTESTER FTESTER FTESTER ...}T ;
 : RRRR}T FTESTER FTESTER FTESTER FTESTER ...}T ;  : RRRR}T FTESTER FTESTER FTESTER FTESTER ...}T ;
   [THEN]
   
 : TESTING       \ ( -- ) TALKING COMMENT.  : TESTING       \ ( -- ) TALKING COMMENT.
    SOURCE VERBOSE @     SOURCE VERBOSE @

Removed from v.1.10  
changed lines
  Added in v.1.13


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>