Return to tester.fs CVS log

Up to [gforth] / gforth / test

jwilke's changes:
Moved many files to other directories
renamed many files
other changes unknown to me.

    1: \ From: John Hayes S1I
    2: \ Subject: tester.fr
    3: \ Date: Mon, 27 Nov 95 13:10:09 PST  
    4: 
    5: \ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
    6: \ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
    7: \ VERSION 1.1
    8: HEX
    9: 
   10: \ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
   11: \ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
   12: VARIABLE VERBOSE
   13:    FALSE VERBOSE !
   14: 
   15: : EMPTY-STACK	\ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
   16:    DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
   17: 
   18: : ERROR		\ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
   19: 		\ THE LINE THAT HAD THE ERROR.
   20:    TYPE SOURCE TYPE CR			\ DISPLAY LINE CORRESPONDING TO ERROR
   21:    EMPTY-STACK				\ THROW AWAY EVERY THING ELSE
   22: ;
   23: 
   24: VARIABLE ACTUAL-DEPTH			\ STACK RECORD
   25: CREATE ACTUAL-RESULTS 20 CELLS ALLOT
   26: 
   27: : {		\ ( -- ) SYNTACTIC SUGAR.
   28:    ;
   29: 
   30: : ->		\ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
   31:    DEPTH DUP ACTUAL-DEPTH !		\ RECORD DEPTH
   32:    ?DUP IF				\ IF THERE IS SOMETHING ON STACK
   33:       0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
   34:    THEN ;
   35: 
   36: : }		\ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
   37: 		\ (ACTUAL) CONTENTS.
   38:    DEPTH ACTUAL-DEPTH @ = IF		\ IF DEPTHS MATCH
   39:       DEPTH ?DUP IF			\ IF THERE IS SOMETHING ON THE STACK
   40:          0 DO				\ FOR EACH STACK ITEM
   41: 	    ACTUAL-RESULTS I CELLS + @	\ COMPARE ACTUAL WITH EXPECTED
   42: 	    <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
   43: 	 LOOP
   44:       THEN
   45:    ELSE					\ DEPTH MISMATCH
   46:       S" WRONG NUMBER OF RESULTS: " ERROR
   47:    THEN ;
   48: 
   49: : TESTING	\ ( -- ) TALKING COMMENT.
   50:    SOURCE VERBOSE @
   51:    IF DUP >R TYPE CR R> >IN !
   52:    ELSE >IN ! DROP
   53:    THEN ;
   54: