stack-checker.*: new tests
parent
e67745aaba
commit
b43221770c
|
@ -0,0 +1,48 @@
|
|||
USING: accessors alien.c-types alien.private kernel kernel.private
|
||||
math namespaces stack-checker.alien stack-checker.state
|
||||
stack-checker.values threads.private tools.test ;
|
||||
IN: stack-checker.alien.tests
|
||||
|
||||
! alien-inputs/outputs
|
||||
{
|
||||
V{ 31 32 }
|
||||
{ 33 }
|
||||
} [
|
||||
0 inner-d-index set
|
||||
V{ } clone (meta-d) set
|
||||
H{ } clone known-values set
|
||||
V{ } clone literals set
|
||||
30 \ <value> set-global
|
||||
alien-node-params new int >>return { int int } >>parameters
|
||||
alien-inputs/outputs
|
||||
] unit-test
|
||||
|
||||
{
|
||||
V{ 31 32 33 }
|
||||
{ 34 }
|
||||
} [
|
||||
0 inner-d-index set
|
||||
V{ } clone (meta-d) set
|
||||
H{ } clone known-values set
|
||||
V{ } clone literals set
|
||||
30 \ <value> set-global
|
||||
alien-indirect-params new int >>return { int int } >>parameters
|
||||
alien-inputs/outputs
|
||||
] unit-test
|
||||
|
||||
! wrap-callback-quot
|
||||
{
|
||||
[
|
||||
[
|
||||
{ fixnum fixnum } declare [ [ ] dip ] dip
|
||||
"hello" >fixnum
|
||||
] [
|
||||
dup current-callback eq?
|
||||
[ drop ] [ wait-for-callback ] if
|
||||
] do-callback
|
||||
]
|
||||
} [
|
||||
alien-node-params new
|
||||
int >>return { int int } >>parameters
|
||||
[ "hello" ] wrap-callback-quot
|
||||
] unit-test
|
|
@ -0,0 +1,26 @@
|
|||
USING: kernel namespaces quotations stack-checker.backend
|
||||
stack-checker.branches stack-checker.recursive-state
|
||||
stack-checker.state stack-checker.values stack-checker.visitor
|
||||
tools.test ;
|
||||
IN: stack-checker.branches.tests
|
||||
|
||||
! infer-branch
|
||||
{
|
||||
H{
|
||||
{ recursive-state T{ recursive-state } }
|
||||
{ current-word f }
|
||||
{ (meta-r) f }
|
||||
{ input-count 2 }
|
||||
{ quotation [ 2drop ] }
|
||||
{ literals V{ } }
|
||||
{ terminated? f }
|
||||
{ stack-visitor f }
|
||||
{ (meta-d) V{ } }
|
||||
{ inner-d-index 0 }
|
||||
}
|
||||
} [
|
||||
init-inference
|
||||
H{ } clone known-values set
|
||||
[ 2drop ] <literal> make-known push-d
|
||||
pop-d known infer-branch
|
||||
] unit-test
|
Loading…
Reference in New Issue