aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt')
-rw-r--r--amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt66
1 files changed, 0 insertions, 66 deletions
diff --git a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt b/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt
deleted file mode 100644
index 01d3ca5..0000000
--- a/amforth-6.5/common/lib/forth2012/tester/tester-amforth.frt
+++ /dev/null
@@ -1,66 +0,0 @@
-\ From: John Hayes S1I
-\ Subject: tester.fr
-\ Date: Mon, 27 Nov 95 13:10:09 PST
-
-\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
-\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
-\ VERSION 1.1
-
-\ modified for amforth by Matthias Trute 2007
-
-\ 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
- 0 VERBOSE !
-
-variable ACTUAL-DEPTH \ STACK RECORD
-variable START-DEPTH
-
-: EMPTY-STACK \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
- depth START-DEPTH @ < if
- depth START-DEPTH @ swap do 0 loop
- then
- depth START-DEPTH @ > if
- depth START-DEPTH @ do drop loop
- then
-;
-
-: ERROR \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
- \ THE LINE THAT HAD THE ERROR.
- itype source type cr \ DISPLAY LINE CORRESPONDING TO ERROR
- EMPTY-STACK \ THROW AWAY EVERY THING ELSE
-;
-
-variable ACTUAL-DEPTH \ STACK RECORD
-variable ACTUAL-RESULTS 20 cells allot \ reserve space in RAM
-
-: t{ \ ( -- ) 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 @ - 0 do ACTUAL-RESULTS i cells + ! loop \ SAVE THEM
- then
-;
-
-: }t \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
- depth ACTUAL-DEPTH @ = if \ IF DEPTHS MATCH
- depth START-DEPTH @ > if \ IF THERE IS SOMETHING ON THE STACK
- depth START-DEPTH @ - 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 ;
-