--- gforth/test/tester.fs 2007/08/12 12:10:35 1.2 +++ gforth/test/tester.fs 2007/08/21 09:26:03 1.7 @@ -1,56 +1,12 @@ -\ From: John Hayes S1I -\ Subject: tester.fr -\ Date: Mon, 27 Nov 95 13:10:09 PST -\ revised by Anton Ertl 2007-08-12 - -\ (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 -; - -VARIABLE ACTUAL-DEPTH \ STACK RECORD -CREATE ACTUAL-RESULTS 20 CELLS ALLOT -VARIABLE START-DEPTH - -: { \ ( -- ) SYNTACTIC SUGAR. - DEPTH START-DEPTH ! ; - -: -> \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK. - DEPTH DUP ACTUAL-DEPTH ! \ RECORD DEPTH - START-DEPTH @ > IF \ IF THERE IS SOMETHING ON STACK - DEPTH START-DEPTH @ 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 START-DEPTH @ > IF \ IF THERE IS SOMETHING ON THE STACK - DEPTH START-DEPTH @ 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 ; +\ drop-in replacement for John Hayes' tester + +\ This file is in the public domain. NO WARRANTY. +\ Note licensing for ttester.fs + +S" ./ttester.fs" INCLUDED + +: { T{ ; + +: } }T ; +