]> gitweb.factorcode.org Git - factor.git/blobdiff - core/kernel/kernel-tests.factor
kernel: fix using for tests
[factor.git] / core / kernel / kernel-tests.factor
index 8442eb3a09ac6af09889c4ee2f09207765fa6afd..7c51468c45ec582266fd0c28963e931b691fcd61 100644 (file)
@@ -1,8 +1,8 @@
-USING: arrays byte-arrays kernel kernel.private literals math
-memory namespaces sequences tools.test math.private quotations
-continuations prettyprint io.streams.string debugger assocs
-sequences.private accessors locals.backend grouping words
-system alien alien.accessors kernel.private ;
+USING: accessors alien alien.accessors arrays assocs byte-arrays
+continuations debugger grouping io.streams.string kernel
+kernel.private literals locals.backend math memory namespaces
+prettyprint sequences sequences.private tools.test vocabs.loader
+words ;
 IN: kernel.tests
 
 { 0 } [ f size ] unit-test
@@ -21,23 +21,26 @@ IN: kernel.tests
         { 1 2 8 }
         { 1 2 9 }
     }
-} [ 1 2 10 iota [ 3array ] 2with map ] unit-test
+} [ 1 2 10 <iota> [ 3array ] 2with map ] unit-test
+
 
 ! Don't leak extra roots if error is thrown
 { } [ 1000 [ [ 3 throw ] ignore-errors ] times ] unit-test
 
-{ } [ 1000 [ [ -1 f <array> ] ignore-errors ] times ] unit-test
+[ -1 f <array> ] must-fail
+{ } [ 10 [ [ -1 f <array> ] ignore-errors ] times ] unit-test
+! { } [ 1000 [ [ -1 f <array> ] ignore-errors ] times ] unit-test ! Travis CI fails
 
 ! Make sure we report the correct error on stack underflow
 [ clear drop ] [
-    2 head ${ "kernel-error" ERROR-DATASTACK-UNDERFLOW } =
+    2 head ${ KERNEL-ERROR ERROR-DATASTACK-UNDERFLOW } =
 ] must-fail-with
 
 { } [ :c ] unit-test
 
 [
     3 [ { } set-retainstack ] dip ]
-    [ 2 head ${ "kernel-error" ERROR-RETAINSTACK-UNDERFLOW } =
+    [ 2 head ${ KERNEL-ERROR ERROR-RETAINSTACK-UNDERFLOW } =
 ] must-fail-with
 
 { } [ :c ] unit-test
@@ -56,34 +59,23 @@ IN: kernel.tests
 >>
 
 [ overflow-d ] [
-    2 head ${ "kernel-error" ERROR-DATASTACK-OVERFLOW } =
+    2 head ${ KERNEL-ERROR ERROR-DATASTACK-OVERFLOW } =
 ] must-fail-with
 
 { } [ :c ] unit-test
 
 [ overflow-d-alt ] [
-    2 head ${ "kernel-error" ERROR-DATASTACK-OVERFLOW } =
+    2 head ${ KERNEL-ERROR ERROR-DATASTACK-OVERFLOW } =
 ] must-fail-with
 
 { } [ [ :c ] with-string-writer drop ] unit-test
 
 [ overflow-r ] [
-    2 head ${ "kernel-error" ERROR-RETAINSTACK-OVERFLOW } =
+    2 head ${ KERNEL-ERROR ERROR-RETAINSTACK-OVERFLOW } =
 ] must-fail-with
 
 { } [ :c ] unit-test
 
-: overflow-c ( -- ) overflow-c overflow-c ;
-
-! The VM cannot recover from callstack overflow on Windows,
-! because no facility exists to run memory protection
-! fault handlers on an alternate callstack.
-os windows? [
-    [ overflow-c ] [
-        2 head ${ "kernel-error" ERROR-CALLSTACK-OVERFLOW } =
-    ] must-fail-with
-] unless
-
 [ -7 <byte-array> ] must-fail
 
 { 3 } [ t 3 and ] unit-test
@@ -144,7 +136,7 @@ os windows? [
 
 ! Regression
 : (loop) ( a b c d -- )
-    [ pick ] dip swap [ pick ] dip swap
+    pickd swap pickd swap
     < [ [ 1 + ] 3dip (loop) ] [ 4drop ] if ; inline recursive
 
 : loop ( obj -- )
@@ -152,11 +144,6 @@ os windows? [
 
 [ loop ] must-fail
 
-! Discovered on Windows
-: total-failure-1 ( -- a ) "" [ ] map unimplemented ;
-
-[ total-failure-1 ] must-fail
-
 { 1 1 2 2 3 3 } [ 1 2 3 [ dup ] tri@ ] unit-test
 { 1 4 9 } [ 1 2 3 [ sq ] tri@ ] unit-test
 [ [ sq ] tri@ ] must-infer
@@ -165,7 +152,7 @@ os windows? [
 
 ! Test traceback accuracy
 : last-frame ( -- pair )
-    error-continuation get call>> callstack>array 6 head* 3 tail* ;
+    6 9 error-continuation get call>> callstack>array subseq ;
 
 {
     { [ 1 2 [ 3 throw ] call 4 ] [ 1 2 [ 3 throw ] call 4 ] 3 }
@@ -218,3 +205,8 @@ os windows? [
 
 { 1 2 3 1 2 3 } [ 1 2 3 3dup ] unit-test
 { 1 2 3 4 1 2 3 4 } [ 1 2 3 4 4dup ] unit-test
+
+{ 2 3 4 1 } [ 1 2 3 4 roll ] unit-test
+{ 1 2 3 4 } [ 2 3 4 1 -roll ] unit-test
+
+{ } [ "kernel" reload ] long-unit-test
\ No newline at end of file