test.frt

\ a portion of the Forth core test suite
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
CREATE ACTUAL-RESULTS $20 CELLS ALLOT
VARIABLE ACTUAL-DEPTH
VARIABLE START-DEPTH

: EMPTY-STACK S0 SP! ;
: ERROR TYPE CR EMPTY-STACK ABORT ;

: T{ DEPTH START-DEPTH ! ;
: ->
  DEPTH DUP ACTUAL-DEPTH !
  START-DEPTH @ - 0 ?DO
    ACTUAL-RESULTS I CELLS + !
  LOOP
;

: }T
  DEPTH ACTUAL-DEPTH @ = IF
    DEPTH START-DEPTH @ - 0 ?DO
      ACTUAL-RESULTS I CELLS + @
      <> IF
        S" INCORRECT RESULT" ERROR LEAVE
      THEN
    LOOP
  ELSE
    S" WRONG NUMBER OF RESULTS" ERROR
  THEN
;

: TESTING
  ." TESTING "
  BEGIN
    KEY DUP #CR <>
  WHILE
    EMIT
  REPEAT
  DROP
  CR
;

CONCLUDE" CORETEST.FRT"