58 lines
918 B
Plaintext
58 lines
918 B
Plaintext
ns: test
|
|
|
|
private
|
|
( swap s:= ) var, test_op
|
|
|
|
: set_op \ w --
|
|
test_op !
|
|
;
|
|
|
|
: get_op \ -- w
|
|
test_op @
|
|
;
|
|
public
|
|
|
|
\ Does nothing but introduce a test
|
|
: test:{ \ --
|
|
;
|
|
|
|
\ Convert data-stack to array, compare with current content of r-stack
|
|
: test:} \ * --
|
|
depth a:close r> #p:get_op a:=
|
|
if
|
|
2drop "OK" . cr
|
|
else
|
|
swap
|
|
"FAIL! Expected:" .
|
|
.
|
|
" Received:" .
|
|
.
|
|
cr
|
|
then
|
|
reset \ clear data stack
|
|
;
|
|
|
|
: test:.eqs. \ * --
|
|
( >s swap >s s:= ) #p:set_op
|
|
\ Convert data-stack to array and move to r-stack
|
|
depth a:close >r
|
|
;
|
|
|
|
: test:.nes. \ * --
|
|
( >s swap >s s:= not ) #p:set_op
|
|
\ Convert data-stack to array and move to r-stack
|
|
depth a:close >r
|
|
;
|
|
|
|
: test:.eq. \ * --
|
|
( >n swap >n n:= ) #p:set_op
|
|
\ Convert data-stack to array and move to r-stack
|
|
depth a:close >r
|
|
;
|
|
|
|
: test:.ne. \ * --
|
|
( >n swap >n n:= not ) #p:set_op
|
|
\ Convert data-stack to array and move to r-stack
|
|
depth a:close >r
|
|
;
|