Stuff

| A quick implementation of tester.fs functionality.
| neal@quartus.net August 2006, for rf 9.2.6
| Version 0.1 -- minor change to error.

| A few helpful definitions lifted from the rf ANS compatibility file:

loc:
  : sp@ dup [ $f089 2, ]  ;
  reset sp@ constant base
 :: base sp@ - 4 / 1- ;
;loc alias depth

: ?dup dup 0; ;

macro
: else  $e9 1, here 0 , swap dup here swap - 4 - swap ! ;

macro : leave x: rdrop x: rdrop x: ;; ; forth

: abort rdrop reset ['] boot execute ;


| tester.fs functionality:

variable actual-depth
create actual-results 20 cells allot

variable temp>in

: error  
  type
  type temp>in @ >in @ over - type cr abort
;

: {{  >in @ 3 - temp>in ! ;
: }}
  depth actual-depth @ = if
    depth ?dup if 
      for
        actual-results r cells + @
        <> if s" Incorrect result: " error  leave then
      next
    then
  else
    s" Wrong number of results: " error
  then ;

: ->
  depth dup actual-depth !
  ?dup if
    for actual-results r cells + ! next
  then ;


| An example test:
{{ 3 5 + -> 8 }}
| One that fails:
{{ true -> false }}