Annotation of gforth/test/tester.fs, revision 1.1
1.1 ! anton 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>