add some unit tests for try-find

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 988be0dd88a6bf3c5257cec15fed13fbec127cd3..5ee61f84d8e418fcf936c4b8338f4e9aecd08cf7 100644 (file)
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -1,108 +1,120 @@
-USING: kernel math namespaces io tools.test sequences vectors
-continuations debugger parser memory arrays words
-kernel.private accessors eval ;
-IN: continuations.tests
-
-: (callcc1-test) ( n obj -- n' obj )
-    [ 1 - dup ] dip ?push
-    over 0 = [ "test-cc" get continue-with ] when
-    (callcc1-test) ;
-
-: callcc1-test ( x -- list )
-    [
-        "test-cc" set V{ } clone (callcc1-test)
-    ] callcc1 nip ;
-
-: callcc-namespace-test ( -- ? )
-    [
-        "test-cc" set
-        5 "x" set
-        [
-            6 "x" set "test-cc" get continue
-        ] with-scope
-    ] callcc0 "x" get 5 = ;
-
-[ t ] [ 10 callcc1-test 10 iota reverse >vector = ] unit-test
-[ t ] [ callcc-namespace-test ] unit-test
-
-[ 5 throw ] [ 5 = ] must-fail-with
-
-[ t ] [
-    [ "Hello" throw ] ignore-errors
-    error get-global
-    "Hello" =
-] unit-test
-
-"!!! The following error is part of the test" print
-
-[ ] [ [ 6 [ 12 [ "2 car" ] ] ] print-error ] unit-test
-
-"!!! The following error is part of the test" print
-
-[ ] [ [ [ "2 car" ] eval ] try ] unit-test
-
-[ f throw ] must-fail
-
-! Weird PowerPC bug.
-[ ] [
-    [ "4" throw ] ignore-errors
-    gc
-    gc
-] unit-test
-
-! ! See how well callstack overflow is handled
-! [ clear drop ] must-fail
-! 
-! : callstack-overflow callstack-overflow f ;
-! [ callstack-overflow ] must-fail
-
-: don't-compile-me ( -- ) ;
-: foo ( -- ) callstack "c" set don't-compile-me ;
-: bar ( -- a b ) 1 foo 2 ;
-
-<< { don't-compile-me foo bar } [ t "no-compile" set-word-prop ] each >>
-
-[ 1 2 ] [ bar ] unit-test
-
-[ t ] [ \ bar def>> "c" get innermost-frame-executing = ] unit-test
-
-[ 1 ] [ "c" get innermost-frame-scan ] unit-test
-
-SYMBOL: always-counter
-SYMBOL: error-counter
-
-[
-    0 always-counter set
-    0 error-counter set
-
-    [ ] [ always-counter inc ] [ error-counter inc ] cleanup
-
-    [ 1 ] [ always-counter get ] unit-test
-    [ 0 ] [ error-counter get ] unit-test
-
-    [
-        [ "a" throw ]
-        [ always-counter inc ]
-        [ error-counter inc ] cleanup
-    ] [ "a" = ] must-fail-with
-
-    [ 2 ] [ always-counter get ] unit-test
-    [ 1 ] [ error-counter get ] unit-test
-
-    [
-        [ ]
-        [ always-counter inc "a" throw ]
-        [ error-counter inc ] cleanup
-    ] [ "a" = ] must-fail-with
-
-    [ 3 ] [ always-counter get ] unit-test
-    [ 1 ] [ error-counter get ] unit-test
-] with-scope
-
-[ ] [ [ return ] with-return ] unit-test
-
-[ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with
-
-[ { 4 } ] [ { 2 2 } [ + ] with-datastack ] unit-test
-
-[ with-datastack ] must-infer
+USING: kernel math namespaces io tools.test sequences vectors\r
+continuations debugger parser memory arrays words\r
+kernel.private accessors eval ;\r
+IN: continuations.tests\r
+\r
+: (callcc1-test) ( n obj -- n' obj )\r
+    [ 1 - dup ] dip ?push\r
+    over 0 = [ "test-cc" get continue-with ] when\r
+    (callcc1-test) ;\r
+\r
+: callcc1-test ( x -- list )\r
+    [\r
+        "test-cc" set V{ } clone (callcc1-test)\r
+    ] callcc1 nip ;\r
+\r
+: callcc-namespace-test ( -- ? )\r
+    [\r
+        "test-cc" set\r
+        5 "x" set\r
+        [\r
+            6 "x" set "test-cc" get continue\r
+        ] with-scope\r
+    ] callcc0 "x" get 5 = ;\r
+\r
+[ t ] [ 10 callcc1-test 10 iota reverse >vector = ] unit-test\r
+[ t ] [ callcc-namespace-test ] unit-test\r
+\r
+[ 5 throw ] [ 5 = ] must-fail-with\r
+\r
+[ t ] [\r
+    [ "Hello" throw ] ignore-errors\r
+    error get-global\r
+    "Hello" =\r
+] unit-test\r
+\r
+"!!! The following error is part of the test" print\r
+\r
+[ ] [ [ 6 [ 12 [ "2 car" ] ] ] print-error ] unit-test\r
+\r
+"!!! The following error is part of the test" print\r
+\r
+[ ] [ [ [ "2 car" ] eval ] try ] unit-test\r
+\r
+[ f throw ] must-fail\r
+\r
+! Weird PowerPC bug.\r
+[ ] [\r
+    [ "4" throw ] ignore-errors\r
+    gc\r
+    gc\r
+] unit-test\r
+\r
+! ! See how well callstack overflow is handled\r
+! [ clear drop ] must-fail\r
+! \r
+! : callstack-overflow callstack-overflow f ;\r
+! [ callstack-overflow ] must-fail\r
+\r
+: don't-compile-me ( -- ) ;\r
+: foo ( -- ) callstack "c" set don't-compile-me ;\r
+: bar ( -- a b ) 1 foo 2 ;\r
+\r
+<< { don't-compile-me foo bar } [ t "no-compile" set-word-prop ] each >>\r
+\r
+[ 1 2 ] [ bar ] unit-test\r
+\r
+[ t ] [ \ bar def>> "c" get innermost-frame-executing = ] unit-test\r
+\r
+[ 1 ] [ "c" get innermost-frame-scan ] unit-test\r
+\r
+SYMBOL: always-counter\r
+SYMBOL: error-counter\r
+\r
+[\r
+    0 always-counter set\r
+    0 error-counter set\r
+\r
+    [ ] [ always-counter inc ] [ error-counter inc ] cleanup\r
+\r
+    [ 1 ] [ always-counter get ] unit-test\r
+    [ 0 ] [ error-counter get ] unit-test\r
+\r
+    [\r
+        [ "a" throw ]\r
+        [ always-counter inc ]\r
+        [ error-counter inc ] cleanup\r
+    ] [ "a" = ] must-fail-with\r
+\r
+    [ 2 ] [ always-counter get ] unit-test\r
+    [ 1 ] [ error-counter get ] unit-test\r
+\r
+    [\r
+        [ ]\r
+        [ always-counter inc "a" throw ]\r
+        [ error-counter inc ] cleanup\r
+    ] [ "a" = ] must-fail-with\r
+\r
+    [ 3 ] [ always-counter get ] unit-test\r
+    [ 1 ] [ error-counter get ] unit-test\r
+] with-scope\r
+\r
+[ ] [ [ return ] with-return ] unit-test\r
+\r
+[ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with\r
+\r
+[ { 4 } ] [ { 2 2 } [ + ] with-datastack ] unit-test\r
+\r
+[ with-datastack ] must-infer\r
+\r
+[ { t 1 } ]\r
+[ { 1 1 } [ odd? ] try-find 2array ] unit-test\r
+\r
+[ { 9 3 } ]\r
+[ { 3 3 } [ sq ] try-find 2array ] unit-test\r
+\r
+[ { f f } ]\r
+[ { 1 1 } [ even? ] try-find 2array ] unit-test\r
+\r
+[ { f f } ]\r
+[ { 1 1 } [ "error" throw ] try-find 2array ] unit-test\r