stack-checker.*: new tests

diff --git a/basis/stack-checker/alien/alien-tests.factor b/basis/stack-checker/alien/alien-tests.factor
new file mode 100644 (file)
index 0000000..6768bdb
--- /dev/null
+++ b/basis/stack-checker/alien/alien-tests.factor
@@ -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

diff --git a/basis/stack-checker/branches/branches-tests.factor b/basis/stack-checker/branches/branches-tests.factor
new file mode 100644 (file)
index 0000000..5ccb5e4
--- /dev/null
+++ b/basis/stack-checker/branches/branches-tests.factor
@@ -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