Rename unit-test-fails to must-fail and add must-fail-with to replace [ t ] [ [ ... ] catch ... ] unit-test idiom

db4
Slava Pestov 2008-02-06 13:47:19 -06:00
parent 8a4db99029
commit be2c8b13d7
76 changed files with 299 additions and 369 deletions

View File

@ -14,7 +14,7 @@ prettyprint ;
! Testing the various bignum accessor ! Testing the various bignum accessor
10 <byte-array> "dump" set 10 <byte-array> "dump" set
[ "dump" get alien-address ] unit-test-fails [ "dump" get alien-address ] must-fail
[ 123 ] [ [ 123 ] [
123 "dump" get 0 set-alien-signed-1 123 "dump" get 0 set-alien-signed-1
@ -61,9 +61,9 @@ cell 8 = [
[ ] [ 0 F{ 1 2 3 } <displaced-alien> drop ] unit-test [ ] [ 0 F{ 1 2 3 } <displaced-alien> drop ] unit-test
[ ] [ 0 ?{ t f t } <displaced-alien> drop ] unit-test [ ] [ 0 ?{ t f t } <displaced-alien> drop ] unit-test
[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] unit-test-fails [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
[ 1 1 <displaced-alien> ] unit-test-fails [ 1 1 <displaced-alien> ] must-fail
[ f ] [ 0 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test [ f ] [ 0 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test

View File

@ -71,4 +71,4 @@ TYPEDEF: uchar* MyLPBYTE
[ [
0 B{ 1 2 3 4 } <displaced-alien> <void*> 0 B{ 1 2 3 4 } <displaced-alien> <void*>
] unit-test-fails ] must-fail

View File

@ -2,10 +2,10 @@ USING: arrays kernel sequences sequences.private growable
tools.test vectors layouts system math vectors.private ; tools.test vectors layouts system math vectors.private ;
IN: temporary IN: temporary
[ -2 { "a" "b" "c" } nth ] unit-test-fails [ -2 { "a" "b" "c" } nth ] must-fail
[ 10 { "a" "b" "c" } nth ] unit-test-fails [ 10 { "a" "b" "c" } nth ] must-fail
[ "hi" -2 { "a" "b" "c" } set-nth ] unit-test-fails [ "hi" -2 { "a" "b" "c" } set-nth ] must-fail
[ "hi" 10 { "a" "b" "c" } set-nth ] unit-test-fails [ "hi" 10 { "a" "b" "c" } set-nth ] must-fail
[ f ] [ { "a" "b" "c" } dup clone eq? ] unit-test [ f ] [ { "a" "b" "c" } dup clone eq? ] unit-test
[ "hi" ] [ "hi" 1 { "a" "b" "c" } clone [ set-nth ] keep second ] unit-test [ "hi" ] [ "hi" 1 { "a" "b" "c" } clone [ set-nth ] keep second ] unit-test
[ V{ "a" "b" "c" } ] [ { "a" "b" "c" } >vector ] unit-test [ V{ "a" "b" "c" } ] [ { "a" "b" "c" } >vector ] unit-test
@ -17,5 +17,5 @@ IN: temporary
[ { "a" "b" "c" "d" "e" } ] [ { "a" "b" "c" "d" "e" } ]
[ { "a" } { "b" "c" } { "d" "e" } 3append ] unit-test [ { "a" } { "b" "c" } { "d" "e" } 3append ] unit-test
[ -1 f <array> ] unit-test-fails [ -1 f <array> ] must-fail
[ cell-bits cell log2 - 2^ f <array> ] unit-test-fails [ cell-bits cell log2 - 2^ f <array> ] must-fail

View File

@ -51,4 +51,4 @@ IN: temporary
[ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize-bit-array ] unit-test [ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize-bit-array ] unit-test
[ -10 ?{ } resize-bit-array ] unit-test-fails [ -10 ?{ } resize-bit-array ] must-fail

View File

@ -5,4 +5,4 @@ USING: tools.test byte-arrays ;
[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test [ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test
[ -10 B{ } resize-byte-array ] unit-test-fails [ -10 B{ } resize-byte-array ] must-fail

View File

@ -91,7 +91,7 @@ M: union-1 generic-update-test drop "union-1" ;
[ f ] [ union-1 union-class? ] unit-test [ f ] [ union-1 union-class? ] unit-test
[ t ] [ union-1 predicate-class? ] unit-test [ t ] [ union-1 predicate-class? ] unit-test
[ "union-1" ] [ 8 generic-update-test ] unit-test [ "union-1" ] [ 8 generic-update-test ] unit-test
[ -7 generic-update-test ] unit-test-fails [ -7 generic-update-test ] must-fail
! Test mixins ! Test mixins
MIXIN: sequence-mixin MIXIN: sequence-mixin
@ -193,7 +193,7 @@ DEFER: mixin-forget-test-g
] unit-test ] unit-test
[ { } ] [ { } mixin-forget-test-g ] unit-test [ { } ] [ { } mixin-forget-test-g ] unit-test
[ H{ } mixin-forget-test-g ] unit-test-fails [ H{ } mixin-forget-test-g ] must-fail
[ ] [ [ ] [
{ {
@ -207,7 +207,7 @@ DEFER: mixin-forget-test-g
parse-stream drop parse-stream drop
] unit-test ] unit-test
[ { } mixin-forget-test-g ] unit-test-fails [ { } mixin-forget-test-g ] must-fail
[ H{ } ] [ H{ } mixin-forget-test-g ] unit-test [ H{ } ] [ H{ } mixin-forget-test-g ] unit-test
! Method flattening interfered with mixin update ! Method flattening interfered with mixin update

View File

@ -38,7 +38,7 @@ namespaces combinators words ;
! Interpreted ! Interpreted
[ "two" ] [ 2 \ case-test-1 word-def call ] unit-test [ "two" ] [ 2 \ case-test-1 word-def call ] unit-test
[ "x" case-test-1 ] unit-test-fails [ "x" case-test-1 ] must-fail
: case-test-2 : case-test-2
{ {

View File

@ -13,7 +13,7 @@ FUNCTION: int ffi_test_1 ;
FUNCTION: int ffi_test_2 int x int y ; FUNCTION: int ffi_test_2 int x int y ;
[ 5 ] [ 2 3 ffi_test_2 ] unit-test [ 5 ] [ 2 3 ffi_test_2 ] unit-test
[ "hi" 3 ffi_test_2 ] unit-test-fails [ "hi" 3 ffi_test_2 ] must-fail
FUNCTION: int ffi_test_3 int x int y int z int t ; FUNCTION: int ffi_test_3 int x int y int z int t ;
[ 25 ] [ 2 3 4 5 ffi_test_3 ] unit-test [ 25 ] [ 2 3 4 5 ffi_test_3 ] unit-test
@ -26,8 +26,8 @@ FUNCTION: double ffi_test_5 ;
FUNCTION: int ffi_test_9 int a int b int c int d int e int f int g ; FUNCTION: int ffi_test_9 int a int b int c int d int e int f int g ;
[ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test [ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test
[ "a" 2 3 4 5 6 7 ffi_test_9 ] unit-test-fails [ "a" 2 3 4 5 6 7 ffi_test_9 ] must-fail
[ 1 2 3 4 5 6 "a" ffi_test_9 ] unit-test-fails [ 1 2 3 4 5 6 "a" ffi_test_9 ] must-fail
C-STRUCT: foo C-STRUCT: foo
{ "int" "x" } { "int" "x" }
@ -53,7 +53,7 @@ FUNCTION: char* ffi_test_15 char* x char* y ;
[ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test [ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test
[ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test [ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test
[ 1 2 ffi_test_15 ] unit-test-fails [ 1 2 ffi_test_15 ] must-fail
C-STRUCT: bar C-STRUCT: bar
{ "long" "x" } { "long" "x" }
@ -75,7 +75,7 @@ FUNCTION: tiny ffi_test_17 int x ;
[ 11 ] [ 11 ffi_test_17 tiny-x ] unit-test [ 11 ] [ 11 ffi_test_17 tiny-x ] unit-test
[ t ] [ [ [ alien-indirect ] infer ] catch inference-error? ] unit-test [ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
: indirect-test-1 : indirect-test-1
"int" { } "cdecl" alien-indirect ; "int" { } "cdecl" alien-indirect ;
@ -84,7 +84,7 @@ FUNCTION: tiny ffi_test_17 int x ;
[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test [ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test
[ -1 indirect-test-1 ] unit-test-fails [ -1 indirect-test-1 ] must-fail
: indirect-test-2 : indirect-test-2
"int" { "int" "int" } "cdecl" alien-indirect data-gc ; "int" { "int" "int" } "cdecl" alien-indirect data-gc ;
@ -120,7 +120,7 @@ unit-test
FUNCTION: double ffi_test_6 float x float y ; FUNCTION: double ffi_test_6 float x float y ;
[ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test [ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test
[ "a" "b" ffi_test_6 ] unit-test-fails [ "a" "b" ffi_test_6 ] must-fail
FUNCTION: double ffi_test_7 double x double y ; FUNCTION: double ffi_test_7 double x double y ;
[ 6.0 ] [ 3.0 2.0 ffi_test_7 ] unit-test [ 6.0 ] [ 3.0 2.0 ffi_test_7 ] unit-test
@ -157,7 +157,7 @@ FUNCTION: long ffi_test_22 long x longlong y longlong z ;
[ 987655432 ] [ 987655432 ]
[ 1111 121932631112635269 123456789 ffi_test_22 ] unit-test [ 1111 121932631112635269 123456789 ffi_test_22 ] unit-test
[ 1111 f 123456789 ffi_test_22 ] unit-test-fails [ 1111 f 123456789 ffi_test_22 ] must-fail
C-STRUCT: rect C-STRUCT: rect
{ "float" "x" } { "float" "x" }
@ -177,7 +177,7 @@ FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ;
[ 45 ] [ 1 2 3.0 4.0 5.0 6.0 <rect> 7 8 9 ffi_test_12 ] unit-test [ 45 ] [ 1 2 3.0 4.0 5.0 6.0 <rect> 7 8 9 ffi_test_12 ] unit-test
[ 1 2 { 1 2 3 } 7 8 9 ffi_test_12 ] unit-test-fails [ 1 2 { 1 2 3 } 7 8 9 ffi_test_12 ] must-fail
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ; FUNCTION: float ffi_test_23 ( float[3] x, float[3] y ) ;
@ -292,7 +292,7 @@ FUNCTION: double ffi_test_36 ( test-struct-12 x ) ;
[ ] [ callback-1 callback_test_1 ] unit-test [ ] [ callback-1 callback_test_1 ] unit-test
: callback-2 "void" { } "cdecl" [ [ 5 throw ] catch drop ] alien-callback ; : callback-2 "void" { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
[ ] [ callback-2 callback_test_1 ] unit-test [ ] [ callback-2 callback_test_1 ] unit-test

View File

@ -422,11 +422,11 @@ cell 8 = [
[ [
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
] unit-test-fails ] must-fail
[ [
B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-call B{ 0 0 0 0 } [ { c-ptr } declare <void*> ] compile-call
] unit-test-fails ] must-fail
[ [
4 5 4 5

View File

@ -136,7 +136,7 @@ TUPLE: pred-test ;
GENERIC: void-generic ( obj -- * ) GENERIC: void-generic ( obj -- * )
: breakage "hi" void-generic ; : breakage "hi" void-generic ;
[ t ] [ \ breakage compiled? ] unit-test [ t ] [ \ breakage compiled? ] unit-test
[ breakage ] unit-test-fails [ breakage ] must-fail
! regression ! regression
: test-0 ( n -- ) dup 0 = [ drop ] [ 1- test-0 ] if ; inline : test-0 ( n -- ) dup 0 = [ drop ] [ 1- test-0 ] if ; inline
@ -247,7 +247,7 @@ M: slice foozul ;
GENERIC: detect-number ( obj -- obj ) GENERIC: detect-number ( obj -- obj )
M: number detect-number ; M: number detect-number ;
[ 10 f [ <array> 0 + detect-number ] compile-call ] unit-test-fails [ 10 f [ <array> 0 + detect-number ] compile-call ] must-fail
! Regression ! Regression
[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test [ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test

View File

@ -243,7 +243,7 @@ DEFER: defer-redefine-test-2
[ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test [ ] [ "IN: temporary : defer-redefine-test-2 defer-redefine-test-1 1 ;" eval ] unit-test
[ defer-redefine-test-2 ] unit-test-fails [ defer-redefine-test-2 ] must-fail
[ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test [ ] [ "IN: temporary : defer-redefine-test-1 2 ;" eval ] unit-test

View File

@ -57,8 +57,8 @@ IN: temporary
! Make sure error reporting works ! Make sure error reporting works
[ [ dup ] compile-call ] unit-test-fails [ [ dup ] compile-call ] must-fail
[ [ drop ] compile-call ] unit-test-fails [ [ drop ] compile-call ] must-fail
! Regression ! Regression

View File

@ -10,7 +10,7 @@ words splitting ;
: foo 3 throw 7 ; : foo 3 throw 7 ;
: bar foo 4 ; : bar foo 4 ;
: baz bar 5 ; : baz bar 5 ;
[ 3 ] [ [ baz ] catch ] unit-test [ baz ] [ 3 = ] must-fail-with
[ t ] [ [ t ] [
symbolic-stack-trace symbolic-stack-trace
[ word? ] subset [ word? ] subset
@ -22,11 +22,11 @@ words splitting ;
: stack-trace-contains? symbolic-stack-trace memq? ; : stack-trace-contains? symbolic-stack-trace memq? ;
[ t ] [ [ t ] [
[ { 1 "hi" } bleh ] catch drop \ + stack-trace-contains? [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-contains?
] unit-test ] unit-test
[ t f ] [ [ t f ] [
[ { "hi" } bleh ] catch drop [ { "hi" } bleh ] ignore-errors
\ + stack-trace-contains? \ + stack-trace-contains?
\ > stack-trace-contains? \ > stack-trace-contains?
] unit-test ] unit-test
@ -34,6 +34,6 @@ words splitting ;
: quux [ t [ "hi" throw ] when ] times ; : quux [ t [ "hi" throw ] when ] times ;
[ t ] [ [ t ] [
[ 10 quux ] catch drop [ 10 quux ] ignore-errors
\ (each-integer) stack-trace-contains? \ (each-integer) stack-trace-contains?
] unit-test ] unit-test

View File

@ -23,10 +23,9 @@ $nl
"Two words raise an error in the innermost error handler for the current dynamic extent:" "Two words raise an error in the innermost error handler for the current dynamic extent:"
{ $subsection throw } { $subsection throw }
{ $subsection rethrow } { $subsection rethrow }
"A set of words establish an error handler:" "Two words for establishing an error handler:"
{ $subsection cleanup } { $subsection cleanup }
{ $subsection recover } { $subsection recover }
{ $subsection catch }
"Unhandled errors are reported in the listener and can be debugged using various tools. See " { $link "debugger" } "." "Unhandled errors are reported in the listener and can be debugged using various tools. See " { $link "debugger" } "."
{ $subsection "errors-restartable" } { $subsection "errors-restartable" }
{ $subsection "errors-post-mortem" } ; { $subsection "errors-post-mortem" } ;
@ -147,12 +146,7 @@ HELP: throw
{ $values { "error" object } } { $values { "error" object } }
{ $description "Saves the current continuation in the " { $link error-continuation } " global variable and throws an error. Execution does not continue at the point after the " { $link throw } " call. Rather, the innermost catch block is invoked, and execution continues at that point." } ; { $description "Saves the current continuation in the " { $link error-continuation } " global variable and throws an error. Execution does not continue at the point after the " { $link throw } " call. Rather, the innermost catch block is invoked, and execution continues at that point." } ;
HELP: catch { cleanup recover } related-words
{ $values { "try" quotation } { "error/f" object } }
{ $description "Calls the " { $snippet "try" } " quotation. If an error is thrown in the dynamic extent of the quotation, restores the data stack and pushes the error. If the quotation returns successfully, outputs " { $link f } " without restoring the data stack." }
{ $notes "This word cannot differentiate between the case of " { $link f } " being thrown, and no error being thrown. You should never throw " { $link f } ", and you should also use other error handling combinators where possible." } ;
{ catch cleanup recover } related-words
HELP: cleanup HELP: cleanup
{ $values { "try" quotation } { "cleanup-always" quotation } { "cleanup-error" quotation } } { $values { "try" quotation } { "cleanup-always" quotation } { "cleanup-error" quotation } }
@ -166,7 +160,7 @@ HELP: rethrow
{ $values { "error" object } } { $values { "error" object } }
{ $description "Throws an error without saving the current continuation in the " { $link error-continuation } " global variable. This is done so that inspecting the error stacks sheds light on the original cause of the exception, rather than the point where it was rethrown." } { $description "Throws an error without saving the current continuation in the " { $link error-continuation } " global variable. This is done so that inspecting the error stacks sheds light on the original cause of the exception, rather than the point where it was rethrown." }
{ $notes { $notes
"This word is intended to be used in conjunction with " { $link recover } " or " { $link catch } " to implement error handlers which perform an action and pass the error to the next outermost error handler." "This word is intended to be used in conjunction with " { $link recover } " to implement error handlers which perform an action and pass the error to the next outermost error handler."
} }
{ $examples { $examples
"The " { $link with-parser } " catches errors, annotates them with file name and line number information, and rethrows them:" "The " { $link with-parser } " catches errors, annotates them with file name and line number information, and rethrows them:"

View File

@ -25,13 +25,11 @@ IN: temporary
[ t ] [ 10 callcc1-test 10 reverse >vector = ] unit-test [ t ] [ 10 callcc1-test 10 reverse >vector = ] unit-test
[ t ] [ callcc-namespace-test ] unit-test [ t ] [ callcc-namespace-test ] unit-test
[ f ] [ [ ] catch ] unit-test [ 5 throw ] [ 5 = ] must-fail-with
[ 5 ] [ [ 5 throw ] catch ] unit-test
[ t ] [ [ t ] [
[ "Hello" throw ] catch drop [ "Hello" throw ] ignore-errors
global [ error get ] bind error get-global
"Hello" = "Hello" =
] unit-test ] unit-test
@ -41,13 +39,13 @@ IN: temporary
"!!! The following error is part of the test" print "!!! The following error is part of the test" print
[ [ "2 car" ] eval ] catch print-error [ ] [ [ [ "2 car" ] eval ] [ print-error ] recover ] unit-test
[ f throw ] unit-test-fails [ f throw ] must-fail
! Weird PowerPC bug. ! Weird PowerPC bug.
[ ] [ [ ] [
[ "4" throw ] catch drop [ "4" throw ] ignore-errors
data-gc data-gc
data-gc data-gc
] unit-test ] unit-test
@ -56,10 +54,10 @@ IN: temporary
[ f ] [ { "A" "B" } kernel-error? ] unit-test [ f ] [ { "A" "B" } kernel-error? ] unit-test
! ! See how well callstack overflow is handled ! ! See how well callstack overflow is handled
! [ clear drop ] unit-test-fails ! [ clear drop ] must-fail
! !
! : callstack-overflow callstack-overflow f ; ! : callstack-overflow callstack-overflow f ;
! [ callstack-overflow ] unit-test-fails ! [ callstack-overflow ] must-fail
: don't-compile-me { } [ ] each ; : don't-compile-me { } [ ] each ;
@ -84,24 +82,20 @@ SYMBOL: error-counter
[ 1 ] [ always-counter get ] unit-test [ 1 ] [ always-counter get ] unit-test
[ 0 ] [ error-counter get ] unit-test [ 0 ] [ error-counter get ] unit-test
[ "a" ] [ [
[ [ "a" throw ]
[ "a" throw ] [ always-counter inc ]
[ always-counter inc ] [ error-counter inc ] cleanup
[ error-counter inc ] cleanup ] [ "a" = ] must-fail-with
] catch
] unit-test
[ 2 ] [ always-counter get ] unit-test [ 2 ] [ always-counter get ] unit-test
[ 1 ] [ error-counter get ] unit-test [ 1 ] [ error-counter get ] unit-test
[ "a" ] [ [
[ [ ]
[ ] [ always-counter inc "a" throw ]
[ always-counter inc "a" throw ] [ error-counter inc ] cleanup
[ error-counter inc ] cleanup ] [ "a" = ] must-fail-with
] catch
] unit-test
[ 3 ] [ always-counter get ] unit-test [ 3 ] [ always-counter get ] unit-test
[ 1 ] [ error-counter get ] unit-test [ 1 ] [ error-counter get ] unit-test

View File

@ -1,4 +1,4 @@
! Copyright (C) 2003, 2007 Slava Pestov. ! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays vectors kernel kernel.private sequences USING: arrays vectors kernel kernel.private sequences
namespaces math splitting sorting quotations assocs ; namespaces math splitting sorting quotations assocs ;
@ -17,9 +17,6 @@ SYMBOL: restarts
: c> ( -- continuation ) catchstack* pop ; : c> ( -- continuation ) catchstack* pop ;
: (catch) ( quot -- newquot )
[ swap >c call c> drop ] curry ; inline
: dummy ( -- obj ) : dummy ( -- obj )
#! Optimizing compiler assumes stack won't be messed with #! Optimizing compiler assumes stack won't be messed with
#! in-transit. To ensure that a value is actually reified #! in-transit. To ensure that a value is actually reified
@ -120,11 +117,8 @@ PRIVATE>
catchstack* empty? [ die ] when catchstack* empty? [ die ] when
dup save-error c> continue-with ; dup save-error c> continue-with ;
: catch ( try -- error/f )
(catch) [ f ] compose callcc1 ; inline
: recover ( try recovery -- ) : recover ( try recovery -- )
>r (catch) r> ifcc ; inline >r [ swap >c call c> drop ] curry r> ifcc ; inline
: cleanup ( try cleanup-always cleanup-error -- ) : cleanup ( try cleanup-always cleanup-error -- )
over >r compose [ dip rethrow ] curry over >r compose [ dip rethrow ] curry

View File

@ -7,4 +7,4 @@ USING: float-arrays tools.test ;
[ F{ 1 2 } ] [ 2 F{ 1 2 3 4 5 6 7 8 9 } resize-float-array ] unit-test [ F{ 1 2 } ] [ 2 F{ 1 2 3 4 5 6 7 8 9 } resize-float-array ] unit-test
[ -10 F{ } resize-float-array ] unit-test-fails [ -10 F{ } resize-float-array ] must-fail

View File

@ -16,7 +16,7 @@ M: word class-of drop "word" ;
[ "fixnum" ] [ 5 class-of ] unit-test [ "fixnum" ] [ 5 class-of ] unit-test
[ "word" ] [ \ class-of class-of ] unit-test [ "word" ] [ \ class-of class-of ] unit-test
[ 3.4 class-of ] unit-test-fails [ 3.4 class-of ] must-fail
[ "Hello world" ] [ 4 foobar foobar ] unit-test [ "Hello world" ] [ 4 foobar foobar ] unit-test
[ "Goodbye cruel world" ] [ 4 foobar ] unit-test [ "Goodbye cruel world" ] [ 4 foobar ] unit-test
@ -90,7 +90,7 @@ M: number union-containment drop 2 ;
"IN: temporary GENERIC: unhappy ( x -- x )" eval "IN: temporary GENERIC: unhappy ( x -- x )" eval
[ [
"IN: temporary M: dictionary unhappy ;" eval "IN: temporary M: dictionary unhappy ;" eval
] unit-test-fails ] must-fail
[ ] [ "IN: temporary GENERIC: unhappy ( x -- x )" eval ] unit-test [ ] [ "IN: temporary GENERIC: unhappy ( x -- x )" eval ] unit-test
GENERIC# complex-combination 1 ( a b -- c ) GENERIC# complex-combination 1 ( a b -- c )
@ -155,9 +155,7 @@ M: string my-hook "a string" ;
[ "an integer" ] [ 3 my-var set my-hook ] unit-test [ "an integer" ] [ 3 my-var set my-hook ] unit-test
[ "a string" ] [ my-hook my-var set my-hook ] unit-test [ "a string" ] [ my-hook my-var set my-hook ] unit-test
[ T{ no-method f 1.0 my-hook } ] [ [ 1.0 my-var set my-hook ] [ [ T{ no-method f 1.0 my-hook } = ] must-fail-with
1.0 my-var set [ my-hook ] catch
] unit-test
GENERIC: tag-and-f ( x -- x x ) GENERIC: tag-and-f ( x -- x x )

View File

@ -9,16 +9,16 @@ IN: temporary
! overflow bugs ! overflow bugs
[ "hi" most-positive-fixnum 2 * 2 + V{ } clone set-nth ] [ "hi" most-positive-fixnum 2 * 2 + V{ } clone set-nth ]
unit-test-fails must-fail
[ most-positive-fixnum 2 * 2 + { 1 } clone nth ] [ most-positive-fixnum 2 * 2 + { 1 } clone nth ]
unit-test-fails must-fail
[ most-positive-fixnum 2 * 2 + V{ } clone lengthen ] [ most-positive-fixnum 2 * 2 + V{ } clone lengthen ]
unit-test-fails must-fail
[ most-positive-fixnum 2 * 2 + V{ } clone set-length ] [ most-positive-fixnum 2 * 2 + V{ } clone set-length ]
unit-test-fails must-fail
[ ] [ [ ] [
10 V{ } [ set-length ] keep 10 V{ } [ set-length ] keep

View File

@ -127,9 +127,9 @@ H{ } "x" set
! Another crash discovered by erg ! Another crash discovered by erg
[ ] [ [ ] [
H{ } clone H{ } clone
[ 1 swap set-at ] catch drop [ 1 swap set-at ] ignore-errors
[ 2 swap set-at ] catch drop [ 2 swap set-at ] ignore-errors
[ 3 swap set-at ] catch drop [ 3 swap set-at ] ignore-errors
drop drop
] unit-test ] unit-test

View File

@ -5,8 +5,8 @@ USING: arrays kernel math namespaces tools.test
heaps heaps.private ; heaps heaps.private ;
IN: temporary IN: temporary
[ <min-heap> heap-pop ] unit-test-fails [ <min-heap> heap-pop ] must-fail
[ <max-heap> heap-pop ] unit-test-fails [ <max-heap> heap-pop ] must-fail
[ t ] [ <min-heap> heap-empty? ] unit-test [ t ] [ <min-heap> heap-empty? ] unit-test
[ f ] [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test [ f ] [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test

View File

@ -12,14 +12,14 @@ IN: temporary
{ 1 2 } [ dup ] unit-test-effect { 1 2 } [ dup ] unit-test-effect
{ 1 2 } [ [ dup ] call ] unit-test-effect { 1 2 } [ [ dup ] call ] unit-test-effect
[ [ call ] infer ] unit-test-fails [ [ call ] infer ] must-fail
{ 2 4 } [ 2dup ] unit-test-effect { 2 4 } [ 2dup ] unit-test-effect
{ 1 0 } [ [ ] [ ] if ] unit-test-effect { 1 0 } [ [ ] [ ] if ] unit-test-effect
[ [ if ] infer ] unit-test-fails [ [ if ] infer ] must-fail
[ [ [ ] if ] infer ] unit-test-fails [ [ [ ] if ] infer ] must-fail
[ [ [ 2 ] [ ] if ] infer ] unit-test-fails [ [ [ 2 ] [ ] if ] infer ] must-fail
{ 4 3 } [ [ rot ] [ -rot ] if ] unit-test-effect { 4 3 } [ [ rot ] [ -rot ] if ] unit-test-effect
{ 4 3 } [ { 4 3 } [
@ -42,7 +42,7 @@ IN: temporary
[ [
[ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer [ [ [ 2 2 fixnum+ ] ] [ [ 2 2 fixnum* ] ] if call ] infer
] unit-test-fails ] must-fail
! Test inference of termination of control flow ! Test inference of termination of control flow
: termination-test-1 : termination-test-1
@ -54,10 +54,10 @@ IN: temporary
: infinite-loop infinite-loop ; : infinite-loop infinite-loop ;
[ [ infinite-loop ] infer ] unit-test-fails [ [ infinite-loop ] infer ] must-fail
: no-base-case-1 dup [ no-base-case-1 ] [ no-base-case-1 ] if ; : no-base-case-1 dup [ no-base-case-1 ] [ no-base-case-1 ] if ;
[ [ no-base-case-1 ] infer ] unit-test-fails [ [ no-base-case-1 ] infer ] must-fail
: simple-recursion-1 ( obj -- obj ) : simple-recursion-1 ( obj -- obj )
dup [ simple-recursion-1 ] [ ] if ; dup [ simple-recursion-1 ] [ ] if ;
@ -72,7 +72,7 @@ IN: temporary
: bad-recursion-2 ( obj -- obj ) : bad-recursion-2 ( obj -- obj )
dup [ dup first swap second bad-recursion-2 ] [ ] if ; dup [ dup first swap second bad-recursion-2 ] [ ] if ;
[ [ bad-recursion-2 ] infer ] unit-test-fails [ [ bad-recursion-2 ] infer ] must-fail
: funny-recursion ( obj -- obj ) : funny-recursion ( obj -- obj )
dup [ funny-recursion 1 ] [ 2 ] if drop ; dup [ funny-recursion 1 ] [ 2 ] if drop ;
@ -192,7 +192,7 @@ DEFER: blah4
[ swap slip ] keep swap bad-combinator [ swap slip ] keep swap bad-combinator
] if ; inline ] if ; inline
[ [ [ 1 ] [ ] bad-combinator ] infer ] unit-test-fails [ [ [ 1 ] [ ] bad-combinator ] infer ] must-fail
! Regression ! Regression
: bad-input# : bad-input#
@ -207,13 +207,13 @@ DEFER: blah4
DEFER: do-crap DEFER: do-crap
: more-crap ( obj -- ) dup [ drop ] [ dup do-crap call ] if ; : more-crap ( obj -- ) dup [ drop ] [ dup do-crap call ] if ;
: do-crap ( obj -- ) dup [ more-crap ] [ do-crap ] if ; : do-crap ( obj -- ) dup [ more-crap ] [ do-crap ] if ;
[ [ do-crap ] infer ] unit-test-fails [ [ do-crap ] infer ] must-fail
! This one does not ! This one does not
DEFER: do-crap* DEFER: do-crap*
: more-crap* ( obj -- ) dup [ drop ] [ dup do-crap* call ] if ; : more-crap* ( obj -- ) dup [ drop ] [ dup do-crap* call ] if ;
: do-crap* ( obj -- ) dup [ do-crap* ] [ more-crap* ] if ; : do-crap* ( obj -- ) dup [ do-crap* ] [ more-crap* ] if ;
[ [ do-crap* ] infer ] unit-test-fails [ [ do-crap* ] infer ] must-fail
! Regression ! Regression
: too-deep ( a b -- c ) : too-deep ( a b -- c )
@ -226,7 +226,7 @@ M: fixnum xyz 2array ;
M: float xyz M: float xyz
[ 3 ] 2apply swapd >r 2array swap r> 2array swap ; [ 3 ] 2apply swapd >r 2array swap r> 2array swap ;
[ t ] [ [ [ xyz ] infer ] catch inference-error? ] unit-test [ [ xyz ] infer ] [ inference-error? ] must-fail-with
! Doug Coleman discovered this one while working on the ! Doug Coleman discovered this one while working on the
! calendar library ! calendar library
@ -277,78 +277,66 @@ DEFER: #1
: #4 ( a -- ) dup [ drop ] [ dup #4 dup #3 call ] if ; : #4 ( a -- ) dup [ drop ] [ dup #4 dup #3 call ] if ;
: #1 ( a -- ) dup [ dup #4 dup #3 ] [ ] if drop ; : #1 ( a -- ) dup [ dup #4 dup #3 ] [ ] if drop ;
[ \ #4 word-def infer ] unit-test-fails [ \ #4 word-def infer ] must-fail
[ [ #1 ] infer ] unit-test-fails [ [ #1 ] infer ] must-fail
! Similar ! Similar
DEFER: bar DEFER: bar
: foo ( a b -- c d ) dup [ 2drop f f bar ] [ ] if ; : foo ( a b -- c d ) dup [ 2drop f f bar ] [ ] if ;
: bar ( a b -- ) [ 2 2 + ] t foo drop call drop ; : bar ( a b -- ) [ 2 2 + ] t foo drop call drop ;
[ [ foo ] infer ] unit-test-fails [ [ foo ] infer ] must-fail
[ 1234 infer ] unit-test-fails [ 1234 infer ] must-fail
! This used to hang ! This used to hang
[ t ] [ [ [ [ dup call ] dup call ] infer ]
[ [ [ dup call ] dup call ] infer ] catch [ inference-error? ] must-fail-with
inference-error?
] unit-test
: m dup call ; inline : m dup call ; inline
[ t ] [ [ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
[ [ [ m ] m ] infer ] catch inference-error?
] unit-test
: m' dup curry call ; inline : m' dup curry call ; inline
[ t ] [ [ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
[ [ [ m' ] m' ] infer ] catch inference-error?
] unit-test
: m'' [ dup curry ] ; inline : m'' [ dup curry ] ; inline
: m''' m'' call call ; inline : m''' m'' call call ; inline
[ t ] [ [ [ [ m''' ] m''' ] infer ] [ inference-error? ] must-fail-with
[ [ [ m''' ] m''' ] infer ] catch inference-error?
] unit-test
: m-if t over if ; inline : m-if t over if ; inline
[ t ] [ [ [ [ m-if ] m-if ] infer ] [ inference-error? ] must-fail-with
[ [ [ m-if ] m-if ] infer ] catch inference-error?
] unit-test
! This doesn't hang but it's also an example of the ! This doesn't hang but it's also an example of the
! undedicable case ! undedicable case
[ t ] [ [ [ [ [ drop 3 ] swap call ] dup call ] infer ]
[ [ [ [ drop 3 ] swap call ] dup call ] infer ] catch [ inference-error? ] must-fail-with
inference-error?
] unit-test
! This form should not have a stack effect ! This form should not have a stack effect
: bad-recursion-1 ( a -- b ) : bad-recursion-1 ( a -- b )
dup [ drop bad-recursion-1 5 ] [ ] if ; dup [ drop bad-recursion-1 5 ] [ ] if ;
[ [ bad-recursion-1 ] infer ] unit-test-fails [ [ bad-recursion-1 ] infer ] must-fail
: bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ; : bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ;
[ [ bad-bin ] infer ] unit-test-fails [ [ bad-bin ] infer ] must-fail
[ t ] [ [ [ r> ] infer ] catch inference-error? ] unit-test [ [ [ r> ] infer ] [ inference-error? ] must-fail-with
! Regression ! Regression
[ t ] [ [ [ get-slots ] infer ] catch inference-error? ] unit-test [ [ [ get-slots ] infer ] [ inference-error? ] must-fail-with
! Test some curry stuff ! Test some curry stuff
{ 1 1 } [ 3 [ ] curry 4 [ ] curry if ] unit-test-effect { 1 1 } [ 3 [ ] curry 4 [ ] curry if ] unit-test-effect
{ 2 1 } [ [ ] curry 4 [ ] curry if ] unit-test-effect { 2 1 } [ [ ] curry 4 [ ] curry if ] unit-test-effect
[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] unit-test-fails [ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail
! Test number protocol ! Test number protocol
\ bitor must-infer \ bitor must-infer
@ -459,7 +447,7 @@ DEFER: bar
: fooxxx ( a b -- c ) over [ foo ] when ; inline : fooxxx ( a b -- c ) over [ foo ] when ; inline
: barxxx fooxxx ; : barxxx fooxxx ;
[ [ barxxx ] infer ] unit-test-fails [ [ barxxx ] infer ] must-fail
! A typo ! A typo
{ 1 0 } [ { [ ] } dispatch ] unit-test-effect { 1 0 } [ { [ ] } dispatch ] unit-test-effect

View File

@ -31,4 +31,4 @@ TUPLE: a-tuple x y z ;
: set-slots-test-2 : set-slots-test-2
{ set-a-tuple-x set-a-tuple-x } set-slots ; { set-a-tuple-x set-a-tuple-x } set-slots ;
[ [ set-slots-test-2 ] infer ] unit-test-fails [ [ set-slots-test-2 ] infer ] must-fail

View File

@ -28,13 +28,13 @@ M: unclosable-stream dispose
[ t ] [ [ t ] [
<unclosable-stream> <closing-stream> [ <unclosable-stream> <closing-stream> [
<duplex-stream> <duplex-stream>
[ dup dispose ] catch 2drop [ dup dispose ] [ 2drop ] recover
] keep closing-stream-closed? ] keep closing-stream-closed?
] unit-test ] unit-test
[ t ] [ [ t ] [
<closing-stream> [ <unclosable-stream> <closing-stream> [ <unclosable-stream>
<duplex-stream> <duplex-stream>
[ dup dispose ] catch 2drop [ dup dispose ] [ 2drop ] recover
] keep closing-stream-closed? ] keep closing-stream-closed?
] unit-test ] unit-test

View File

@ -7,25 +7,22 @@ IN: temporary
[ t ] [ [ \ = \ = ] all-equal? ] unit-test [ t ] [ [ \ = \ = ] all-equal? ] unit-test
! Don't leak extra roots if error is thrown ! Don't leak extra roots if error is thrown
[ ] [ 10000 [ [ 3 throw ] catch drop ] times ] unit-test [ ] [ 10000 [ [ 3 throw ] ignore-errors ] times ] unit-test
[ ] [ 10000 [ [ -1 f <array> ] catch drop ] times ] unit-test [ ] [ 10000 [ [ -1 f <array> ] ignore-errors ] times ] unit-test
! Make sure we report the correct error on stack underflow ! Make sure we report the correct error on stack underflow
[ { "kernel-error" 11 f f } ] [ clear drop ] [ { "kernel-error" 11 f f } = ] must-fail-with
[ [ clear drop ] catch ] unit-test
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
[ { "kernel-error" 13 f f } ] [ { } set-retainstack r> ] [ { "kernel-error" 13 f f } = ] must-fail-with
[ [ { } set-retainstack r> ] catch ] unit-test
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
: overflow-d 3 overflow-d ; : overflow-d 3 overflow-d ;
[ { "kernel-error" 12 f f } ] [ overflow-d ] [ { "kernel-error" 12 f f } = ] must-fail-with
[ [ overflow-d ] catch ] unit-test
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
@ -33,24 +30,17 @@ IN: temporary
: overflow-d-alt (overflow-d-alt) overflow-d-alt ; : overflow-d-alt (overflow-d-alt) overflow-d-alt ;
[ { "kernel-error" 12 f f } ] [ overflow-d-alt ] [ { "kernel-error" 12 f f } = ] must-fail-with
[ [ overflow-d-alt ] catch ] unit-test
[ ] [ [ :c ] string-out drop ] unit-test [ ] [ [ :c ] string-out drop ] unit-test
: overflow-r 3 >r overflow-r ; : overflow-r 3 >r overflow-r ;
[ { "kernel-error" 14 f f } ] [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with
[ [ overflow-r ] catch ] unit-test
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
! : overflow-c overflow-c 3 ; [ -7 <byte-array> ] must-fail
!
! [ { "kernel-error" 16 f f } ]
! [ [ overflow-c ] catch ] unit-test
[ -7 <byte-array> ] unit-test-fails
[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test [ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
[ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test [ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
@ -61,27 +51,27 @@ IN: temporary
[ 4 ] [ 4 6 or ] unit-test [ 4 ] [ 4 6 or ] unit-test
[ 6 ] [ f 6 or ] unit-test [ 6 ] [ f 6 or ] unit-test
[ slip ] unit-test-fails [ slip ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
[ 1 slip ] unit-test-fails [ 1 slip ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
[ 1 2 slip ] unit-test-fails [ 1 2 slip ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
[ 1 2 3 slip ] unit-test-fails [ 1 2 3 slip ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
[ 5 ] [ [ 2 2 + ] 1 slip + ] unit-test [ 5 ] [ [ 2 2 + ] 1 slip + ] unit-test
[ [ ] keep ] unit-test-fails [ [ ] keep ] must-fail
[ 6 ] [ 2 [ sq ] keep + ] unit-test [ 6 ] [ 2 [ sq ] keep + ] unit-test
[ [ ] 2keep ] unit-test-fails [ [ ] 2keep ] must-fail
[ 1 [ ] 2keep ] unit-test-fails [ 1 [ ] 2keep ] must-fail
[ 3 1 2 ] [ 1 2 [ 2drop 3 ] 2keep ] unit-test [ 3 1 2 ] [ 1 2 [ 2drop 3 ] 2keep ] unit-test
[ 0 ] [ f [ sq ] [ 0 ] if* ] unit-test [ 0 ] [ f [ sq ] [ 0 ] if* ] unit-test
@ -100,13 +90,13 @@ IN: temporary
[ ] [ callstack set-callstack ] unit-test [ ] [ callstack set-callstack ] unit-test
[ 3drop datastack ] unit-test-fails [ 3drop datastack ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
! Doesn't compile; important ! Doesn't compile; important
: foo 5 + 0 [ ] each ; : foo 5 + 0 [ ] each ;
[ drop foo ] unit-test-fails [ drop foo ] must-fail
[ ] [ :c ] unit-test [ ] [ :c ] unit-test
! Regression ! Regression
@ -117,4 +107,4 @@ IN: temporary
: loop ( obj obj -- ) : loop ( obj obj -- )
H{ } values swap >r dup length swap r> 0 -roll (loop) ; H{ } values swap >r dup length swap r> 0 -roll (loop) ;
[ loop ] unit-test-fails [ loop ] must-fail

View File

@ -22,7 +22,7 @@ IN: temporary
[ [
"\\ + 1 2 3 4" parse-interactive "\\ + 1 2 3 4" parse-interactive
"cont" get continue-with "cont" get continue-with
] catch ] ignore-errors
"USE: debugger :1" eval "USE: debugger :1" eval
] callcc1 ] callcc1
] unit-test ] unit-test
@ -36,7 +36,7 @@ IN: temporary
[ [
"USE: vocabs.loader.test.c" parse-interactive "USE: vocabs.loader.test.c" parse-interactive
] unit-test-fails ] must-fail
[ ] [ [ ] [
[ [

View File

@ -121,8 +121,8 @@ unit-test
! We don't care if this fails or returns 0 (its CPU-specific) ! We don't care if this fails or returns 0 (its CPU-specific)
! as long as it doesn't crash ! as long as it doesn't crash
[ ] [ [ 0 0 /i ] catch clear ] unit-test [ ] [ [ 0 0 /i drop ] ignore-errors ] unit-test
[ ] [ [ 100000000000000000 0 /i ] catch clear ] unit-test [ ] [ [ 100000000000000000 0 /i drop ] ignore-errors ] unit-test
[ -2 ] [ 1 bitnot ] unit-test [ -2 ] [ 1 bitnot ] unit-test
[ -2 ] [ 1 >bignum bitnot ] unit-test [ -2 ] [ 1 >bignum bitnot ] unit-test

View File

@ -105,6 +105,6 @@ unit-test
! [ dup number>string string>number = ] all? ! [ dup number>string string>number = ] all?
! ] unit-test ! ] unit-test
[ 1 1 >base ] unit-test-fails [ 1 1 >base ] must-fail
[ 1 0 >base ] unit-test-fails [ 1 0 >base ] must-fail
[ 1 -1 >base ] unit-test-fails [ 1 -1 >base ] must-fail

View File

@ -4,7 +4,7 @@ IN: temporary
TUPLE: testing x y z ; TUPLE: testing x y z ;
[ save-image-and-exit ] unit-test-fails [ save-image-and-exit ] must-fail
[ ] [ [ ] [
num-types get [ num-types get [

View File

@ -93,12 +93,12 @@ IN: temporary
! Funny bug ! Funny bug
[ 2 ] [ "IN: temporary : \0. 2 ; \0." eval ] unit-test [ 2 ] [ "IN: temporary : \0. 2 ; \0." eval ] unit-test
[ "IN: temporary : missing-- ( a b ) ;" eval ] unit-test-fails [ "IN: temporary : missing-- ( a b ) ;" eval ] must-fail
! These should throw errors ! These should throw errors
[ "HEX: zzz" eval ] unit-test-fails [ "HEX: zzz" eval ] must-fail
[ "OCT: 999" eval ] unit-test-fails [ "OCT: 999" eval ] must-fail
[ "BIN: --0" eval ] unit-test-fails [ "BIN: --0" eval ] must-fail
! Another funny bug ! Another funny bug
[ t ] [ [ t ] [
@ -205,12 +205,10 @@ IN: temporary
"a" source-files get delete-at "a" source-files get delete-at
[ t ] [ [
[ "IN: temporary : x ; : y 3 throw ; this is an error"
"IN: temporary : x ; : y 3 throw ; this is an error" <string-reader> "a" parse-stream
<string-reader> "a" parse-stream ] [ parse-error? ] must-fail-with
] catch parse-error?
] unit-test
[ t ] [ [ t ] [
"y" "temporary" lookup >boolean "y" "temporary" lookup >boolean
@ -307,62 +305,50 @@ IN: temporary
"killer?" "temporary" lookup >boolean "killer?" "temporary" lookup >boolean
] unit-test ] unit-test
[ t ] [ [
[ "IN: temporary TUPLE: another-pred-test ; GENERIC: another-pred-test?"
"IN: temporary TUPLE: another-pred-test ; GENERIC: another-pred-test?" <string-reader> "removing-the-predicate" parse-stream
<string-reader> "removing-the-predicate" parse-stream ] [ [ redefine-error? ] is? ] must-fail-with
] catch [ redefine-error? ] is?
] unit-test
[ t ] [ [
[ "IN: temporary TUPLE: class-redef-test ; TUPLE: class-redef-test ;"
"IN: temporary TUPLE: class-redef-test ; TUPLE: class-redef-test ;" <string-reader> "redefining-a-class-1" parse-stream
<string-reader> "redefining-a-class-1" parse-stream ] [ [ redefine-error? ] is? ] must-fail-with
] catch [ redefine-error? ] is?
] unit-test
[ ] [ [ ] [
"IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test" "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test"
<string-reader> "redefining-a-class-2" parse-stream drop <string-reader> "redefining-a-class-2" parse-stream drop
] unit-test ] unit-test
[ t ] [ [
[ "IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;"
"IN: temporary TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;" <string-reader> "redefining-a-class-3" parse-stream drop
<string-reader> "redefining-a-class-3" parse-stream drop ] [ [ redefine-error? ] is? ] must-fail-with
] catch [ redefine-error? ] is?
] unit-test
[ ] [ [ ] [
"IN: temporary TUPLE: class-fwd-test ;" "IN: temporary TUPLE: class-fwd-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] unit-test ] unit-test
[ t ] [ [
[ "IN: temporary \\ class-fwd-test"
"IN: temporary \\ class-fwd-test" <string-reader> "redefining-a-class-3" parse-stream drop
<string-reader> "redefining-a-class-3" parse-stream drop ] [ [ no-word? ] is? ] must-fail-with
] catch [ no-word? ] is?
] unit-test
[ ] [ [ ] [
"IN: temporary TUPLE: class-fwd-test ; SYMBOL: class-fwd-test" "IN: temporary TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop <string-reader> "redefining-a-class-3" parse-stream drop
] unit-test ] unit-test
[ t ] [ [
[ "IN: temporary \\ class-fwd-test"
"IN: temporary \\ class-fwd-test" <string-reader> "redefining-a-class-3" parse-stream drop
<string-reader> "redefining-a-class-3" parse-stream drop ] [ [ no-word? ] is? ] must-fail-with
] catch [ no-word? ] is?
] unit-test
[ t ] [ [
[ "IN: temporary : foo ; TUPLE: foo ;"
"IN: temporary : foo ; TUPLE: foo ;" <string-reader> "redefining-a-class-4" parse-stream drop
<string-reader> "redefining-a-class-4" parse-stream drop ] [ [ redefine-error? ] is? ] must-fail-with
] catch [ redefine-error? ] is?
] unit-test
] with-file-vocabs ] with-file-vocabs
[ [

View File

@ -15,4 +15,4 @@ IN: temporary
[ [ "hi" ] ] [ "hi" 1quotation ] unit-test [ [ "hi" ] ] [ "hi" 1quotation ] unit-test
[ 1 \ + curry ] unit-test-fails [ 1 \ + curry ] must-fail

View File

@ -83,8 +83,8 @@ unit-test
[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] append ] unit-test [ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] append ] unit-test
[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] { 4 } append ] unit-test [ [ 1 2 3 4 ] ] [ [ 1 2 3 ] { 4 } append ] unit-test
[ "a" -1 append ] unit-test-fails [ "a" -1 append ] must-fail
[ -1 "a" append ] unit-test-fails [ -1 "a" append ] must-fail
[ [ ] ] [ 1 [ ] remove ] unit-test [ [ ] ] [ 1 [ ] remove ] unit-test
[ [ ] ] [ 1 [ 1 ] remove ] unit-test [ [ ] ] [ 1 [ 1 ] remove ] unit-test
@ -119,7 +119,7 @@ unit-test
[ V{ 0 1 4 5 } ] [ 6 >vector 2 4 pick delete-slice ] unit-test [ V{ 0 1 4 5 } ] [ 6 >vector 2 4 pick delete-slice ] unit-test
[ 6 >vector 2 8 pick delete-slice ] unit-test-fails [ 6 >vector 2 8 pick delete-slice ] must-fail
[ V{ } ] [ 6 >vector 0 6 pick delete-slice ] unit-test [ V{ } ] [ 6 >vector 0 6 pick delete-slice ] unit-test
@ -173,7 +173,7 @@ unit-test
[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] 2apply ] unit-test [ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] 2apply ] unit-test
[ -1 1 "abc" <slice> ] unit-test-fails [ -1 1 "abc" <slice> ] must-fail
[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] 2apply ] unit-test [ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] 2apply ] unit-test
@ -195,8 +195,8 @@ unit-test
! Pathological case ! Pathological case
[ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test [ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
[ -10 "hi" "bye" copy ] unit-test-fails [ -10 "hi" "bye" copy ] must-fail
[ 10 "hi" "bye" copy ] unit-test-fails [ 10 "hi" "bye" copy ] must-fail
[ V{ 1 2 3 5 6 } ] [ [ V{ 1 2 3 5 6 } ] [
3 V{ 1 2 3 4 5 6 } clone [ delete-nth ] keep 3 V{ 1 2 3 4 5 6 } clone [ delete-nth ] keep
@ -228,13 +228,13 @@ unit-test
[ SBUF" \0\0\0" ] [ 3 SBUF" " new ] unit-test [ SBUF" \0\0\0" ] [ 3 SBUF" " new ] unit-test
[ 0 ] [ f length ] unit-test [ 0 ] [ f length ] unit-test
[ f first ] unit-test-fails [ f first ] must-fail
[ 3 ] [ 3 10 nth ] unit-test [ 3 ] [ 3 10 nth ] unit-test
[ 3 ] [ 3 10 nth-unsafe ] unit-test [ 3 ] [ 3 10 nth-unsafe ] unit-test
[ -3 10 nth ] unit-test-fails [ -3 10 nth ] must-fail
[ 11 10 nth ] unit-test-fails [ 11 10 nth ] must-fail
[ -1./0. 0 delete-nth ] unit-test-fails [ -1./0. 0 delete-nth ] must-fail
[ "" ] [ "" [ CHAR: \s = ] trim ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
[ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test [ "" ] [ "" [ CHAR: \s = ] left-trim ] unit-test
[ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test [ "" ] [ "" [ CHAR: \s = ] right-trim ] unit-test

View File

@ -1,7 +1,7 @@
USING: splitting tools.test ; USING: splitting tools.test ;
IN: temporary IN: temporary
[ { 1 2 3 } 0 group ] unit-test-fails [ { 1 2 3 } 0 group ] must-fail
[ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test [ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test

View File

@ -4,7 +4,7 @@ IN: temporary
[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test [ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
[ ] [ 10 [ [ -1000000 <sbuf> ] catch drop ] times ] unit-test [ ] [ 10 [ [ -1000000 <sbuf> ] ignore-errors ] times ] unit-test
[ "abc" ] [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test [ "abc" ] [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test
@ -31,7 +31,7 @@ IN: temporary
[ t ] [ "abc" "abd" <=> 0 < ] unit-test [ t ] [ "abc" "abd" <=> 0 < ] unit-test
[ t ] [ "z" "abd" <=> 0 > ] unit-test [ t ] [ "z" "abd" <=> 0 > ] unit-test
[ f ] [ [ 0 10 "hello" subseq ] catch not ] unit-test [ 0 10 "hello" subseq ] must-fail
[ "Replacing+spaces+with+plus" ] [ "Replacing+spaces+with+plus" ]
[ [
@ -43,8 +43,8 @@ unit-test
[ "05" ] [ "5" 2 CHAR: 0 pad-left ] unit-test [ "05" ] [ "5" 2 CHAR: 0 pad-left ] unit-test
[ "666" ] [ "666" 2 CHAR: 0 pad-left ] unit-test [ "666" ] [ "666" 2 CHAR: 0 pad-left ] unit-test
[ 1 "" nth ] unit-test-fails [ 1 "" nth ] must-fail
[ -6 "hello" nth ] unit-test-fails [ -6 "hello" nth ] must-fail
[ t ] [ "hello world" dup >vector >string = ] unit-test [ t ] [ "hello world" dup >vector >string = ] unit-test
@ -55,8 +55,7 @@ unit-test
[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test [ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
! Random tester found this ! Random tester found this
[ { "kernel-error" 3 12 -7 } ] [ 2 -7 resize-string ] [ { "kernel-error" 3 12 -7 } = ] must-fail-with
[ [ 2 -7 resize-string ] catch ] unit-test
! Make sure 24-bit strings work ! Make sure 24-bit strings work
"hello world" "s" set "hello world" "s" set

View File

@ -9,4 +9,4 @@ IN: temporary
yield yield
[ ] [ 0.3 sleep ] unit-test [ ] [ 0.3 sleep ] unit-test
[ "hey" sleep ] unit-test-fails [ "hey" sleep ] must-fail

View File

@ -55,7 +55,7 @@ C: <point> point
"IN: temporary TUPLE: point z y ;" eval "IN: temporary TUPLE: point z y ;" eval
[ "p" get point-x ] unit-test-fails [ "p" get point-x ] must-fail
[ 200 ] [ "p" get point-y ] unit-test [ 200 ] [ "p" get point-y ] unit-test
[ 300 ] [ "p" get "point-z" "temporary" lookup execute ] unit-test [ 300 ] [ "p" get "point-z" "temporary" lookup execute ] unit-test
@ -97,7 +97,7 @@ TUPLE: delegate-clone ;
[ f ] [ \ tuple \ delegate-clone class< ] unit-test [ f ] [ \ tuple \ delegate-clone class< ] unit-test
! Compiler regression ! Compiler regression
[ t ] [ [ t length ] catch no-method-object ] unit-test [ t length ] [ no-method-object t eq? ] must-fail-with
[ "<constructor-test>" ] [ "<constructor-test>" ]
[ "TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test [ "TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
@ -204,15 +204,15 @@ SYMBOL: not-a-tuple-class
[ [
"IN: temporary C: <not-a-tuple-class> not-a-tuple-class" "IN: temporary C: <not-a-tuple-class> not-a-tuple-class"
eval eval
] unit-test-fails ] must-fail
[ t ] [ [ t ] [
"not-a-tuple-class" "temporary" lookup symbol? "not-a-tuple-class" "temporary" lookup symbol?
] unit-test ] unit-test
! Missing check ! Missing check
[ not-a-tuple-class construct-boa ] unit-test-fails [ not-a-tuple-class construct-boa ] must-fail
[ not-a-tuple-class construct-empty ] unit-test-fails [ not-a-tuple-class construct-empty ] must-fail
TUPLE: erg's-reshape-problem a b c d ; TUPLE: erg's-reshape-problem a b c d ;
@ -234,8 +234,6 @@ C: <erg's-reshape-problem> erg's-reshape-problem
[ t ] [ 1 cons-test-3 array-capacity "a" get array-capacity = ] unit-test [ t ] [ 1 cons-test-3 array-capacity "a" get array-capacity = ] unit-test
[ t ] [ [
[ "IN: temporary SYMBOL: not-a-class C: <not-a-class> not-a-class" eval
"IN: temporary SYMBOL: not-a-class C: <not-a-class> not-a-class" eval ] [ [ check-tuple? ] is? ] must-fail-with
] catch [ check-tuple? ] is?
] unit-test

View File

@ -3,25 +3,25 @@ sequences sequences.private strings tools.test vectors
continuations random growable classes ; continuations random growable classes ;
IN: temporary IN: temporary
[ ] [ 10 [ [ -1000000 <vector> ] catch drop ] times ] unit-test [ ] [ 10 [ [ -1000000 <vector> ] ignore-errors ] times ] unit-test
[ 3 ] [ [ t f t ] length ] unit-test [ 3 ] [ [ t f t ] length ] unit-test
[ 3 ] [ V{ t f t } length ] unit-test [ 3 ] [ V{ t f t } length ] unit-test
[ -3 V{ } nth ] unit-test-fails [ -3 V{ } nth ] must-fail
[ 3 V{ } nth ] unit-test-fails [ 3 V{ } nth ] must-fail
[ 3 54.3 nth ] unit-test-fails [ 3 54.3 nth ] must-fail
[ "hey" [ 1 2 ] set-length ] unit-test-fails [ "hey" [ 1 2 ] set-length ] must-fail
[ "hey" V{ 1 2 } set-length ] unit-test-fails [ "hey" V{ 1 2 } set-length ] must-fail
[ 3 ] [ 3 0 <vector> [ set-length ] keep length ] unit-test [ 3 ] [ 3 0 <vector> [ set-length ] keep length ] unit-test
[ "yo" ] [ [ "yo" ] [
"yo" 4 1 <vector> [ set-nth ] keep 4 swap nth "yo" 4 1 <vector> [ set-nth ] keep 4 swap nth
] unit-test ] unit-test
[ 1 V{ } nth ] unit-test-fails [ 1 V{ } nth ] must-fail
[ -1 V{ } set-length ] unit-test-fails [ -1 V{ } set-length ] must-fail
[ V{ } ] [ [ ] >vector ] unit-test [ V{ } ] [ [ ] >vector ] unit-test
[ V{ 1 2 } ] [ [ 1 2 ] >vector ] unit-test [ V{ 1 2 } ] [ [ 1 2 ] >vector ] unit-test
@ -64,8 +64,8 @@ IN: temporary
[ V{ 2 3 } ] [ "funny-stack" get pop ] unit-test [ V{ 2 3 } ] [ "funny-stack" get pop ] unit-test
[ V{ 1 5 } ] [ "funny-stack" get peek ] unit-test [ V{ 1 5 } ] [ "funny-stack" get peek ] unit-test
[ V{ 1 5 } ] [ "funny-stack" get pop ] unit-test [ V{ 1 5 } ] [ "funny-stack" get pop ] unit-test
[ "funny-stack" get pop ] unit-test-fails [ "funny-stack" get pop ] must-fail
[ "funny-stack" get pop ] unit-test-fails [ "funny-stack" get pop ] must-fail
[ ] [ "funky" "funny-stack" get push ] unit-test [ ] [ "funky" "funny-stack" get push ] unit-test
[ "funky" ] [ "funny-stack" get pop ] unit-test [ "funky" ] [ "funny-stack" get pop ] unit-test

View File

@ -18,16 +18,6 @@ debugger compiler.units ;
[ t ] [ t ]
[ "kernel" f >vocab-link "kernel" vocab = ] unit-test [ "kernel" f >vocab-link "kernel" vocab = ] unit-test
! This vocab should not exist, but just in case...
[ ] [ [ "core" forget-vocab ] with-compilation-unit ] unit-test
2 [
[ T{ no-vocab f "core" } ]
[ [ "core" require ] catch ] unit-test
] times
[ f ] [ "core" vocab ] unit-test
[ t ] [ [ t ] [
"kernel" vocab-files "kernel" vocab-files
"kernel" vocab vocab-files "kernel" vocab vocab-files
@ -59,7 +49,7 @@ IN: temporary
0 "count-me" set-global 0 "count-me" set-global
2 [ 2 [
[ "vocabs.loader.test.a" require ] unit-test-fails [ "vocabs.loader.test.a" require ] must-fail
[ f ] [ "vocabs.loader.test.a" vocab-source-loaded? ] unit-test [ f ] [ "vocabs.loader.test.a" vocab-source-loaded? ] unit-test
@ -97,7 +87,7 @@ IN: temporary
] with-compilation-unit ] with-compilation-unit
] unit-test ] unit-test
[ "vocabs.loader.test.b" require ] unit-test-fails [ "vocabs.loader.test.b" require ] must-fail
[ 1 ] [ "count-me" get-global ] unit-test [ 1 ] [ "count-me" get-global ] unit-test

View File

@ -110,7 +110,7 @@ M: array freakish ;
[ t ] [ \ bar \ freakish usage member? ] unit-test [ t ] [ \ bar \ freakish usage member? ] unit-test
DEFER: x DEFER: x
[ t ] [ [ x ] catch undefined? ] unit-test [ x ] [ undefined? ] must-fail-with
[ ] [ "no-loc" "temporary" create drop ] unit-test [ ] [ "no-loc" "temporary" create drop ] unit-test
[ f ] [ "no-loc" "temporary" lookup where ] unit-test [ f ] [ "no-loc" "temporary" lookup where ] unit-test
@ -141,10 +141,8 @@ SYMBOL: quot-uses-b
[ { + } ] [ \ quot-uses-b uses ] unit-test [ { + } ] [ \ quot-uses-b uses ] unit-test
[ t ] [ [ "IN: temporary : undef-test ; << undef-test >>" eval ]
[ "IN: temporary : undef-test ; << undef-test >>" eval ] catch [ [ undefined? ] is? ] must-fail-with
[ undefined? ] is?
] unit-test
[ ] [ [ ] [
"IN: temporary GENERIC: symbol-generic" eval "IN: temporary GENERIC: symbol-generic" eval

View File

@ -10,12 +10,12 @@ SAFE-BITFIELD: foo bar:5 baz:10 111 bing:2 ;
[ 855 ] [ 21 852 3 <foo> 855 swap with-foo-baz foo-baz ] unit-test [ 855 ] [ 21 852 3 <foo> 855 swap with-foo-baz foo-baz ] unit-test
[ 1 ] [ 21 852 3 <foo> 1 swap with-foo-bing foo-bing ] unit-test [ 1 ] [ 21 852 3 <foo> 1 swap with-foo-bing foo-bing ] unit-test
[ 100 0 0 <foo> ] unit-test-fails [ 100 0 0 <foo> ] must-fail
[ 0 5000 0 <foo> ] unit-test-fails [ 0 5000 0 <foo> ] must-fail
[ 0 0 10 <foo> ] unit-test-fails [ 0 0 10 <foo> ] must-fail
[ 100 0 with-foo-bar ] unit-test-fails [ 100 0 with-foo-bar ] must-fail
[ 5000 0 with-foo-baz ] unit-test-fails [ 5000 0 with-foo-baz ] must-fail
[ 10 0 with-foo-bing ] unit-test-fails [ 10 0 with-foo-bing ] must-fail
[ BIN: 00101100000000111111 ] [ BIN: 101 BIN: 1000000001 BIN: 11 <foo> ] unit-test [ BIN: 00101100000000111111 ] [ BIN: 101 BIN: 1000000001 BIN: 11 <foo> ] unit-test

View File

@ -10,5 +10,3 @@ IN: bootstrap.io
{ [ wince? ] [ "windows.ce" ] } { [ wince? ] [ "windows.ce" ] }
} cond append require } cond append require
] when ] when
"vocabs.monitor" require

View File

@ -1,14 +1,14 @@
USING: arrays calendar kernel math sequences tools.test USING: arrays calendar kernel math sequences tools.test
continuations system ; continuations system ;
[ "invalid timestamp" ] [ [ 2004 12 32 0 0 0 0 make-timestamp ] catch ] unit-test [ 2004 12 32 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 2 30 0 0 0 0 make-timestamp ] catch ] unit-test [ 2004 2 30 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2003 2 29 0 0 0 0 make-timestamp ] catch ] unit-test [ 2003 2 29 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 -2 9 0 0 0 0 make-timestamp ] catch ] unit-test [ 2004 -2 9 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 12 0 0 0 0 0 make-timestamp ] catch ] unit-test [ 2004 12 0 0 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 12 1 24 0 0 0 make-timestamp ] catch ] unit-test [ 2004 12 1 24 0 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 12 1 23 60 0 0 make-timestamp ] catch ] unit-test [ 2004 12 1 23 60 0 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ "invalid timestamp" ] [ [ 2004 12 1 23 59 60 0 0 make-timestamp ] catch ] unit-test [ 2004 12 1 23 59 60 0 make-timestamp ] [ "invalid timestamp" = ] must-fail-with
[ f ] [ 1900 leap-year? ] unit-test [ f ] [ 1900 leap-year? ] unit-test
[ t ] [ 1904 leap-year? ] unit-test [ t ] [ 1904 leap-year? ] unit-test

View File

@ -9,7 +9,7 @@ circular strings ;
[ CHAR: t ] [ "test" <circular> 0 swap nth ] unit-test [ CHAR: t ] [ "test" <circular> 0 swap nth ] unit-test
[ "test" ] [ "test" <circular> >string ] unit-test [ "test" ] [ "test" <circular> >string ] unit-test
[ "test" <circular> 5 swap nth ] unit-test-fails [ "test" <circular> 5 swap nth ] must-fail
[ CHAR: e ] [ "test" <circular> 5 swap nth-unsafe ] unit-test [ CHAR: e ] [ "test" <circular> 5 swap nth-unsafe ] unit-test
[ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test [ [ 1 2 3 ] ] [ { 1 2 3 } <circular> [ ] like ] unit-test
@ -18,7 +18,7 @@ circular strings ;
[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test [ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test
[ "fob" ] [ "foo" <circular> CHAR: b 2 pick set-nth >string ] unit-test [ "fob" ] [ "foo" <circular> CHAR: b 2 pick set-nth >string ] unit-test
[ "foo" <circular> CHAR: b 3 rot set-nth ] unit-test-fails [ "foo" <circular> CHAR: b 3 rot set-nth ] must-fail
[ "boo" ] [ "foo" <circular> CHAR: b 3 pick set-nth-unsafe >string ] unit-test [ "boo" ] [ "foo" <circular> CHAR: b 3 pick set-nth-unsafe >string ] unit-test
[ "ornact" ] [ "factor" <circular> 4 over change-circular-start CHAR: n 2 pick set-nth >string ] unit-test [ "ornact" ] [ "factor" <circular> 4 over change-circular-start CHAR: n 2 pick set-nth >string ] unit-test

View File

@ -8,26 +8,25 @@ IN: temporary
[ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test [ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test
[ 328350 ] [ 100 [ sq ] sigma ] unit-test [ 328350 ] [ 100 [ sq ] sigma ] unit-test
: infers? [ infer drop ] curry catch not ;
[ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test [ { 910 911 912 } ] [ 10 900 3 [ + + ] map-with2 ] unit-test
{ 6 2 } [ 1 2 [ 5 + ] dip ] unit-test { 6 2 } [ 1 2 [ 5 + ] dip ] unit-test
{ 6 2 1 } [ 1 2 1 [ 5 + ] dipd ] unit-test { 6 2 1 } [ 1 2 1 [ 5 + ] dipd ] unit-test
{ t } [ [ [ 99 ] 1 2 3 4 5 5 nslip ] infers? ] unit-test
[ [ 99 ] 1 2 3 4 5 5 nslip ] must-infer
{ 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test { 99 1 2 3 4 5 } [ [ 99 ] 1 2 3 4 5 5 nslip ] unit-test
{ t } [ [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] infers? ] unit-test [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] must-infer
{ 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test { 2 1 2 3 4 5 } [ 1 2 3 4 5 [ drop drop drop drop drop 2 ] 5 nkeep ] unit-test
[ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test [ [ 1 2 3 + ] ] [ 1 2 3 [ + ] 3 ncurry ] unit-test
{ t } [ [ 1 2 { 3 4 } [ + + ] 2 map-withn ] infers? ] unit-test [ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer
{ { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test { { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test
{ { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test
{ t } [ [ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] infers? ] unit-test [ 1 2 { 3 4 } [ + + drop ] 2 each-withn ] must-infer
{ 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test { 13 } [ 1 2 { 3 4 } [ + + ] 2 each-withn + ] unit-test
[ 1 1 2 2 3 3 ] [ 1 2 3 [ dup ] 3apply ] unit-test [ 1 1 2 2 3 3 ] [ 1 2 3 [ dup ] 3apply ] unit-test
[ 1 4 9 ] [ 1 2 3 [ sq ] 3apply ] unit-test [ 1 4 9 ] [ 1 2 3 [ sq ] 3apply ] unit-test
[ t ] [ [ [ sq ] 3apply ] infers? ] unit-test [ [ sq ] 3apply ] must-infer
[ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test [ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
[ t ] [ [ [ dup 2^ 2array ] 5 napply ] infers? ] unit-test [ [ dup 2^ 2array ] 5 napply ] must-infer
! && ! &&

View File

@ -146,7 +146,7 @@ ARTICLE: { "concurrency" "exceptions" } "Exceptions"
"A process can handle exceptions using the standard Factor exception handling mechanism. If an exception is uncaught the process will terminate. For example:" "A process can handle exceptions using the standard Factor exception handling mechanism. If an exception is uncaught the process will terminate. For example:"
{ $code "[ 1 0 / \"This will not print\" print ] spawn" } { $code "[ 1 0 / \"This will not print\" print ] spawn" }
"Processes can be linked so that a parent process can receive the exception that caused the child process to terminate. In this way 'supervisor' processes can be created that are notified when child processes terminate and possibly restart them.\n\nThe easiest way to form this link is using " { $link spawn-link } ". This will create a unidirectional link, such that if an uncaught exception causes the child to terminate, the parent process can catch it:" "Processes can be linked so that a parent process can receive the exception that caused the child process to terminate. In this way 'supervisor' processes can be created that are notified when child processes terminate and possibly restart them.\n\nThe easiest way to form this link is using " { $link spawn-link } ". This will create a unidirectional link, such that if an uncaught exception causes the child to terminate, the parent process can catch it:"
{ $code "[\n [ 1 0 / \"This will not print\" print ] spawn-link drop\n receive\n] catch [ \"Exception caught.\" print ] when" } { $code "[\n [ 1 0 / \"This will not print\" print ] spawn-link drop\n receive\n] [ \"Exception caught.\" print ] recover" }
"Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ; "Exceptions are only raised in the parent when the parent does a " { $link receive } " or " { $link receive-if } ". This is because the exception is sent from the child to the parent as a message." ;
ARTICLE: { "concurrency" "futures" } "Futures" ARTICLE: { "concurrency" "futures" } "Futures"

View File

@ -67,15 +67,12 @@ IN: temporary
] unit-test ] unit-test
[ "crash" ] [ [
[ [
[ "crash" throw
"crash" throw ] spawn-link drop
] spawn-link drop receive
receive ] [ "crash" = ] must-fail-with
]
catch
] unit-test
[ 50 ] [ [ 50 ] [
[ 50 ] future ?future [ 50 ] future ?future
@ -115,7 +112,7 @@ SYMBOL: value
! this is fixed (via a timeout). ! this is fixed (via a timeout).
! [ ! [
! [ "this should propogate" throw ] future ?future ! [ "this should propogate" throw ] future ?future
! ] unit-test-fails ! ] must-fail
[ ] [ [ ] [
[ "this should not propogate" throw ] future drop [ "this should not propogate" throw ] future drop

View File

@ -166,7 +166,7 @@ M: process send ( message process -- )
PRIVATE> PRIVATE>
: spawn-link ( quot -- process ) : spawn-link ( quot -- process )
[ catch [ rethrow-linked ] when* ] curry [ [ rethrow-linked ] recover ] curry
[ ((spawn)) ] curry (spawn-link) ; inline [ ((spawn)) ] curry (spawn-link) ; inline
<PRIVATE <PRIVATE

View File

@ -10,7 +10,7 @@ USING: coroutines kernel sequences prettyprint tools.test math ;
[ 1+ coyield* ] cocreate ; [ 1+ coyield* ] cocreate ;
test1 dup *coresume . dup *coresume . dup *coresume . dup *coresume 2drop test1 dup *coresume . dup *coresume . dup *coresume . dup *coresume 2drop
[ test2 42 over coresume . dup *coresume . drop ] unit-test-fails [ test2 42 over coresume . dup *coresume . drop ] must-fail
{ 43 } [ 42 test2 coresume ] unit-test { 43 } [ 42 test2 coresume ] unit-test
: test3 ( -- co ) : test3 ( -- co )

View File

@ -2,10 +2,10 @@ USING: continuations crypto.xor kernel strings tools.test ;
IN: temporary IN: temporary
! No key ! No key
[ T{ no-xor-key f } ] [ [ "" dup xor-crypt ] catch ] unit-test [ "" dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with
[ T{ no-xor-key f } ] [ [ { } dup xor-crypt ] catch ] unit-test [ { } dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with
[ T{ no-xor-key f } ] [ [ V{ } dup xor-crypt ] catch ] unit-test [ V{ } dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with
[ T{ no-xor-key f } ] [ [ "" "asdf" dupd xor-crypt xor-crypt ] catch ] unit-test [ "" "asdf" dupd xor-crypt xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with
! a xor a = 0 ! a xor a = 0
[ "\0\0\0\0\0\0\0" ] [ "abcdefg" dup xor-crypt ] unit-test [ "\0\0\0\0\0\0\0" ] [ "abcdefg" dup xor-crypt ] unit-test

View File

@ -14,7 +14,7 @@ IN: temporary
[ ] [ [ ] [
test-db [ test-db [
[ "drop table person;" sql-command ] catch drop [ "drop table person;" sql-command ] ignore-errors
"create table person (name varchar(30), country varchar(30));" "create table person (name varchar(30), country varchar(30));"
sql-command sql-command
@ -83,7 +83,7 @@ IN: temporary
"oops" throw "oops" throw
] with-transaction ] with-transaction
] with-db ] with-db
] unit-test-fails ] must-fail
[ 3 ] [ [ 3 ] [
test-db [ test-db [

View File

@ -5,7 +5,7 @@ IN: temporary
: test.db "extra/db/sqlite/test.db" resource-path ; : test.db "extra/db/sqlite/test.db" resource-path ;
[ ] [ [ test.db delete-file ] catch drop ] unit-test [ ] [ [ test.db delete-file ] ignore-errors ] unit-test
[ ] [ [ ] [
test.db [ test.db [
@ -64,7 +64,7 @@ IN: temporary
"oops" throw "oops" throw
] with-transaction ] with-transaction
] with-sqlite ] with-sqlite
] unit-test-fails ] must-fail
[ 3 ] [ [ 3 ] [
test.db [ test.db [

View File

@ -36,7 +36,7 @@ M: dummy-destructor destruct ( obj -- )
dup destroy-always dup destroy-always
"foo" throw "foo" throw
] with-destructors ] with-destructors
] catch drop dummy-obj-destroyed? ] ignore-errors dummy-obj-destroyed?
] unit-test ] unit-test
[ t ] [ [ t ] [
@ -45,6 +45,6 @@ M: dummy-destructor destruct ( obj -- )
dup destroy-later dup destroy-later
"foo" throw "foo" throw
] with-destructors ] with-destructors
] catch drop dummy-obj-destroyed? ] ignore-errors dummy-obj-destroyed?
] unit-test ] unit-test

View File

@ -50,7 +50,7 @@ io.streams.string continuations debugger compiler.units ;
[ [
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"yyy\" \"YYY\" ; ARTICLE: \"xxx\" \"XXX\" { $subsection \"yyy\" } ; ARTICLE: \"yyy\" \"YYY\" ;" "IN: azz USE: help.syntax USE: help.markup ARTICLE: \"yyy\" \"YYY\" ; ARTICLE: \"xxx\" \"XXX\" { $subsection \"yyy\" } ; ARTICLE: \"yyy\" \"YYY\" ;"
<string-reader> "parent-test" parse-stream drop <string-reader> "parent-test" parse-stream drop
] catch [ :1 ] when ] [ :1 ] recover
] unit-test ] unit-test
[ "xxx" ] [ "yyy" article-parent ] unit-test [ "xxx" ] [ "yyy" article-parent ] unit-test

View File

@ -3,7 +3,7 @@ math.functions math.constants ;
IN: inverse-tests IN: inverse-tests
[ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test [ 2 ] [ { 3 2 } [ 3 swap 2array ] undo ] unit-test
[ { 3 4 } [ dup 2array ] undo ] unit-test-fails [ { 3 4 } [ dup 2array ] undo ] must-fail
TUPLE: foo bar baz ; TUPLE: foo bar baz ;
@ -15,7 +15,7 @@ C: <foo> foo
[ t ] [ { 3 3 } [ 2same ] matches? ] unit-test [ t ] [ { 3 3 } [ 2same ] matches? ] unit-test
[ f ] [ { 3 4 } [ 2same ] matches? ] unit-test [ f ] [ { 3 4 } [ 2same ] matches? ] unit-test
[ [ 2same ] matches? ] unit-test-fails [ [ 2same ] matches? ] must-fail
: something ( array -- num ) : something ( array -- num )
{ {
@ -25,9 +25,9 @@ C: <foo> foo
[ 5 ] [ { 1 2 2 } something ] unit-test [ 5 ] [ { 1 2 2 } something ] unit-test
[ 6 ] [ { 2 3 } something ] unit-test [ 6 ] [ { 2 3 } something ] unit-test
[ { 1 } something ] unit-test-fails [ { 1 } something ] must-fail
[ 1 2 [ eq? ] undo ] unit-test-fails [ 1 2 [ eq? ] undo ] must-fail
: f>c ( *fahrenheit -- *celsius ) : f>c ( *fahrenheit -- *celsius )
32 - 1.8 / ; 32 - 1.8 / ;

View File

@ -75,5 +75,5 @@ sequences tools.test namespaces ;
"b" get buffer-free "b" get buffer-free
100 <buffer> "b" set 100 <buffer> "b" set
[ 1000 "b" get n>buffer ] unit-test-fails [ 1000 "b" get n>buffer ] must-fail
"b" get buffer-free "b" get buffer-free

View File

@ -1,9 +1,9 @@
USING: io io.mmap io.files kernel tools.test continuations sequences ; USING: io io.mmap io.files kernel tools.test continuations sequences ;
IN: temporary IN: temporary
[ "mmap-test-file.txt" resource-path delete-file ] catch drop [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors
[ ] [ "mmap-test-file.txt" resource-path <file-writer> [ "12345" write ] with-stream ] unit-test [ ] [ "mmap-test-file.txt" resource-path <file-writer> [ "12345" write ] with-stream ] unit-test
[ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test [ ] [ "mmap-test-file.txt" resource-path dup file-length [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
[ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test [ 5 ] [ "mmap-test-file.txt" resource-path dup file-length [ length ] with-mapped-file ] unit-test
[ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test [ "22345" ] [ "mmap-test-file.txt" resource-path file-contents ] unit-test
[ "mmap-test-file.txt" resource-path delete-file ] catch drop [ "mmap-test-file.txt" resource-path delete-file ] ignore-errors

View File

@ -1,8 +1,8 @@
IN: temporary IN: temporary
USING: io.unix.launcher tools.test ; USING: io.unix.launcher tools.test ;
[ "" tokenize-command ] unit-test-fails [ "" tokenize-command ] must-fail
[ " " tokenize-command ] unit-test-fails [ " " tokenize-command ] must-fail
[ { "a" } ] [ "a" tokenize-command ] unit-test [ { "a" } ] [ "a" tokenize-command ] unit-test
[ { "abc" } ] [ "abc" tokenize-command ] unit-test [ { "abc" } ] [ "abc" tokenize-command ] unit-test
[ { "abc" } ] [ "abc " tokenize-command ] unit-test [ { "abc" } ] [ "abc " tokenize-command ] unit-test
@ -14,8 +14,8 @@ USING: io.unix.launcher tools.test ;
[ { "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test [ { "abc\\ def" } ] [ " 'abc\\\\ def'" tokenize-command ] unit-test
[ { "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test [ { "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
[ { "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test [ { "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
[ "'abc def' \"hey" tokenize-command ] unit-test-fails [ "'abc def' \"hey" tokenize-command ] must-fail
[ "'abc def" tokenize-command ] unit-test-fails [ "'abc def" tokenize-command ] must-fail
[ { "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test [ { "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\" " tokenize-command ] unit-test
[ [

View File

@ -3,7 +3,7 @@
USING: kernel io.backend io.monitors io.monitors.private io.files USING: kernel io.backend io.monitors io.monitors.private io.files
io.buffers io.nonblocking io.unix.backend io.unix.select io.buffers io.nonblocking io.unix.backend io.unix.select
io.unix.launcher unix.linux.inotify assocs namespaces threads io.unix.launcher unix.linux.inotify assocs namespaces threads
continuations init math alien.c-types alien ; continuations init math alien.c-types alien vocabs.loader ;
IN: io.unix.linux IN: io.unix.linux
TUPLE: linux-io ; TUPLE: linux-io ;
@ -134,4 +134,6 @@ M: linux-io init-io ( -- )
T{ linux-io } set-io-backend T{ linux-io } set-io-backend
[ start-wait-thread ] "io.unix.linux" add-init-hook [ start-wait-thread ] "io.unix.linux" add-init-hook
"vocabs.monitor" require

View File

@ -7,7 +7,7 @@ IN: temporary
[ [
[ [
"unix-domain-socket-test" resource-path delete-file "unix-domain-socket-test" resource-path delete-file
] catch drop ] ignore-errors
"unix-domain-socket-test" resource-path <local> "unix-domain-socket-test" resource-path <local>
<server> [ <server> [
@ -36,7 +36,7 @@ yield
! Unix domain datagram sockets ! Unix domain datagram sockets
[ [
"unix-domain-datagram-test" resource-path delete-file "unix-domain-datagram-test" resource-path delete-file
] catch drop ] ignore-errors
: server-addr "unix-domain-datagram-test" resource-path <local> ; : server-addr "unix-domain-datagram-test" resource-path <local> ;
: client-addr "unix-domain-datagram-test-2" resource-path <local> ; : client-addr "unix-domain-datagram-test-2" resource-path <local> ;
@ -75,7 +75,7 @@ yield
[ [
"unix-domain-datagram-test-2" resource-path delete-file "unix-domain-datagram-test-2" resource-path delete-file
] catch drop ] ignore-errors
client-addr <datagram> client-addr <datagram>
"d" set "d" set
@ -110,7 +110,7 @@ client-addr <datagram>
[ [
"unix-domain-datagram-test-3" resource-path delete-file "unix-domain-datagram-test-3" resource-path delete-file
] catch drop ] ignore-errors
"unix-domain-datagram-test-2" resource-path delete-file "unix-domain-datagram-test-2" resource-path delete-file
@ -118,29 +118,29 @@ client-addr <datagram>
[ [
B{ 1 2 3 } "unix-domain-datagram-test-3" <local> "d" get send B{ 1 2 3 } "unix-domain-datagram-test-3" <local> "d" get send
] unit-test-fails ] must-fail
[ ] [ "d" get dispose ] unit-test [ ] [ "d" get dispose ] unit-test
! See what happens on send/receive after close ! See what happens on send/receive after close
[ "d" get receive ] unit-test-fails [ "d" get receive ] must-fail
[ B{ 1 2 } server-addr "d" get send ] unit-test-fails [ B{ 1 2 } server-addr "d" get send ] must-fail
! Invalid parameter tests ! Invalid parameter tests
[ [
image <file-reader> [ stdio get accept ] with-stream image <file-reader> [ stdio get accept ] with-stream
] unit-test-fails ] must-fail
[ [
image <file-reader> [ stdio get receive ] with-stream image <file-reader> [ stdio get receive ] with-stream
] unit-test-fails ] must-fail
[ [
image <file-reader> [ image <file-reader> [
B{ 1 2 } server-addr B{ 1 2 } server-addr
stdio get send stdio get send
] with-stream ] with-stream
] unit-test-fails ] must-fail

View File

@ -1,6 +1,7 @@
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman, ! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman,
! Slava Pestov. ! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USE: vocabs.loader
USE: io.windows USE: io.windows
USE: io.windows.nt.backend USE: io.windows.nt.backend
USE: io.windows.nt.files USE: io.windows.nt.files
@ -11,3 +12,5 @@ USE: io.windows.mmap
USE: io.backend USE: io.backend
T{ windows-nt-io } set-io-backend T{ windows-nt-io } set-io-backend
"vocabs.monitor" require

View File

@ -189,7 +189,7 @@ SYMBOL: line
: with-infinite-loop ( quot timeout -- quot timeout ) : with-infinite-loop ( quot timeout -- quot timeout )
"looping" print flush "looping" print flush
over catch drop dup sleep with-infinite-loop ; over [ drop ] recover dup sleep with-infinite-loop ;
: start-irc ( irc-client -- ) : start-irc ( irc-client -- )
! [ [ do-irc ] curry 3000 with-infinite-loop ] with-scope ; ! [ [ do-irc ] curry 3000 with-infinite-loop ] with-scope ;

View File

@ -2,8 +2,8 @@ USING: kernel math math.constants math.functions tools.test
prettyprint ; prettyprint ;
IN: temporary IN: temporary
[ 1 C{ 0 1 } rect> ] unit-test-fails [ 1 C{ 0 1 } rect> ] must-fail
[ C{ 0 1 } 1 rect> ] unit-test-fails [ C{ 0 1 } 1 rect> ] must-fail
[ f ] [ C{ 5 12.5 } 5 = ] unit-test [ f ] [ C{ 5 12.5 } 5 = ] unit-test
[ t ] [ C{ 1.0 2.0 } C{ 1 2 } = ] unit-test [ t ] [ C{ 1.0 2.0 } C{ 1 2 } = ] unit-test

View File

@ -73,7 +73,7 @@ IN: temporary
[ 3 ] [ 5 7 mod-inv ] unit-test [ 3 ] [ 5 7 mod-inv ] unit-test
[ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test [ 78572682077 ] [ 234829342 342389423843 mod-inv ] unit-test
[ 2 10 mod-inv ] unit-test-fails [ 2 10 mod-inv ] must-fail
[ t ] [ 0 0 ^ fp-nan? ] unit-test [ t ] [ 0 0 ^ fp-nan? ] unit-test
[ 1 ] [ 10 0 ^ ] unit-test [ 1 ] [ 10 0 ^ ] unit-test

View File

@ -7,4 +7,4 @@ MEMO: fib ( m -- n )
[ 89 ] [ 10 fib ] unit-test [ 89 ] [ 10 fib ] unit-test
[ "USING: kernel math memoize ; MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] unit-test-fails [ "USING: kernel math memoize ; MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] must-fail

View File

@ -52,7 +52,7 @@ METHOD: beats? { thing thing } f ;
: play ( obj1 obj2 -- ? ) beats? 2nip ; : play ( obj1 obj2 -- ? ) beats? 2nip ;
[ { } 3 play ] unit-test-fails [ { } 3 play ] must-fail
[ t ] [ error get no-method? ] unit-test [ t ] [ error get no-method? ] unit-test
[ ] [ error get error. ] unit-test [ ] [ error get error. ] unit-test
[ t ] [ T{ paper } T{ scissors } play ] unit-test [ t ] [ T{ paper } T{ scissors } play ] unit-test

View File

@ -76,7 +76,7 @@ IN: scratchpad
[ [
"begin1" "begin" token some parse "begin1" "begin" token some parse
] unit-test-fails ] must-fail
{ "begin" } [ { "begin" } [
"begin" "begin" token some parse "begin" "begin" token some parse

View File

@ -95,7 +95,7 @@ IN: regexp-tests
[ t ] [ "]" "[]]" f <regexp> matches? ] unit-test [ t ] [ "]" "[]]" f <regexp> matches? ] unit-test
[ f ] [ "]" "[^]]" f <regexp> matches? ] unit-test [ f ] [ "]" "[^]]" f <regexp> matches? ] unit-test
! [ "^" "[^]" f <regexp> matches? ] unit-test-fails ! [ "^" "[^]" f <regexp> matches? ] must-fail
[ t ] [ "^" "[]^]" f <regexp> matches? ] unit-test [ t ] [ "^" "[]^]" f <regexp> matches? ] unit-test
[ t ] [ "]" "[]^]" f <regexp> matches? ] unit-test [ t ] [ "]" "[]^]" f <regexp> matches? ] unit-test

View File

@ -28,11 +28,11 @@ USING: arrays kernel math roman roman.private sequences tools.test ;
[ 1666 ] [ 1666 >roman roman> ] unit-test [ 1666 ] [ 1666 >roman roman> ] unit-test
[ 3444 ] [ 3444 >roman roman> ] unit-test [ 3444 ] [ 3444 >roman roman> ] unit-test
[ 3999 ] [ 3999 >roman roman> ] unit-test [ 3999 ] [ 3999 >roman roman> ] unit-test
[ 0 >roman ] unit-test-fails [ 0 >roman ] must-fail
[ 4000 >roman ] unit-test-fails [ 4000 >roman ] must-fail
[ "vi" ] [ "iii" "iii" roman+ ] unit-test [ "vi" ] [ "iii" "iii" roman+ ] unit-test
[ "viii" ] [ "x" "ii" roman- ] unit-test [ "viii" ] [ "x" "ii" roman- ] unit-test
[ "ix" ] [ "iii" "iii" roman* ] unit-test [ "ix" ] [ "iii" "iii" roman* ] unit-test
[ "i" ] [ "iii" "ii" roman/i ] unit-test [ "i" ] [ "iii" "ii" roman/i ] unit-test
[ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test [ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test
[ "iii" "iii" roman- ] unit-test-fails [ "iii" "iii" roman- ] must-fail

View File

@ -38,7 +38,7 @@ math.functions tools.test strings ;
[ f ] [ { "asdf" "bsdf" } singleton? ] unit-test [ f ] [ { "asdf" "bsdf" } singleton? ] unit-test
[ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test [ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
[ V{ } [ delete-random drop ] keep length ] unit-test-fails [ V{ } [ delete-random drop ] keep length ] must-fail
[ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test [ { 1 9 25 } ] [ { 1 3 5 6 } [ sq ] [ even? ] map-until ] unit-test
[ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test [ { 2 4 } ] [ { 2 4 1 3 } [ even? ] take-while ] unit-test

View File

@ -5,7 +5,7 @@ colors ;
[ { { f f } { f f } { f f } } ] [ 2 3 <board> board-rows ] unit-test [ { { f f } { f f } { f f } } ] [ 2 3 <board> board-rows ] unit-test
[ 1 { f f } ] [ 2 3 <board> { 1 1 } board@block ] unit-test [ 1 { f f } ] [ 2 3 <board> { 1 1 } board@block ] unit-test
[ f ] [ 2 3 <board> { 1 1 } board-block ] unit-test [ f ] [ 2 3 <board> { 1 1 } board-block ] unit-test
[ 2 3 <board> { 2 3 } board-block ] unit-test-fails [ 2 3 <board> { 2 3 } board-block ] must-fail
red 1array [ 2 3 <board> dup { 1 1 } red board-set-block { 1 1 } board-block ] unit-test red 1array [ 2 3 <board> dup { 1 1 } red board-set-block { 1 1 } board-block ] unit-test
[ t ] [ 2 3 <board> { 1 1 } block-free? ] unit-test [ t ] [ 2 3 <board> { 1 1 } block-free? ] unit-test
[ f ] [ 2 3 <board> dup { 1 1 } red board-set-block { 1 1 } block-free? ] unit-test [ f ] [ 2 3 <board> dup { 1 1 } red board-set-block { 1 1 } block-free? ] unit-test

View File

@ -99,7 +99,7 @@ IN: temporary
[ [ [ 3 swap continue-with ] callcc1 2 * ] test-interpreter ] unit-test [ [ [ 3 swap continue-with ] callcc1 2 * ] test-interpreter ] unit-test
[ { 6 } ] [ { 6 } ]
[ [ [ 3 throw ] catch 2 * ] test-interpreter ] unit-test [ [ [ 3 throw ] [ 2 * ] recover ] test-interpreter ] unit-test
[ { "{ 1 2 3 }\n" } ] [ [ { "{ 1 2 3 }\n" } ] [
[ [ { 1 2 3 } . ] string-out ] test-interpreter [ [ { 1 2 3 } . ] string-out ] test-interpreter

View File

@ -10,7 +10,6 @@ IN: tools.test.inference
: unit-test-effect ( effect quot -- ) : unit-test-effect ( effect quot -- )
>r 1quotation r> [ infer short-effect ] curry unit-test ; >r 1quotation r> [ infer short-effect ] curry unit-test ;
: must-infer ( word -- ) : must-infer ( word/quot -- )
dup "declared-effect" word-prop dup word? [ 1quotation ] when
dup effect-in length swap effect-out length 2array [ infer drop ] curry [ ] swap unit-test ;
swap 1quotation unit-test-effect ;

View File

@ -42,6 +42,9 @@ M: expected-error summary
: must-fail ( quot -- ) : must-fail ( quot -- )
[ drop t ] must-fail-with ; [ drop t ] must-fail-with ;
: ignore-errors ( quot -- )
[ drop ] recover ; inline
: run-test ( path -- failures ) : run-test ( path -- failures )
[ "temporary" forget-vocab ] with-compilation-unit [ "temporary" forget-vocab ] with-compilation-unit
[ [

View File

@ -25,7 +25,7 @@ timers [ init-timers ] unless
[ ] [ "SYMBOL:" "i" get set-editor-string ] unit-test [ ] [ "SYMBOL:" "i" get set-editor-string ] unit-test
[ ] [ [ ] [
"i" get [ { "SYMBOL:" } parse-lines ] catch go-to-error "i" get [ { "SYMBOL:" } parse-lines ] [ go-to-error ] recover
] unit-test ] unit-test
[ t ] [ [ t ] [

View File

@ -1,7 +1,7 @@
USING: continuations xml xml.errors tools.test kernel arrays xml.data state-parser quotations ; USING: continuations xml xml.errors tools.test kernel arrays xml.data state-parser quotations ;
: xml-error-test ( expected-error xml-string -- ) : xml-error-test ( expected-error xml-string -- )
swap 1array >quotation swap [ [ string>xml ] catch nip ] curry unit-test ; [ string>xml ] curry swap [ = ] curry must-fail-with ;
T{ no-entity T{ parsing-error f 1 10 } "nbsp" } "<x>&nbsp;</x>" xml-error-test T{ no-entity T{ parsing-error f 1 10 } "nbsp" } "<x>&nbsp;</x>" xml-error-test
T{ mismatched T{ parsing-error f 1 8 } T{ name f "" "x" "" } T{ name f "" "y" "" } T{ mismatched T{ parsing-error f 1 8 } T{ name f "" "x" "" } T{ name f "" "y" "" }

View File

@ -17,7 +17,7 @@ SYMBOL: xml-file
xml-file get T{ name f "" "this" "http://d.de" } swap at xml-file get T{ name f "" "this" "http://d.de" } swap at
] unit-test ] unit-test
[ t ] [ xml-file get tag-children second contained-tag? ] unit-test [ t ] [ xml-file get tag-children second contained-tag? ] unit-test
[ t ] [ [ "<a></b>" string>xml ] catch xml-parse-error? ] unit-test [ "<a></b>" string>xml ] [ xml-parse-error? ] must-fail-with
[ T{ comment f "This is where the fun begins!" } ] [ [ T{ comment f "This is where the fun begins!" } ] [
xml-file get xml-before [ comment? ] find nip xml-file get xml-before [ comment? ] find nip
] unit-test ] unit-test