--- gforth/test/tester.fs 1997/05/21 20:40:20 1.1 +++ gforth/test/tester.fs 2007/08/28 19:15:03 1.8 @@ -1,54 +1,12 @@ -\ From: John Hayes S1I -\ Subject: tester.fr -\ Date: Mon, 27 Nov 95 13:10:09 PST +\ drop-in replacement for John Hayes' tester -\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY -\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS. -\ VERSION 1.1 -HEX - -\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY -\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG. -VARIABLE VERBOSE - FALSE VERBOSE ! - -: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO. - DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ; - -: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY - \ THE LINE THAT HAD THE ERROR. - TYPE SOURCE TYPE CR \ DISPLAY LINE CORRESPONDING TO ERROR - EMPTY-STACK \ THROW AWAY EVERY THING ELSE -; +\ This file is in the public domain. NO WARRANTY. +\ Note licensing for ttester.fs -VARIABLE ACTUAL-DEPTH \ STACK RECORD -CREATE ACTUAL-RESULTS 20 CELLS ALLOT +S" ./ttester.fs" INCLUDED -: { \ ( -- ) SYNTACTIC SUGAR. - ; +: { T{ ; -: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH - ?DUP IF \ IF THERE IS SOMETHING ON STACK - 0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM - THEN ; - -: } \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED - \ (ACTUAL) CONTENTS. - DEPTH ACTUAL-DEPTH @ = IF \ IF DEPTHS MATCH - DEPTH ?DUP IF \ IF THERE IS SOMETHING ON THE STACK - 0 DO \ FOR EACH STACK ITEM - ACTUAL-RESULTS I CELLS + @ \ COMPARE ACTUAL WITH EXPECTED - <> IF S" INCORRECT RESULT: " ERROR LEAVE THEN - LOOP - THEN - ELSE \ DEPTH MISMATCH - S" WRONG NUMBER OF RESULTS: " ERROR - THEN ; - -: TESTING \ ( -- ) TALKING COMMENT. - SOURCE VERBOSE @ - IF DUP >R TYPE CR R> >IN ! - ELSE >IN ! DROP - THEN ; +: } }T ; +HEX