Diff for /gforth/test/tester.fs between versions 1.1 and 1.2

version 1.1, 1997/05/21 20:40:20 version 1.2, 2007/08/12 12:10:35
Line 1 Line 1
 \ 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  
   \ revised by Anton Ertl 2007-08-12
   
 \ (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.
Line 23  VARIABLE VERBOSE Line 24  VARIABLE VERBOSE
   
 VARIABLE ACTUAL-DEPTH                   \ STACK RECORD  VARIABLE ACTUAL-DEPTH                   \ STACK RECORD
 CREATE ACTUAL-RESULTS 20 CELLS ALLOT  CREATE ACTUAL-RESULTS 20 CELLS ALLOT
   VARIABLE START-DEPTH
   
 : {             \ ( -- ) SYNTACTIC SUGAR.  : {             \ ( -- ) SYNTACTIC SUGAR.
    ;     DEPTH START-DEPTH ! ;
   
 : ->            \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.  : ->            \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
    DEPTH DUP ACTUAL-DEPTH !             \ RECORD DEPTH     DEPTH DUP ACTUAL-DEPTH !             \ RECORD DEPTH
    ?DUP IF                              \ IF THERE IS SOMETHING ON STACK     START-DEPTH @ > IF           \ IF THERE IS SOMETHING ON STACK
       0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM         DEPTH START-DEPTH @ DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
    THEN ;     THEN ;
   
 : }             \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED  : }             \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
                 \ (ACTUAL) CONTENTS.                  \ (ACTUAL) CONTENTS.
    DEPTH ACTUAL-DEPTH @ = IF            \ IF DEPTHS MATCH     DEPTH ACTUAL-DEPTH @ = IF            \ IF DEPTHS MATCH
       DEPTH ?DUP IF                     \ IF THERE IS SOMETHING ON THE STACK        DEPTH START-DEPTH @ > IF          \ IF THERE IS SOMETHING ON THE STACK
          0 DO                           \ FOR EACH STACK ITEM           DEPTH START-DEPTH @ DO         \ FOR EACH STACK ITEM
             ACTUAL-RESULTS I CELLS + @  \ COMPARE ACTUAL WITH EXPECTED              ACTUAL-RESULTS I CELLS + @  \ COMPARE ACTUAL WITH EXPECTED
             <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN              <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
          LOOP           LOOP

Removed from v.1.1  
changed lines
  Added in v.1.2


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