Merge up

[factor.git] / core / continuations / continuations-tests.factor

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 0d2880eddefbe7c93255e8e54607eeb82183c21f..988be0dd88a6bf3c5257cec15fed13fbec127cd3 100644 (file)
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -1,108 +1,108 @@
-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
+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