factor/extra/tools/interpreter/interpreter-tests.factor

159 lines
3.1 KiB
Factor
Raw Normal View History

2007-09-20 18:09:08 -04:00
USING: tools.interpreter io io.streams.string kernel math
math.private namespaces prettyprint sequences tools.test
continuations math.parser threads arrays
tools.interpreter.debug ;
2007-09-20 18:09:08 -04:00
IN: temporary
[ "Ooops" throw ] break-hook set
2007-09-20 18:09:08 -04:00
[ { } ] [
2007-09-20 18:09:08 -04:00
[ ] test-interpreter
] unit-test
[ { 1 } ] [
2007-09-20 18:09:08 -04:00
[ 1 ] test-interpreter
] unit-test
[ { 1 2 3 } ] [
2007-09-20 18:09:08 -04:00
[ 1 2 3 ] test-interpreter
] unit-test
[ { "Yo" 2 } ] [
2007-09-20 18:09:08 -04:00
[ 2 >r "Yo" r> ] test-interpreter
] unit-test
[ { 2 } ] [
2007-09-20 18:09:08 -04:00
[ t [ 2 ] [ "hi" ] if ] test-interpreter
] unit-test
[ { "hi" } ] [
2007-09-20 18:09:08 -04:00
[ f [ 2 ] [ "hi" ] if ] test-interpreter
] unit-test
[ { 4 } ] [
2007-09-20 18:09:08 -04:00
[ 2 2 fixnum+ ] test-interpreter
] unit-test
: foo 2 2 fixnum+ ;
[ { 8 } ] [
2007-09-20 18:09:08 -04:00
[ foo 4 fixnum+ ] test-interpreter
] unit-test
[ { C{ 1 1.5 } { } C{ 1 1.5 } { } } ] [
2007-09-20 18:09:08 -04:00
[ C{ 1 1.5 } { } 2dup ] test-interpreter
] unit-test
[ { t } ] [
2007-09-20 18:09:08 -04:00
[ 5 5 number= ] test-interpreter
] unit-test
[ { f } ] [
2007-09-20 18:09:08 -04:00
[ 5 6 number= ] test-interpreter
] unit-test
[ { f } ] [
2007-09-20 18:09:08 -04:00
[ "XYZ" "XYZ" mismatch ] test-interpreter
] unit-test
[ { t } ] [
2007-09-20 18:09:08 -04:00
[ "XYZ" "XYZ" sequence= ] test-interpreter
] unit-test
[ { t } ] [
2007-09-20 18:09:08 -04:00
[ "XYZ" "XYZ" = ] test-interpreter
] unit-test
[ { f } ] [
2007-09-20 18:09:08 -04:00
[ "XYZ" "XuZ" = ] test-interpreter
] unit-test
[ { 4 } ] [
2007-09-20 18:09:08 -04:00
[ 2 2 + ] test-interpreter
] unit-test
[ { } 2 ] [
2007-09-20 18:09:08 -04:00
2 "x" set [ [ 3 "x" set ] with-scope ] test-interpreter "x" get
] unit-test
[ { 3 } ] [
2007-09-20 18:09:08 -04:00
[ 3 "x" set "x" get ] test-interpreter
] unit-test
[ { "hi\n" } ] [
2007-09-20 18:09:08 -04:00
[ [ "hi" print ] string-out ] test-interpreter
] unit-test
[ { "4\n" } ] [
2007-09-20 18:09:08 -04:00
[ [ 2 2 + number>string print ] string-out ] test-interpreter
] unit-test
2007-10-03 20:49:17 -04:00
[ { 1 2 3 } ] [
[ { 1 2 3 } set-datastack ] test-interpreter
] unit-test
[ { 6 } ]
[ [ 3 [ nip continue ] callcc0 2 * ] test-interpreter ] unit-test
2007-09-20 18:09:08 -04:00
[ { 6 } ]
2007-09-20 18:09:08 -04:00
[ [ [ 3 swap continue-with ] callcc1 2 * ] test-interpreter ] unit-test
[ { 6 } ]
[ [ [ 3 throw ] catch 2 * ] test-interpreter ] unit-test
2007-10-03 20:49:17 -04:00
[ { "{ 1 2 3 }\n" } ] [
[ [ { 1 2 3 } . ] string-out ] test-interpreter
] unit-test
: meta-catch interpreter get continuation-catch ;
2007-09-20 18:09:08 -04:00
! Step back test
! [
! init-interpreter
! V{ } clone meta-history set
!
! V{ f } clone
! V{ } clone
! V{ [ 1 2 3 ] 0 3 } clone
! V{ } clone
! V{ } clone
! f <continuation>
! meta-catch push
!
! [ ] [ [ 2 2 + throw ] (meta-call) ] unit-test
!
! [ ] [ step ] unit-test
!
! [ ] [ step ] unit-test
!
! [ { 2 2 } ] [ meta-d ] unit-test
!
! [ ] [ step ] unit-test
!
! [ { 4 } ] [ meta-d ] unit-test
! [ 3 ] [ callframe-scan get ] unit-test
!
! [ ] [ step-back ] unit-test
! [ 2 ] [ callframe-scan get ] unit-test
!
! [ { 2 2 } ] [ meta-d ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ meta-catch peek continuation-call first ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ callframe get ] unit-test
! [ ] [ step-back ] unit-test
!
! [ { 4 } ] [ meta-d ] unit-test
!
! [ [ 1 2 3 ] ] [ meta-catch peek continuation-call first ] unit-test
!
! [ ] [ step ] unit-test
!
! [ [ 1 2 3 ] ] [ callframe get ] unit-test
!
! ] with-scope