CONSTANT: xyz 123
-[ 492 ] [ { int xyz } heap-size ] unit-test
+{ 492 } [ { int xyz } heap-size ] unit-test
UNION-STRUCT: foo
{ a int }
{ b int } ;
-[ t ] [ pointer: void lookup-c-type void* lookup-c-type = ] unit-test
-[ t ] [ pointer: int lookup-c-type void* lookup-c-type = ] unit-test
-[ t ] [ pointer: int* lookup-c-type void* lookup-c-type = ] unit-test
-[ f ] [ pointer: foo lookup-c-type void* lookup-c-type = ] unit-test
-[ t ] [ pointer: foo* lookup-c-type void* lookup-c-type = ] unit-test
+{ t } [ pointer: void lookup-c-type void* lookup-c-type = ] unit-test
+{ t } [ pointer: int lookup-c-type void* lookup-c-type = ] unit-test
+{ t } [ pointer: int* lookup-c-type void* lookup-c-type = ] unit-test
+{ f } [ pointer: foo lookup-c-type void* lookup-c-type = ] unit-test
+{ t } [ pointer: foo* lookup-c-type void* lookup-c-type = ] unit-test
-[ t ] [ c-string lookup-c-type c-string lookup-c-type = ] unit-test
+{ t } [ c-string lookup-c-type c-string lookup-c-type = ] unit-test
-[ t ] [ foo heap-size int heap-size = ] unit-test
+{ t } [ foo heap-size int heap-size = ] unit-test
TYPEDEF: int MyInt
-[ t ] [ int lookup-c-type MyInt lookup-c-type = ] unit-test
-[ t ] [ void* lookup-c-type pointer: MyInt lookup-c-type = ] unit-test
+{ t } [ int lookup-c-type MyInt lookup-c-type = ] unit-test
+{ t } [ void* lookup-c-type pointer: MyInt lookup-c-type = ] unit-test
-[ 32 ] [ { int 8 } heap-size ] unit-test
+{ 32 } [ { int 8 } heap-size ] unit-test
-[ ] [ pointer: { int 8 } heap-size pointer: void heap-size assert= ] unit-test
+{ } [ pointer: { int 8 } heap-size pointer: void heap-size assert= ] unit-test
TYPEDEF: char MyChar
-[ t ] [ pointer: void lookup-c-type pointer: MyChar lookup-c-type = ] unit-test
+{ t } [ pointer: void lookup-c-type pointer: MyChar lookup-c-type = ] unit-test
TYPEDEF: { c-string ascii } MyFunkyString
-[ { c-string ascii } ] [ MyFunkyString lookup-c-type ] unit-test
+{ { c-string ascii } } [ MyFunkyString lookup-c-type ] unit-test
TYPEDEF: c-string MyString
-[ t ] [ c-string lookup-c-type MyString lookup-c-type = ] unit-test
-[ t ] [ void* lookup-c-type pointer: MyString lookup-c-type = ] unit-test
+{ t } [ c-string lookup-c-type MyString lookup-c-type = ] unit-test
+{ t } [ void* lookup-c-type pointer: MyString lookup-c-type = ] unit-test
TYPEDEF: int* MyIntArray
-[ t ] [ void* lookup-c-type MyIntArray lookup-c-type = ] unit-test
+{ t } [ void* lookup-c-type MyIntArray lookup-c-type = ] unit-test
-[ 0 ] [ -10 uchar c-type-clamp ] unit-test
-[ 12 ] [ 12 uchar c-type-clamp ] unit-test
-[ -10 ] [ -10 char c-type-clamp ] unit-test
-[ 127 ] [ 230 char c-type-clamp ] unit-test
-[ t ] [ pi dup float c-type-clamp = ] unit-test
+{ 0 } [ -10 uchar c-type-clamp ] unit-test
+{ 12 } [ 12 uchar c-type-clamp ] unit-test
+{ -10 } [ -10 char c-type-clamp ] unit-test
+{ 127 } [ 230 char c-type-clamp ] unit-test
+{ t } [ pi dup float c-type-clamp = ] unit-test
C-TYPE: opaque
-[ t ] [ void* lookup-c-type pointer: opaque lookup-c-type = ] unit-test
+{ t } [ void* lookup-c-type pointer: opaque lookup-c-type = ] unit-test
[ opaque lookup-c-type ] [ no-c-type? ] must-fail-with
[ """
STRUCT: backward { x forward* } ;
STRUCT: forward { x backward* } ;
-[ t ] [ forward lookup-c-type struct-c-type? ] unit-test
-[ t ] [ backward lookup-c-type struct-c-type? ] unit-test
+{ t } [ forward lookup-c-type struct-c-type? ] unit-test
+{ t } [ backward lookup-c-type struct-c-type? ] unit-test
DEFER: struct-redefined
-[ f ]
+{ f }
[
"""
: <complex-holder> ( z -- alien )
complex-holder <struct-boa> ;
-[ ] [
+{ } [
C{ 1.0 2.0 } <complex-holder> "h" set
] unit-test
-[ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
+{ C{ 1.0 2.0 } } [ "h" get z>> ] unit-test
-[ complex ] [ complex-float c-type-boxed-class ] unit-test
+{ complex } [ complex-float c-type-boxed-class ] unit-test
-[ complex ] [ complex-double c-type-boxed-class ] unit-test
+{ complex } [ complex-double c-type-boxed-class ] unit-test
QUALIFIED-WITH: alien.c-types c
IN: alien.data.tests
-[ -1 ] [ -1 c:char <ref> c:char deref ] unit-test
-[ -1 ] [ -1 c:short <ref> c:short deref ] unit-test
-[ -1 ] [ -1 c:int <ref> c:int deref ] unit-test
+{ -1 } [ -1 c:char <ref> c:char deref ] unit-test
+{ -1 } [ -1 c:short <ref> c:short deref ] unit-test
+{ -1 } [ -1 c:int <ref> c:int deref ] unit-test
! I don't care if this throws an error or works, but at least
! it should be consistent between platforms
-[ -1 ] [ -1.0 c:int <ref> c:int deref ] unit-test
-[ -1 ] [ -1.0 c:long <ref> c:long deref ] unit-test
-[ -1 ] [ -1.0 c:longlong <ref> c:longlong deref ] unit-test
-[ 1 ] [ 1.0 c:uint <ref> c:uint deref ] unit-test
-[ 1 ] [ 1.0 c:ulong <ref> c:ulong deref ] unit-test
-[ 1 ] [ 1.0 c:ulonglong <ref> c:ulonglong deref ] unit-test
+{ -1 } [ -1.0 c:int <ref> c:int deref ] unit-test
+{ -1 } [ -1.0 c:long <ref> c:long deref ] unit-test
+{ -1 } [ -1.0 c:longlong <ref> c:longlong deref ] unit-test
+{ 1 } [ 1.0 c:uint <ref> c:uint deref ] unit-test
+{ 1 } [ 1.0 c:ulong <ref> c:ulong deref ] unit-test
+{ 1 } [ 1.0 c:ulonglong <ref> c:ulonglong deref ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> c:void* <ref>
SPECIALIZED-ARRAY: foo
-[ t ] [ 0 binary-zero? ] unit-test
-[ f ] [ 1 binary-zero? ] unit-test
-[ f ] [ -1 binary-zero? ] unit-test
-[ t ] [ 0.0 binary-zero? ] unit-test
-[ f ] [ 1.0 binary-zero? ] unit-test
-[ f ] [ -0.0 binary-zero? ] unit-test
-[ t ] [ C{ 0.0 0.0 } binary-zero? ] unit-test
-[ f ] [ C{ 1.0 0.0 } binary-zero? ] unit-test
-[ f ] [ C{ -0.0 0.0 } binary-zero? ] unit-test
-[ f ] [ C{ 0.0 1.0 } binary-zero? ] unit-test
-[ f ] [ C{ 0.0 -0.0 } binary-zero? ] unit-test
-[ t ] [ f binary-zero? ] unit-test
-
[ t ] [ 0 <alien> binary-zero? ] unit-test
-
[ f ] [ 1 <alien> binary-zero? ] unit-test
-[ f ] [ B{ } binary-zero? ] unit-test
-[ t ] [ S{ foo f 0 f f } binary-zero? ] unit-test
-[ f ] [ S{ foo f 1 f f } binary-zero? ] unit-test
-[ f ] [ S{ foo f 0 ALIEN: 8 f } binary-zero? ] unit-test
-[ f ] [ S{ foo f 0 f t } binary-zero? ] unit-test
-[ t t f ] [
+{ t } [ 0 binary-zero? ] unit-test
+{ f } [ 1 binary-zero? ] unit-test
+{ f } [ -1 binary-zero? ] unit-test
+{ t } [ 0.0 binary-zero? ] unit-test
+{ f } [ 1.0 binary-zero? ] unit-test
+{ f } [ -0.0 binary-zero? ] unit-test
+{ t } [ C{ 0.0 0.0 } binary-zero? ] unit-test
+{ f } [ C{ 1.0 0.0 } binary-zero? ] unit-test
+{ f } [ C{ -0.0 0.0 } binary-zero? ] unit-test
+{ f } [ C{ 0.0 1.0 } binary-zero? ] unit-test
+{ f } [ C{ 0.0 -0.0 } binary-zero? ] unit-test
+{ t } [ f binary-zero? ] unit-test
+
{ t } [ 0 <alien> binary-zero? ] unit-test
+
{ f } [ 1 <alien> binary-zero? ] unit-test
+{ f } [ B{ } binary-zero? ] unit-test
+{ t } [ S{ foo f 0 f f } binary-zero? ] unit-test
+{ f } [ S{ foo f 1 f f } binary-zero? ] unit-test
+{ f } [ S{ foo f 0 ALIEN: 8 f } binary-zero? ] unit-test
+{ f } [ S{ foo f 0 f t } binary-zero? ] unit-test
+{ t t f } [
foo-array{
S{ foo f 0 f f }
S{ foo f 0 f f }
} [ first binary-zero? ] [ second binary-zero? ] [ third binary-zero? ] tri
] unit-test
-[ ] [
+{ } [
[
foo specialized-array-vocab forget-vocab
] with-compilation-unit
: endian-test-struct-f0 ( -- obj )
endian-bytes-f0 endian-struct memory>struct ;
-[ 0xff00 ] [ endian-test-struct-0f a>> ] unit-test
-[ -256 ] [ endian-test-struct-0f b>> ] unit-test
-[ 0x00ff ] [ endian-test-struct-0f c>> ] unit-test
-[ 0x00ff ] [ endian-test-struct-0f d>> ] unit-test
-
-[ 0xff000000 ] [ endian-test-struct-0f e>> ] unit-test
-[ -16777216 ] [ endian-test-struct-0f f>> ] unit-test
-[ 0x000000ff ] [ endian-test-struct-0f g>> ] unit-test
-[ 0x000000ff ] [ endian-test-struct-0f h>> ] unit-test
-
-[ 0xff00000000000000 ] [ endian-test-struct-0f i>> ] unit-test
-[ -72057594037927936 ] [ endian-test-struct-0f j>> ] unit-test
-[ 0x00000000000000ff ] [ endian-test-struct-0f k>> ] unit-test
-[ 0x00000000000000ff ] [ endian-test-struct-0f l>> ] unit-test
-
-
-[ 0xff00 ] [ endian-test-struct-f0 c>> ] unit-test
-[ -256 ] [ endian-test-struct-f0 d>> ] unit-test
-[ 0x00ff ] [ endian-test-struct-f0 a>> ] unit-test
-[ 0x00ff ] [ endian-test-struct-f0 b>> ] unit-test
-
-[ 0xff000000 ] [ endian-test-struct-f0 g>> ] unit-test
-[ -16777216 ] [ endian-test-struct-f0 h>> ] unit-test
-[ 0x000000ff ] [ endian-test-struct-f0 e>> ] unit-test
-[ 0x000000ff ] [ endian-test-struct-f0 f>> ] unit-test
-
-[ 0xff00000000000000 ] [ endian-test-struct-f0 k>> ] unit-test
-[ -72057594037927936 ] [ endian-test-struct-f0 l>> ] unit-test
-[ 0x00000000000000ff ] [ endian-test-struct-f0 i>> ] unit-test
-[ 0x00000000000000ff ] [ endian-test-struct-f0 j>> ] unit-test
-
-[ t ]
+{ 0xff00 } [ endian-test-struct-0f a>> ] unit-test
+{ -256 } [ endian-test-struct-0f b>> ] unit-test
+{ 0x00ff } [ endian-test-struct-0f c>> ] unit-test
+{ 0x00ff } [ endian-test-struct-0f d>> ] unit-test
+
+{ 0xff000000 } [ endian-test-struct-0f e>> ] unit-test
+{ -16777216 } [ endian-test-struct-0f f>> ] unit-test
+{ 0x000000ff } [ endian-test-struct-0f g>> ] unit-test
+{ 0x000000ff } [ endian-test-struct-0f h>> ] unit-test
+
+{ 0xff00000000000000 } [ endian-test-struct-0f i>> ] unit-test
+{ -72057594037927936 } [ endian-test-struct-0f j>> ] unit-test
+{ 0x00000000000000ff } [ endian-test-struct-0f k>> ] unit-test
+{ 0x00000000000000ff } [ endian-test-struct-0f l>> ] unit-test
+
+
+{ 0xff00 } [ endian-test-struct-f0 c>> ] unit-test
+{ -256 } [ endian-test-struct-f0 d>> ] unit-test
+{ 0x00ff } [ endian-test-struct-f0 a>> ] unit-test
+{ 0x00ff } [ endian-test-struct-f0 b>> ] unit-test
+
+{ 0xff000000 } [ endian-test-struct-f0 g>> ] unit-test
+{ -16777216 } [ endian-test-struct-f0 h>> ] unit-test
+{ 0x000000ff } [ endian-test-struct-f0 e>> ] unit-test
+{ 0x000000ff } [ endian-test-struct-f0 f>> ] unit-test
+
+{ 0xff00000000000000 } [ endian-test-struct-f0 k>> ] unit-test
+{ -72057594037927936 } [ endian-test-struct-f0 l>> ] unit-test
+{ 0x00000000000000ff } [ endian-test-struct-f0 i>> ] unit-test
+{ 0x00000000000000ff } [ endian-test-struct-f0 j>> ] unit-test
+
+{ t }
[ endian-test-struct-0f binary [ write ] with-byte-writer endian-bytes-0f = ] unit-test
-[ t ]
+{ t }
[ endian-test-struct-f0 binary [ write ] with-byte-writer endian-bytes-f0 = ] unit-test
LE-STRUCT: le-endian-struct
{ k ube64 }
{ l be64 } ;
-[ t ]
+{ t }
[
endian-bytes-0f le-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
-[ t ]
+{ t }
[
endian-bytes-f0 le-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
{ k ube64 }
{ l be64 } ;
-[ t ]
+{ t }
[
endian-bytes-0f be-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
-[ t ]
+{ t }
[
endian-bytes-f0 be-endian-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
{ k ube64 }
{ l be64 } ;
-[ t ]
+{ t }
[
endian-bytes-0f le-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
-[ t ]
+{ t }
[
endian-bytes-f0 le-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
{ k ulonglong }
{ l longlong } ;
-[ t ]
+{ t }
[
endian-bytes-0f be-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-0f =
] unit-test
-[ t ]
+{ t }
[
endian-bytes-f0 be-override-struct memory>struct
binary [ write ] with-byte-writer endian-bytes-f0 =
{ a char[7] }
{ b int } ;
-[ t ]
+{ t }
[
B{ 0 0 0 0 0 0 0 3 0 0 0 } [
le-packed-struct memory>struct
] keep =
] unit-test
-[ 3 ]
+{ 3 }
[
B{ 0 0 0 0 0 0 0 3 0 0 0 } le-packed-struct memory>struct
b>>
{ a char[7] }
{ b int } ;
-[ t ]
+{ t }
[
B{ 0 0 0 0 0 0 0 0 0 0 3 } [
be-packed-struct memory>struct
] keep =
] unit-test
-[ 3 ]
+{ 3 }
[
B{ 0 0 0 0 0 0 0 0 0 0 3 } be-packed-struct memory>struct
b>>
ENUM: colores { rojo red } { verde green } { azul blue } { colorado rojo } ;
-[ { 0 3 4 0 } ] [ { rojo verde azul colorado } [ enum>number ] map ] unit-test
+{ { 0 3 4 0 } } [ { rojo verde azul colorado } [ enum>number ] map ] unit-test
SYMBOLS: couleurs rouge vert bleu jaune azure ;
{ azure bleu }
} define-enum >>
-[ { 0 3 4 14 4 } ] [ { rouge vert bleu jaune azure } [ enum>number ] map ] unit-test
+{ { 0 3 4 14 4 } } [ { rouge vert bleu jaune azure } [ enum>number ] map ] unit-test
USING: alien alien.libraries alien.syntax tools.test kernel ;
IN: alien.libraries.tests
-[ f ] [ DLL" fadfasdfsada" dll-valid? ] unit-test
+{ f } [ DLL" fadfasdfsada" dll-valid? ] unit-test
-[ f ] [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
+{ f } [ "does not exist" DLL" fadsfasfdsaf" dlsym ] unit-test
-[ ] [ "doesnotexist" dlopen dlclose ] unit-test
+{ } [ "doesnotexist" dlopen dlclose ] unit-test
[ "fdasfsf" dll-valid? drop ] must-fail
-[ t ] [
+{ t } [
"test-library" "blah" cdecl add-library
"test-library" "BLAH" cdecl add-library?
"blah" remove-library
] unit-test
-[ t ] [
+{ t } [
"test-library" "blah" cdecl add-library
"test-library" "blah" stdcall add-library?
"blah" remove-library
] unit-test
-[ f ] [
+{ f } [
"test-library" "blah" cdecl add-library
"test-library" "blah" cdecl add-library?
"blah" remove-library
USING: ascii tools.test sequences kernel math strings ;
IN: ascii.tests
-[ t ] [ CHAR: a letter? ] unit-test
-[ f ] [ CHAR: A letter? ] unit-test
-[ f ] [ CHAR: a LETTER? ] unit-test
-[ t ] [ CHAR: A LETTER? ] unit-test
-[ t ] [ CHAR: 0 digit? ] unit-test
-[ f ] [ CHAR: x digit? ] unit-test
+{ t } [ CHAR: a letter? ] unit-test
+{ f } [ CHAR: A letter? ] unit-test
+{ f } [ CHAR: a LETTER? ] unit-test
+{ t } [ CHAR: A LETTER? ] unit-test
+{ t } [ CHAR: 0 digit? ] unit-test
+{ f } [ CHAR: x digit? ] unit-test
-[ 4 ] [
+{ 4 } [
0 "There are Four Upper Case characters"
[ LETTER? [ 1 + ] when ] each
] unit-test
-[ t f ] [ CHAR: \s ascii? 400 ascii? ] unit-test
+{ t f } [ CHAR: \s ascii? 400 ascii? ] unit-test
-[ "HELLO HOW ARE YOU?" ] [ "hellO hOw arE YOU?" >upper ] unit-test
-[ "i'm good thx bai" ] [ "I'm Good THX bai" >lower ] unit-test
+{ "HELLO HOW ARE YOU?" } [ "hellO hOw arE YOU?" >upper ] unit-test
+{ "i'm good thx bai" } [ "I'm Good THX bai" >lower ] unit-test
-[ "Hello How Are You?" ] [ "hEllo how ARE yOU?" >title ] unit-test
-[ { " " "Hello" " " " " " " "World" } ] [ " Hello World" >words [ >string ] map ] unit-test
+{ "Hello How Are You?" } [ "hEllo how ARE yOU?" >title ] unit-test
+{ { " " "Hello" " " " " " " "World" } } [ " Hello World" >words [ >string ] map ] unit-test
io.encodings.string io.encodings.ascii ;
IN: base64.tests
-[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
+{ "abcdefghijklmnopqrstuvwxyz" } [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
] unit-test
-[ "" ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
-[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
-[ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
-[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
-[ "abcde" ] [ "abcde" ascii encode >base64 3 cut "\r\n" swap 3append base64> ascii decode ] unit-test
+{ "" } [ "" ascii encode >base64 base64> ascii decode ] unit-test
+{ "a" } [ "a" ascii encode >base64 base64> ascii decode ] unit-test
+{ "ab" } [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
+{ "abc" } [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
+{ "abcde" } [ "abcde" ascii encode >base64 3 cut "\r\n" swap 3append base64> ascii decode ] unit-test
! From http://en.wikipedia.org/wiki/Base64
-[ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
+{ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" }
[
"Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
ascii encode >base64 >string
] unit-test
-[ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
+{ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" }
[
"Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
ascii encode >base64-lines >string
<bihash> "h" set
-[ 0 ] [ "h" get assoc-size ] unit-test
+{ 0 } [ "h" get assoc-size ] unit-test
-[ ] [ 1 2 "h" get set-at ] unit-test
+{ } [ 1 2 "h" get set-at ] unit-test
-[ 1 ] [ 2 "h" get at ] unit-test
+{ 1 } [ 2 "h" get at ] unit-test
-[ 2 ] [ 1 "h" get value-at ] unit-test
+{ 2 } [ 1 "h" get value-at ] unit-test
-[ 1 ] [ "h" get assoc-size ] unit-test
+{ 1 } [ "h" get assoc-size ] unit-test
-[ ] [ 1 3 "h" get set-at ] unit-test
+{ } [ 1 3 "h" get set-at ] unit-test
-[ 1 ] [ 3 "h" get at ] unit-test
+{ 1 } [ 3 "h" get at ] unit-test
-[ 2 ] [ 1 "h" get value-at ] unit-test
+{ 2 } [ 1 "h" get value-at ] unit-test
-[ 2 ] [ "h" get assoc-size ] unit-test
+{ 2 } [ "h" get assoc-size ] unit-test
H{ { "a" "A" } { "b" "B" } } "a" set
-[ ] [ "a" get >biassoc "b" set ] unit-test
+{ } [ "a" get >biassoc "b" set ] unit-test
-[ t ] [ "b" get biassoc? ] unit-test
+{ t } [ "b" get biassoc? ] unit-test
-[ "A" ] [ "a" "b" get at ] unit-test
+{ "A" } [ "a" "b" get at ] unit-test
-[ "a" ] [ "A" "b" get value-at ] unit-test
+{ "a" } [ "A" "b" get value-at ] unit-test
-[ ] [ H{ { 1 2 } } >biassoc "h" set ] unit-test
+{ } [ H{ { 1 2 } } >biassoc "h" set ] unit-test
-[ ] [ "h" get clone "g" set ] unit-test
+{ } [ "h" get clone "g" set ] unit-test
-[ ] [ 3 4 "g" get set-at ] unit-test
+{ } [ 3 4 "g" get set-at ] unit-test
-[ H{ { 1 2 } } ] [ "h" get >hashtable ] unit-test
+{ H{ { 1 2 } } } [ "h" get >hashtable ] unit-test
-[ H{ { 1 2 } { 4 3 } } ] [ "g" get >hashtable ] unit-test
+{ H{ { 1 2 } { 4 3 } } } [ "g" get >hashtable ] unit-test
USING: binary-search math.order sequences kernel tools.test ;
IN: binary-search.tests
-[ f ] [ 3 { } [ <=> ] with search drop ] unit-test
-[ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
-[ 1 ] [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test
-[ 3 ] [ 4 { 1 2 3 4 5 6 } [ <=> ] with search drop ] unit-test
-[ 2 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
-[ 4 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
-[ 10 ] [ 10 20 iota [ <=> ] with search drop ] unit-test
+{ f } [ 3 { } [ <=> ] with search drop ] unit-test
+{ 0 } [ 3 { 3 } [ <=> ] with search drop ] unit-test
+{ 1 } [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test
+{ 3 } [ 4 { 1 2 3 4 5 6 } [ <=> ] with search drop ] unit-test
+{ 2 } [ 3.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
+{ 4 } [ 5.5 { 1 2 3 4 5 6 7 8 } [ <=> ] with search drop ] unit-test
+{ 10 } [ 10 20 iota [ <=> ] with search drop ] unit-test
-[ 0 ] [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
-[ 3 ] [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
-[ 5 ] [ "java" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
-[ t ] [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
-[ f ] [ "hello" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
-[ f ] [ "zebra" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
+{ 0 } [ "alligator" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
+{ 3 } [ "hey" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
+{ 5 } [ "java" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-index ] unit-test
+{ t } [ "hello" { "alligator" "cat" "fish" "hello" "ikarus" "java" } sorted-member? ] unit-test
+{ f } [ "hello" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
+{ f } [ "zebra" { "alligator" "cat" "fish" "ikarus" "java" } sorted-member? ] unit-test
[ -1 <bit-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
-[ 100 ] [ 100 <bit-array> length ] unit-test
+{ 100 } [ 100 <bit-array> length ] unit-test
-[
+{
{ t f t }
-] [
+} [
3 <bit-array> t 0 pick set-nth t 2 pick set-nth
>array
] unit-test
-[
+{
{ t f t }
-] [
+} [
{ t f t } >bit-array >array
] unit-test
-[
+{
{ t f t } { f t f }
-] [
+} [
{ t f t } >bit-array dup clone [ not ] map!
[ >array ] bi@
] unit-test
-[
+{
{ f f f f f }
-] [
+} [
{ t f t t f } >bit-array dup clear-bits >array
] unit-test
-[
+{
{ t t t t t }
-] [
+} [
{ t f t t f } >bit-array dup set-bits >array
] unit-test
-[ t ] [
+{ t } [
100 [
drop 100 [ 2 random zero? ] replicate
dup >bit-array >array =
] all-integers?
] unit-test
-[ ?{ f } ] [
+{ ?{ f } } [
1 2 { t f t f } <slice> >bit-array
] unit-test
-[ ?{ f t } ] [ 0 2 ?{ f t f } subseq ] unit-test
+{ ?{ f t } } [ 0 2 ?{ f t f } subseq ] unit-test
-[ ?{ t f t f f f } ] [ 6 ?{ t f t } resize ] unit-test
+{ ?{ t f t f f f } } [ 6 ?{ t f t } resize ] unit-test
-[ ?{ t t } ] [ 2 ?{ t t f t f t f t t t f t } resize ] unit-test
+{ ?{ t t } } [ 2 ?{ t t f t f t f t t t f t } resize ] unit-test
[ -10 ?{ } resize ] must-fail
[ -1 integer>bit-array ] must-fail
-[ ?{ } ] [ 0 integer>bit-array ] unit-test
-[ ?{ f t } ] [ 2 integer>bit-array ] unit-test
-[ ?{ t t t t t t t t t } ] [ 511 integer>bit-array ] unit-test
-[ ?{
+{ ?{ } } [ 0 integer>bit-array ] unit-test
+{ ?{ f t } } [ 2 integer>bit-array ] unit-test
+{ ?{ t t t t t t t t t } } [ 511 integer>bit-array ] unit-test
+{ ?{
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
-} ] [
+} } [
0xffffffffffffffffffffffffffffffff integer>bit-array
] unit-test
-[ 14 ] [ ?{ f t t t } bit-array>integer ] unit-test
-[ 0 ] [ ?{ } bit-array>integer ] unit-test
-[ 0xffffffffffffffffffffffffffffffff ] [ ?{
+{ 14 } [ ?{ f t t t } bit-array>integer ] unit-test
+{ 0 } [ ?{ } bit-array>integer ] unit-test
+{ 0xffffffffffffffffffffffffffffffff } [ ?{
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t t
} bit-array>integer ] unit-test
-[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test
+{ 49 } [ 49 <bit-array> dup set-bits [ ] count ] unit-test
-[ 1 ] [ ?{ f t f t } byte-length ] unit-test
+{ 1 } [ ?{ f t f t } byte-length ] unit-test
-[ 0xa ] [ ?{ f t f t } bit-array>integer ] unit-test
+{ 0xa } [ ?{ f t f t } bit-array>integer ] unit-test
-[ 0x100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test
+{ 0x100 } [ ?{ f f f f f f f f t } bit-array>integer ] unit-test
USING: bit-sets tools.test sets kernel bit-arrays ;
IN: bit-sets.tests
-[ T{ bit-set f ?{ t f t f t f } } ] [
+{ T{ bit-set f ?{ t f t f t f } } } [
T{ bit-set f ?{ t f f f t f } }
T{ bit-set f ?{ f f t f t f } } union
] unit-test
-[ T{ bit-set f ?{ f f f f t f } } ] [
+{ T{ bit-set f ?{ f f f f t f } } } [
T{ bit-set f ?{ t f f f t f } }
T{ bit-set f ?{ f f t f t f } } intersect
] unit-test
-[ f ] [ T{ bit-set f ?{ t f f f t f } } null? ] unit-test
-[ t ] [ T{ bit-set f ?{ f f f f f f } } null? ] unit-test
+{ f } [ T{ bit-set f ?{ t f f f t f } } null? ] unit-test
+{ t } [ T{ bit-set f ?{ f f f f f f } } null? ] unit-test
-[ T{ bit-set f ?{ t f t f f f } } ] [
+{ T{ bit-set f ?{ t f t f f f } } } [
T{ bit-set f ?{ t t t f f f } }
T{ bit-set f ?{ f t f f t t } } diff
] unit-test
-[ f ] [
+{ f } [
T{ bit-set f ?{ t t t f f f } }
T{ bit-set f ?{ f t f f t t } } subset?
] unit-test
-[ t ] [
+{ t } [
T{ bit-set f ?{ t t t f f f } }
T{ bit-set f ?{ f t f f f f } } subset?
] unit-test
-[ t ] [
+{ t } [
{ 0 1 2 }
T{ bit-set f ?{ f t f f f f } } subset?
] unit-test
-[ f ] [
+{ f } [
T{ bit-set f ?{ f t f f f f } }
T{ bit-set f ?{ t t t f f f } } subset?
] unit-test
-[ f ] [
+{ f } [
{ 1 }
T{ bit-set f ?{ t t t f f f } } subset?
] unit-test
-[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } members ] unit-test
+{ V{ 0 2 5 } } [ T{ bit-set f ?{ t f t f f t } } members ] unit-test
-[ t V{ 1 2 3 } ] [
+{ t V{ 1 2 3 } } [
{ 1 2 } 5 <bit-set> set-like
[ bit-set? ] keep
3 over adjoin
members
] unit-test
-[ V{ 0 1 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap adjoin ] keep members ] unit-test
+{ V{ 0 1 2 5 } } [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap adjoin ] keep members ] unit-test
[ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap adjoin ] keep members ] must-fail
[ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap adjoin ] keep members ] must-fail
-[ V{ 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 0 swap delete ] keep members ] unit-test
-[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep members ] unit-test
-[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep members ] unit-test
-[ V{ 0 2 5 } ] [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep members ] unit-test
+{ V{ 2 5 } } [ T{ bit-set f ?{ t f t f f t } } clone [ 0 swap delete ] keep members ] unit-test
+{ V{ 0 2 5 } } [ T{ bit-set f ?{ t f t f f t } } clone [ 1 swap delete ] keep members ] unit-test
+{ V{ 0 2 5 } } [ T{ bit-set f ?{ t f t f f t } } clone [ 9 swap delete ] keep members ] unit-test
+{ V{ 0 2 5 } } [ T{ bit-set f ?{ t f t f f t } } clone [ "foo" swap delete ] keep members ] unit-test
-[ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } ]
+{ T{ bit-set f ?{ f } } T{ bit-set f ?{ t } } }
[ 1 <bit-set> dup clone 0 over adjoin ] unit-test
-[ 0 ] [ T{ bit-set f ?{ } } cardinality ] unit-test
-[ 0 ] [ T{ bit-set f ?{ f f f f } } cardinality ] unit-test
-[ 1 ] [ T{ bit-set f ?{ f t f f } } cardinality ] unit-test
-[ 2 ] [ T{ bit-set f ?{ f t f t } } cardinality ] unit-test
+{ 0 } [ T{ bit-set f ?{ } } cardinality ] unit-test
+{ 0 } [ T{ bit-set f ?{ f f f f } } cardinality ] unit-test
+{ 1 } [ T{ bit-set f ?{ f t f f } } cardinality ] unit-test
+{ 2 } [ T{ bit-set f ?{ f t f t } } cardinality ] unit-test
USING: tools.test bit-vectors vectors sequences kernel math ;
IN: bit-vectors.tests
-[ 0 ] [ 123 <bit-vector> length ] unit-test
+{ 0 } [ 123 <bit-vector> length ] unit-test
: do-it ( seq -- )
1234 swap [ [ even? ] dip push ] curry each-integer ;
-[ t ] [
+{ t } [
3 <bit-vector> dup do-it
3 <vector> dup do-it sequence=
] unit-test
-[ t ] [ ?V{ } bit-vector? ] unit-test
+{ t } [ ?V{ } bit-vector? ] unit-test
io.streams.byte-array ;
IN: bitstreams.tests
-[ 0b1111111111 ]
+{ 0b1111111111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
10 swap peek
] unit-test
-[ 0b111111111 ]
+{ 0b111111111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
9 swap peek
] unit-test
-[ 0b11111111 ]
+{ 0b11111111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
8 swap peek
] unit-test
-[ 0b1111111 ]
+{ 0b1111111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
7 swap peek
] unit-test
-[ 0b111111 ]
+{ 0b111111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
6 swap peek
] unit-test
-[ 0b11111 ]
+{ 0b11111 }
[
B{ 0x0f 0xff 0xff 0xff } <msb0-bit-reader>
2 >>byte-pos 6 >>bit-pos
[ B{ } <msb0-bit-reader> 1 swap peek ] must-fail
[ B{ } <msb0-bit-reader> 8 swap peek ] must-fail
-[ 0 ] [ B{ } <msb0-bit-reader> 0 swap peek ] unit-test
+{ 0 } [ B{ } <msb0-bit-reader> 0 swap peek ] unit-test
USING: boxes namespaces tools.test accessors ;
IN: boxes.tests
-[ ] [ <box> "b" set ] unit-test
+{ } [ <box> "b" set ] unit-test
-[ ] [ 3 "b" get >box ] unit-test
+{ } [ 3 "b" get >box ] unit-test
-[ t ] [ "b" get occupied>> ] unit-test
+{ t } [ "b" get occupied>> ] unit-test
[ 4 "b" >box ] must-fail
-[ 3 ] [ "b" get box> ] unit-test
+{ 3 } [ "b" get box> ] unit-test
-[ f ] [ "b" get occupied>> ] unit-test
+{ f } [ "b" get occupied>> ] unit-test
[ "b" get box> ] must-fail
-[ f f ] [ "b" get ?box ] unit-test
+{ f f } [ "b" get ?box ] unit-test
-[ ] [ 12 "b" get >box ] unit-test
+{ } [ 12 "b" get >box ] unit-test
-[ 12 t ] [ "b" get ?box ] unit-test
+{ 12 t } [ "b" get ?box ] unit-test
-[ f ] [ "b" get occupied>> ] unit-test
+{ f } [ "b" get occupied>> ] unit-test
M: mock-disposable dispose* drop ;
-[ ] [ <cache-assoc> "cache" set ] unit-test
+{ } [ <cache-assoc> "cache" set ] unit-test
-[ 0 ] [ "cache" get assoc-size ] unit-test
+{ 0 } [ "cache" get assoc-size ] unit-test
-[ ] [ "cache" get 2 >>max-age drop ] unit-test
+{ } [ "cache" get 2 >>max-age drop ] unit-test
-[ ] [ 1 <mock-disposable> dup "a" set 2 "cache" get set-at ] unit-test
+{ } [ 1 <mock-disposable> dup "a" set 2 "cache" get set-at ] unit-test
-[ 1 ] [ "cache" get assoc-size ] unit-test
+{ 1 } [ "cache" get assoc-size ] unit-test
-[ ] [ "cache" get purge-cache ] unit-test
+{ } [ "cache" get purge-cache ] unit-test
-[ ] [ 2 <mock-disposable> 3 "cache" get set-at ] unit-test
+{ } [ 2 <mock-disposable> 3 "cache" get set-at ] unit-test
-[ 2 ] [ "cache" get assoc-size ] unit-test
+{ 2 } [ "cache" get assoc-size ] unit-test
-[ ] [ "cache" get purge-cache ] unit-test
+{ } [ "cache" get purge-cache ] unit-test
-[ 1 ] [ "cache" get assoc-size ] unit-test
+{ 1 } [ "cache" get assoc-size ] unit-test
-[ ] [ 3 <mock-disposable> dup "b" set 4 "cache" get set-at ] unit-test
+{ } [ 3 <mock-disposable> dup "b" set 4 "cache" get set-at ] unit-test
-[ 2 ] [ "cache" get assoc-size ] unit-test
+{ 2 } [ "cache" get assoc-size ] unit-test
-[ ] [ "cache" get purge-cache ] unit-test
+{ } [ "cache" get purge-cache ] unit-test
-[ 1 ] [ "cache" get assoc-size ] unit-test
+{ 1 } [ "cache" get assoc-size ] unit-test
-[ f ] [ 2 "cache" get key? ] unit-test
+{ f } [ 2 "cache" get key? ] unit-test
-[ 3 ] [ 4 "cache" get at n>> ] unit-test
+{ 3 } [ 4 "cache" get at n>> ] unit-test
-[ t ] [ "a" get disposed>> ] unit-test
+{ t } [ "a" get disposed>> ] unit-test
-[ f ] [ "b" get disposed>> ] unit-test
+{ f } [ "b" get disposed>> ] unit-test
-[ ] [ "cache" get clear-assoc ] unit-test
+{ } [ "cache" get clear-assoc ] unit-test
-[ t ] [ "b" get disposed>> ] unit-test
+{ t } [ "b" get disposed>> ] unit-test
USING: cairo tools.test math.rectangles accessors ;
IN: cairo.tests
-[ { 10 20 } ] [
+{ { 10 20 } } [
{ 10 20 } [
{ 0 1 } { 3 4 } <rect> fill-rect
] make-bitmap-image dim>>
random ;
IN: calendar.tests
-[ f ] [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 2 30 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2003 2 29 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 -2 9 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12 0 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12 1 24 0 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12 1 23 60 0 instant <timestamp> valid-timestamp? ] unit-test
-[ f ] [ 2004 12 1 23 59 60 instant <timestamp> valid-timestamp? ] unit-test
-[ t ] [ now valid-timestamp? ] unit-test
-
-[ f ] [ 1900 leap-year? ] unit-test
-[ t ] [ 1904 leap-year? ] unit-test
-[ t ] [ 2000 leap-year? ] unit-test
-[ f ] [ 2001 leap-year? ] unit-test
-[ f ] [ 2006 leap-year? ] unit-test
-
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 1 seconds time+
+{ f } [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 2 30 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2003 2 29 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 -2 9 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 12 0 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 12 1 24 0 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 12 1 23 60 0 instant <timestamp> valid-timestamp? ] unit-test
+{ f } [ 2004 12 1 23 59 60 instant <timestamp> valid-timestamp? ] unit-test
+{ t } [ now valid-timestamp? ] unit-test
+
+{ f } [ 1900 leap-year? ] unit-test
+{ t } [ 1904 leap-year? ] unit-test
+{ t } [ 2000 leap-year? ] unit-test
+{ f } [ 2001 leap-year? ] unit-test
+{ f } [ 2006 leap-year? ] unit-test
+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 1 seconds time+
2006 10 10 0 0 1 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 100 seconds time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 100 seconds time+
2006 10 10 0 1 40 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -100 seconds time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> -100 seconds time+
2006 10 9 23 58 20 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 86400 seconds time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 86400 seconds time+
2006 10 11 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 10 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 10 minutes time+
2006 10 10 0 10 0 instant <timestamp> = ] unit-test
-[ +eq+ ] [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
+{ +eq+ } [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
2006 10 10 0 10 30 instant <timestamp> <=> ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 3/4 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 3/4 minutes time+
2006 10 10 0 0 45 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -3/4 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> -3/4 minutes time+
2006 10 9 23 59 15 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 7200 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> 7200 minutes time+
2006 10 15 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -10 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> -10 minutes time+
2006 10 9 23 50 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> -100 minutes time+
+{ t } [ 2006 10 10 0 0 0 instant <timestamp> -100 minutes time+
2006 10 9 22 20 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 hours time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 1 hours time+
2006 1 1 1 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 24 hours time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 24 hours time+
2006 1 2 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -24 hours time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -24 hours time+
2005 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 12 hours time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 12 hours time+
2006 1 1 12 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 72 hours time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 72 hours time+
2006 1 4 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 days time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 1 days time+
2006 1 2 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 days time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -1 days time+
2005 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 365 days time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 365 days time+
2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -365 days time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -365 days time+
2005 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 365 days time+
+{ t } [ 2004 1 1 0 0 0 instant <timestamp> 365 days time+
2004 12 31 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 366 days time+
+{ t } [ 2004 1 1 0 0 0 instant <timestamp> 366 days time+
2005 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 11 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 11 months time+
2006 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 12 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 12 months time+
2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 24 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 24 months time+
2008 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 13 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 13 months time+
2007 2 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 1 months time+
2006 2 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 0 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 0 months time+
2006 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -1 months time+
2005 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -2 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -2 months time+
2005 11 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -13 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -13 months time+
2004 12 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -24 months time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -24 months time+
2004 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 2 29 0 0 0 instant <timestamp> 12 months time+
+{ t } [ 2004 2 29 0 0 0 instant <timestamp> 12 months time+
2005 3 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 2 29 0 0 0 instant <timestamp> -12 months time+
+{ t } [ 2004 2 29 0 0 0 instant <timestamp> -12 months time+
2003 3 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 0 years time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 0 years time+
2006 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> 1 years time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> 1 years time+
2007 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -1 years time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -1 years time+
2005 1 1 0 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 1 1 0 0 0 instant <timestamp> -100 years time+
+{ t } [ 2006 1 1 0 0 0 instant <timestamp> -100 years time+
1906 1 1 0 0 0 instant <timestamp> = ] unit-test
! [ t ] [ 2004 2 29 0 0 0 instant <timestamp> -1 years time+
! 2003 2 28 0 0 0 instant <timestamp> = ] unit-test
-[ 5 ] [ 2006 7 14 0 0 0 instant <timestamp> day-of-week ] unit-test
+{ 5 } [ 2006 7 14 0 0 0 instant <timestamp> day-of-week ] unit-test
-[ t ] [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 instant <timestamp> ] 3keep 0 0 0 instant <timestamp> = ] unit-test
+{ t } [ 2006 7 14 [ julian-day-number julian-day-number>date 0 0 0 instant <timestamp> ] 3keep 0 0 0 instant <timestamp> = ] unit-test
-[ 1 ] [ 2006 1 1 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 60 ] [ 2004 2 29 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 61 ] [ 2004 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 366 ] [ 2004 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 365 ] [ 2003 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ 60 ] [ 2003 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 1 } [ 2006 1 1 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 60 } [ 2004 2 29 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 61 } [ 2004 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 366 } [ 2004 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 365 } [ 2003 12 31 0 0 0 instant <timestamp> day-of-year ] unit-test
+{ 60 } [ 2003 3 1 0 0 0 instant <timestamp> day-of-year ] unit-test
-[ t ] [ 2004 12 31 0 0 0 instant <timestamp> dup = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 instant <timestamp> 10 seconds 5 years time+ time+
+{ t } [ 2004 12 31 0 0 0 instant <timestamp> dup = ] unit-test
+{ t } [ 2004 1 1 0 0 0 instant <timestamp> 10 seconds 5 years time+ time+
2009 1 1 0 0 10 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 0 0 0 instant <timestamp> -10 seconds -5 years time+ time+
+{ t } [ 2004 1 1 0 0 0 instant <timestamp> -10 seconds -5 years time+ time+
1998 12 31 23 59 50 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 23 0 0 12 hours <timestamp> >gmt
+{ t } [ 2004 1 1 23 0 0 12 hours <timestamp> >gmt
2004 1 1 11 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 5 0 0 -11 hours <timestamp> >gmt
+{ t } [ 2004 1 1 5 0 0 -11 hours <timestamp> >gmt
2004 1 1 16 0 0 instant <timestamp> = ] unit-test
-[ t ] [ 2004 1 1 23 0 0 9+1/2 hours <timestamp> >gmt
+{ t } [ 2004 1 1 23 0 0 9+1/2 hours <timestamp> >gmt
2004 1 1 13 30 0 instant <timestamp> = ] unit-test
-[ +eq+ ] [ 2004 1 1 13 30 0 instant <timestamp>
+{ +eq+ } [ 2004 1 1 13 30 0 instant <timestamp>
2004 1 1 12 30 0 -1 hours <timestamp> <=> ] unit-test
-[ +gt+ ] [ 2004 1 1 13 30 0 instant <timestamp>
+{ +gt+ } [ 2004 1 1 13 30 0 instant <timestamp>
2004 1 1 12 30 0 instant <timestamp> <=> ] unit-test
-[ +lt+ ] [ 2004 1 1 12 30 0 instant <timestamp>
+{ +lt+ } [ 2004 1 1 12 30 0 instant <timestamp>
2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
-[ +gt+ ] [ 2005 1 1 12 30 0 instant <timestamp>
+{ +gt+ } [ 2005 1 1 12 30 0 instant <timestamp>
2004 1 1 13 30 0 instant <timestamp> <=> ] unit-test
-[ t ] [ 0 micros>timestamp unix-1970 = ] unit-test
-[ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
-[ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
+{ t } [ 0 micros>timestamp unix-1970 = ] unit-test
+{ t } [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
+{ t } [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test
: checktime+ ( duration -- ? ) now dup clone [ rot time+ drop ] keep = ;
-[ t ] [ 5 seconds checktime+ ] unit-test
+{ t } [ 5 seconds checktime+ ] unit-test
-[ t ] [ 5 minutes checktime+ ] unit-test
+{ t } [ 5 minutes checktime+ ] unit-test
-[ t ] [ 5 hours checktime+ ] unit-test
+{ t } [ 5 hours checktime+ ] unit-test
-[ t ] [ 5 days checktime+ ] unit-test
+{ t } [ 5 days checktime+ ] unit-test
-[ t ] [ 5 weeks checktime+ ] unit-test
+{ t } [ 5 weeks checktime+ ] unit-test
-[ t ] [ 5 months checktime+ ] unit-test
+{ t } [ 5 months checktime+ ] unit-test
-[ t ] [ 5 years checktime+ ] unit-test
+{ t } [ 5 years checktime+ ] unit-test
-[ t ] [ now 50 milliseconds sleep now before? ] unit-test
-[ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
-[ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+{ t } [ now 50 milliseconds sleep now before? ] unit-test
+{ t } [ now 50 milliseconds sleep now swap after? ] unit-test
+{ t } [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
-[ 4 12 ] [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
-[ 4 2 ] [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
+{ 4 12 } [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
+{ 4 2 } [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
-[ f ] [ now dup midnight eq? ] unit-test
-[ f ] [ now dup easter eq? ] unit-test
-[ f ] [ now dup beginning-of-year eq? ] unit-test
+{ f } [ now dup midnight eq? ] unit-test
+{ f } [ now dup easter eq? ] unit-test
+{ f } [ now dup beginning-of-year eq? ] unit-test
-[ t ] [ 1325376000 unix-time>timestamp 2012 <year-gmt> = ] unit-test
-[ t ] [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
+{ t } [ 1325376000 unix-time>timestamp 2012 <year-gmt> = ] unit-test
+{ t } [ 1356998399 unix-time>timestamp 2013 <year-gmt> 1 seconds time- = ] unit-test
-[ t ] [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test
+{ t } [ 1500000000 random [ unix-time>timestamp timestamp>unix-time ] keep = ] unit-test
-[ t ] [
+{ t } [
2009 1 29 <date> 1 months time+
2009 3 1 <date> =
] unit-test
-[ t ] [
+{ t } [
2008 1 29 <date> 1 months time+
2008 2 29 <date> =
] unit-test
-[ 0 ]
+{ 0 }
[ gmt gmt-offset>> duration>seconds ] unit-test
strings tools.test ;
IN: circular.tests
-[ 0 ] [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
-[ 2 ] [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
+{ 0 } [ { 0 1 2 3 4 } <circular> 0 swap virtual@ drop ] unit-test
+{ 2 } [ { 0 1 2 3 4 } <circular> 2 swap virtual@ drop ] unit-test
-[ CHAR: t ] [ "test" <circular> 0 swap nth ] unit-test
-[ "test" ] [ "test" <circular> >string ] unit-test
+{ CHAR: t } [ "test" <circular> 0 swap nth ] unit-test
+{ "test" } [ "test" <circular> >string ] unit-test
-[ 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
-[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
-[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> [ rotate-circular ] keep [ rotate-circular ] keep [ ] like ] unit-test
-[ [ 2 3 1 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start [ ] like ] unit-test
-[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> 1 over change-circular-start 1 over change-circular-start [ ] like ] unit-test
-[ [ 3 1 2 ] ] [ { 1 2 3 } <circular> -100 over change-circular-start [ ] like ] unit-test
+{ [ 1 2 3 ] } [ { 1 2 3 } <circular> [ ] like ] unit-test
+{ [ 2 3 1 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ ] like ] unit-test
+{ [ 3 1 2 ] } [ { 1 2 3 } <circular> [ rotate-circular ] keep [ rotate-circular ] keep [ ] like ] unit-test
+{ [ 2 3 1 ] } [ { 1 2 3 } <circular> 1 over change-circular-start [ ] like ] unit-test
+{ [ 3 1 2 ] } [ { 1 2 3 } <circular> 1 over change-circular-start 1 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
-[ "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
+{ "fob" } [ "foo" <circular> CHAR: b 2 pick set-nth >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
-[ "bcd" ] [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test
+{ "bcd" } [ 3 <circular-string> "abcd" [ over circular-push ] each >string ] unit-test
-[ { 0 0 } ] [ { 0 0 } <circular> -1 over change-circular-start >array ] unit-test
+{ { 0 0 } } [ { 0 0 } <circular> -1 over change-circular-start >array ] unit-test
! This no longer fails
! [ "test" <circular> 5 swap nth ] must-fail
! [ "foo" <circular> CHAR: b 3 rot set-nth ] must-fail
-[ { } ] [ 3 <growing-circular> >array ] unit-test
-[ { 1 2 } ] [
+{ { } } [ 3 <growing-circular> >array ] unit-test
+{ { 1 2 } } [
3 <growing-circular>
[ 1 swap growing-circular-push ] keep
[ 2 swap growing-circular-push ] keep >array
] unit-test
-[ { 3 4 5 } ] [
+{ { 3 4 5 } } [
3 <growing-circular> dup { 1 2 3 4 5 } [
swap growing-circular-push
] with each >array
] unit-test
-[ V{ 1 2 3 } ] [
+{ V{ 1 2 3 } } [
{ 1 2 3 } <circular> V{ } [
[ push f ] curry circular-while
] keep
] unit-test
CONSTANT: test-sequence1 { t f f f }
-[ V{ 1 2 3 1 } ] [
+{ V{ 1 2 3 1 } } [
{ 1 2 3 } <circular> V{ } [
[ [ push ] [ length 1 - test-sequence1 nth ] bi ] curry circular-while
] keep
] unit-test
CONSTANT: test-sequence2 { t f t t f f t t t f f f }
-[ V{ 1 2 3 1 2 3 1 2 3 1 2 3 } ] [
+{ V{ 1 2 3 1 2 3 1 2 3 1 2 3 } } [
{ 1 2 3 } <circular> V{ } [
[ [ push ] [ length 1 - test-sequence2 nth ] bi ] curry circular-while
] keep
] unit-test
-[ V{ 1 2 3 1 2 } ] [
+{ V{ 1 2 3 1 2 } } [
{ 1 2 3 } <circular> V{ } [
[ [ push ] [ length 5 < ] bi ] curry circular-loop
] keep
] unit-test
-[ V{ 1 } ] [
+{ V{ 1 } } [
{ 1 2 3 } <circular> V{ } [
[ push f ] curry circular-loop
] keep
dup 1.0 2.0 101.0 102.0 <CGRect> -> foo:
-> release ;
-[ ] [ test-foo ] unit-test
+{ } [ test-foo ] unit-test
-[ 1.0 ] [ "x" get CGRect-x ] unit-test
-[ 2.0 ] [ "x" get CGRect-y ] unit-test
-[ 101.0 ] [ "x" get CGRect-w ] unit-test
-[ 102.0 ] [ "x" get CGRect-h ] unit-test
+{ 1.0 } [ "x" get CGRect-x ] unit-test
+{ 2.0 } [ "x" get CGRect-y ] unit-test
+{ 101.0 } [ "x" get CGRect-w ] unit-test
+{ 102.0 } [ "x" get CGRect-h ] unit-test
CLASS: Bar < NSObject
[
METHOD: NSRect bar [ test-foo "x" get ]
]
-[ ] [
+{ } [
Bar [
-> alloc -> init
dup -> bar "x" set
] compile-call
] unit-test
-[ 1.0 ] [ "x" get CGRect-x ] unit-test
-[ 2.0 ] [ "x" get CGRect-y ] unit-test
-[ 101.0 ] [ "x" get CGRect-w ] unit-test
-[ 102.0 ] [ "x" get CGRect-h ] unit-test
+{ 1.0 } [ "x" get CGRect-x ] unit-test
+{ 2.0 } [ "x" get CGRect-y ] unit-test
+{ 101.0 } [ "x" get CGRect-w ] unit-test
+{ 102.0 } [ "x" get CGRect-h ] unit-test
! Make sure that we can add methods
CLASS: Bar < NSObject
METHOD: int babb: int x [ x sq ]
]
-[ 144 ] [
+{ 144 } [
Bar [
-> alloc -> init
dup 12 -> babb:
! Columns
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } [ clone ] map "seq" set
-[ { 1 4 7 } ] [ "seq" get 0 <column> >array ] unit-test
-[ ] [ "seq" get 1 <column> [ sq ] map! drop ] unit-test
-[ { 4 25 64 } ] [ "seq" get 1 <column> >array ] unit-test
+{ { 1 4 7 } } [ "seq" get 0 <column> >array ] unit-test
+{ } [ "seq" get 1 <column> [ sq ] map! drop ] unit-test
+{ { 4 25 64 } } [ "seq" get 1 <column> >array ] unit-test
-[ { { 1 3 } { 2 4 } } ] [ { { 1 2 } { 3 4 } } <flipped> [ >array ] map ] unit-test
+{ { { 1 3 } { 2 4 } } } [ { { 1 2 } { 3 4 } } <flipped> [ >array ] map ] unit-test
USING: tools.test core-graphics kernel images ;
IN: core-graphics.tests
-[ t ] [ { 100 200 } [ drop ] make-bitmap-image image? ] unit-test
+{ t } [ { 100 200 } [ drop ] make-bitmap-image image? ] unit-test
-[ ] [ dummy-context drop ] unit-test
+{ } [ dummy-context drop ] unit-test
CGBitmapInfo bitmapInfo
) ;
-FUNCTION: CGImageRef CGBitmapContextCreateImage
+FUNCTION: CGImageRef CGBitmapContextCreateImage (
CGContextRef c
) ;
: test-font ( name -- font )
[ >cf &CFRelease 0.0 f CTFontCreateWithName ] with-destructors ;
-[ ] [ "Helvetica" test-font CFRelease ] unit-test
+{ } [ "Helvetica" test-font CFRelease ] unit-test
-[ ] [
+{ } [
[
kCTFontAttributeName "Helvetica" test-font &CFRelease 2array 1array
<CFDictionary> &CFRelease drop
} cleave and and and
] with-destructors ;
-[ t ] [ "Hello world" "Helvetica" test-typographic-bounds ] unit-test
+{ t } [ "Hello world" "Helvetica" test-typographic-bounds ] unit-test
-[ t ] [ "Hello world" "Chicago" test-typographic-bounds ] unit-test
+{ t } [ "Hello world" "Chicago" test-typographic-bounds ] unit-test
-[ t ] [ "日本語" "Helvetica" test-typographic-bounds ] unit-test
+{ t } [ "日本語" "Helvetica" test-typographic-bounds ] unit-test
! !!!!!!!! other tests
-[ { { "Phil Dawes" } } ]
+{ { { "Phil Dawes" } } }
[ "\"Phil Dawes\"" string>csv ] unit-test
-[ { { "1" "2" "3" } { "4" "5" "6" } } ]
+{ { { "1" "2" "3" } { "4" "5" "6" } } }
[ "1,2,3\n4,5,6\n" string>csv ] unit-test
"trims leading and trailing whitespace - n.b. this isn't really conformant, but lots of csv seems to assume this"
[ "\"fo\"\"o1\",bar1\n\"fo\no2\",\"b,ar2\"\n" ]
[ { { "fo\"o1" "bar1" } { "fo\no2" "b,ar2" } } csv>string ] named-unit-test ! "
-[ { { "writing" "some" "csv" "tests" } } ]
+{ { { "writing" "some" "csv" "tests" } } }
[
"writing,some,csv,tests"
"csv-test1-" unique-file utf8
[ set-file-contents ] [ file>csv ] [ drop delete-file ] 2tri
] unit-test
-[ t ] [
+{ t } [
{ { "writing,some,csv,tests" } } dup "csv-test2-"
unique-file utf8 [ csv>file ] [ file>csv ] 2bi =
] unit-test
-[ { { "hello" "" "" "" "goodbye" "" } } ]
+{ { { "hello" "" "" "" "goodbye" "" } } }
[ "hello,,\"\",,goodbye," string>csv ] unit-test
{ { { "asd\"f\"" "asdf" } } } [ "asd\"f\",asdf" string>csv ] unit-test
! FIXME: { { { "asd\"f\"" "asdf" } } } [ "\"asd\"\"\"f\",asdf" string>csv ] unit-test
{ { { "as,d\"f" "asdf" } } } [ "\"as,\"d\"\"\"\"f,asdf" string>csv ] unit-test
-[ { } ] [ "" string>csv ] unit-test
+{ { } } [ "" string>csv ] unit-test
-[
+{
{ { "Year" "Make" "Model" }
{ "1997" "Ford" "E350" }
}
-]
+}
[ "Year,Make,\"Model\"\r\n1997,Ford,E350" string>csv ] unit-test
namespaces tools.test ;
IN: debugger.tests
-[ ] [ [ drop ] [ error. ] recover ] unit-test
+{ } [ [ drop ] [ error. ] recover ] unit-test
-[ f ] [ { } vm-error? ] unit-test
-[ f ] [ { "A" "B" } vm-error? ] unit-test
+{ f } [ { } vm-error? ] unit-test
+{ f } [ { "A" "B" } vm-error? ] unit-test
-[ ] [
+{ } [
T{ test-failure
{ error
{
} error.
] unit-test
-[ "foo" { 1 2 3 "foo" } ] [
+{ "foo" { 1 2 3 "foo" } } [
[ 1 2 3 "foo" throw ] [ ] recover error-continuation get data>>
] unit-test
CONSULT: hello goodbye those>> ;
M: hello bing hello-test ;
-[ 1 { t 1 0 } ] [ 1 0 <hello> [ foo ] [ bar ] bi ] unit-test
-[ { t 1 0 } ] [ 1 0 <hello> bing ] unit-test
-[ 1 ] [ 1 0 <hello> f <goodbye> foo ] unit-test
-[ { t 1 0 } ] [ 1 0 <hello> f <goodbye> bar ] unit-test
-[ 3 ] [ 1 0 <hello> 2 whoa ] unit-test
-[ 3 ] [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
+{ 1 { t 1 0 } } [ 1 0 <hello> [ foo ] [ bar ] bi ] unit-test
+{ { t 1 0 } } [ 1 0 <hello> bing ] unit-test
+{ 1 } [ 1 0 <hello> f <goodbye> foo ] unit-test
+{ { t 1 0 } } [ 1 0 <hello> f <goodbye> bar ] unit-test
+{ 3 } [ 1 0 <hello> 2 whoa ] unit-test
+{ 3 } [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
-[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval( -- ) ] times ] unit-test
-[ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } ] [ baz protocol-consult ] unit-test
-[ H{ } ] [ bee protocol-consult ] unit-test
+{ } [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval( -- ) ] times ] unit-test
+{ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } } [ baz protocol-consult ] unit-test
+{ H{ } } [ bee protocol-consult ] unit-test
-[ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" ] [ [ baz see ] with-string-writer ] unit-test
+{ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" } [ [ baz see ] with-string-writer ] unit-test
GENERIC: one ( a -- b )
M: integer one ;
CONSULT: alpha hey value>> 1 + ;
CONSULT: beta hey value>> 1 - ;
-[ 2 ] [ 1 <hey> one ] unit-test
-[ 2 ] [ 1 <hey> two ] unit-test
-[ 0 ] [ 1 <hey> three ] unit-test
-[ { hey } ] [ alpha protocol-users ] unit-test
-[ { hey } ] [ beta protocol-users ] unit-test
-[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval( -- ) ] unit-test
-[ f ] [ hey \ two ?lookup-method ] unit-test
-[ f ] [ hey \ four ?lookup-method ] unit-test
-[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval( -- ) ] unit-test
-[ { hey } ] [ alpha protocol-users ] unit-test
-[ { hey } ] [ beta protocol-users ] unit-test
-[ 2 ] [ 1 <hey> one ] unit-test
-[ 0 ] [ 1 <hey> two ] unit-test
-[ 0 ] [ 1 <hey> three ] unit-test
-[ 0 ] [ 1 <hey> four ] unit-test
-[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval( -- ) ] unit-test
-[ 2 ] [ 1 <hey> one ] unit-test
-[ -1 ] [ 1 <hey> two ] unit-test
-[ -1 ] [ 1 <hey> three ] unit-test
-[ -1 ] [ 1 <hey> four ] unit-test
-[ ] [ "IN: delegate.tests FORGET: alpha" eval( -- ) ] unit-test
-[ f ] [ hey \ one ?lookup-method ] unit-test
+{ 2 } [ 1 <hey> one ] unit-test
+{ 2 } [ 1 <hey> two ] unit-test
+{ 0 } [ 1 <hey> three ] unit-test
+{ { hey } } [ alpha protocol-users ] unit-test
+{ { hey } } [ beta protocol-users ] unit-test
+{ } [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval( -- ) ] unit-test
+{ f } [ hey \ two ?lookup-method ] unit-test
+{ f } [ hey \ four ?lookup-method ] unit-test
+{ } [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval( -- ) ] unit-test
+{ { hey } } [ alpha protocol-users ] unit-test
+{ { hey } } [ beta protocol-users ] unit-test
+{ 2 } [ 1 <hey> one ] unit-test
+{ 0 } [ 1 <hey> two ] unit-test
+{ 0 } [ 1 <hey> three ] unit-test
+{ 0 } [ 1 <hey> four ] unit-test
+{ } [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval( -- ) ] unit-test
+{ 2 } [ 1 <hey> one ] unit-test
+{ -1 } [ 1 <hey> two ] unit-test
+{ -1 } [ 1 <hey> three ] unit-test
+{ -1 } [ 1 <hey> four ] unit-test
+{ } [ "IN: delegate.tests FORGET: alpha" eval( -- ) ] unit-test
+{ f } [ hey \ one ?lookup-method ] unit-test
TUPLE: slot-protocol-test-1 a b ;
TUPLE: slot-protocol-test-2 < slot-protocol-test-1 { c integer } ;
CONSULT: slot-protocol-test-2 slot-protocol-test-3 d>> ;
-[ "a" "b" 5 ] [
+{ "a" "b" 5 } [
T{ slot-protocol-test-3 f T{ slot-protocol-test-2 f "a" "b" 5 } }
[ a>> ] [ b>> ] [ c>> ] tri
] unit-test
CONSULT: slot-protocol-test-5 slot-protocol-test-4 x>> ;
-[ "hey" ] [
+{ "hey" } [
"hey" slot-protocol-test-5 boa slot-protocol-test-4 boa
a-read-only-slot>>
] unit-test
M: f do-me drop ;
-[ ] [ f do-me ] unit-test
+{ } [ f do-me ] unit-test
TUPLE: a-tuple ;
PROTOCOL: silly-protocol do-me ;
! Replacing a method definition with a consultation would cause problems
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USE: kernel
M: a-tuple do-me drop ;" <string-reader> "delegate-test" parse-stream
] unit-test
-[ ] [ T{ a-tuple } do-me ] unit-test
+{ } [ T{ a-tuple } do-me ] unit-test
! Change method definition to consultation
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USE: kernel
USE: delegate
] unit-test
! Method should be there
-[ ] [ T{ a-tuple } do-me ] unit-test
+{ } [ T{ a-tuple } do-me ] unit-test
! Now try removing the consultation
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests" <string-reader> "delegate-test" parse-stream
] unit-test
DEFER: slot-protocol-test-3
SLOT: y
-[ f ] [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
+{ f } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USING: accessors delegate ;
TUPLE: slot-protocol-test-3 x ;
<string-reader> "delegate-test-1" parse-stream
] unit-test
-[ t ] [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
+{ t } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
TUPLE: slot-protocol-test-3 x y ;"
<string-reader> "delegate-test-1" parse-stream
! We now have a real accessor for the y slot; we don't want it to
! get lost
-[ t ] [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
+{ t } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
! We want to be able to override methods after consultation
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USING: delegate kernel sequences delegate.protocols accessors ;
TUPLE: override-method-test seq ;
DEFER: seq-delegate
! See if removing a consultation updates protocol-consult word prop
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USING: accessors delegate delegate.protocols ;
TUPLE: seq-delegate seq ;
<string-reader> "remove-consult-test" parse-stream
] unit-test
-[ t ] [
+{ t } [
seq-delegate
sequence-protocol \ protocol-consult word-prop
key?
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: delegate.tests
USING: delegate delegate.protocols ;
TUPLE: seq-delegate seq ;"
<string-reader> "remove-consult-test" parse-stream
] unit-test
-[ f ] [
+{ f } [
seq-delegate
sequence-protocol \ protocol-consult word-prop
key?
[ "USING: accessors delegate ; IN: delegate.tests BROADCAST: nonbroadcastable broadcaster targets>> ;" eval( -- ) ]
[ error>> broadcast-words-must-have-no-outputs? ] must-fail-with
-[ { 2 3 4 } ]
+{ { 2 3 4 } }
[ { 1 2 3 } broadcaster boa [ broadcastable ] { } make ] unit-test
SYMBOL: uf
-[ ] [
+{ } [
<disjoint-set> uf set
+blah+ uf get add-atom
19026 uf get add-atom
19026 +blah+ uf get equate
] unit-test
-[ 2 ] [ 19026 uf get equiv-set-size ] unit-test
+{ 2 } [ 19026 uf get equiv-set-size ] unit-test
math sequences tools.test ;
IN: dlists.tests
-
[ t ] [ <dlist> deque-empty? ] unit-test
+
{ t } [ <dlist> deque-empty? ] unit-test
-[ T{ dlist f T{ dlist-node f f f 1 } T{ dlist-node f f f 1 } } ]
+{ T{ dlist f T{ dlist-node f f f 1 } T{ dlist-node f f f 1 } } }
[ <dlist> 1 over push-front ] unit-test
! Make sure empty lists are empty
-
[ t ] [ <dlist> deque-empty? ] unit-test
-
[ f ] [ <dlist> 1 over push-front deque-empty? ] unit-test
-
[ f ] [ <dlist> 1 over push-back deque-empty? ] unit-test
-
-
[ 1 ] [ <dlist> 1 over push-front pop-front ] unit-test
-
[ 1 ] [ <dlist> 1 over push-front pop-back ] unit-test
-
[ 1 ] [ <dlist> 1 over push-back pop-front ] unit-test
-
[ 1 ] [ <dlist> 1 over push-back pop-back ] unit-test
-
[ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-front* ] unit-test
-
[ T{ dlist f f f } ] [ <dlist> 1 over push-front dup pop-back* ] unit-test
-
[ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-front* ] unit-test
-
[ T{ dlist f f f } ] [ <dlist> 1 over push-back dup pop-back* ] unit-test
+
{ t } [ <dlist> deque-empty? ] unit-test
+
{ f } [ <dlist> 1 over push-front deque-empty? ] unit-test
+
{ f } [ <dlist> 1 over push-back deque-empty? ] unit-test
+
+
{ 1 } [ <dlist> 1 over push-front pop-front ] unit-test
+
{ 1 } [ <dlist> 1 over push-front pop-back ] unit-test
+
{ 1 } [ <dlist> 1 over push-back pop-front ] unit-test
+
{ 1 } [ <dlist> 1 over push-back pop-back ] unit-test
+
{ T{ dlist f f f } } [ <dlist> 1 over push-front dup pop-front* ] unit-test
+
{ T{ dlist f f f } } [ <dlist> 1 over push-front dup pop-back* ] unit-test
+
{ T{ dlist f f f } } [ <dlist> 1 over push-back dup pop-front* ] unit-test
+
{ T{ dlist f f f } } [ <dlist> 1 over push-back dup pop-back* ] unit-test
! Test the prev,next links for two nodes
-[ f ] [
+{ f } [
<dlist> 1 over push-back 2 over push-back
front>> prev>>
] unit-test
-[ 2 ] [
+{ 2 } [
<dlist> 1 over push-back 2 over push-back
front>> next>> obj>>
] unit-test
-[ 1 ] [
+{ 1 } [
<dlist> 1 over push-back 2 over push-back
front>> next>> prev>> obj>>
] unit-test
-[ f ] [
+{ f } [
<dlist> 1 over push-back 2 over push-back
front>> next>> next>>
] unit-test
-
[ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
-
[ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
-
[ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
-
[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
-
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
+
{ f f } [ <dlist> [ 1 = ] dlist-find ] unit-test
+
{ 1 t } [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
+
{ f f } [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
+
{ f } [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
+
{ t } [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
-
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
-
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
-
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
+
{ 1 } [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
+
{ t } [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
+
{ t } [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test
-
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node class-of dlist-node = ] unit-test
-
[ t ] [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node class-of dlist-node = ] unit-test
-
[ t ] [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class-of dlist-node = ] unit-test
-
[ ] [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
+
{ t } [ <dlist> 4 over push-back 5 over push-back [ obj>> 4 = ] dlist-find-node class-of dlist-node = ] unit-test
+
{ t } [ <dlist> 4 over push-back 5 over push-back [ obj>> 5 = ] dlist-find-node class-of dlist-node = ] unit-test
+
{ t } [ <dlist> 4 over push-back 5 over push-back* [ = ] curry dlist-find-node class-of dlist-node = ] unit-test
+
{ } [ <dlist> 4 over push-back 5 over push-back [ drop ] dlist-each ] unit-test
-
[ f ] [ <dlist> ?peek-front ] unit-test
-
[ 1 ] [ <dlist> 1 over push-front ?peek-front ] unit-test
-
[ f ] [ <dlist> ?peek-back ] unit-test
-
[ 1 ] [ <dlist> 1 over push-back ?peek-back ] unit-test
+
{ f } [ <dlist> ?peek-front ] unit-test
+
{ 1 } [ <dlist> 1 over push-front ?peek-front ] unit-test
+
{ f } [ <dlist> ?peek-back ] unit-test
+
{ 1 } [ <dlist> 1 over push-back ?peek-back ] unit-test
[ <dlist> peek-front ] [ empty-deque? ] must-fail-with
[ <dlist> peek-back ] [ empty-deque? ] must-fail-with
[ <dlist> pop-front ] [ empty-deque? ] must-fail-with
[ <dlist> pop-back ] [ empty-deque? ] must-fail-with
-
[ t ] [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
+
{ t } [ <dlist> 3 over push-front 4 over push-back 3 swap deque-member? ] unit-test
-
[ f ] [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
+
{ f } [ <dlist> 3 over push-front 4 over push-back -1 swap deque-member? ] unit-test
-
[ f ] [ <dlist> 0 swap deque-member? ] unit-test
+
{ f } [ <dlist> 0 swap deque-member? ] unit-test
! Make sure clone does the right thing
-[ V{ 2 1 } V{ 2 1 3 } ] [
+{ V{ 2 1 } V{ 2 1 3 } } [
<dlist> 1 over push-front 2 over push-front
dup clone 3 over push-back
[ dlist>sequence ] bi@
] unit-test
-
[ V{ f 3 1 f } ] [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>sequence ] unit-test
+
{ V{ f 3 1 f } } [ <dlist> 1 over push-front 3 over push-front f over push-front f over push-back dlist>sequence ] unit-test
-
[ V{ } ] [ <dlist> dlist>sequence ] unit-test
+
{ V{ } } [ <dlist> dlist>sequence ] unit-test
-
[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
-
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
-
[ V{ 2 4 } ] [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
-
[ V{ 0 2 4 } ] [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
+
{ V{ 0 2 4 } } [ <dlist> { 0 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
+
{ V{ 2 4 } } [ <dlist> { 1 2 3 4 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
+
{ V{ 2 4 } } [ <dlist> { 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
+
{ V{ 0 2 4 } } [ <dlist> { 0 1 2 3 4 5 } over push-all-back [ even? ] dlist-filter dlist>sequence ] unit-test
-[ t ] [ DL{ } DL{ } = ] unit-test
-[ t ] [ DL{ 1 } DL{ 1 } = ] unit-test
-[ t ] [ DL{ 1 2 } DL{ 1 2 } = ] unit-test
-[ t ] [ DL{ 1 1 } DL{ 1 1 } = ] unit-test
-[ f ] [ DL{ 1 2 3 } DL{ 1 2 } = ] unit-test
-[ f ] [ DL{ 1 2 } DL{ 1 2 3 } = ] unit-test
-[ f ] [ DL{ } DL{ 1 } = ] unit-test
-[ f ] [ DL{ f } DL{ 1 } = ] unit-test
-[ f ] [ f DL{ } = ] unit-test
-[ f ] [ DL{ } f = ] unit-test
+{ t } [ DL{ } DL{ } = ] unit-test
+{ t } [ DL{ 1 } DL{ 1 } = ] unit-test
+{ t } [ DL{ 1 2 } DL{ 1 2 } = ] unit-test
+{ t } [ DL{ 1 1 } DL{ 1 1 } = ] unit-test
+{ f } [ DL{ 1 2 3 } DL{ 1 2 } = ] unit-test
+{ f } [ DL{ 1 2 } DL{ 1 2 3 } = ] unit-test
+{ f } [ DL{ } DL{ 1 } = ] unit-test
+{ f } [ DL{ f } DL{ 1 } = ] unit-test
+{ f } [ f DL{ } = ] unit-test
+{ f } [ DL{ } f = ] unit-test
TUPLE: my-node < dlist-link { obj fixnum } ;
my-node new
swap >>obj ; inline
-
[ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-front dlist>sequence ] unit-test
-
[ V{ 2 1 } ] [ <dlist> 1 <my-node> over push-node-front 2 <my-node> over push-node-front dlist>sequence ] unit-test
+
{ V{ 1 } } [ <dlist> 1 <my-node> over push-node-front dlist>sequence ] unit-test
+
{ V{ 2 1 } } [ <dlist> 1 <my-node> over push-node-front 2 <my-node> over push-node-front dlist>sequence ] unit-test
-
[ V{ 1 } ] [ <dlist> 1 <my-node> over push-node-back dlist>sequence ] unit-test
-
[ V{ 1 2 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back dlist>sequence ] unit-test
-
[ V{ 1 2 3 } ] [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back 3 <my-node> over push-node-back dlist>sequence ] unit-test
+
{ V{ 1 } } [ <dlist> 1 <my-node> over push-node-back dlist>sequence ] unit-test
+
{ V{ 1 2 } } [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back dlist>sequence ] unit-test
+
{ V{ 1 2 3 } } [ <dlist> 1 <my-node> over push-node-back 2 <my-node> over push-node-back 3 <my-node> over push-node-back dlist>sequence ] unit-test
: assert-links ( dlist-node -- )
[ prev>> ] [ next>> ] bi 2array { f f } assert= ;
-
[ V{ } ] [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test
+
{ V{ } } [ <dlist> 1 <my-node> over push-node-back [ [ back>> ] [ ] bi delete-node ] [ ] bi dlist>sequence ] unit-test
[ V{ 1 2 } t ] [| |
<dlist> :> dl
1 <my-node> :> n1 n1 dl push-node-back
! Tests
-[ { } ] [
+{ { } } [
[
{ 1 10 }
{ 1 10 } [ , "HI" , ] each-line
] { } make
] unit-test
-[ { 1 "HI" } ] [
+{ { 1 "HI" } } [
[
{ 1 10 }
{ 1 11 } [ , "HI" , ] each-line
] { } make
] unit-test
-[ { 1 "HI" 2 "HI" } ] [
+{ { 1 "HI" 2 "HI" } } [
[
{ 1 10 }
{ 2 11 } [ , "HI" , ] each-line
] { } make
] unit-test
-[ { { t f 1 } { t f 2 } } ] [
+{ { { t f 1 } { t f 2 } } } [
[
{ 1 10 } { 2 11 }
t f
] { } make
] unit-test
-[ { 10 4 } ] [ { "a" } { 10 3 } text+loc ] unit-test
-[ { 10 4 } ] [ { "a" } { 10 3 } text+loc ] unit-test
+{ { 10 4 } } [ { "a" } { 10 3 } text+loc ] unit-test
+{ { 10 4 } } [ { "a" } { 10 3 } text+loc ] unit-test
-[ { 2 9 } ] [
+{ { 2 9 } } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
{ 10 0 } "doc" get validate-loc
] unit-test
-[ { 1 12 } ] [
+{ { 1 12 } } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
{ 1 20 } "doc" get validate-loc
] unit-test
-[ " world,\nhow are you?\nMore" ] [
+{ " world,\nhow are you?\nMore" } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
{ 0 5 } { 2 4 } "doc" get doc-range
] unit-test
-[ "Hello world,\nhow you?\nMore text" ] [
+{ "Hello world,\nhow you?\nMore text" } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
"doc" get doc-string
] unit-test
-[ "Hello world,\nhow text" ] [
+{ "Hello world,\nhow text" } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
"doc" get doc-string
] unit-test
-[ "Hello world,\nhow you?\nMore text" ] [
+{ "Hello world,\nhow you?\nMore text" } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
"doc" get doc-string
] unit-test
-[ "Hello world,\nhow text" ] [
+{ "Hello world,\nhow text" } [
<document> "doc" set
"Hello world,\nhow are you?\nMore text"
"doc" get set-doc-string
<document> "doc" set
"Hello\nworld, how are\nyou?" "doc" get set-doc-string
-[ { 2 4 } ] [ "doc" get doc-end ] unit-test
+{ { 2 4 } } [ "doc" get doc-end ] unit-test
! Undo/redo
-[ ] [ <document> "d" set ] unit-test
+{ } [ <document> "d" set ] unit-test
-[ ] [ "Hello, world." "d" get set-doc-string ] unit-test
+{ } [ "Hello, world." "d" get set-doc-string ] unit-test
-[
+{
T{ edit
{ old-string "" }
{ new-string "Hello, world." }
{ old-to { 0 0 } }
{ new-to { 0 13 } }
}
-] [ "d" get undos>> first ] unit-test
+} [ "d" get undos>> first ] unit-test
-[ ] [ "Goodbye" { 0 0 } { 0 5 } "d" get set-doc-range ] unit-test
+{ } [ "Goodbye" { 0 0 } { 0 5 } "d" get set-doc-range ] unit-test
-[ "Goodbye, world." ] [ "d" get doc-string ] unit-test
+{ "Goodbye, world." } [ "d" get doc-string ] unit-test
-[ ] [ "cruel " { 0 9 } { 0 9 } "d" get set-doc-range ] unit-test
+{ } [ "cruel " { 0 9 } { 0 9 } "d" get set-doc-range ] unit-test
-[ 3 ] [ "d" get undos>> length ] unit-test
+{ 3 } [ "d" get undos>> length ] unit-test
-[ "Goodbye, cruel world." ] [ "d" get doc-string ] unit-test
+{ "Goodbye, cruel world." } [ "d" get doc-string ] unit-test
-[ "" { 0 9 } { 0 15 } ] [
+{ "" { 0 9 } { 0 15 } } [
"d" get undos>> last
[ old-string>> ] [ from>> ] [ new-to>> ] tri
] unit-test
-[ ] [ "d" get undo ] unit-test
+{ } [ "d" get undo ] unit-test
-[ "Goodbye, world." ] [ "d" get doc-string ] unit-test
+{ "Goodbye, world." } [ "d" get doc-string ] unit-test
-[ ] [ "d" get undo ] unit-test
+{ } [ "d" get undo ] unit-test
-[ "Hello, world." ] [ "d" get doc-string ] unit-test
+{ "Hello, world." } [ "d" get doc-string ] unit-test
-[ ] [ "d" get redo ] unit-test
+{ } [ "d" get redo ] unit-test
-[ "Goodbye, world." ] [ "d" get doc-string ] unit-test
+{ "Goodbye, world." } [ "d" get doc-string ] unit-test
-[ ] [ <document> "d" set ] unit-test
+{ } [ <document> "d" set ] unit-test
-[ ] [ "d" get clear-doc ] unit-test
+{ } [ "d" get clear-doc ] unit-test
-[ ] [ "d" get clear-doc ] unit-test
+{ } [ "d" get clear-doc ] unit-test
-[ 0 ] [ "d" get undos>> length ] unit-test
+{ 0 } [ "d" get undos>> length ] unit-test
-[ ] [ <document> "d" set ] unit-test
+{ } [ <document> "d" set ] unit-test
-[ ] [ "d" get value>> "value" set ] unit-test
+{ } [ "d" get value>> "value" set ] unit-test
-[ ] [ "Hello world" "d" get set-doc-string ] unit-test
+{ } [ "Hello world" "d" get set-doc-string ] unit-test
-[ { "" } ] [ "value" get ] unit-test
+{ { "" } } [ "value" get ] unit-test
USING: kernel namespaces tools.test endian ;
IN: endian.tests
-[ t ] [ [ endianness get big-endian = ] with-big-endian ] unit-test
-[ t ] [ [ endianness get little-endian = ] with-little-endian ] unit-test
+{ t } [ [ endianness get big-endian = ] with-big-endian ] unit-test
+{ t } [ [ endianness get little-endian = ] with-little-endian ] unit-test
environment strings sequences ;
IN: environment.tests
-[ ] [ os-envs . ] unit-test
+{ } [ os-envs . ] unit-test
os unix? [
[ ] [ os-envs "envs" set ] unit-test
[ t ] [ os-envs "envs" get = ] unit-test
] when
-[ ] [ "factor-test-key-1" unset-os-env ] unit-test
-[ ] [ "ps3" "factor-test-key-1" set-os-env ] unit-test
-[ "ps3" ] [ "factor-test-key-1" os-env ] unit-test
-[ ] [ "factor-test-key-1" unset-os-env ] unit-test
-[ f ] [ "factor-test-key-1" os-env ] unit-test
+{ } [ "factor-test-key-1" unset-os-env ] unit-test
+{ } [ "ps3" "factor-test-key-1" set-os-env ] unit-test
+{ "ps3" } [ "factor-test-key-1" os-env ] unit-test
+{ } [ "factor-test-key-1" unset-os-env ] unit-test
+{ f } [ "factor-test-key-1" os-env ] unit-test
-[ ] [
+{ } [
32766 CHAR: a <string> "factor-test-key-long" set-os-env
] unit-test
-[ 32766 ] [ "factor-test-key-long" os-env length ] unit-test
-[ ] [ "factor-test-key-long" unset-os-env ] unit-test
+{ 32766 } [ "factor-test-key-long" os-env length ] unit-test
+{ } [ "factor-test-key-long" unset-os-env ] unit-test
-[ "abc" ] [
+{ "abc" } [
"a" "factor-test-key-change" set-os-env
"factor-test-key-change" [ "bc" append ] change-os-env
"factor-test-key-change" os-env
] unit-test
-[ ] [ "factor-test-key-change" unset-os-env ] unit-test
+{ } [ "factor-test-key-change" unset-os-env ] unit-test
! Issue #794, setting something to ``f`` is a memory protection fault on mac
-[ ] [ f "dummy-env-variable-for-factor-test" set-os-env ] unit-test
+{ } [ f "dummy-env-variable-for-factor-test" set-os-env ] unit-test
{ f "value" f } [
"factor-test-key" os-env
USING: eval tools.test ;
IN: eval.tests
-[ 4 ] [ "USE: math 2 2 +" eval( -- result ) ] unit-test
+{ 4 } [ "USE: math 2 2 +" eval( -- result ) ] unit-test
[ "USE: math 2 2 +" eval( -- ) ] must-fail
-[ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test
+{ "4\n" } [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test
disable-images? off
link-no-follow? off
-[ "Baz" ] [ "Foo/Bar/Baz" simple-link-title ] unit-test
-[ "Baz" ] [ "Baz" simple-link-title ] unit-test
+{ "Baz" } [ "Foo/Bar/Baz" simple-link-title ] unit-test
+{ "Baz" } [ "Baz" simple-link-title ] unit-test
-[ ] [
+{ } [
"abcd-*strong*\nasdifj\nweouh23ouh23" parse-farkup drop
] unit-test
-[ ] [
+{ } [
"abcd-*strong*\nasdifj\nweouh23ouh23\n" parse-farkup drop
] unit-test
-[ "<p>a-b</p>" ] [ "a-b" convert-farkup ] unit-test
-[ "<p><strong>foo</strong></p><p>bar</p>" ] [ "*foo\nbar\n" convert-farkup ] unit-test
-[ "<p><strong>Wow!</strong></p>" ] [ "*Wow!*" convert-farkup ] unit-test
-[ "<p><em>Wow.</em></p>" ] [ "_Wow._" convert-farkup ] unit-test
+{ "<p>a-b</p>" } [ "a-b" convert-farkup ] unit-test
+{ "<p><strong>foo</strong></p><p>bar</p>" } [ "*foo\nbar\n" convert-farkup ] unit-test
+{ "<p><strong>Wow!</strong></p>" } [ "*Wow!*" convert-farkup ] unit-test
+{ "<p><em>Wow.</em></p>" } [ "_Wow._" convert-farkup ] unit-test
-[ "<p><strong></strong></p>" ] [ "*" convert-farkup ] unit-test
-[ "<p>*</p>" ] [ "\\*" convert-farkup ] unit-test
-[ "<p>*<strong></strong></p>" ] [ "\\**" convert-farkup ] unit-test
+{ "<p><strong></strong></p>" } [ "*" convert-farkup ] unit-test
+{ "<p>*</p>" } [ "\\*" convert-farkup ] unit-test
+{ "<p>*<strong></strong></p>" } [ "\\**" convert-farkup ] unit-test
-[ "<ul><li>a-b</li></ul>" ] [ "-a-b" convert-farkup ] unit-test
-[ "<ul><li>foo</li></ul>" ] [ "-foo" convert-farkup ] unit-test
-[ "<ul><li>foo</li></ul>" ] [ "-foo\n" convert-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar" convert-farkup ] unit-test
-[ "<ul><li>foo</li><li>bar</li></ul>" ] [ "-foo\n-bar\n" convert-farkup ] unit-test
+{ "<ul><li>a-b</li></ul>" } [ "-a-b" convert-farkup ] unit-test
+{ "<ul><li>foo</li></ul>" } [ "-foo" convert-farkup ] unit-test
+{ "<ul><li>foo</li></ul>" } [ "-foo\n" convert-farkup ] unit-test
+{ "<ul><li>foo</li><li>bar</li></ul>" } [ "-foo\n-bar" convert-farkup ] unit-test
+{ "<ul><li>foo</li><li>bar</li></ul>" } [ "-foo\n-bar\n" convert-farkup ] unit-test
-[ "<ul><li>foo</li></ul><p>bar</p>" ] [ "-foo\nbar\n" convert-farkup ] unit-test
+{ "<ul><li>foo</li></ul><p>bar</p>" } [ "-foo\nbar\n" convert-farkup ] unit-test
-[ "<ol><li>a-b</li></ol>" ] [ "#a-b" convert-farkup ] unit-test
-[ "<ol><li>foo</li></ol>" ] [ "#foo" convert-farkup ] unit-test
-[ "<ol><li>foo</li></ol>" ] [ "#foo\n" convert-farkup ] unit-test
-[ "<ol><li>foo</li><li>bar</li></ol>" ] [ "#foo\n#bar" convert-farkup ] unit-test
-[ "<ol><li>foo</li><li>bar</li></ol>" ] [ "#foo\n#bar\n" convert-farkup ] unit-test
+{ "<ol><li>a-b</li></ol>" } [ "#a-b" convert-farkup ] unit-test
+{ "<ol><li>foo</li></ol>" } [ "#foo" convert-farkup ] unit-test
+{ "<ol><li>foo</li></ol>" } [ "#foo\n" convert-farkup ] unit-test
+{ "<ol><li>foo</li><li>bar</li></ol>" } [ "#foo\n#bar" convert-farkup ] unit-test
+{ "<ol><li>foo</li><li>bar</li></ol>" } [ "#foo\n#bar\n" convert-farkup ] unit-test
-[ "<ol><li>foo</li></ol><p>bar</p>" ] [ "#foo\nbar\n" convert-farkup ] unit-test
+{ "<ol><li>foo</li></ol><p>bar</p>" } [ "#foo\nbar\n" convert-farkup ] unit-test
-[ "" ] [ "\n\n" convert-farkup ] unit-test
-[ "" ] [ "\r\n\r\n" convert-farkup ] unit-test
-[ "" ] [ "\r\r\r\r" convert-farkup ] unit-test
-[ "" ] [ "\r\r\r" convert-farkup ] unit-test
-[ "" ] [ "\n\n\n" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\nbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\n\r\nbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\rbar" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\r\r\nbar" convert-farkup ] unit-test
+{ "" } [ "\n\n" convert-farkup ] unit-test
+{ "" } [ "\r\n\r\n" convert-farkup ] unit-test
+{ "" } [ "\r\r\r\r" convert-farkup ] unit-test
+{ "" } [ "\r\r\r" convert-farkup ] unit-test
+{ "" } [ "\n\n\n" convert-farkup ] unit-test
+{ "<p>foo</p><p>bar</p>" } [ "foo\n\nbar" convert-farkup ] unit-test
+{ "<p>foo</p><p>bar</p>" } [ "foo\r\n\r\nbar" convert-farkup ] unit-test
+{ "<p>foo</p><p>bar</p>" } [ "foo\r\rbar" convert-farkup ] unit-test
+{ "<p>foo</p><p>bar</p>" } [ "foo\r\r\nbar" convert-farkup ] unit-test
-[ "<p>bar</p>" ] [ "\nbar\n" convert-farkup ] unit-test
-[ "<p>bar</p>" ] [ "\rbar\r" convert-farkup ] unit-test
-[ "<p>bar</p>" ] [ "\r\nbar\r\n" convert-farkup ] unit-test
+{ "<p>bar</p>" } [ "\nbar\n" convert-farkup ] unit-test
+{ "<p>bar</p>" } [ "\rbar\r" convert-farkup ] unit-test
+{ "<p>bar</p>" } [ "\r\nbar\r\n" convert-farkup ] unit-test
-[ "<p>foo</p><p>bar</p>" ] [ "foo\n\n\nbar" convert-farkup ] unit-test
+{ "<p>foo</p><p>bar</p>" } [ "foo\n\n\nbar" convert-farkup ] unit-test
-[ "" ] [ "" convert-farkup ] unit-test
+{ "" } [ "" convert-farkup ] unit-test
-[ "<table><tr><td>a</td></tr></table>" ]
+{ "<table><tr><td>a</td></tr></table>" }
[ "|a" convert-farkup ] unit-test
-[ "<table><tr><td>a</td></tr></table>" ]
+{ "<table><tr><td>a</td></tr></table>" }
[ "|a|" convert-farkup ] unit-test
-[ "<table><tr><td>a</td><td>b</td></tr></table>" ]
+{ "<table><tr><td>a</td><td>b</td></tr></table>" }
[ "|a|b|" convert-farkup ] unit-test
-[ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" ]
+{ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" }
[ "|a|b|\n|c|d|" convert-farkup ] unit-test
-[ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" ]
+{ "<table><tr><td>a</td><td>b</td></tr><tr><td>c</td><td>d</td></tr></table>" }
[ "|a|b|\n|c|d|\n" convert-farkup ] unit-test
-[ "<p><strong>foo</strong></p><h1>aheading</h1><p>adfasd</p>" ]
+{ "<p><strong>foo</strong></p><h1>aheading</h1><p>adfasd</p>" }
[ "*foo*\n=aheading=\nadfasd" convert-farkup ] unit-test
-[ "<h1>foo</h1>" ] [ "=foo=\n" convert-farkup ] unit-test
-[ "<p>lol=foo=</p>" ] [ "lol=foo=\n" convert-farkup ] unit-test
-[ "<p>=foo</p>" ] [ "=foo\n" convert-farkup ] unit-test
-[ "<p>=foo</p>" ] [ "=foo" convert-farkup ] unit-test
-[ "<p>==foo</p>" ] [ "==foo" convert-farkup ] unit-test
-[ "<h1>foo</h1>" ] [ "==foo=" convert-farkup ] unit-test
-[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
-[ "<h2>foo</h2>" ] [ "==foo==" convert-farkup ] unit-test
-[ "<h2>foo</h2>" ] [ "===foo==" convert-farkup ] unit-test
-[ "<h1>foo</h1>" ] [ "=foo==" convert-farkup ] unit-test
-
-[ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></pre>" ]
+{ "<h1>foo</h1>" } [ "=foo=\n" convert-farkup ] unit-test
+{ "<p>lol=foo=</p>" } [ "lol=foo=\n" convert-farkup ] unit-test
+{ "<p>=foo</p>" } [ "=foo\n" convert-farkup ] unit-test
+{ "<p>=foo</p>" } [ "=foo" convert-farkup ] unit-test
+{ "<p>==foo</p>" } [ "==foo" convert-farkup ] unit-test
+{ "<h1>foo</h1>" } [ "==foo=" convert-farkup ] unit-test
+{ "<h2>foo</h2>" } [ "==foo==" convert-farkup ] unit-test
+{ "<h2>foo</h2>" } [ "==foo==" convert-farkup ] unit-test
+{ "<h2>foo</h2>" } [ "===foo==" convert-farkup ] unit-test
+{ "<h1>foo</h1>" } [ "=foo==" convert-farkup ] unit-test
+
+{ "<pre><span class=\"KEYWORD3\">int</span> <span class=\"FUNCTION\">main</span><span class=\"OPERATOR\">(</span><span class=\"OPERATOR\">)</span></pre>" }
[ "[c{int main()}]" convert-farkup ] unit-test
-[ "<p><img src=\"lol.jpg\" alt=\"lol.jpg\"/></p>" ] [ "[[image:lol.jpg]]" convert-farkup ] unit-test
-[ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" ] [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
-[ "<p><a href=\"http://lol.com\">http://lol.com</a></p>" ] [ "[[http://lol.com]]" convert-farkup ] unit-test
-[ "<p><a href=\"http://lol.com\">haha</a></p>" ] [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
-[ "<p><a href=\"http://lol.com/search?q=sex\">haha</a></p>" ] [ "[[http://lol.com/search?q=sex|haha]]" convert-farkup ] unit-test
-[ "<p><a href=\"Foo/Bar\">Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
+{ "<p><img src=\"lol.jpg\" alt=\"lol.jpg\"/></p>" } [ "[[image:lol.jpg]]" convert-farkup ] unit-test
+{ "<p><img src=\"lol.jpg\" alt=\"teh lol\"/></p>" } [ "[[image:lol.jpg|teh lol]]" convert-farkup ] unit-test
+{ "<p><a href=\"http://lol.com\">http://lol.com</a></p>" } [ "[[http://lol.com]]" convert-farkup ] unit-test
+{ "<p><a href=\"http://lol.com\">haha</a></p>" } [ "[[http://lol.com|haha]]" convert-farkup ] unit-test
+{ "<p><a href=\"http://lol.com/search?q=sex\">haha</a></p>" } [ "[[http://lol.com/search?q=sex|haha]]" convert-farkup ] unit-test
+{ "<p><a href=\"Foo/Bar\">Bar</a></p>" } [ "[[Foo/Bar]]" convert-farkup ] unit-test
"/wiki/view/" relative-link-prefix [
[ "<p><a href=\"/wiki/view/Foo/Bar\">Bar</a></p>" ] [ "[[Foo/Bar]]" convert-farkup ] unit-test
] with-variable
-[ ] [ "[{}]" convert-farkup drop ] unit-test
+{ } [ "[{}]" convert-farkup drop ] unit-test
-[ "<pre>hello</pre>" ] [ "[{hello}]" convert-farkup ] unit-test
+{ "<pre>hello</pre>" } [ "[{hello}]" convert-farkup ] unit-test
-[
+{
"<p>Feature comparison:</p><table><tr><td>a</td><td>Factor</td><td>Java</td><td>Lisp</td></tr><tr><td>Coolness</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Badass</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Enterprise</td><td>Yes</td><td>Yes</td><td>No</td></tr><tr><td>Kosher</td><td>Yes</td><td>No</td><td>Yes</td></tr></table>"
-] [ "Feature comparison:\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test
+} [ "Feature comparison:\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test
-[
+{
"<p>Feature comparison:</p><table><tr><td>a</td><td>Factor</td><td>Java</td><td>Lisp</td></tr><tr><td>Coolness</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Badass</td><td>Yes</td><td>No</td><td>No</td></tr><tr><td>Enterprise</td><td>Yes</td><td>Yes</td><td>No</td></tr><tr><td>Kosher</td><td>Yes</td><td>No</td><td>Yes</td></tr></table>"
-] [ "Feature comparison:\n\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test
+} [ "Feature comparison:\n\n|a|Factor|Java|Lisp|\n|Coolness|Yes|No|No|\n|Badass|Yes|No|No|\n|Enterprise|Yes|Yes|No|\n|Kosher|Yes|No|Yes|\n" convert-farkup ] unit-test
-[
+{
"<p>This wiki is written in <a href=\"Factor\">Factor</a> and is hosted on a <a href=\"http://linode.com\">http://linode.com</a> virtual server.</p>"
-] [
+} [
"This wiki is written in [[Factor]] and is hosted on a [[http://linode.com|http://linode.com]] virtual server."
convert-farkup
] unit-test
-[ "<p><a href=\"a\">a</a> <a href=\"b\">c</a></p>" ] [ "[[a]] [[b|c]]" convert-farkup ] unit-test
+{ "<p><a href=\"a\">a</a> <a href=\"b\">c</a></p>" } [ "[[a]] [[b|c]]" convert-farkup ] unit-test
-[ "<p><a href=\"C%2B%2B\">C++</a></p>" ] [ "[[C++]]" convert-farkup ] unit-test
+{ "<p><a href=\"C%2B%2B\">C++</a></p>" } [ "[[C++]]" convert-farkup ] unit-test
-[ "<p><foo></p>" ] [ "<foo>" convert-farkup ] unit-test
+{ "<p><foo></p>" } [ "<foo>" convert-farkup ] unit-test
-[ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" ] [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
+{ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" } [ "asdf\n-lol\n-haha" convert-farkup ] unit-test
-[ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" ]
+{ "<p>asdf</p><ul><li>lol</li><li>haha</li></ul>" }
[ "asdf\n\n-lol\n-haha" convert-farkup ] unit-test
-[ "<hr/>" ] [ "___" convert-farkup ] unit-test
-[ "<hr/>" ] [ "___\n" convert-farkup ] unit-test
+{ "<hr/>" } [ "___" convert-farkup ] unit-test
+{ "<hr/>" } [ "___\n" convert-farkup ] unit-test
-[ "<p>before:</p><pre><span class=\"OPERATOR\">{</span> <span class=\"DIGIT\">1</span> <span class=\"DIGIT\">2</span> <span class=\"DIGIT\">3</span> <span class=\"OPERATOR\">}</span> <span class=\"DIGIT\">1</span> tail</pre>" ]
+{ "<p>before:</p><pre><span class=\"OPERATOR\">{</span> <span class=\"DIGIT\">1</span> <span class=\"DIGIT\">2</span> <span class=\"DIGIT\">3</span> <span class=\"OPERATOR\">}</span> <span class=\"DIGIT\">1</span> tail</pre>" }
[ "before:\n[factor{{ 1 2 3 } 1 tail}]" convert-farkup ] unit-test
-[ "<p><a href=\"Factor\">Factor</a>-rific!</p>" ]
+{ "<p><a href=\"Factor\">Factor</a>-rific!</p>" }
[ "[[Factor]]-rific!" convert-farkup ] unit-test
-[ "<pre> 1 2 3 </pre>" ]
+{ "<pre> 1 2 3 </pre>" }
[ "[ factor { 1 2 3 }]" convert-farkup ] unit-test
-[ "<p>paragraph</p><hr/>" ]
+{ "<p>paragraph</p><hr/>" }
[ "paragraph\n___" convert-farkup ] unit-test
-[ "<p>paragraph</p><p> a <em></em><em> b</em></p>" ]
+{ "<p>paragraph</p><p> a <em></em><em> b</em></p>" }
[ "paragraph\n a ___ b" convert-farkup ] unit-test
-[ "<ul><li> a</li></ul><hr/>" ]
+{ "<ul><li> a</li></ul><hr/>" }
[ "\n- a\n___" convert-farkup ] unit-test
-[ "<p>hello<em>world how are you today?</em></p><ul><li> hello<em>world how are you today?</em></li></ul>" ]
+{ "<p>hello<em>world how are you today?</em></p><ul><li> hello<em>world how are you today?</em></li></ul>" }
[ "hello_world how are you today?\n- hello_world how are you today?" convert-farkup ] unit-test
: check-link-escaping ( string -- link )
convert-farkup string>xml-chunk
"a" deep-tag-named "href" attr url-decode ;
-[ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test
-[ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test
-[ "&blah;" ] [ "[[&blah;]]" check-link-escaping ] unit-test
-[ "C++" ] [ "[[C++]]" check-link-escaping ] unit-test
+{ "Trader Joe\"s" } [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test
+{ "<foo>" } [ "[[<foo>]]" check-link-escaping ] unit-test
+{ "&blah;" } [ "[[&blah;]]" check-link-escaping ] unit-test
+{ "C++" } [ "[[C++]]" check-link-escaping ] unit-test
-[ "<h1>The <em>important</em> thing</h1>" ] [ "=The _important_ thing=" convert-farkup ] unit-test
-[ "<p><a href=\"Foo\"><strong>emphasized</strong> text</a></p>" ] [ "[[Foo|*emphasized* text]]" convert-farkup ] unit-test
-[ "<table><tr><td><strong>bold</strong></td><td><em>italics</em></td></tr></table>" ]
+{ "<h1>The <em>important</em> thing</h1>" } [ "=The _important_ thing=" convert-farkup ] unit-test
+{ "<p><a href=\"Foo\"><strong>emphasized</strong> text</a></p>" } [ "[[Foo|*emphasized* text]]" convert-farkup ] unit-test
+{ "<table><tr><td><strong>bold</strong></td><td><em>italics</em></td></tr></table>" }
[ "|*bold*|_italics_|" convert-farkup ] unit-test
-[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both" convert-farkup ] unit-test
-[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both*" convert-farkup ] unit-test
-[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both*_" convert-farkup ] unit-test
-[ "<p><em>italics<strong>both</strong></em></p>" ] [ "_italics*both_" convert-farkup ] unit-test
-[ "<p><em>italics<strong>both</strong></em>after<strong></strong></p>" ] [ "_italics*both_after*" convert-farkup ] unit-test
-[ "<table><tr><td>foo|bar</td></tr></table>" ] [ "|foo\\|bar|" convert-farkup ] unit-test
-[ "<p></p>" ] [ "\\" convert-farkup ] unit-test
+{ "<p><em>italics<strong>both</strong></em></p>" } [ "_italics*both" convert-farkup ] unit-test
+{ "<p><em>italics<strong>both</strong></em></p>" } [ "_italics*both*" convert-farkup ] unit-test
+{ "<p><em>italics<strong>both</strong></em></p>" } [ "_italics*both*_" convert-farkup ] unit-test
+{ "<p><em>italics<strong>both</strong></em></p>" } [ "_italics*both_" convert-farkup ] unit-test
+{ "<p><em>italics<strong>both</strong></em>after<strong></strong></p>" } [ "_italics*both_after*" convert-farkup ] unit-test
+{ "<table><tr><td>foo|bar</td></tr></table>" } [ "|foo\\|bar|" convert-farkup ] unit-test
+{ "<p></p>" } [ "\\" convert-farkup ] unit-test
-[ "<p>[abc]</p>" ] [ "[abc]" convert-farkup ] unit-test
+{ "<p>[abc]</p>" } [ "[abc]" convert-farkup ] unit-test
: random-markup ( -- string )
10 [
] if
] replicate concat ;
-[ t ] [
+{ t } [
100 [
drop random-markup
[ convert-farkup drop t ] [ drop print f ] recover
] all-integers?
] unit-test
-[ "<p><a href=\"http://foo.com/~foo\">http://foo.com/~foo</a></p>" ] [ "[[http://foo.com/~foo]]" convert-farkup ] unit-test
+{ "<p><a href=\"http://foo.com/~foo\">http://foo.com/~foo</a></p>" } [ "[[http://foo.com/~foo]]" convert-farkup ] unit-test
[ "%s" printf ] must-infer
[ "%s" sprintf ] must-infer
-[ "" ] [ "" sprintf ] unit-test
-[ "asdf" ] [ "asdf" sprintf ] unit-test
-[ "10" ] [ 10 "%d" sprintf ] unit-test
-[ "+10" ] [ 10 "%+d" sprintf ] unit-test
-[ "-10" ] [ -10 "%d" sprintf ] unit-test
-[ " 23" ] [ 23 "% d" sprintf ] unit-test
-[ "-23" ] [ -23 "% d" sprintf ] unit-test
-[ " -10" ] [ -10 "%5d" sprintf ] unit-test
-[ "-0010" ] [ -10 "%05d" sprintf ] unit-test
-[ "+0010" ] [ 10 "%+05d" sprintf ] unit-test
-[ "123.456000" ] [ 123.456 "%f" sprintf ] unit-test
-[ "2.44" ] [ 2.436 "%.2f" sprintf ] unit-test
-[ "8.950" ] [ 8.950179003580072 "%.3f" sprintf ] unit-test
-[ "123.10" ] [ 123.1 "%01.2f" sprintf ] unit-test
-[ "1.2346" ] [ 1.23456789 "%.4f" sprintf ] unit-test
-[ " 1.23" ] [ 1.23456789 "%6.2f" sprintf ] unit-test
-[ "001100" ] [ 12 "%06b" sprintf ] unit-test
-[ "==14" ] [ 12 "%'=4o" sprintf ] unit-test
+{ "" } [ "" sprintf ] unit-test
+{ "asdf" } [ "asdf" sprintf ] unit-test
+{ "10" } [ 10 "%d" sprintf ] unit-test
+{ "+10" } [ 10 "%+d" sprintf ] unit-test
+{ "-10" } [ -10 "%d" sprintf ] unit-test
+{ " 23" } [ 23 "% d" sprintf ] unit-test
+{ "-23" } [ -23 "% d" sprintf ] unit-test
+{ " -10" } [ -10 "%5d" sprintf ] unit-test
+{ "-0010" } [ -10 "%05d" sprintf ] unit-test
+{ "+0010" } [ 10 "%+05d" sprintf ] unit-test
+{ "123.456000" } [ 123.456 "%f" sprintf ] unit-test
+{ "2.44" } [ 2.436 "%.2f" sprintf ] unit-test
+{ "8.950" } [ 8.950179003580072 "%.3f" sprintf ] unit-test
+{ "123.10" } [ 123.1 "%01.2f" sprintf ] unit-test
+{ "1.2346" } [ 1.23456789 "%.4f" sprintf ] unit-test
+{ " 1.23" } [ 1.23456789 "%6.2f" sprintf ] unit-test
+{ "001100" } [ 12 "%06b" sprintf ] unit-test
+{ "==14" } [ 12 "%'=4o" sprintf ] unit-test
{ "foo: 1 bar: 2" } [ { 1 2 3 } "foo: %d bar: %s" vsprintf ] unit-test
-[ "1.234000e+08" ] [ 123400000 "%e" sprintf ] unit-test
-[ "-1.234000e+08" ] [ -123400000 "%e" sprintf ] unit-test
-[ "1.234567e+08" ] [ 123456700 "%e" sprintf ] unit-test
-[ "3.625e+08" ] [ 362525200 "%.3e" sprintf ] unit-test
-[ "2.500000e-03" ] [ 0.0025 "%e" sprintf ] unit-test
-[ "2.500000E-03" ] [ 0.0025 "%E" sprintf ] unit-test
-[ " 1.0E+01" ] [ 10 "%10.1E" sprintf ] unit-test
-[ " -1.0E+01" ] [ -10 "%10.1E" sprintf ] unit-test
-[ " -1.0E+01" ] [ -10 "%+10.1E" sprintf ] unit-test
-[ " +1.0E+01" ] [ 10 "%+10.1E" sprintf ] unit-test
-[ "-001.0E+01" ] [ -10 "%+010.1E" sprintf ] unit-test
-[ "+001.0E+01" ] [ 10 "%+010.1E" sprintf ] unit-test
+{ "1.234000e+08" } [ 123400000 "%e" sprintf ] unit-test
+{ "-1.234000e+08" } [ -123400000 "%e" sprintf ] unit-test
+{ "1.234567e+08" } [ 123456700 "%e" sprintf ] unit-test
+{ "3.625e+08" } [ 362525200 "%.3e" sprintf ] unit-test
+{ "2.500000e-03" } [ 0.0025 "%e" sprintf ] unit-test
+{ "2.500000E-03" } [ 0.0025 "%E" sprintf ] unit-test
+{ " 1.0E+01" } [ 10 "%10.1E" sprintf ] unit-test
+{ " -1.0E+01" } [ -10 "%10.1E" sprintf ] unit-test
+{ " -1.0E+01" } [ -10 "%+10.1E" sprintf ] unit-test
+{ " +1.0E+01" } [ 10 "%+10.1E" sprintf ] unit-test
+{ "-001.0E+01" } [ -10 "%+010.1E" sprintf ] unit-test
+{ "+001.0E+01" } [ 10 "%+010.1E" sprintf ] unit-test
-[ "ff" ] [ 0xff "%x" sprintf ] unit-test
-[ "FF" ] [ 0xff "%X" sprintf ] unit-test
-[ "0f" ] [ 0xf "%02x" sprintf ] unit-test
-[ "0F" ] [ 0xf "%02X" sprintf ] unit-test
-[ "2008-09-10" ] [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test
-[ "Hello, World!" ] [ "Hello, World!" "%s" sprintf ] unit-test
-[ "printf test" ] [ "printf test" sprintf ] unit-test
-[ "char a = 'a'" ] [ CHAR: a "char %c = 'a'" sprintf ] unit-test
-[ "00" ] [ 0x0 "%02x" sprintf ] unit-test
-[ "ff" ] [ 0xff "%02x" sprintf ] unit-test
-[ "0 message(s)" ] [ 0 "message" "%d %s(s)" sprintf ] unit-test
-[ "0 message(s) with %" ] [ 0 "message" "%d %s(s) with %%" sprintf ] unit-test
-[ "justif: \"left \"" ] [ "left" "justif: \"%-10s\"" sprintf ] unit-test
-[ "justif: \" right\"" ] [ "right" "justif: \"%10s\"" sprintf ] unit-test
-[ " 3: 0003 zero padded" ] [ 3 " 3: %04d zero padded" sprintf ] unit-test
-[ " 3: 3 left justif" ] [ 3 " 3: %-4d left justif" sprintf ] unit-test
-[ " 3: 3 right justif" ] [ 3 " 3: %4d right justif" sprintf ] unit-test
-[ " -3: -003 zero padded" ] [ -3 " -3: %04d zero padded" sprintf ] unit-test
-[ " -3: -3 left justif" ] [ -3 " -3: %-4d left justif" sprintf ] unit-test
-[ " -3: -3 right justif" ] [ -3 " -3: %4d right justif" sprintf ] unit-test
-[ "There are 10 monkeys in the kitchen" ] [ 10 "kitchen" "There are %d monkeys in the %s" sprintf ] unit-test
-[ "10" ] [ 10 "%d" sprintf ] unit-test
-[ "[monkey]" ] [ "monkey" "[%s]" sprintf ] unit-test
-[ "[ monkey]" ] [ "monkey" "[%10s]" sprintf ] unit-test
-[ "[monkey ]" ] [ "monkey" "[%-10s]" sprintf ] unit-test
-[ "[0000monkey]" ] [ "monkey" "[%010s]" sprintf ] unit-test
-[ "[####monkey]" ] [ "monkey" "[%'#10s]" sprintf ] unit-test
-[ "[many monke]" ] [ "many monkeys" "[%10.10s]" sprintf ] unit-test
+{ "ff" } [ 0xff "%x" sprintf ] unit-test
+{ "FF" } [ 0xff "%X" sprintf ] unit-test
+{ "0f" } [ 0xf "%02x" sprintf ] unit-test
+{ "0F" } [ 0xf "%02X" sprintf ] unit-test
+{ "2008-09-10" } [ 2008 9 10 "%04d-%02d-%02d" sprintf ] unit-test
+{ "Hello, World!" } [ "Hello, World!" "%s" sprintf ] unit-test
+{ "printf test" } [ "printf test" sprintf ] unit-test
+{ "char a = 'a'" } [ CHAR: a "char %c = 'a'" sprintf ] unit-test
+{ "00" } [ 0x0 "%02x" sprintf ] unit-test
+{ "ff" } [ 0xff "%02x" sprintf ] unit-test
+{ "0 message(s)" } [ 0 "message" "%d %s(s)" sprintf ] unit-test
+{ "0 message(s) with %" } [ 0 "message" "%d %s(s) with %%" sprintf ] unit-test
+{ "justif: \"left \"" } [ "left" "justif: \"%-10s\"" sprintf ] unit-test
+{ "justif: \" right\"" } [ "right" "justif: \"%10s\"" sprintf ] unit-test
+{ " 3: 0003 zero padded" } [ 3 " 3: %04d zero padded" sprintf ] unit-test
+{ " 3: 3 left justif" } [ 3 " 3: %-4d left justif" sprintf ] unit-test
+{ " 3: 3 right justif" } [ 3 " 3: %4d right justif" sprintf ] unit-test
+{ " -3: -003 zero padded" } [ -3 " -3: %04d zero padded" sprintf ] unit-test
+{ " -3: -3 left justif" } [ -3 " -3: %-4d left justif" sprintf ] unit-test
+{ " -3: -3 right justif" } [ -3 " -3: %4d right justif" sprintf ] unit-test
+{ "There are 10 monkeys in the kitchen" } [ 10 "kitchen" "There are %d monkeys in the %s" sprintf ] unit-test
+{ "10" } [ 10 "%d" sprintf ] unit-test
+{ "[monkey]" } [ "monkey" "[%s]" sprintf ] unit-test
+{ "[ monkey]" } [ "monkey" "[%10s]" sprintf ] unit-test
+{ "[monkey ]" } [ "monkey" "[%-10s]" sprintf ] unit-test
+{ "[0000monkey]" } [ "monkey" "[%010s]" sprintf ] unit-test
+{ "[####monkey]" } [ "monkey" "[%'#10s]" sprintf ] unit-test
+{ "[many monke]" } [ "many monkeys" "[%10.10s]" sprintf ] unit-test
-[ "{ 1, 2, 3 }" ] [ { 1 2 3 } "%[%s, %]" sprintf ] unit-test
-[ "{ 1:2, 3:4 }" ] [ H{ { 1 2 } { 3 4 } } "%[%s: %s %]" sprintf ] unit-test
+{ "{ 1, 2, 3 }" } [ { 1 2 3 } "%[%s, %]" sprintf ] unit-test
+{ "{ 1:2, 3:4 }" } [ H{ { 1 2 } { 3 4 } } "%[%s: %s %]" sprintf ] unit-test
[ "%H:%M:%S" strftime ] must-infer
: testtime ( -- timestamp )
2008 10 9 12 3 15 instant <timestamp> ;
-[ t ] [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
-[ t ] [ "12:03:15" testtime "%X" strftime = ] unit-test
-[ t ] [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
-[ t ] [ "10/09/2008" testtime "%x" strftime = ] unit-test
-[ t ] [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test
-[ t ] [ "Thu" testtime "%a" strftime = ] unit-test
-[ t ] [ "Thursday" testtime "%A" strftime = ] unit-test
-[ t ] [ "Oct" testtime "%b" strftime = ] unit-test
-[ t ] [ "October" testtime "%B" strftime = ] unit-test
-[ t ] [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
-[ t ] [ "PM" testtime "%p" strftime = ] unit-test
+{ t } [ "12:03:15" testtime "%H:%M:%S" strftime = ] unit-test
+{ t } [ "12:03:15" testtime "%X" strftime = ] unit-test
+{ t } [ "10/09/2008" testtime "%m/%d/%Y" strftime = ] unit-test
+{ t } [ "10/09/2008" testtime "%x" strftime = ] unit-test
+{ t } [ "10/09/08" testtime "%m/%d/%y" strftime = ] unit-test
+{ t } [ "Thu" testtime "%a" strftime = ] unit-test
+{ t } [ "Thursday" testtime "%A" strftime = ] unit-test
+{ t } [ "Oct" testtime "%b" strftime = ] unit-test
+{ t } [ "October" testtime "%B" strftime = ] unit-test
+{ t } [ "Thu Oct 09 12:03:15 2008" testtime "%c" strftime = ] unit-test
+{ t } [ "PM" testtime "%p" strftime = ] unit-test
SYMBOLS: a b c d e f g h ;
-[ [ ] ] [ '[ ] ] unit-test
-[ [ + ] ] [ '[ + ] ] unit-test
-[ [ 1 ] ] [ 1 '[ _ ] ] unit-test
-[ [ 1 ] ] [ [ 1 ] '[ @ ] ] unit-test
-[ [ 1 2 ] ] [ [ 1 ] [ 2 ] '[ @ @ ] ] unit-test
+{ [ ] } [ '[ ] ] unit-test
+{ [ + ] } [ '[ + ] ] unit-test
+{ [ 1 ] } [ 1 '[ _ ] ] unit-test
+{ [ 1 ] } [ [ 1 ] '[ @ ] ] unit-test
+{ [ 1 2 ] } [ [ 1 ] [ 2 ] '[ @ @ ] ] unit-test
-[ [ 1 2 a ] ] [ 1 2 '[ _ _ a ] ] unit-test
-[ [ 1 2 ] ] [ 1 2 '[ _ _ ] ] unit-test
-[ [ a 1 2 ] ] [ 1 2 '[ a _ _ ] ] unit-test
-[ [ 1 2 a ] ] [ [ 1 ] [ 2 ] '[ @ @ a ] ] unit-test
-[ [ 1 a 2 b ] ] [ 1 2 '[ _ a _ b ] ] unit-test
-[ [ 1 a 2 b ] ] [ 1 [ 2 ] '[ _ a @ b ] ] unit-test
-[ [ a 1 b ] ] [ 1 '[ a _ b ] ] unit-test
+{ [ 1 2 a ] } [ 1 2 '[ _ _ a ] ] unit-test
+{ [ 1 2 ] } [ 1 2 '[ _ _ ] ] unit-test
+{ [ a 1 2 ] } [ 1 2 '[ a _ _ ] ] unit-test
+{ [ 1 2 a ] } [ [ 1 ] [ 2 ] '[ @ @ a ] ] unit-test
+{ [ 1 a 2 b ] } [ 1 2 '[ _ a _ b ] ] unit-test
+{ [ 1 a 2 b ] } [ 1 [ 2 ] '[ _ a @ b ] ] unit-test
+{ [ a 1 b ] } [ 1 '[ a _ b ] ] unit-test
-[ [ a 1 b ] ] [ [ 1 ] '[ a @ b ] ] unit-test
-[ [ a 1 2 ] ] [ [ 1 ] [ 2 ] '[ a @ @ ] ] unit-test
+{ [ a 1 b ] } [ [ 1 ] '[ a @ b ] ] unit-test
+{ [ a 1 2 ] } [ [ 1 ] [ 2 ] '[ a @ @ ] ] unit-test
-[ [ a [ 1 ] b ] ] [ 1 '[ a [ _ ] b ] ] unit-test
-[ [ a 1 b [ c 2 d ] e 3 f ] ] [ 1 2 3 '[ a _ b [ c _ d ] e _ f ] ] unit-test
-[ [ a 1 b [ c 2 d [ e 3 f ] ] g 4 h ] ] [ 1 2 3 4 '[ a _ b [ c _ d [ e _ f ] ] g _ h ] ] unit-test
-[ [ a 1 b [ [ c 2 d ] e 3 f ] g 4 h ] ] [ 1 2 3 4 '[ a _ b [ [ c _ d ] e _ f ] g _ h ] ] unit-test
+{ [ a [ 1 ] b ] } [ 1 '[ a [ _ ] b ] ] unit-test
+{ [ a 1 b [ c 2 d ] e 3 f ] } [ 1 2 3 '[ a _ b [ c _ d ] e _ f ] ] unit-test
+{ [ a 1 b [ c 2 d [ e 3 f ] ] g 4 h ] } [ 1 2 3 4 '[ a _ b [ c _ d [ e _ f ] ] g _ h ] ] unit-test
+{ [ a 1 b [ [ c 2 d ] e 3 f ] g 4 h ] } [ 1 2 3 4 '[ a _ b [ [ c _ d ] e _ f ] g _ h ] ] unit-test
-[ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
+{ [ 3 + ] } [ 3 '[ _ + ] ] unit-test
-[ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
+{ [ 1 3 + ] } [ 1 3 '[ _ _ + ] ] unit-test
-[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
+{ [ 1 + ] } [ 1 [ + ] '[ _ @ ] ] unit-test
-[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
+{ [ 1 + . ] } [ 1 [ + ] '[ _ @ . ] ] unit-test
-[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
+{ [ + - ] } [ [ + ] [ - ] '[ @ @ ] ] unit-test
-[ [ "a" write "b" print ] ]
+{ [ "a" write "b" print ] }
[ "a" "b" '[ _ write _ print ] ] unit-test
-[ 1/2 ] [
+{ 1/2 } [
1 '[ [ _ ] dip / ] 2 swap call
] unit-test
-[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
+{ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } } [
1 '[ [ _ ] 2dip 3array ]
{ "a" "b" "c" } { "A" "B" "C" } rot 2map
] unit-test
-[ { { 1 "a" } { 1 "b" } { 1 "c" } } ] [
+{ { { 1 "a" } { 1 "b" } { 1 "c" } } } [
'[ [ 1 ] dip 2array ]
{ "a" "b" "c" } swap map
] unit-test
-[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
+{ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } } [
1 2 '[ [ _ ] dip _ 3array ]
{ "a" "b" "c" } swap map
] unit-test
: funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline
-[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
+{ "hi" 3 } [ "h" "i" 3 [ append ] funny-dip ] unit-test
-[ { 1 2 3 } ] [
+{ { 1 2 3 } } [
3 1 '[ _ iota [ _ + ] map ] call
] unit-test
-[ { 1 { 2 { 3 } } } ] [
+{ { 1 { 2 { 3 } } } } [
1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
] unit-test
{ 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
-[ { { { 3 } } } ] [
+{ { { { 3 } } } } [
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
-[ { { { 3 } } } ] [
+{ { { { 3 } } } } [
3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
[ "USING: fry locals.backend ; f '[ load-local _ ]" eval( -- quot ) ]
[ error>> >r/r>-in-fry-error? ] must-fail-with
-[ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [
+{ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } } [
1 2 3 4 '[ "a" _ 2array "b" _ 2array "c" _ 2array "d" _ 2array 4array ] call
] unit-test
"$funny-dispatcher" resolve-base-path
<text-content> ;
-[ ] [
+{ } [
<dispatcher>
<dispatcher>
<funny-dispatcher>
main-responder set
] unit-test
-[ "/a/b/" ] [
+{ "/a/b/" } [
V{ } responder-nesting set
"a/b/c" split-path main-responder get call-responder body>>
] unit-test
-[ "<input type=\"hidden\" value=\"&&&\" name=\"foo\"/>" ]
+{ "<input type=\"hidden\" value=\"&&&\" name=\"foo\"/>" }
[ "&&&" "foo" hidden-form-field xml>string ]
unit-test
-[ f ] [ <request> request [ referrer ] with-variable ] unit-test
+{ f } [ <request> request [ referrer ] with-variable ] unit-test
-[ t ] [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
+{ t } [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
-[ f ] [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test
+{ f } [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test
{ 17 } [ 3 1 3 3 7 5 nsum ] unit-test
{ 4 1 } [ 4 nsum ] must-infer-as
-[ "e1" "o1" "o2" "e2" "o1" "o2" ] [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
+{ "e1" "o1" "o2" "e2" "o1" "o2" } [ "e1" "e2" "o1" "o2" 2 nweave ] unit-test
{ 3 5 } [ 2 nweave ] must-infer-as
{ { 0 1 2 } { 3 5 4 } { 7 8 6 } }
USING: globs io.pathnames literals sequences tools.test ;
IN: globs.tests
-[ f ] [ "abd" "fdf" glob-matches? ] unit-test
-[ f ] [ "fdsafas" "?" glob-matches? ] unit-test
-[ t ] [ "fdsafas" "*as" glob-matches? ] unit-test
-[ t ] [ "fdsafas" "*a*" glob-matches? ] unit-test
-[ t ] [ "fdsafas" "*a?" glob-matches? ] unit-test
-[ t ] [ "fdsafas" "*?" glob-matches? ] unit-test
-[ f ] [ "fdsafas" "*s?" glob-matches? ] unit-test
-[ t ] [ "a" "[abc]" glob-matches? ] unit-test
-[ f ] [ "a" "[^abc]" glob-matches? ] unit-test
-[ t ] [ "d" "[^abc]" glob-matches? ] unit-test
-[ f ] [ "foo.java" "*.{xml,txt}" glob-matches? ] unit-test
-[ t ] [ "foo.txt" "*.{xml,txt}" glob-matches? ] unit-test
-[ t ] [ "foo.xml" "*.{xml,txt}" glob-matches? ] unit-test
-[ f ] [ "foo." "*.{xml,txt}" glob-matches? ] unit-test
-[ t ] [ "foo." "*.{,xml,txt}" glob-matches? ] unit-test
-[ t ] [ "foo.{" "*.{" glob-matches? ] unit-test
+{ f } [ "abd" "fdf" glob-matches? ] unit-test
+{ f } [ "fdsafas" "?" glob-matches? ] unit-test
+{ t } [ "fdsafas" "*as" glob-matches? ] unit-test
+{ t } [ "fdsafas" "*a*" glob-matches? ] unit-test
+{ t } [ "fdsafas" "*a?" glob-matches? ] unit-test
+{ t } [ "fdsafas" "*?" glob-matches? ] unit-test
+{ f } [ "fdsafas" "*s?" glob-matches? ] unit-test
+{ t } [ "a" "[abc]" glob-matches? ] unit-test
+{ f } [ "a" "[^abc]" glob-matches? ] unit-test
+{ t } [ "d" "[^abc]" glob-matches? ] unit-test
+{ f } [ "foo.java" "*.{xml,txt}" glob-matches? ] unit-test
+{ t } [ "foo.txt" "*.{xml,txt}" glob-matches? ] unit-test
+{ t } [ "foo.xml" "*.{xml,txt}" glob-matches? ] unit-test
+{ f } [ "foo." "*.{xml,txt}" glob-matches? ] unit-test
+{ t } [ "foo." "*.{,xml,txt}" glob-matches? ] unit-test
+{ t } [ "foo.{" "*.{" glob-matches? ] unit-test
-[ f ] [ "foo" "bar" append-path "*" glob-matches? ] unit-test
-[ t ] [ "foo" "bar" append-path "*" "*" append-path glob-matches? ] unit-test
-[ f ] [ "foo" "bar" append-path "foo?bar" glob-matches? ] unit-test
-[ t ] [ "foo" "bar" append-path "fo?" "bar" append-path glob-matches? ] unit-test
+{ f } [ "foo" "bar" append-path "*" glob-matches? ] unit-test
+{ t } [ "foo" "bar" append-path "*" "*" append-path glob-matches? ] unit-test
+{ f } [ "foo" "bar" append-path "foo?bar" glob-matches? ] unit-test
+{ t } [ "foo" "bar" append-path "fo?" "bar" append-path glob-matches? ] unit-test
-[ f ] [ "foo" glob-pattern? ] unit-test
-[ t ] [ "fo?" glob-pattern? ] unit-test
-[ t ] [ "fo*" glob-pattern? ] unit-test
-[ t ] [ "fo[mno]" glob-pattern? ] unit-test
-[ t ] [ "fo\\*" glob-pattern? ] unit-test
-[ t ] [ "fo{o,bro}" glob-pattern? ] unit-test
+{ f } [ "foo" glob-pattern? ] unit-test
+{ t } [ "fo?" glob-pattern? ] unit-test
+{ t } [ "fo*" glob-pattern? ] unit-test
+{ t } [ "fo[mno]" glob-pattern? ] unit-test
+{ t } [ "fo\\*" glob-pattern? ] unit-test
+{ t } [ "fo{o,bro}" glob-pattern? ] unit-test
${ { "foo" "bar" } path-separator join }
[ { "foo" "bar" "ba?" } path-separator join glob-parent-directory ] unit-test
-[ "foo" ]
+{ "foo" }
[ { "foo" "b?r" "bas" } path-separator join glob-parent-directory ] unit-test
-[ "" ]
+{ "" }
[ { "f*" "bar" "bas" } path-separator join glob-parent-directory ] unit-test
H{ } "g" set
{ 1 2 3 } "v" set
-[ ] [ "v" dup get "g" get add-vertex ] unit-test
+{ } [ "v" dup get "g" get add-vertex ] unit-test
-[ { "v" } ] [ 1 "g" get at keys ] unit-test
+{ { "v" } } [ 1 "g" get at keys ] unit-test
H{
{ 1 H{ { 1 1 } { 2 2 } } }
{ 4 H{ { 4 4 } { 5 5 } } }
} "g" set
-[ { 2 3 4 5 } ] [
+{ { 2 3 4 5 } } [
2 [ "g" get at ] closure keys natural-sort
] unit-test
H{ } "g" set
-[ ] [
+{ } [
"mary"
H{ { "billy" "one" } { "joey" "two" } }
"g" get add-vertex*
] unit-test
-[ H{ { "mary" "one" } } ] [
+{ H{ { "mary" "one" } } } [
"billy" "g" get at
] unit-test
-[ ] [
+{ } [
"liz"
H{ { "billy" "four" } { "fred" "three" } }
"g" get add-vertex*
] unit-test
-[ H{ { "mary" "one" } { "liz" "four" } } ] [
+{ H{ { "mary" "one" } { "liz" "four" } } } [
"billy" "g" get at
] unit-test
-[ ] [
+{ } [
"mary"
H{ { "billy" "one" } { "joey" "two" } }
"g" get remove-vertex*
] unit-test
-[ H{ { "liz" "four" } } ] [
+{ H{ { "liz" "four" } } } [
"billy" "g" get at
] unit-test
[ { 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
-[ 0 ] [ { } 2 <clumps> length ] unit-test
-[ 0 ] [ { 1 } 2 <clumps> length ] unit-test
-[ 1 ] [ { 1 2 } 2 <clumps> length ] unit-test
-[ 2 ] [ { 1 2 3 } 2 <clumps> length ] unit-test
+{ 0 } [ { } 2 <clumps> length ] unit-test
+{ 0 } [ { 1 } 2 <clumps> length ] unit-test
+{ 1 } [ { 1 2 } 2 <clumps> length ] unit-test
+{ 2 } [ { 1 2 3 } 2 <clumps> length ] unit-test
{ { } } [ { 1 } 2 clump ] unit-test
{ { { 1 2 } } } [ { 1 2 } 2 clump ] unit-test
{ 0 } [ { } 2 <circular-clumps> length ] unit-test
{ 1 } [ { 1 } 2 <circular-clumps> length ] unit-test
-[ 2 ] [ { 1 2 } 2 <circular-clumps> length ] unit-test
-[ 3 ] [ { 1 2 3 } 2 <circular-clumps> length ] unit-test
+{ 2 } [ { 1 2 } 2 <circular-clumps> length ] unit-test
+{ 3 } [ { 1 2 3 } 2 <circular-clumps> length ] unit-test
-[ { { 1 1 } } ] [ { 1 } 2 circular-clump ] unit-test
-[ { { 1 2 } { 2 1 } } ] [ { 1 2 } 2 circular-clump ] unit-test
-[ { { 1 2 } { 2 3 } { 3 1 } } ] [ { 1 2 3 } 2 circular-clump ] unit-test
+{ { { 1 1 } } } [ { 1 } 2 circular-clump ] unit-test
+{ { { 1 2 } { 2 1 } } } [ { 1 2 } 2 circular-clump ] unit-test
+{ { { 1 2 } { 2 3 } { 3 1 } } } [ { 1 2 3 } 2 circular-clump ] unit-test
-[ 1 ] [ V{ } 2 <clumps> 0 over set-length seq>> length ] unit-test
-[ 2 ] [ V{ } 2 <clumps> 1 over set-length seq>> length ] unit-test
-[ 3 ] [ V{ } 2 <clumps> 2 over set-length seq>> length ] unit-test
+{ 1 } [ V{ } 2 <clumps> 0 over set-length seq>> length ] unit-test
+{ 2 } [ V{ } 2 <clumps> 1 over set-length seq>> length ] unit-test
+{ 3 } [ V{ } 2 <clumps> 2 over set-length seq>> length ] unit-test
-[ { { 1 2 } { 2 3 } } ] [ { 1 2 3 } 2 <clumps> [ >array ] map ] unit-test
+{ { { 1 2 } { 2 3 } } } [ { 1 2 3 } 2 <clumps> [ >array ] map ] unit-test
-[ f ] [ [ { } { } "Hello" ] all-equal? ] unit-test
-[ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test
-[ t ] [ [ ] all-equal? ] unit-test
-[ t ] [ [ 1234 ] all-equal? ] unit-test
-[ f ] [ [ 1.0 1 1 ] all-equal? ] unit-test
-[ t ] [ { 1 2 3 4 } [ < ] monotonic? ] unit-test
-[ f ] [ { 1 2 3 4 } [ > ] monotonic? ] unit-test
+{ f } [ [ { } { } "Hello" ] all-equal? ] unit-test
+{ f } [ [ { 2 } { } { } ] all-equal? ] unit-test
+{ t } [ [ ] all-equal? ] unit-test
+{ t } [ [ 1234 ] all-equal? ] unit-test
+{ f } [ [ 1.0 1 1 ] all-equal? ] unit-test
+{ t } [ { 1 2 3 4 } [ < ] monotonic? ] unit-test
+{ f } [ { 1 2 3 4 } [ > ] monotonic? ] unit-test
[ <min-heap> heap-pop ] must-fail
[ <max-heap> heap-pop ] must-fail
-[ t ] [ <min-heap> heap-empty? ] unit-test
-[ f ] [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test
-[ t ] [ <max-heap> heap-empty? ] unit-test
-[ f ] [ <max-heap> 1 t pick heap-push heap-empty? ] unit-test
+{ t } [ <min-heap> heap-empty? ] unit-test
+{ f } [ <min-heap> 1 t pick heap-push heap-empty? ] unit-test
+{ t } [ <max-heap> heap-empty? ] unit-test
+{ f } [ <max-heap> 1 t pick heap-push heap-empty? ] unit-test
! Binary Min Heap
{ 1 2 3 4 5 6 } [ 0 left 0 right 1 left 1 right 2 left 2 right ] unit-test
{ t } [ t 5 f <entry> t 3 f <entry> T{ min-heap } heap-compare ] unit-test
{ f } [ t 5 f <entry> t 3 f <entry> T{ max-heap } heap-compare ] unit-test
-[ t 2 ] [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push heap-pop ] unit-test
+{ t 2 } [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push heap-pop ] unit-test
-[ t 1 ] [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
+{ t 1 } [ <min-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
-[ t 400 ] [ <max-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
+{ t 400 } [ <max-heap> t 300 pick heap-push t 200 pick heap-push t 400 pick heap-push t 3 pick heap-push t 2 pick heap-push t 1 pick heap-push heap-pop ] unit-test
-[ 0 ] [ <max-heap> heap-size ] unit-test
-[ 1 ] [ <max-heap> t 1 pick heap-push heap-size ] unit-test
+{ 0 } [ <max-heap> heap-size ] unit-test
+{ 1 } [ <max-heap> t 1 pick heap-push heap-size ] unit-test
: heap-sort ( alist heap -- keys )
[ heap-push-all ] keep heap-pop-all ;
IN: help.tests
[ 3 throw ] must-fail
-[ ] [ :help ] unit-test
-[ ] [ f print-topic ] unit-test
+{ } [ :help ] unit-test
+{ } [ f print-topic ] unit-test
HINTS: M\ hashtable blahblah { object fixnum object } { object word object } ;
-[ t ] [ M\ hashtable blahblah { count>> count<< } inlined? ] unit-test
+{ t } [ M\ hashtable blahblah { count>> count<< } inlined? ] unit-test
io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.encodings.string
io.encodings.ascii kernel arrays splitting sequences assocs io.sockets db
db.sqlite make continuations urls hashtables accessors namespaces xml.data
-io.encodings.8-bit.latin1 random combinators.short-circuit ;
+io.encodings.8-bit.latin1 random combinators.short-circuit literals ;
IN: http.tests
-[ "text/plain" "UTF-8" ] [ "text/plain" parse-content-type ] unit-test
+{ "text/plain" "UTF-8" } [ "text/plain" parse-content-type ] unit-test
-[ "text/html" "ASCII" ] [ "text/html; charset=ASCII" parse-content-type ] unit-test
+{ "text/html" "ASCII" } [ "text/html; charset=ASCII" parse-content-type ] unit-test
-[ "text/html" "utf-8" ] [ "text/html; charset=\"utf-8\"" parse-content-type ] unit-test
+{ "text/html" "utf-8" } [ "text/html; charset=\"utf-8\"" parse-content-type ] unit-test
-[ "application/octet-stream" f ] [ "application/octet-stream" parse-content-type ] unit-test
+{ "application/octet-stream" f } [ "application/octet-stream" parse-content-type ] unit-test
-[ "localhost" f ] [ "localhost" parse-host ] unit-test
-[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
-[ "::1" 8888 ] [ "::1:8888" parse-host ] unit-test
-[ "127.0.0.1" 8888 ] [ "127.0.0.1:8888" parse-host ] unit-test
+{ "localhost" f } [ "localhost" parse-host ] unit-test
+{ "localhost" 8888 } [ "localhost:8888" parse-host ] unit-test
+{ "::1" 8888 } [ "::1:8888" parse-host ] unit-test
+{ "127.0.0.1" 8888 } [ "127.0.0.1:8888" parse-host ] unit-test
-[ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } } unparse-host ] unit-test
-[ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } { port 80 } } unparse-host ] unit-test
-[ "localhost" ] [ T{ url { protocol "https" } { host "localhost" } { port 443 } } unparse-host ] unit-test
-[ "localhost:8080" ] [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
-[ "localhost:8443" ] [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
+{ "localhost" } [ T{ url { protocol "http" } { host "localhost" } } unparse-host ] unit-test
+{ "localhost" } [ T{ url { protocol "http" } { host "localhost" } { port 80 } } unparse-host ] unit-test
+{ "localhost" } [ T{ url { protocol "https" } { host "localhost" } { port 443 } } unparse-host ] unit-test
+{ "localhost:8080" } [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
+{ "localhost:8443" } [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
STRING: read-request-test-1
POST /bar HTTP/1.1
blah
;
-[
+{
T{ request
{ url T{ url { path "/bar" } } }
{ method "POST" }
{ cookies V{ } }
{ redirects 10 }
}
-] [
+} [
read-request-test-1 lf>crlf [
read-request
] with-string-reader
;
-[
+{
T{ request
{ url T{ url { host "www.sex.com" } { path "/bar" } } }
{ method "HEAD" }
{ cookies V{ } }
{ redirects 10 }
}
-] [
+} [
read-request-test-2 lf>crlf [
read-request
] with-string-reader
;
-[
+{
T{ request
{ url T{ url { host "www.sex.com" } { port 101 } { path "/bar" } } }
{ method "HEAD" }
{ cookies V{ } }
{ redirects 10 }
}
-] [
+} [
read-request-test-2' lf>crlf [
read-request
] with-string-reader
Host: "www.amazon.com"
;
-[ "www.amazon.com" ]
+{ "www.amazon.com" }
[
read-request-test-4 lf>crlf [ read-request ] with-string-reader
"host" header
blah
;
-[
+{
T{ response
{ version "1.1" }
{ code 404 }
{ content-charset "UTF-8" }
{ content-encoding utf8 }
}
-] [
+} [
read-response-test-1 lf>crlf
[ read-response ] with-string-reader
] unit-test
string-lines "\n" join
] unit-test
-[ t ] [
+{ t } [
"rmid=732423sdfs73242; path=/; domain=.example.net; expires=Fri, 31-Dec-2010 23:59:59 GMT"
dup parse-set-cookie first unparse-set-cookie =
] unit-test
-[ t ] [
+{ t } [
"a="
dup parse-set-cookie first unparse-set-cookie =
] unit-test
;
-[ 2 ] [
+{ 2 } [
read-response-test-2 lf>crlf
[ read-response ] with-string-reader
cookies>> length
;
-[ 1 ] [
+{ 1 } [
read-response-test-3 lf>crlf
[ read-response ] with-string-reader
cookies>> length
"http://localhost/quit" add-addr http-get nip
"Goodbye" assert= ;
-[ ] [
+{ } [
[ test-db-file delete-file ] ignore-errors
test-db [
] test-with-db-persistence
! Test cloning
-[ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
-[ f ] [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test
+{ f } [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
+{ f } [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test
! Test basic auth
-[ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [
+{ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" } [
<request> "Aladdin" "open sesame" set-basic-auth "Authorization" header
] unit-test
USING: images tools.test kernel accessors ;
IN: images.tests
-[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
+{ B{ 57 57 57 255 } } [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
} } pixel-at ] unit-test
-[ B{
+{ B{
0 0 0 0
0 0 0 0
0 0 0 0
57 57 57 255
0 0 0 0
0 0 0 0
-} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
+} } [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f f B{
0 0 0 0
0 0 0 0
0 0 0 0
H{ } describe
H{ } describe
-[ "fixnum\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
+{ "fixnum\n\n" } [ [ 3 describe ] with-string-writer ] unit-test
-[ ] [ H{ } clone inspect ] unit-test
+{ } [ H{ } clone inspect ] unit-test
-[ ] [ "a" "b" &add ] unit-test
+{ } [ "a" "b" &add ] unit-test
-[ H{ { "b" "a" } } ] [ me get ] unit-test
+{ H{ { "b" "a" } } } [ me get ] unit-test
-[ ] [ "x" 0 &put ] unit-test
+{ } [ "x" 0 &put ] unit-test
-[ H{ { "b" "x" } } ] [ me get ] unit-test
+{ H{ { "b" "x" } } } [ me get ] unit-test
-[ ] [ 0 &at ] unit-test
+{ } [ 0 &at ] unit-test
-[ "x" ] [ me get ] unit-test
+{ "x" } [ me get ] unit-test
-[ ] [ &back ] unit-test
+{ } [ &back ] unit-test
-[ ] [ "y" 0 &rename ] unit-test
+{ } [ "y" 0 &rename ] unit-test
-[ H{ { "y" "x" } } ] [ me get ] unit-test
+{ H{ { "y" "x" } } } [ me get ] unit-test
-[ ] [ 0 &delete ] unit-test
+{ } [ 0 &delete ] unit-test
-[ H{ } ] [ me get ] unit-test
+{ H{ } } [ me get ] unit-test
SYMBOL: test
-[ ] [ { { { 4 8 } 3 } { 1 2 } } <interval-map> test set ] unit-test
-[ 3 ] [ 5 test get interval-at ] unit-test
-[ 3 ] [ 8 test get interval-at ] unit-test
-[ 3 ] [ 4 test get interval-at ] unit-test
-[ f ] [ 9 test get interval-at ] unit-test
-[ 2 ] [ 1 test get interval-at ] unit-test
-[ f ] [ 2 test get interval-at ] unit-test
-[ f ] [ 0 test get interval-at ] unit-test
+{ } [ { { { 4 8 } 3 } { 1 2 } } <interval-map> test set ] unit-test
+{ 3 } [ 5 test get interval-at ] unit-test
+{ 3 } [ 8 test get interval-at ] unit-test
+{ 3 } [ 4 test get interval-at ] unit-test
+{ f } [ 9 test get interval-at ] unit-test
+{ 2 } [ 1 test get interval-at ] unit-test
+{ f } [ 2 test get interval-at ] unit-test
+{ f } [ 0 test get interval-at ] unit-test
[ { { { 1 4 } 3 } { { 4 8 } 6 } } <interval-map> ] must-fail
-[ { { { 1 3 } 2 } { { 4 5 } 4 } { { 7 8 } 4 } } ]
+{ { { { 1 3 } 2 } { { 4 5 } 4 } { { 7 8 } 4 } } }
[ { { 1 2 } { 2 2 } { 3 2 } { 4 4 } { 5 4 } { 7 4 } { 8 4 } } coalesce ] unit-test
combinators.short-circuit literals ;
IN: interval-sets.tests
-[ f ] [ 0 T{ interval-set } in? ] unit-test
-[ f ] [ 2 T{ interval-set } in? ] unit-test
+{ f } [ 0 T{ interval-set } in? ] unit-test
+{ f } [ 2 T{ interval-set } in? ] unit-test
CONSTANT: i1 $[
{ { 3 4 } } <interval-set> ]
-[ f ] [ 2 i1 in? ] unit-test
-[ t ] [ 3 i1 in? ] unit-test
-[ t ] [ 4 i1 in? ] unit-test
-[ f ] [ 5 i1 in? ] unit-test
+{ f } [ 2 i1 in? ] unit-test
+{ t } [ 3 i1 in? ] unit-test
+{ t } [ 4 i1 in? ] unit-test
+{ f } [ 5 i1 in? ] unit-test
CONSTANT: i2 $[
{ { 3 4 } } <interval-set>
0x10FFFF <interval-not> ] ! unicode-max
-[ t ] [ 2 i2 in? ] unit-test
-[ f ] [ 3 i2 in? ] unit-test
-[ f ] [ 4 i2 in? ] unit-test
-[ t ] [ 5 i2 in? ] unit-test
+{ t } [ 2 i2 in? ] unit-test
+{ f } [ 3 i2 in? ] unit-test
+{ f } [ 4 i2 in? ] unit-test
+{ t } [ 5 i2 in? ] unit-test
CONSTANT: i3 $[
{ { 2 4 } } <interval-set>
{ { 6 8 } } <interval-set>
<interval-or> ]
-[ f ] [ 1 i3 in? ] unit-test
-[ t ] [ 2 i3 in? ] unit-test
-[ t ] [ 3 i3 in? ] unit-test
-[ t ] [ 4 i3 in? ] unit-test
-[ f ] [ 5 i3 in? ] unit-test
-[ t ] [ 6 i3 in? ] unit-test
-[ t ] [ 7 i3 in? ] unit-test
-[ t ] [ 8 i3 in? ] unit-test
-[ f ] [ 9 i3 in? ] unit-test
+{ f } [ 1 i3 in? ] unit-test
+{ t } [ 2 i3 in? ] unit-test
+{ t } [ 3 i3 in? ] unit-test
+{ t } [ 4 i3 in? ] unit-test
+{ f } [ 5 i3 in? ] unit-test
+{ t } [ 6 i3 in? ] unit-test
+{ t } [ 7 i3 in? ] unit-test
+{ t } [ 8 i3 in? ] unit-test
+{ f } [ 9 i3 in? ] unit-test
CONSTANT: i4 $[
{ { 2 4 } } <interval-set>
{ { 6 8 } } <interval-set>
<interval-and> ]
-[ f ] [ 1 i4 in? ] unit-test
-[ f ] [ 2 i4 in? ] unit-test
-[ f ] [ 3 i4 in? ] unit-test
-[ f ] [ 4 i4 in? ] unit-test
-[ f ] [ 5 i4 in? ] unit-test
-[ f ] [ 6 i4 in? ] unit-test
-[ f ] [ 7 i4 in? ] unit-test
-[ f ] [ 8 i4 in? ] unit-test
-[ f ] [ 9 i4 in? ] unit-test
+{ f } [ 1 i4 in? ] unit-test
+{ f } [ 2 i4 in? ] unit-test
+{ f } [ 3 i4 in? ] unit-test
+{ f } [ 4 i4 in? ] unit-test
+{ f } [ 5 i4 in? ] unit-test
+{ f } [ 6 i4 in? ] unit-test
+{ f } [ 7 i4 in? ] unit-test
+{ f } [ 8 i4 in? ] unit-test
+{ f } [ 9 i4 in? ] unit-test
CONSTANT: i5 $[
{ { 2 5 } } <interval-set>
{ { 4 8 } } <interval-set>
<interval-or> ]
-[ f ] [ 1 i5 in? ] unit-test
-[ t ] [ 2 i5 in? ] unit-test
-[ t ] [ 3 i5 in? ] unit-test
-[ t ] [ 4 i5 in? ] unit-test
-[ t ] [ 5 i5 in? ] unit-test
-[ t ] [ 6 i5 in? ] unit-test
-[ t ] [ 7 i5 in? ] unit-test
-[ t ] [ 8 i5 in? ] unit-test
-[ f ] [ 9 i5 in? ] unit-test
+{ f } [ 1 i5 in? ] unit-test
+{ t } [ 2 i5 in? ] unit-test
+{ t } [ 3 i5 in? ] unit-test
+{ t } [ 4 i5 in? ] unit-test
+{ t } [ 5 i5 in? ] unit-test
+{ t } [ 6 i5 in? ] unit-test
+{ t } [ 7 i5 in? ] unit-test
+{ t } [ 8 i5 in? ] unit-test
+{ f } [ 9 i5 in? ] unit-test
CONSTANT: i6 $[
{ { 2 5 } } <interval-set>
{ { 4 8 } } <interval-set>
<interval-and> ]
-[ f ] [ 1 i6 in? ] unit-test
-[ f ] [ 2 i6 in? ] unit-test
-[ f ] [ 3 i6 in? ] unit-test
-[ t ] [ 4 i6 in? ] unit-test
-[ t ] [ 5 i6 in? ] unit-test
-[ f ] [ 6 i6 in? ] unit-test
-[ f ] [ 7 i6 in? ] unit-test
-[ f ] [ 8 i6 in? ] unit-test
-[ f ] [ 9 i6 in? ] unit-test
+{ f } [ 1 i6 in? ] unit-test
+{ f } [ 2 i6 in? ] unit-test
+{ f } [ 3 i6 in? ] unit-test
+{ t } [ 4 i6 in? ] unit-test
+{ t } [ 5 i6 in? ] unit-test
+{ f } [ 6 i6 in? ] unit-test
+{ f } [ 7 i6 in? ] unit-test
+{ f } [ 8 i6 in? ] unit-test
+{ f } [ 9 i6 in? ] unit-test
: criterion ( interval-set -- ? )
array>> {
[ length even? ]
} 1&& ;
-[ t ] [ i1 criterion ] unit-test
-[ t ] [ i2 criterion ] unit-test
-[ t ] [ i3 criterion ] unit-test
-[ t ] [ i4 criterion ] unit-test
-[ t ] [ i5 criterion ] unit-test
-[ t ] [ i6 criterion ] unit-test
+{ t } [ i1 criterion ] unit-test
+{ t } [ i2 criterion ] unit-test
+{ t } [ i3 criterion ] unit-test
+{ t } [ i4 criterion ] unit-test
+{ t } [ i5 criterion ] unit-test
+{ t } [ i6 criterion ] unit-test
math.functions math.constants continuations combinators.smart ;
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 ] must-fail
TUPLE: foo bar baz ;
C: <foo> foo
-[ 1 2 ] [ 1 2 <foo> [ <foo> ] undo ] unit-test
+{ 1 2 } [ 1 2 <foo> [ <foo> ] undo ] unit-test
: 2same ( x -- {x,x} ) dup 2array ;
-[ t ] [ { 3 3 } [ 2same ] matches? ] unit-test
-[ f ] [ { 3 4 } [ 2same ] matches? ] unit-test
+{ t } [ { 3 3 } [ 2same ] matches? ] unit-test
+{ f } [ { 3 4 } [ 2same ] matches? ] unit-test
[ [ 2same ] matches? ] must-fail
: something ( array -- num )
{ [ 3array ] [ + + ] }
} switch ;
-[ 5 ] [ { 1 2 2 } something ] unit-test
-[ 6 ] [ { 2 3 } something ] unit-test
+{ 5 } [ { 1 2 2 } something ] unit-test
+{ 6 } [ { 2 3 } something ] unit-test
[ { 1 } something ] must-fail
[ 1 2 [ eq? ] undo ] must-fail
: f>c ( *fahrenheit -- *celsius )
32 - 1.8 / ;
-[ { 212.0 32.0 } ] [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
-[ { t t f } ] [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
-[ { t f } ] [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
-[ 9 9 ] [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
-[ 5 ] [ 6 5 - [ 6 swap - ] undo ] unit-test
-[ 6 ] [ 6 5 - [ 5 - ] undo ] unit-test
+{ { 212.0 32.0 } } [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
+{ { t t f } } [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
+{ { t f } } [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
+{ 9 9 } [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
+{ 5 } [ 6 5 - [ 6 swap - ] undo ] unit-test
+{ 6 } [ 6 5 - [ 5 - ] undo ] unit-test
TUPLE: cons car cdr ;
[ "Malformed list" throw ]
} switch ;
-[ 10 ] [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
-[ ] [ <nil> [ <nil> ] undo ] unit-test
-[ 1 2 ] [ 1 2 <cons> [ <cons> ] undo ] unit-test
-[ t ] [ 1 2 <cons> [ <cons> ] matches? ] unit-test
-[ f ] [ 1 2 <cons> [ <foo> ] matches? ] unit-test
-[ "Malformed list" ] [ [ f list-sum ] [ ] recover ] unit-test
+{ 10 } [ 1 2 3 4 <nil> <cons> <cons> <cons> <cons> list-sum ] unit-test
+{ } [ <nil> [ <nil> ] undo ] unit-test
+{ 1 2 } [ 1 2 <cons> [ <cons> ] undo ] unit-test
+{ t } [ 1 2 <cons> [ <cons> ] matches? ] unit-test
+{ f } [ 1 2 <cons> [ <foo> ] matches? ] unit-test
+{ "Malformed list" } [ [ f list-sum ] [ ] recover ] unit-test
: empty-cons ( -- cons ) cons new ;
: cons* ( cdr car -- cons ) cons boa ;
-[ ] [ T{ cons f f f } [ empty-cons ] undo ] unit-test
-[ 1 2 ] [ 1 2 <cons> [ cons* ] undo ] unit-test
+{ } [ T{ cons f f f } [ empty-cons ] undo ] unit-test
+{ 1 2 } [ 1 2 <cons> [ cons* ] undo ] unit-test
-[ t ] [ pi [ pi ] matches? ] unit-test
-[ 0.0 ] [ 0.0 pi + [ pi + ] undo ] unit-test
-[ ] [ 3 [ __ ] undo ] unit-test
+{ t } [ pi [ pi ] matches? ] unit-test
+{ 0.0 } [ 0.0 pi + [ pi + ] undo ] unit-test
+{ } [ 3 [ __ ] undo ] unit-test
-[ 2.0 ] [ 2 3 ^ [ 3 ^ ] undo ] unit-test
-[ 3.0 ] [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
+{ 2.0 } [ 2 3 ^ [ 3 ^ ] undo ] unit-test
+{ 3.0 } [ 2 3 ^ [ 2 swap ^ ] undo ] unit-test
-[ { 1 } ] [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
-[ { 3 } ] [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
+{ { 1 } } [ { 1 2 3 } [ { 2 3 } append ] undo ] unit-test
+{ { 3 } } [ { 1 2 3 } [ { 1 2 } prepend ] undo ] unit-test
[ { 1 2 3 } [ { 1 2 } append ] undo ] must-fail
[ { 1 2 3 } [ { 2 3 } prepend ] undo ] must-fail
-[ [ sq ] ] [ [ sqrt ] [undo] ] unit-test
-[ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
-[ [ not ] ] [ [ not ] [undo] ] unit-test
-[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test
+{ [ sq ] } [ [ sqrt ] [undo] ] unit-test
+{ [ sqrt ] } [ [ sq ] [undo] ] unit-test
+{ [ not ] } [ [ not ] [undo] ] unit-test
+{ { 3 2 1 } } [ { 1 2 3 } [ reverse ] undo ] unit-test
TUPLE: funny-tuple ;
: <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
: funny-tuple ( -- ) "OOPS" throw ;
-[ ] [ [ <funny-tuple> ] [undo] drop ] unit-test
+{ } [ [ <funny-tuple> ] [undo] drop ] unit-test
-[ 0 ] [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
-[ { 0 1 } ] [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test
+{ 0 } [ { 1 2 } [ [ 1 + 2 ] { } output>sequence ] undo ] unit-test
+{ { 0 1 } } [ 1 2 [ [ [ 1 + ] bi@ ] input<sequence ] undo ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test lcs ;
-[ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
-[ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
-[ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test
-[ 1 ] [ "freshpack" "freshpak" levenshtein ] unit-test
+{ 3 } [ "sitting" "kitten" levenshtein ] unit-test
+{ 3 } [ "kitten" "sitting" levenshtein ] unit-test
+{ 1 } [ "freshpak" "freshpack" levenshtein ] unit-test
+{ 1 } [ "freshpack" "freshpak" levenshtein ] unit-test
-[ "hell" ] [ "hello" "hell" lcs ] unit-test
-[ "hell" ] [ "hell" "hello" lcs ] unit-test
-[ "ell" ] [ "ell" "hell" lcs ] unit-test
-[ "ell" ] [ "hell" "ell" lcs ] unit-test
-[ "abd" ] [ "faxbcd" "abdef" lcs ] unit-test
+{ "hell" } [ "hello" "hell" lcs ] unit-test
+{ "hell" } [ "hell" "hello" lcs ] unit-test
+{ "ell" } [ "ell" "hell" lcs ] unit-test
+{ "ell" } [ "hell" "ell" lcs ] unit-test
+{ "abd" } [ "faxbcd" "abdef" lcs ] unit-test
-[ {
+{ {
T{ delete f CHAR: f }
T{ retain f CHAR: a }
T{ delete f CHAR: x }
T{ retain f CHAR: d }
T{ insert f CHAR: e }
T{ insert f CHAR: f }
-} ] [ "faxbcd" "abdef" lcs-diff ] unit-test
+} } [ "faxbcd" "abdef" lcs-diff ] unit-test
100 malloc "block" set
-[ t ] [ "block" get malloc-exists? ] unit-test
+{ t } [ "block" get malloc-exists? ] unit-test
-[ ] [ [ "block" get &free drop ] with-destructors ] unit-test
+{ } [ [ "block" get &free drop ] with-destructors ] unit-test
-[ f ] [ "block" get malloc-exists? ] unit-test
+{ f } [ "block" get malloc-exists? ] unit-test
-[ "Operation not permitted" ] [ 1 strerror ] unit-test
+{ "Operation not permitted" } [ 1 strerror ] unit-test
] unit-test
] with-file-vocabs
-[ ] [
+{ } [
[
"vocabs.loader.test.c" forget-vocab
] with-compilation-unit
] must-fail
] with-file-vocabs
-[ ] [
+{ } [
[
"vocabs.loader.test.c" forget-vocab
] with-compilation-unit
{ 1 2 3 } sequence>list { 4 5 6 } sequence>list lappend list>array
] unit-test
-[ { 1 } { 2 } ] [ { 1 2 } sequence>list 1 lcut [ list>array ] bi@ ] unit-test
+{ { 1 } { 2 } } [ { 1 2 } sequence>list 1 lcut [ list>array ] bi@ ] unit-test
: five ( -- a ) 5 ;
: seven-eleven ( -- b c ) 7 11 ;
-[ { 5 } ] [ { $ five } ] unit-test
-[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
-[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test
+{ { 5 } } [ { $ five } ] unit-test
+{ { 7 11 } } [ { $ seven-eleven } ] unit-test
+{ { 6 6 6 } } [ { $ six-six-six } ] unit-test
-[ { 6 6 6 7 } ] [ { $ six-six-six 7 } ] unit-test
+{ { 6 6 6 7 } } [ { $ six-six-six 7 } ] unit-test
-[ { 8 8 8 } ] [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
+{ { 8 8 8 } } [ { $[ six-six-six [ 2 + ] tri@ ] } ] unit-test
-[ { 0.5 2.0 } ] [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
+{ { 0.5 2.0 } } [ { $[ 1.0 2.0 / ] 2.0 } ] unit-test
-[ { 1.0 { 0.5 1.5 } 4.0 } ] [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
+{ { 1.0 { 0.5 1.5 } 4.0 } } [ { 1.0 { $[ 1.0 2.0 / ] 1.5 } $[ 2.0 2.0 * ] } ] unit-test
CONSTANT: constant-a 3
-[ { 3 10 "ftw" } ] [ ${ constant-a 10 "ftw" } ] unit-test
+{ { 3 10 "ftw" } } [ ${ constant-a 10 "ftw" } ] unit-test
{ { 4 } } [ ${ 1 constant-a + } ] unit-test
{ { 3 } } [ ${ 1 2 + } ] unit-test
{ { 1 2 \ + } } [ ${ 1 2 \ + } ] unit-test
: sixty-nine ( -- a b ) 6 9 ;
-[ { 6 9 } ] [ ${ sixty-nine } ] unit-test
+{ { 6 9 } } [ ${ sixty-nine } ] unit-test
CONSTANT: a 1
CONSTANT: b 2
CONSTANT: foo flags{ a b d }
-[ 3 ] [ foo ] unit-test
-[ 3 ] [ flags{ a b d } ] unit-test
+{ 3 } [ foo ] unit-test
+{ 3 } [ flags{ a b d } ] unit-test
\ foo def>> must-infer
-[ 1 ] [ flags{ 1 } ] unit-test
+{ 1 } [ flags{ 1 } ] unit-test
:: foo ( a b -- a a ) a a ;
-[ 1 1 ] [ 1 2 foo ] unit-test
+{ 1 1 } [ 1 2 foo ] unit-test
:: add-test ( a b -- c ) a b + ;
-[ 3 ] [ 1 2 add-test ] unit-test
+{ 3 } [ 1 2 add-test ] unit-test
:: sub-test ( a b -- c ) a b - ;
-[ -1 ] [ 1 2 sub-test ] unit-test
+{ -1 } [ 1 2 sub-test ] unit-test
:: map-test ( a b -- seq ) a [ b + ] map ;
-[ { 5 6 7 } ] [ { 1 2 3 } 4 map-test ] unit-test
+{ { 5 6 7 } } [ { 1 2 3 } 4 map-test ] unit-test
:: map-test-2 ( seq inc -- seq ) seq [| elt | elt inc + ] map ;
-[ { 5 6 7 } ] [ { 1 2 3 } 4 map-test-2 ] unit-test
+{ { 5 6 7 } } [ { 1 2 3 } 4 map-test-2 ] unit-test
:: let-test ( c -- d )
[let 1 :> a 2 :> b a b + c + ] ;
-[ 7 ] [ 4 let-test ] unit-test
+{ 7 } [ 4 let-test ] unit-test
:: let-test-2 ( a -- a )
a [let :> a [let a :> b a ] ] ;
-[ 3 ] [ 3 let-test-2 ] unit-test
+{ 3 } [ 3 let-test-2 ] unit-test
:: let-test-3 ( a -- a )
a [let :> a [let [ a ] :> b [let 3 :> a b ] ] ] ;
:: let-test-4 ( a -- b )
a [let 1 :> a :> b a b 2array ] ;
-[ { 1 2 } ] [ 2 let-test-4 ] unit-test
+{ { 1 2 } } [ 2 let-test-4 ] unit-test
:: let-test-5 ( a b -- b )
a b [let :> a :> b a b 2array ] ;
-[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
+{ { 2 1 } } [ 1 2 let-test-5 ] unit-test
:: let-test-6 ( a -- b )
a [let :> a 1 :> b a b 2array ] ;
-[ { 2 1 } ] [ 2 let-test-6 ] unit-test
+{ { 2 1 } } [ 2 let-test-6 ] unit-test
-[ -1 ] [ -1 let-test-3 call ] unit-test
+{ -1 } [ -1 let-test-3 call ] unit-test
:: write-test-1 ( n! -- q )
[| i | n i + dup n! ] ;
{ 1 1 } "q" get must-infer-as
-[ 1 ] [ 1 "q" get call ] unit-test
+{ 1 } [ 1 "q" get call ] unit-test
-[ 2 ] [ 1 "q" get call ] unit-test
+{ 2 } [ 1 "q" get call ] unit-test
-[ 3 ] [ 1 "q" get call ] unit-test
+{ 3 } [ 1 "q" get call ] unit-test
-[ 5 ] [ 2 "q" get call ] unit-test
+{ 5 } [ 2 "q" get call ] unit-test
:: write-test-2 ( -- q )
[let 0 :> n! [| i | n i + dup n! ] ] ;
write-test-2 "q" set
-[ 1 ] [ 1 "q" get call ] unit-test
+{ 1 } [ 1 "q" get call ] unit-test
-[ 2 ] [ 1 "q" get call ] unit-test
+{ 2 } [ 1 "q" get call ] unit-test
-[ 3 ] [ 1 "q" get call ] unit-test
+{ 3 } [ 1 "q" get call ] unit-test
-[ 5 ] [ 2 "q" get call ] unit-test
+{ 5 } [ 2 "q" get call ] unit-test
-[ 10 20 ]
+{ 10 20 }
[
20 10 [| a! | [| b! | a b ] ] call call
] unit-test
:: write-test-3 ( a! -- q ) [| b | b a! ] ;
-[ ] [ 1 2 write-test-3 call ] unit-test
+{ } [ 1 2 write-test-3 call ] unit-test
:: write-test-4 ( x! -- q ) [ [let 0 :> y! f x! ] ] ;
-[ ] [ 5 write-test-4 drop ] unit-test
+{ } [ 5 write-test-4 drop ] unit-test
:: let-let-test ( n -- n ) [let n 3 + :> n n ] ;
-[ 13 ] [ 10 let-let-test ] unit-test
+{ 13 } [ 10 let-let-test ] unit-test
GENERIC: lambda-generic ( a b -- c )
M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
-[ 10 ] [ 5 2 lambda-generic ] unit-test
+{ 10 } [ 5 2 lambda-generic ] unit-test
-[ "abab" ] [ "aba" "b" lambda-generic ] unit-test
+{ "abab" } [ "aba" "b" lambda-generic ] unit-test
-[ "abaxxx" ] [ "aba" 3 lambda-generic ] unit-test
+{ "abaxxx" } [ "aba" 3 lambda-generic ] unit-test
-[ "xaba" ] [ 1 "aba" lambda-generic ] unit-test
+{ "xaba" } [ 1 "aba" lambda-generic ] unit-test
-[ ] [ \ lambda-generic-1 see ] unit-test
+{ } [ \ lambda-generic-1 see ] unit-test
-[ ] [ \ lambda-generic-2 see ] unit-test
+{ } [ \ lambda-generic-2 see ] unit-test
-[ ] [ \ lambda-generic see ] unit-test
+{ } [ \ lambda-generic see ] unit-test
:: unparse-test-1 ( a -- ) [let 3 :> a! 4 :> b ] ;
-[ "[let 3 :> a! 4 :> b ]" ] [
+{ "[let 3 :> a! 4 :> b ]" } [
\ unparse-test-1 "lambda" word-prop body>> first unparse
] unit-test
:: unparse-test-3 ( -- b ) [| a! | ] ;
-[ "[| a! | ]" ] [
+{ "[| a! | ]" } [
\ unparse-test-3 "lambda" word-prop body>> first unparse
] unit-test
DEFER: xyzzy
-[ ] [
+{ } [
"IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) M: integer xyzzy ;"
<string-reader> "lambda-generic-test" parse-stream drop
] unit-test
-[ 10 ] [ 10 xyzzy ] unit-test
+{ 10 } [ 10 xyzzy ] unit-test
-[ ] [
+{ } [
"IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) 5 ;"
<string-reader> "lambda-generic-test" parse-stream drop
] unit-test
-[ 5 ] [ 10 xyzzy ] unit-test
+{ 5 } [ 10 xyzzy ] unit-test
GENERIC: next-method-test ( a -- b )
M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
-[ 5 ] [ 1 next-method-test ] unit-test
+{ 5 } [ 1 next-method-test ] unit-test
: no-with-locals-test ( -- seq ) { 1 2 3 } [| x | x 3 + ] map ;
-[ { 4 5 6 } ] [ no-with-locals-test ] unit-test
+{ { 4 5 6 } } [ no-with-locals-test ] unit-test
{ 3 0 } [| a b c | ] must-infer-as
-[ ] [ 1 [let :> a ] ] unit-test
+{ } [ 1 [let :> a ] ] unit-test
-[ 3 ] [ 1 [let :> a 3 ] ] unit-test
+{ 3 } [ 1 [let :> a 3 ] ] unit-test
-[ ] [ 1 2 [let :> a :> b ] ] unit-test
+{ } [ 1 2 [let :> a :> b ] ] unit-test
:: a-word-with-locals ( a b -- ) ;
CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n"
-[ ] [ new-definition eval( -- ) ] unit-test
+{ } [ new-definition eval( -- ) ] unit-test
-[ t ] [
+{ t } [
[ \ a-word-with-locals see ] with-string-writer
new-definition =
] unit-test
M:: sequence method-with-locals ( a -- y ) a reverse ;
-[ t ] [
+{ t } [
[ \ sequence \ method-with-locals lookup-method see ] with-string-writer
method-definition =
] unit-test
\ cond-test def>> must-infer
-[ 3 ] [ 1 2 cond-test ] unit-test
-[ 4 ] [ 2 2 cond-test ] unit-test
-[ 5 ] [ 3 2 cond-test ] unit-test
+{ 3 } [ 1 2 cond-test ] unit-test
+{ 4 } [ 2 2 cond-test ] unit-test
+{ 5 } [ 3 2 cond-test ] unit-test
:: 0&&-test ( a -- ? )
{ [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ;
\ 0&&-test def>> must-infer
-[ f ] [ 1.5 0&&-test ] unit-test
-[ f ] [ 3 0&&-test ] unit-test
-[ f ] [ 8 0&&-test ] unit-test
-[ t ] [ 12 0&&-test ] unit-test
+{ f } [ 1.5 0&&-test ] unit-test
+{ f } [ 3 0&&-test ] unit-test
+{ f } [ 8 0&&-test ] unit-test
+{ t } [ 12 0&&-test ] unit-test
:: &&-test ( a -- ? )
{ [ a integer? ] [ a even? ] [ a 10 > ] } && ;
\ &&-test def>> must-infer
-[ f ] [ 1.5 &&-test ] unit-test
-[ f ] [ 3 &&-test ] unit-test
-[ f ] [ 8 &&-test ] unit-test
-[ t ] [ 12 &&-test ] unit-test
+{ f } [ 1.5 &&-test ] unit-test
+{ f } [ 3 &&-test ] unit-test
+{ f } [ 8 &&-test ] unit-test
+{ t } [ 12 &&-test ] unit-test
:: let-and-cond-test-1 ( -- a )
[let 10 :> a
\ let-and-cond-test-1 def>> must-infer
-[ 20 ] [ let-and-cond-test-1 ] unit-test
+{ 20 } [ let-and-cond-test-1 ] unit-test
:: let-and-cond-test-2 ( -- pair )
[let 10 :> A
\ let-and-cond-test-2 def>> must-infer
-[ { 10 20 } ] [ let-and-cond-test-2 ] unit-test
+{ { 10 20 } } [ let-and-cond-test-2 ] unit-test
-[ { 10 } ] [ 10 [| a | { a } ] call ] unit-test
-[ { 10 20 } ] [ 10 20 [| a b | { a b } ] call ] unit-test
-[ { 10 20 30 } ] [ 10 20 30 [| a b c | { a b c } ] call ] unit-test
+{ { 10 } } [ 10 [| a | { a } ] call ] unit-test
+{ { 10 20 } } [ 10 20 [| a b | { a b } ] call ] unit-test
+{ { 10 20 30 } } [ 10 20 30 [| a b c | { a b c } ] call ] unit-test
-[ { 10 20 30 } ] [ [let 10 :> a 20 :> b 30 :> c { a b c } ] ] unit-test
+{ { 10 20 30 } } [ [let 10 :> a 20 :> b 30 :> c { a b c } ] ] unit-test
-[ V{ 10 20 30 } ] [ 10 20 30 [| a b c | V{ a b c } ] call ] unit-test
+{ V{ 10 20 30 } } [ 10 20 30 [| a b c | V{ a b c } ] call ] unit-test
-[ H{ { 10 "a" } { 20 "b" } { 30 "c" } } ]
+{ H{ { 10 "a" } { 20 "b" } { 30 "c" } } }
[ 10 20 30 [| a b c | H{ { a "a" } { b "b" } { c "c" } } ] call ] unit-test
-[ T{ slice f 0 3 "abc" } ]
+{ T{ slice f 0 3 "abc" } }
[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
ERROR: punned-class x ;
-[ T{ punned-class f 3 } ] [ 3 [| a | T{ punned-class f a } ] call ] unit-test
+{ T{ punned-class f 3 } } [ 3 [| a | T{ punned-class f a } ] call ] unit-test
:: literal-identity-test ( -- a b )
{ 1 } V{ } ;
-[ t t ] [
+{ t t } [
literal-identity-test
literal-identity-test
[ eq? ] [ eq? ] bi-curry* bi*
:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ;
-[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test
+{ { 4 } } [ 3 mutable-local-in-literal-test ] unit-test
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
obj1 obj2 <=> {
\ big-case-test def>> must-infer
-[ 9 ] [ 3 big-case-test ] unit-test
+{ 9 } [ 3 big-case-test ] unit-test
! Dan found this problem
: littledan-case-problem-1 ( a -- b )
\ littledan-case-problem-1 def>> must-infer
-[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test
-[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test
+{ "howdy" } [ -12 \ littledan-case-problem-1 def>> call ] unit-test
+{ "howdy" } [ -12 littledan-case-problem-1 ] unit-test
:: littledan-case-problem-2 ( a -- b )
a {
\ littledan-case-problem-2 def>> must-infer
-[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test
-[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test
+{ "howdy" } [ -12 \ littledan-case-problem-2 def>> call ] unit-test
+{ "howdy" } [ -12 littledan-case-problem-2 ] unit-test
:: littledan-cond-problem-1 ( a -- b )
a {
\ littledan-cond-problem-1 def>> must-infer
-[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test
-[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test
-[ "howdy" ] [ 0 \ littledan-cond-problem-1 def>> call ] unit-test
-[ f ] [ -12 littledan-cond-problem-1 ] unit-test
-[ 4 ] [ 12 littledan-cond-problem-1 ] unit-test
-[ "howdy" ] [ 0 littledan-cond-problem-1 ] unit-test
+{ f } [ -12 \ littledan-cond-problem-1 def>> call ] unit-test
+{ 4 } [ 12 \ littledan-cond-problem-1 def>> call ] unit-test
+{ "howdy" } [ 0 \ littledan-cond-problem-1 def>> call ] unit-test
+{ f } [ -12 littledan-cond-problem-1 ] unit-test
+{ 4 } [ 12 littledan-cond-problem-1 ] unit-test
+{ "howdy" } [ 0 littledan-cond-problem-1 ] unit-test
/*
:: littledan-case-problem-3 ( a quot -- b )
quot
} case ; inline
-[ f ] [ t [ ] littledan-case-problem-3 ] unit-test
-[ 144 ] [ 12 [ sq ] littledan-case-problem-3 ] unit-test
+{ f } [ t [ ] littledan-case-problem-3 ] unit-test
+{ 144 } [ 12 [ sq ] littledan-case-problem-3 ] unit-test
[| | [| a | a ] littledan-case-problem-3 ] must-infer
: littledan-case-problem-4 ( a -- b )
M:: integer lambda-method-forget-test ( a -- b ) a ;
-[ ] [ [ M\ integer lambda-method-forget-test forget ] with-compilation-unit ] unit-test
+{ } [ [ M\ integer lambda-method-forget-test forget ] with-compilation-unit ] unit-test
-[ 10 ] [ 10 [| A | { [ A ] } ] call first call ] unit-test
+{ 10 } [ 10 [| A | { [ A ] } ] call first call ] unit-test
[
"USING: locals fry math ; 1 '[ [let 10 :> A A _ + ] ]"
\ funny-macro-test def>> must-infer
-[ t ] [ 3 funny-macro-test ] unit-test
-[ f ] [ 2 funny-macro-test ] unit-test
+{ t } [ 3 funny-macro-test ] unit-test
+{ f } [ 2 funny-macro-test ] unit-test
[ "USE: locals [let" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
[ "USE: locals [|" eval( -- ) ] [ error>> unexpected-eof? ] must-fail-with
-[ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
-[ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
+{ 25 } [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
+{ 25 } [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
:: FAILdog-1 ( -- b ) { [| c | c ] } ;
\ FAILdog-2 def>> must-infer
-[ 3 ] [ 3 [| a | \ a ] call ] unit-test
+{ 3 } [ 3 [| a | \ a ] call ] unit-test
[ "USE: locals [| | { [let 0 :> a a ] } ]" eval( -- ) ] must-fail
[ "USE: locals 3 :> a" eval( -- ) ] must-fail
-[ 3 ] [ 3 [| | :> a a ] call ] unit-test
+{ 3 } [ 3 [| | :> a a ] call ] unit-test
-[ 3 ] [ 3 [| | :> a! a ] call ] unit-test
+{ 3 } [ 3 [| | :> a! a ] call ] unit-test
-[ 3 ] [ 2 [| | :> a! a 1 + a! a ] call ] unit-test
+{ 3 } [ 2 [| | :> a! a 1 + a! a ] call ] unit-test
: fry-locals-test-1 ( -- n )
[let 6 '[ [let 4 :> A A _ + ] ] call ] ;
\ fry-locals-test-1 def>> must-infer
-[ 10 ] [ fry-locals-test-1 ] unit-test
+{ 10 } [ fry-locals-test-1 ] unit-test
:: fry-locals-test-2 ( -- n )
[let 6 '[ [let 4 :> A A _ + ] ] call ] ;
\ fry-locals-test-2 def>> must-infer
-[ 10 ] [ fry-locals-test-2 ] unit-test
+{ 10 } [ fry-locals-test-2 ] unit-test
-[ 1 ] [ 3 4 [| | '[ [ _ swap - ] call ] call ] call ] unit-test
-[ -1 ] [ 3 4 [| | [| a | a - ] call ] call ] unit-test
-[ -1 ] [ 3 4 [| | [| a | a - ] curry call ] call ] unit-test
-[ -1 ] [ 3 4 [| a | a - ] curry call ] unit-test
-[ 1 ] [ 3 4 [| | '[ [| a | _ a - ] call ] call ] call ] unit-test
-[ -1 ] [ 3 4 [| | '[ [| a | a _ - ] call ] call ] call ] unit-test
+{ 1 } [ 3 4 [| | '[ [ _ swap - ] call ] call ] call ] unit-test
+{ -1 } [ 3 4 [| | [| a | a - ] call ] call ] unit-test
+{ -1 } [ 3 4 [| | [| a | a - ] curry call ] call ] unit-test
+{ -1 } [ 3 4 [| a | a - ] curry call ] unit-test
+{ 1 } [ 3 4 [| | '[ [| a | _ a - ] call ] call ] call ] unit-test
+{ -1 } [ 3 4 [| | '[ [| a | a _ - ] call ] call ] call ] unit-test
-[ { 1 2 3 4 } ] [
+{ { 1 2 3 4 } } [
1 3 2 4
[| | '[ [| a b | a _ b _ 4array ] call ] call ] call
] unit-test
-[ 10 ] [
+{ 10 } [
[| | 0 '[ [let 10 :> A A _ + ] ] call ] call
] unit-test
! littledan found this problem
-[ "bar" ] [ [let [let "bar" :> foo foo ] :> a a ] ] unit-test
-[ 10 ] [ [let 10 :> a [let a :> b b ] ] ] unit-test
+{ "bar" } [ [let [let "bar" :> foo foo ] :> a a ] ] unit-test
+{ 10 } [ [let 10 :> a [let a :> b b ] ] ] unit-test
-[ { \ + } ] [ [let \ + :> x { \ x } ] ] unit-test
+{ { \ + } } [ [let \ + :> x { \ x } ] ] unit-test
-[ { \ + 3 } ] [ [let 3 :> a { \ + a } ] ] unit-test
+{ { \ + 3 } } [ [let 3 :> a { \ + a } ] ] unit-test
-[ 3 ] [ [let \ + :> a 1 2 [ \ a execute ] ] call ] unit-test
+{ 3 } [ [let \ + :> a 1 2 [ \ a execute ] ] call ] unit-test
! erg found this problem
:: erg's-:>-bug ( n ? -- n ) ? [ n :> n n ] [ n :> b b ] if ;
-[ 3 ] [ 3 f erg's-:>-bug ] unit-test
+{ 3 } [ 3 f erg's-:>-bug ] unit-test
-[ 3 ] [ 3 t erg's-:>-bug ] unit-test
+{ 3 } [ 3 t erg's-:>-bug ] unit-test
:: erg's-:>-bug-2 ( n ? -- n ) ? n '[ _ :> n n ] [ n :> b b ] if ;
-[ 3 ] [ 3 f erg's-:>-bug-2 ] unit-test
+{ 3 } [ 3 f erg's-:>-bug-2 ] unit-test
-[ 3 ] [ 3 t erg's-:>-bug-2 ] unit-test
+{ 3 } [ 3 t erg's-:>-bug-2 ] unit-test
! dharmatech found this problem
GENERIC: ed's-bug ( a -- b )
:: ed's-test-case ( a -- b )
{ [ a ed's-bug ] } && ;
-[ t ] [ \ ed's-test-case optimized? ] unit-test
+{ t } [ \ ed's-test-case optimized? ] unit-test
! multiple bind
-[ 3 1 2 ] [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test
+{ 3 1 2 } [ [let 1 2 3 :> ( a b c ) c a b ] ] unit-test
! Test smart combinators and locals interaction
:: smart-combinator-locals ( a b c -- seq ) [ a b c ] output>array ;
-[ { 1 2 3 } ] [ 1 2 3 smart-combinator-locals ] unit-test
+{ { 1 2 3 } } [ 1 2 3 smart-combinator-locals ] unit-test
MACRO: see-test ( a b -- quot ) + ;
-[ t ] [ \ see-test macro? ] unit-test
+{ t } [ \ see-test macro? ] unit-test
-[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" ]
+{ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" }
[ [ \ see-test see ] with-string-writer ]
unit-test
-[ t ] [ \ see-test macro? ] unit-test
+{ t } [ \ see-test macro? ] unit-test
-[ t ] [
+{ t } [
"USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval( -- )
[ \ see-test see ] with-string-writer =
] unit-test
-[ f ] [ \ see-test macro? ] unit-test
+{ f } [ \ see-test macro? ] unit-test
-[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ;" eval( -- ) ] unit-test
-[ ] [ "USING: macros kernel ; IN: hanging-macro : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
+{ } [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ;" eval( -- ) ] unit-test
+{ } [ "USING: macros kernel ; IN: hanging-macro : a ( -- ) [ a ] c ;" eval( -- ) ] unit-test
-[ ] [ [ "hanging-macro" forget-vocab ] with-compilation-unit ] unit-test
+{ } [ [ "hanging-macro" forget-vocab ] with-compilation-unit ] unit-test
-[ ] [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
+{ } [ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ;" eval( -- ) ] unit-test
[ "IN: macros.tests USE: macros MACRO: foo ( -- x ) [ ] ; inline" eval( -- ) ] must-fail
! The macro expander code should infer
[ [ 0 bad-macro ] infer ] must-fail
-[ ] [ [ \ bad-macro forget ] with-compilation-unit ] unit-test
+{ } [ [ \ bad-macro forget ] with-compilation-unit ] unit-test
MATCH-VARS: ?a ?b ;
-[ f ] [ { ?a ?a } { 1 2 } match ] unit-test
+{ f } [ { ?a ?a } { 1 2 } match ] unit-test
-[ H{ { ?a 1 } { ?b 2 } } ] [
+{ H{ { ?a 1 } { ?b 2 } } } [
{ ?a ?b } { 1 2 } match
] unit-test
-[ { 1 2 } ] [
+{ { 1 2 } } [
{ 1 2 }
{
{ { ?a ?b } [ ?a ?b 2array ] }
} match-cond
] unit-test
-[ t ] [
+{ t } [
{ 1 2 }
{
{ { 1 2 } [ t ] }
} match-cond
] unit-test
-[ t ] [
+{ t } [
{ 1 3 }
{
{ { 1 2 } [ t ] }
} match-cond
] unit-test
-[ f ] [
+{ f } [
{ 1 5 }
{
{ { 1 2 } [ t ] }
\ ?a \ ?a match
] unit-test
-[ "match" ] [
+{ "match" } [
"abcd" {
{ ?a [ "match" ] }
} match-cond
TUPLE: match-replace-test a b ;
-[
+{
T{ match-replace-test f 2 1 }
-] [
+} [
T{ match-replace-test f 1 2 }
T{ match-replace-test f ?a ?b }
T{ match-replace-test f ?b ?a }
MEMO: x ( a b c d e -- f g h i j )
[ 1 + ] 4 ndip ;
-[ 89 ] [ 10 fib ] unit-test
+{ 89 } [ 10 fib ] unit-test
-[
+{
1 0 0 0 0
1 0 0 0 0
-] [
+} [
0 0 0 0 0 x
0 0 0 0 0 x
] unit-test
MEMO: see-test ( a -- b ) reverse ;
-[ "USING: memoize sequences ;\nIN: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" ]
+{ "USING: memoize sequences ;\nIN: memoize.tests\nMEMO: see-test ( a -- b ) reverse ;\n" }
[ [ \ see-test see ] with-string-writer ]
unit-test
-[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval( -- ) ] unit-test
+{ } [ "IN: memoize.tests : fib ( -- ) ;" eval( -- ) ] unit-test
-[ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
+{ "IN: memoize.tests\n: fib ( -- ) ;\n" } [ [ \ fib see ] with-string-writer ] unit-test
[ sq ] ( a -- b ) memoize-quot "q" set
-[ 9 ] [ 3 "q" get call ] unit-test
+{ 9 } [ 3 "q" get call ] unit-test
C: <foo> foo
-[ 2 ] [ 1 2 <foo> <mirror> assoc-size ] unit-test
+{ 2 } [ 1 2 <foo> <mirror> assoc-size ] unit-test
-[ { "bar" "baz" } ] [ 1 2 <foo> <mirror> keys ] unit-test
+{ { "bar" "baz" } } [ 1 2 <foo> <mirror> keys ] unit-test
-[ 1 t ] [ "bar" 1 2 <foo> <mirror> at* ] unit-test
+{ 1 t } [ "bar" 1 2 <foo> <mirror> at* ] unit-test
-[ f f ] [ "hi" 1 2 <foo> <mirror> at* ] unit-test
+{ f f } [ "hi" 1 2 <foo> <mirror> at* ] unit-test
-[ 3 ] [
+{ 3 } [
3 "baz" 1 2 <foo> [ <mirror> set-at ] keep baz>>
] unit-test
[ 3 "numerator" 1/2 <mirror> set-at ] must-fail
-[ "foo" ] [
+{ "foo" } [
gensym [
<mirror> [
"foo" "name" set
TUPLE: declared-mirror-test
{ a integer initial: 0 } ;
-[ 5 ] [
+{ 5 } [
3 declared-mirror-test boa <mirror> [
5 "a" set
"a" get
{ green integer }
{ blue integer } ;
-[ T{ color f 0 0 0 } ] [
+{ T{ color f 0 0 0 } } [
1 2 3 color boa [ <mirror> clear-assoc ] keep
] unit-test
! Test reshaping with a mirror
1 2 3 color boa <mirror> "mirror" set
-[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
+{ } [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval( -- ) ] unit-test
-[ 1 ] [ "red" "mirror" get at ] unit-test
+{ 1 } [ "red" "mirror" get at ] unit-test
{ 3 } [ { 1 2 3 } make-mirror assoc-size ] unit-test
{ 2 } [ "asdf" make-mirror assoc-size ] unit-test
M: model-tester model-changed nip t >>hit? drop ;
-[ T{ model-tester f t } ]
+{ T{ model-tester f t } }
[
T{ model-tester f f } clone 3 <model> 2dup add-connection
5 swap set-model
"model-a" get "model-b" get 2array <product> "model-c" set
"model-c" get activate-model
-[ { 3 4 } ] [ "model-c" get value>> ] unit-test
+{ { 3 4 } } [ "model-c" get value>> ] unit-test
"model-c" get deactivate-model
T{ model-tester f f } "tester" set
-[ T{ model-tester f t } { 6 4 } ]
+{ T{ model-tester f t } { 6 4 } }
[
"tester" get "model-c" get add-connection
6 "model-a" get set-model
"model-c" get value>>
] unit-test
-[ T{ model-tester f t } V{ 5 } ]
+{ T{ model-tester f t } V{ 5 } }
[
T{ model-tester f f } clone V{ } clone <model> 2dup add-connection
5 swap [ push-model ] [ value>> ] bi
] unit-test
-[ T{ model-tester f t } 5 V{ } ]
+{ T{ model-tester f t } 5 V{ } }
[
T{ model-tester f f } clone V{ 5 } clone <model> 2dup add-connection
[ pop-model ] [ value>> ] bi
;
-[ "foo\nbar\n" ] [ test-it ] unit-test
+{ "foo\nbar\n" } [ test-it ] unit-test
! HEREDOC:
-[ "foo\nbar\n" ] [ HEREDOC: END
+{ "foo\nbar\n" } [ HEREDOC: END
foo
bar
END
] unit-test
-[ "" ] [ HEREDOC: END
+{ "" } [ HEREDOC: END
END
] unit-test
-[ " END\n" ] [ HEREDOC: END
+{ " END\n" } [ HEREDOC: END
END
END
] unit-test
-[ "\n" ] [ HEREDOC: END
+{ "\n" } [ HEREDOC: END
END
] unit-test
-[ "x\n" ] [ HEREDOC: END
+{ "x\n" } [ HEREDOC: END
x
END
] unit-test
-[ "x\n" ] [ HEREDOC: END
+{ "x\n" } [ HEREDOC: END
x
END
] unit-test
! there's a space after xyz
-[ "xyz \n" ] [ HEREDOC: END
+{ "xyz \n" } [ HEREDOC: END
xyz
END
] unit-test
-[ "} ! * # \" «\n" ] [ HEREDOC: END
+{ "} ! * # \" «\n" } [ HEREDOC: END
} ! * # " «
END
] unit-test
-[ 21 "foo\nbar\n" " HEREDOC: FOO\n FOO\n" 22 ] [ 21 HEREDOC: X
+{ 21 "foo\nbar\n" " HEREDOC: FOO\n FOO\n" 22 } [ 21 HEREDOC: X
foo
bar
X
END
22 ] unit-test
-[ "lol\n xyz\n" ]
+{ "lol\n xyz\n" }
[
HEREDOC: xyz
lol
] unit-test
-[ "lol" ]
+{ "lol" }
[ DELIMITED: aol
lolaol ] unit-test
-[ "whoa" ]
+{ "whoa" }
[ DELIMITED: factor blows my mind
whoafactor blows my mind ] unit-test
SYNTAX: MULTILINE-LITERAL: parse-here suffix! ;
>>
-[ { "bar" } ]
+{ { "bar" } }
[
CONSTANT: foo { MULTILINE-LITERAL:
bar
[ -1 <nibble-array> ] [ T{ bad-array-length f -1 } = ] must-fail-with
-[ t ] [ 16 iota dup >nibble-array sequence= ] unit-test
-[ N{ 4 2 1 3 } ] [ N{ 3 1 2 4 } reverse ] unit-test
-[ N{ 1 4 9 0 9 4 } ] [ N{ 1 2 3 4 5 6 } [ sq ] map ] unit-test
+{ t } [ 16 iota dup >nibble-array sequence= ] unit-test
+{ N{ 4 2 1 3 } } [ N{ 3 1 2 4 } reverse ] unit-test
+{ N{ 1 4 9 0 9 4 } } [ N{ 1 2 3 4 5 6 } [ sq ] map ] unit-test
IN: nmake.tests
USING: nmake kernel tools.test ;
-[ ] [ [ ] { } nmake ] unit-test
+{ } [ [ ] { } nmake ] unit-test
-[ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
+{ { 1 } { 2 } } [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
[ [ ] [ call ] curry { { } } nmake ] must-infer
pack strings tools.test pack.private ;
IN: pack.tests
-[ B{ 1 0 2 0 0 3 0 0 0 4 0 0 0 0 0 0 0 5 } ] [
+{ B{ 1 0 2 0 0 3 0 0 0 4 0 0 0 0 0 0 0 5 } } [
{ 1 2 3 4 5 }
"cstiq" pack-be
] unit-test
-[ { 1 2 3 4 5 } ] [
+{ { 1 2 3 4 5 } } [
{ 1 2 3 4 5 }
"cstiq" [ pack-be ] keep unpack-be
] unit-test
-[ B{ 1 2 0 3 0 0 4 0 0 0 5 0 0 0 0 0 0 0 } ] [
+{ B{ 1 2 0 3 0 0 4 0 0 0 5 0 0 0 0 0 0 0 } } [
{ 1 2 3 4 5 } "cstiq" pack-le
] unit-test
-[ { 1 2 3 4 5 } ] [
+{ { 1 2 3 4 5 } } [
{ 1 2 3 4 5 }
"cstiq" [ pack-le ] keep unpack-le
] unit-test
-[ { -1 -2 -3 -4 -5 } ] [
+{ { -1 -2 -3 -4 -5 } } [
{ -1 -2 -3 -4 -5 }
"cstiq" [ pack-le ] keep unpack-le
] unit-test
-[ { -1 -2 -3 -4 -5 3.14 } ] [
+{ { -1 -2 -3 -4 -5 3.14 } } [
{ -1 -2 -3 -4 -5 3.14 }
"cstiqd" [ pack-be ] keep unpack-be
] unit-test
-[ { -1 -2 -3 -4 -5 } ] [
+{ { -1 -2 -3 -4 -5 } } [
{ -1 -2 -3 -4 -5 }
"cstiq" [ pack-native ] keep unpack-native
] unit-test
{ B{ 1 2 3 4 5 0 0 0 } } [ { 1 2 3 4 5 } "4ci" pack-le ] unit-test
{ { 1 2 3 4 5 } } [ B{ 1 2 3 4 5 0 0 0 } "4ci" unpack-le ] unit-test
-[ 9 ] [ "iic" packed-length ] unit-test
+{ 9 } [ "iic" packed-length ] unit-test
[ "iii" read-packed-le ] must-infer
[ "iii" read-packed-be ] must-infer
[ "iii" read-packed-native ] must-infer
sequences peg peg.private peg.parsers words math accessors ;
IN: peg.tests
-[ ] [ reset-pegs ] unit-test
+{ } [ reset-pegs ] unit-test
[
"endbegin" "begin" token parse
USE: compiler
-[ ] [ disable-optimizer ] unit-test
+{ } [ disable-optimizer ] unit-test
-[ ] [ "" epsilon parse drop ] unit-test
+{ } [ "" epsilon parse drop ] unit-test
-[ ] [ enable-optimizer ] unit-test
+{ } [ enable-optimizer ] unit-test
-[ [ ] ] [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
+{ [ ] } [ "" epsilon [ drop [ [ ] ] call ] action parse ] unit-test
{
T{ parse-error
USING: arrays io kernel porter-stemmer sequences tools.test
io.files io.encodings.utf8 ;
-[ 0 ] [ "xa" consonant-seq ] unit-test
-[ 0 ] [ "xxaa" consonant-seq ] unit-test
-[ 1 ] [ "xaxa" consonant-seq ] unit-test
-[ 2 ] [ "xaxaxa" consonant-seq ] unit-test
-[ 3 ] [ "xaxaxaxa" consonant-seq ] unit-test
-[ 3 ] [ "zzzzxaxaxaxaeee" consonant-seq ] unit-test
+{ 0 } [ "xa" consonant-seq ] unit-test
+{ 0 } [ "xxaa" consonant-seq ] unit-test
+{ 1 } [ "xaxa" consonant-seq ] unit-test
+{ 2 } [ "xaxaxa" consonant-seq ] unit-test
+{ 3 } [ "xaxaxaxa" consonant-seq ] unit-test
+{ 3 } [ "zzzzxaxaxaxaeee" consonant-seq ] unit-test
-[ t ] [ 0 "fish" consonant? ] unit-test
-[ f ] [ 0 "and" consonant? ] unit-test
-[ t ] [ 0 "yes" consonant? ] unit-test
-[ f ] [ 1 "gym" consonant? ] unit-test
+{ t } [ 0 "fish" consonant? ] unit-test
+{ f } [ 0 "and" consonant? ] unit-test
+{ t } [ 0 "yes" consonant? ] unit-test
+{ f } [ 1 "gym" consonant? ] unit-test
-[ t ] [ 5 "splitting" double-consonant? ] unit-test
-[ f ] [ 2 "feel" double-consonant? ] unit-test
+{ t } [ 5 "splitting" double-consonant? ] unit-test
+{ f } [ 2 "feel" double-consonant? ] unit-test
-[ f ] [ "xxxz" stem-vowel? ] unit-test
-[ t ] [ "baobab" stem-vowel? ] unit-test
+{ f } [ "xxxz" stem-vowel? ] unit-test
+{ t } [ "baobab" stem-vowel? ] unit-test
-[ t ] [ "hop" cvc? ] unit-test
-[ t ] [ "cav" cvc? ] unit-test
-[ t ] [ "lov" cvc? ] unit-test
-[ t ] [ "crim" cvc? ] unit-test
-[ f ] [ "show" cvc? ] unit-test
-[ f ] [ "box" cvc? ] unit-test
-[ f ] [ "tray" cvc? ] unit-test
-[ f ] [ "meet" cvc? ] unit-test
+{ t } [ "hop" cvc? ] unit-test
+{ t } [ "cav" cvc? ] unit-test
+{ t } [ "lov" cvc? ] unit-test
+{ t } [ "crim" cvc? ] unit-test
+{ f } [ "show" cvc? ] unit-test
+{ f } [ "box" cvc? ] unit-test
+{ f } [ "tray" cvc? ] unit-test
+{ f } [ "meet" cvc? ] unit-test
-[ "caress" ] [ "caresses" step1a step1b "" like ] unit-test
-[ "poni" ] [ "ponies" step1a step1b "" like ] unit-test
-[ "ti" ] [ "ties" step1a step1b "" like ] unit-test
-[ "caress" ] [ "caress" step1a step1b "" like ] unit-test
-[ "cat" ] [ "cats" step1a step1b "" like ] unit-test
-[ "feed" ] [ "feed" step1a step1b "" like ] unit-test
-[ "agree" ] [ "agreed" step1a step1b "" like ] unit-test
-[ "disable" ] [ "disabled" step1a step1b "" like ] unit-test
-[ "mat" ] [ "matting" step1a step1b "" like ] unit-test
-[ "mate" ] [ "mating" step1a step1b "" like ] unit-test
-[ "meet" ] [ "meeting" step1a step1b "" like ] unit-test
-[ "mill" ] [ "milling" step1a step1b "" like ] unit-test
-[ "mess" ] [ "messing" step1a step1b "" like ] unit-test
-[ "meet" ] [ "meetings" step1a step1b "" like ] unit-test
+{ "caress" } [ "caresses" step1a step1b "" like ] unit-test
+{ "poni" } [ "ponies" step1a step1b "" like ] unit-test
+{ "ti" } [ "ties" step1a step1b "" like ] unit-test
+{ "caress" } [ "caress" step1a step1b "" like ] unit-test
+{ "cat" } [ "cats" step1a step1b "" like ] unit-test
+{ "feed" } [ "feed" step1a step1b "" like ] unit-test
+{ "agree" } [ "agreed" step1a step1b "" like ] unit-test
+{ "disable" } [ "disabled" step1a step1b "" like ] unit-test
+{ "mat" } [ "matting" step1a step1b "" like ] unit-test
+{ "mate" } [ "mating" step1a step1b "" like ] unit-test
+{ "meet" } [ "meeting" step1a step1b "" like ] unit-test
+{ "mill" } [ "milling" step1a step1b "" like ] unit-test
+{ "mess" } [ "messing" step1a step1b "" like ] unit-test
+{ "meet" } [ "meetings" step1a step1b "" like ] unit-test
-[ "fishi" ] [ "fishy" step1c ] unit-test
-[ "by" ] [ "by" step1c ] unit-test
+{ "fishi" } [ "fishy" step1c ] unit-test
+{ "by" } [ "by" step1c ] unit-test
-[ "realizat" ] [ "realization" step4 ] unit-test
-[ "ion" ] [ "ion" step4 ] unit-test
-[ "able" ] [ "able" step4 ] unit-test
+{ "realizat" } [ "realization" step4 ] unit-test
+{ "ion" } [ "ion" step4 ] unit-test
+{ "able" } [ "able" step4 ] unit-test
-[ "fear" ] [ "feare" step5 "" like ] unit-test
-[ "mate" ] [ "mate" step5 "" like ] unit-test
-[ "hell" ] [ "hell" step5 "" like ] unit-test
-[ "mate" ] [ "mate" step5 "" like ] unit-test
+{ "fear" } [ "feare" step5 "" like ] unit-test
+{ "mate" } [ "mate" step5 "" like ] unit-test
+{ "hell" } [ "hell" step5 "" like ] unit-test
+{ "mate" } [ "mate" step5 "" like ] unit-test
-[ { } ] [
+{ { } } [
"vocab:porter-stemmer/test/voc.txt" utf8 file-lines
[ stem ] map
"vocab:porter-stemmer/test/output.txt" utf8 file-lines
tools.test vectors vocabs.parser words ;
IN: prettyprint.tests
-[ "4" ] [ 4 unparse ] unit-test
-[ "4096" ] [ 4096 unparse ] unit-test
-[ "0b1000000000000" ] [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
-[ "0o10000" ] [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
-[ "0x1000" ] [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
-[ "1.0" ] [ 1.0 unparse ] unit-test
-[ "8.0" ] [ 8.0 unparse ] unit-test
-[ "8.0" ] [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
-[ "8.0" ] [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
-[ "0x1.0p3" ] [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
-[ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
+{ "4" } [ 4 unparse ] unit-test
+{ "4096" } [ 4096 unparse ] unit-test
+{ "0b1000000000000" } [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
+{ "0o10000" } [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
+{ "0x1000" } [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
+{ "1.0" } [ 1.0 unparse ] unit-test
+{ "8.0" } [ 8.0 unparse ] unit-test
+{ "8.0" } [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
+{ "8.0" } [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
+{ "0x1.0p3" } [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
+{ "1267650600228229401496703205376" } [ 1 100 shift unparse ] unit-test
-[ "+" ] [ \ + unparse ] unit-test
+{ "+" } [ \ + unparse ] unit-test
-[ "\\ +" ] [ [ \ + ] first unparse ] unit-test
+{ "\\ +" } [ [ \ + ] first unparse ] unit-test
-[ "{ }" ] [ { } unparse ] unit-test
+{ "{ }" } [ { } unparse ] unit-test
-[ "{ 1 2 3 }" ] [ { 1 2 3 } unparse ] unit-test
+{ "{ 1 2 3 }" } [ { 1 2 3 } unparse ] unit-test
-[ "\"hello\\\\backslash\"" ]
+{ "\"hello\\\\backslash\"" }
[ "hello\\backslash" unparse ]
unit-test
! [ "\u123456" unparse ]
! unit-test
-[ "\"\\e\"" ]
+{ "\"\\e\"" }
[ "\e" unparse ]
unit-test
-[ "\"\\x01\"" ]
+{ "\"\\x01\"" }
[ 1 1string unparse ]
unit-test
-[ "f" ] [ f unparse ] unit-test
-[ "t" ] [ t unparse ] unit-test
+{ "f" } [ f unparse ] unit-test
+{ "t" } [ t unparse ] unit-test
-[ "SBUF\" hello world\"" ] [ SBUF" hello world" unparse ] unit-test
+{ "SBUF\" hello world\"" } [ SBUF" hello world" unparse ] unit-test
-[ "W{ \\ + }" ] [ [ W{ \ + } ] first unparse ] unit-test
+{ "W{ \\ + }" } [ [ W{ \ + } ] first unparse ] unit-test
-[ ] [ \ fixnum see ] unit-test
+{ } [ \ fixnum see ] unit-test
-[ ] [ \ integer see ] unit-test
+{ } [ \ integer see ] unit-test
-[ ] [ \ generic see ] unit-test
+{ } [ \ generic see ] unit-test
-[ ] [ \ duplex-stream see ] unit-test
+{ } [ \ duplex-stream see ] unit-test
-[ "[ \\ + ]" ] [ [ \ + ] unparse ] unit-test
-[ "[ \\ [ ]" ] [ [ \ [ ] unparse ] unit-test
+{ "[ \\ + ]" } [ [ \ + ] unparse ] unit-test
+{ "[ \\ [ ]" } [ [ \ [ ] unparse ] unit-test
-[ t ] [
+{ t } [
100 \ dup <array> unparse-short
"{" head?
] unit-test
: foo ( a -- b ) dup * ; inline
-[ "USING: kernel math ;\nIN: prettyprint.tests\n: foo ( a -- b ) dup * ; inline\n" ]
+{ "USING: kernel math ;\nIN: prettyprint.tests\n: foo ( a -- b ) dup * ; inline\n" }
[ [ \ foo see ] with-string-writer ] unit-test
: bar ( x -- y ) 2 + ;
-[ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ]
+{ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" }
[ [ \ bar see ] with-string-writer ] unit-test
: blah ( a a a a a a a a a a a a a a a a a a a a -- )
drop
drop ;
-[ "drop ;" ] [
+{ "drop ;" } [
[ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
] unit-test
M: object method-layout ;
-[
+{
{
"USING: kernel math prettyprint.tests ;"
"M: complex method-layout"
"M: object method-layout ;"
""
}
-] [
+} [
[ \ method-layout see-methods ] with-string-writer "\n" split
] unit-test
" ] [ 2drop f ] if ;"
} ;
-[ t ] [
+{ t } [
"soft-break-layout" soft-break-test check-see
] unit-test
" [ <reversed> \"hello world foo\" suffix ] [ ] make ;"
} ;
-[ t ] [
+{ t } [
"another-soft-break-layout" another-soft-break-test
check-see
] unit-test
} ;
-[ t ] [
+{ t } [
"string-layout-test" string-layout check-see
] unit-test
" } cond ;"
} ;
-[ t ] [
+{ t } [
"narrow-layout" narrow-test check-see
] unit-test
" } ;"
} ;
-[ t ] [
+{ t } [
"another-narrow-layout" another-narrow-test check-see
] unit-test
USING: prettyprint.tests ;
M: class-see-layout class-see-layout ;
-[
+{
{
"IN: prettyprint.tests"
"TUPLE: class-see-layout ;"
"GENERIC: class-see-layout ( x -- y )"
""
}
-] [
+} [
[ \ class-see-layout see ] with-string-writer "\n" split
] unit-test
-[
+{
{
"USING: prettyprint.tests ;"
"M: class-see-layout class-see-layout ;"
""
}
-] [
+} [
[ \ class-see-layout see-methods ] with-string-writer "\n" split
] unit-test
-[ ] [ \ in>> synopsis drop ] unit-test
+{ } [ \ in>> synopsis drop ] unit-test
! Regression
-[ t ] [
+{ t } [
"IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
dup eval( -- )
"generic-decl-test" "prettyprint.tests" lookup-word
[ see ] with-string-writer =
] unit-test
-[ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
+{ [ + ] } [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
-[ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
+{ [ (step-into-execute) ] } [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
-[ [ 2 2 + . ] ] [
+{ [ 2 2 + . ] } [
[ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
-[ [ 2 2 + . ] ] [
+{ [ 2 2 + . ] } [
[ 2 break 2 \ + (step-into-execute) . ] (remove-breakpoints)
] unit-test
M: f generic-see-test-with-f ;
-[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
+{ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" } [
[ M\ f generic-see-test-with-f see ] with-string-writer
] unit-test
PREDICATE: predicate-see-test < integer even? ;
-[ "USING: math ;\nIN: prettyprint.tests\nPREDICATE: predicate-see-test < integer even? ;\n" ] [
+{ "USING: math ;\nIN: prettyprint.tests\nPREDICATE: predicate-see-test < integer even? ;\n" } [
[ \ predicate-see-test see ] with-string-writer
] unit-test
INTERSECTION: intersection-see-test sequence number ;
-[ "USING: math sequences ;\nIN: prettyprint.tests\nINTERSECTION: intersection-see-test sequence number ;\n" ] [
+{ "USING: math sequences ;\nIN: prettyprint.tests\nINTERSECTION: intersection-see-test sequence number ;\n" } [
[ \ intersection-see-test see ] with-string-writer
] unit-test
-[ ] [ \ compose see ] unit-test
-[ ] [ \ curry see ] unit-test
+{ } [ \ compose see ] unit-test
+{ } [ \ curry see ] unit-test
-[ "POSTPONE: [" ] [ \ [ unparse ] unit-test
+{ "POSTPONE: [" } [ \ [ unparse ] unit-test
TUPLE: started-out-hustlin' ;
M: started-out-hustlin' ended-up-ballin' ; inline
-[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [
+{ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" } [
[ M\ started-out-hustlin' ended-up-ballin' see ] with-string-writer
] unit-test
TUPLE: tuple-with-declared-slot { x integer } ;
-[
+{
{
"USING: math ;"
"IN: prettyprint.tests"
"TUPLE: tuple-with-declared-slot { x integer initial: 0 } ;"
""
}
-] [
+} [
[ \ tuple-with-declared-slot see ] with-string-writer "\n" split
] unit-test
TUPLE: tuple-with-read-only-slot { x read-only } ;
-[
+{
{
"IN: prettyprint.tests"
"TUPLE: tuple-with-read-only-slot { x read-only } ;"
""
}
-] [
+} [
[ \ tuple-with-read-only-slot see ] with-string-writer "\n" split
] unit-test
TUPLE: tuple-with-initial-slot { x initial: 123 } ;
-[
+{
{
"IN: prettyprint.tests"
"TUPLE: tuple-with-initial-slot { x initial: 123 } ;"
""
}
-] [
+} [
[ \ tuple-with-initial-slot see ] with-string-writer "\n" split
] unit-test
TUPLE: tuple-with-initial-declared-slot { x integer initial: 123 } ;
-[
+{
{
"USING: math ;"
"IN: prettyprint.tests"
" { x integer initial: 123 } ;"
""
}
-] [
+} [
[ \ tuple-with-initial-declared-slot see ] with-string-writer "\n" split
] unit-test
TUPLE: final-tuple ; final
-[
+{
{
"IN: prettyprint.tests"
"TUPLE: final-tuple ; final"
""
}
-] [
+} [
[ \ final-tuple see ] with-string-writer "\n" split
] unit-test
-[ "H{ { 1 2 } }\n" ] [ [ H{ { 1 2 } } short. ] with-string-writer ] unit-test
+{ "H{ { 1 2 } }\n" } [ [ H{ { 1 2 } } short. ] with-string-writer ] unit-test
-[ "H{ { 1 ~array~ } }\n" ] [ [ H{ { 1 { 2 } } } short. ] with-string-writer ] unit-test
+{ "H{ { 1 ~array~ } }\n" } [ [ H{ { 1 { 2 } } } short. ] with-string-writer ] unit-test
-[ "{ ~array~ }\n" ] [ [ { { 1 2 } } short. ] with-string-writer ] unit-test
+{ "{ ~array~ }\n" } [ [ { { 1 2 } } short. ] with-string-writer ] unit-test
-[ "H{ { 1 { 2 3 } } }\n" ] [
+{ "H{ { 1 { 2 3 } } }\n" } [
f nesting-limit [
[ H{ { 1 { 2 3 } } } . ] with-string-writer
] with-variable
] unit-test
-[ "maybe{ integer }\n" ] [ [ maybe{ integer } . ] with-string-writer ] unit-test
+{ "maybe{ integer }\n" } [ [ maybe{ integer } . ] with-string-writer ] unit-test
TUPLE: bob a b ;
-[ "maybe{ bob }\n" ] [ [ maybe{ bob } . ] with-string-writer ] unit-test
-[ "maybe{ word }\n" ] [ [ maybe{ word } . ] with-string-writer ] unit-test
+{ "maybe{ bob }\n" } [ [ maybe{ bob } . ] with-string-writer ] unit-test
+{ "maybe{ word }\n" } [ [ maybe{ word } . ] with-string-writer ] unit-test
TUPLE: har a ;
GENERIC: harhar ( obj -- obj )
M: maybe{ har } harhar ;
M: integer harhar M\ integer harhar drop ;
-[
+{
"""USING: prettyprint.tests ;
M: maybe{ har } harhar ;
USING: kernel math prettyprint.tests ;
M: integer harhar M\\ integer harhar drop ;\n"""
-] [
+} [
[ \ harhar see-methods ] with-string-writer
] unit-test
TUPLE: mo { a union{ float integer } } ;
TUPLE: fo { a intersection{ fixnum integer } } ;
-[
+{
"""USING: math ;
IN: prettyprint.tests
TUPLE: mo { a union{ integer float } initial: 0 } ;
"""
-] [
+} [
[ \ mo see ] with-string-writer
] unit-test
-[
+{
"""USING: math ;
IN: prettyprint.tests
TUPLE: fo { a intersection{ integer fixnum } initial: 0 } ;
"""
-] [
+} [
[ \ fo see ] with-string-writer
] unit-test
-[
+{
"""union{ intersection{ string hashtable } union{ integer float } }\n"""
-] [ [ union{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
+} [ [ union{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
-[
+{
"""intersection{
intersection{ string hashtable }
union{ integer float }
}
"""
-] [ [ intersection{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
+} [ [ intersection{ union{ float integer } intersection{ string hashtable } } . ] with-string-writer ] unit-test
-[
+{
"""maybe{ union{ integer float } }\n"""
-] [
+} [
[ maybe{ union{ float integer } } . ] with-string-writer
] unit-test
-[
+{
"""maybe{ maybe{ integer } }\n"""
-] [
+} [
[ maybe{ maybe{ integer } } . ] with-string-writer
] unit-test
[ CHAR: a <string> text "b" text ] with-pprint
] with-string-writer ;
-[
+{
"""aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa b"""
-] [ margin get 3 - margin-test ] unit-test
+} [ margin get 3 - margin-test ] unit-test
-[
+{
"""aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa b"""
-] [ margin get 2 - margin-test ] unit-test
+} [ margin get 2 - margin-test ] unit-test
-[
+{
"""aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
b"""
-] [ margin get 1 - margin-test ] unit-test
+} [ margin get 1 - margin-test ] unit-test
LAZY: lazy-test ( a -- b ) 1 + ;
{ 1 1 } [ lazy-test ] must-infer-as
-[ 3 ] [ 2 lazy-test force ] unit-test
+{ 3 } [ 2 lazy-test force ] unit-test
sequences splitting kernel io.encodings.8-bit.latin2 ;
IN: quoted-printable.tests
-[ """José was the
+{ """José was the
person who knew how to write the letters:
ő and ü
-and we didn't know hów tö do thât""" ]
+and we didn't know hów tö do thât""" }
[ """Jos=E9 was the
person who knew how to write the letters:
=F5 and =FC=20
and w=
e didn't know h=F3w t=F6 do th=E2t""" quoted> latin2 decode ] unit-test
-[ """Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t""" ]
+{ """Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t""" }
[ """José was the
person who knew how to write the letters:
ő and ü
: message ( -- str )
55 [ "hello" ] replicate concat ;
-[ f ] [ message >quoted "=\r\n" swap subseq? ] unit-test
-[ 1 ] [ message >quoted string-lines length ] unit-test
-[ t ] [ message >quoted-lines "=\r\n" swap subseq? ] unit-test
-[ 4 ] [ message >quoted-lines string-lines length ] unit-test
-[ "===o" ] [ message >quoted-lines string-lines [ last ] "" map-as ] unit-test
+{ f } [ message >quoted "=\r\n" swap subseq? ] unit-test
+{ 1 } [ message >quoted string-lines length ] unit-test
+{ t } [ message >quoted-lines "=\r\n" swap subseq? ] unit-test
+{ 4 } [ message >quoted-lines string-lines length ] unit-test
+{ "===o" } [ message >quoted-lines string-lines [ last ] "" map-as ] unit-test
USING: tools.test quoting ;
IN: quoting.tests
-[ f ] [ "" quoted? ] unit-test
-[ t ] [ "''" quoted? ] unit-test
-[ t ] [ "\"\"" quoted? ] unit-test
-[ t ] [ "\"Circus Maximus\"" quoted? ] unit-test
-[ t ] [ "'Circus Maximus'" quoted? ] unit-test
-[ f ] [ "Circus Maximus" quoted? ] unit-test
+{ f } [ "" quoted? ] unit-test
+{ t } [ "''" quoted? ] unit-test
+{ t } [ "\"\"" quoted? ] unit-test
+{ t } [ "\"Circus Maximus\"" quoted? ] unit-test
+{ t } [ "'Circus Maximus'" quoted? ] unit-test
+{ f } [ "Circus Maximus" quoted? ] unit-test
math.functions sets grouping random.private math.statistics ;
IN: random.tests
-[ 4 ] [ 4 random-bytes length ] unit-test
-[ 7 ] [ 7 random-bytes length ] unit-test
+{ 4 } [ 4 random-bytes length ] unit-test
+{ 7 } [ 7 random-bytes length ] unit-test
-[ 4 ] [ [ 4 random-bytes length ] with-secure-random ] unit-test
-[ 7 ] [ [ 7 random-bytes length ] with-secure-random ] unit-test
+{ 4 } [ [ 4 random-bytes length ] with-secure-random ] unit-test
+{ 7 } [ [ 7 random-bytes length ] with-secure-random ] 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 ] must-fail
-[ t ] [ 10000 [ iota 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test
-[ t ] [ 10000 [ iota 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test
+{ t } [ 10000 [ iota 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test
+{ t } [ 10000 [ iota 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test
-[ t ] [ 1000 [ 400 random ] replicate members length 256 > ] unit-test
+{ t } [ 1000 [ 400 random ] replicate members length 256 > ] unit-test
-[ f ] [ 0 random ] unit-test
+{ f } [ 0 random ] unit-test
-[ { } ] [ { } randomize ] unit-test
-[ { 1 } ] [ { 1 } randomize ] unit-test
+{ { } } [ { } randomize ] unit-test
+{ { 1 } } [ { 1 } randomize ] unit-test
-[ f ]
+{ f }
[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test
-[ 49 ] [ 50 random-bits* log2 ] unit-test
+{ 49 } [ 50 random-bits* log2 ] unit-test
[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
-[ 3 ] [ { 1 2 3 4 } 3 sample members length ] unit-test
-[ 99 ] [ 100 iota 99 sample members length ] unit-test
+{ 3 } [ { 1 2 3 4 } 3 sample members length ] unit-test
+{ 99 } [ 100 iota 99 sample members length ] unit-test
-[ ]
+{ }
[ [ 100 random-bytes ] with-system-random drop ] unit-test
{ t t }
IN: refs.tests
! assoc-refs
-[ 3 ] [
+{ 3 } [
H{ { "a" 3 } } "a" <value-ref> get-ref
] unit-test
-[ 4 ] [
+{ 4 } [
4 H{ { "a" 3 } } clone "a" <value-ref>
[ set-ref ] keep
get-ref
] unit-test
-[ "a" ] [
+{ "a" } [
H{ { "a" 3 } } "a" <key-ref> get-ref
] unit-test
-[ H{ { "b" 3 } } ] [
+{ H{ { "b" 3 } } } [
"b" H{ { "a" 3 } } clone [
"a" <key-ref>
set-ref
SYMBOLS: lion giraffe elephant rabbit ;
! obj-refs
-[ rabbit ] [ rabbit <obj-ref> get-ref ] unit-test
-[ rabbit ] [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
-[ rabbit ] [ rabbit <obj-ref> take ] unit-test
-[ rabbit f ] [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
-[ lion ] [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
+{ rabbit } [ rabbit <obj-ref> get-ref ] unit-test
+{ rabbit } [ f <obj-ref> rabbit set-ref* get-ref ] unit-test
+{ rabbit } [ rabbit <obj-ref> take ] unit-test
+{ rabbit f } [ rabbit <obj-ref> [ take ] keep get-ref ] unit-test
+{ lion } [ rabbit <obj-ref> dup [ drop lion ] change-ref get-ref ] unit-test
! var-refs
-[ giraffe ] [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
+{ giraffe } [ [ giraffe rabbit set rabbit <var-ref> get-ref ] with-scope ] unit-test
-[ rabbit ]
+{ rabbit }
[
[
lion rabbit set [
] with-scope
] unit-test
-[ rabbit ] [
+{ rabbit } [
rabbit <var-ref>
[
lion rabbit set [
] with-scope
] unit-test
-[ elephant ] [
+{ elephant } [
rabbit <var-ref>
[
elephant rabbit set [
] with-scope
] unit-test
-[ rabbit ] [
+{ rabbit } [
rabbit <var-ref>
[
elephant set-ref* [
] with-scope
] unit-test
-[ elephant ] [
+{ elephant } [
rabbit <var-ref>
[
elephant set-ref* [
] unit-test
! Top Hats
-[ lion ] [ lion rabbit set-global rabbit <global-var-ref> get-ref ] unit-test
-[ giraffe ] [ rabbit <global-var-ref> giraffe set-ref* get-ref ] unit-test
+{ lion } [ lion rabbit set-global rabbit <global-var-ref> get-ref ] unit-test
+{ giraffe } [ rabbit <global-var-ref> giraffe set-ref* get-ref ] unit-test
! Tuple refs
TUPLE: foo bar ;
: test-slot-ref ( -- slot-ref )
test-tuple 2 <slot-ref> ; ! hack!
-[ rabbit ] [ test-slot-ref get-ref ] unit-test
-[ lion ] [ test-slot-ref lion set-ref* get-ref ] unit-test
+{ rabbit } [ test-slot-ref get-ref ] unit-test
+{ lion } [ test-slot-ref lion set-ref* get-ref ] unit-test
! Boxes as refs
-[ rabbit ] [ <box> rabbit set-ref* get-ref ] unit-test
+{ rabbit } [ <box> rabbit set-ref* get-ref ] unit-test
[ <box> rabbit set-ref* lion set-ref* ] must-fail
[ <box> get-ref ] must-fail
regexp.private eval strings multiline accessors ;
IN: regexp-tests
-[ f ] [ "b" "a*" <regexp> matches? ] unit-test
-[ t ] [ "" "a*" <regexp> matches? ] unit-test
-[ t ] [ "a" "a*" <regexp> matches? ] unit-test
-[ t ] [ "aaaaaaa" "a*" <regexp> matches? ] unit-test
-[ f ] [ "ab" "a*" <regexp> matches? ] unit-test
-
-[ t ] [ "abc" "abc" <regexp> matches? ] unit-test
-[ t ] [ "a" "a|b|c" <regexp> matches? ] unit-test
-[ t ] [ "b" "a|b|c" <regexp> matches? ] unit-test
-[ t ] [ "c" "a|b|c" <regexp> matches? ] unit-test
-[ f ] [ "c" "d|e|f" <regexp> matches? ] unit-test
-
-[ t ] [ "b" "|b" <regexp> matches? ] unit-test
-[ t ] [ "b" "b|" <regexp> matches? ] unit-test
-[ t ] [ "" "b|" <regexp> matches? ] unit-test
-[ t ] [ "" "b|" <regexp> matches? ] unit-test
-[ t ] [ "" "|" <regexp> matches? ] unit-test
-[ t ] [ "" "|||||||" <regexp> matches? ] unit-test
-
-[ f ] [ "aa" "a|b|c" <regexp> matches? ] unit-test
-[ f ] [ "bb" "a|b|c" <regexp> matches? ] unit-test
-[ f ] [ "cc" "a|b|c" <regexp> matches? ] unit-test
-[ f ] [ "cc" "d|e|f" <regexp> matches? ] unit-test
-
-[ f ] [ "" "a+" <regexp> matches? ] unit-test
-[ t ] [ "a" "a+" <regexp> matches? ] unit-test
-[ t ] [ "aa" "a+" <regexp> matches? ] unit-test
-
-[ t ] [ "" "a?" <regexp> matches? ] unit-test
-[ t ] [ "a" "a?" <regexp> matches? ] unit-test
-[ f ] [ "aa" "a?" <regexp> matches? ] unit-test
-
-[ f ] [ "" "." <regexp> matches? ] unit-test
-[ t ] [ "a" "." <regexp> matches? ] unit-test
-[ t ] [ "." "." <regexp> matches? ] unit-test
+{ f } [ "b" "a*" <regexp> matches? ] unit-test
+{ t } [ "" "a*" <regexp> matches? ] unit-test
+{ t } [ "a" "a*" <regexp> matches? ] unit-test
+{ t } [ "aaaaaaa" "a*" <regexp> matches? ] unit-test
+{ f } [ "ab" "a*" <regexp> matches? ] unit-test
+
+{ t } [ "abc" "abc" <regexp> matches? ] unit-test
+{ t } [ "a" "a|b|c" <regexp> matches? ] unit-test
+{ t } [ "b" "a|b|c" <regexp> matches? ] unit-test
+{ t } [ "c" "a|b|c" <regexp> matches? ] unit-test
+{ f } [ "c" "d|e|f" <regexp> matches? ] unit-test
+
+{ t } [ "b" "|b" <regexp> matches? ] unit-test
+{ t } [ "b" "b|" <regexp> matches? ] unit-test
+{ t } [ "" "b|" <regexp> matches? ] unit-test
+{ t } [ "" "b|" <regexp> matches? ] unit-test
+{ t } [ "" "|" <regexp> matches? ] unit-test
+{ t } [ "" "|||||||" <regexp> matches? ] unit-test
+
+{ f } [ "aa" "a|b|c" <regexp> matches? ] unit-test
+{ f } [ "bb" "a|b|c" <regexp> matches? ] unit-test
+{ f } [ "cc" "a|b|c" <regexp> matches? ] unit-test
+{ f } [ "cc" "d|e|f" <regexp> matches? ] unit-test
+
+{ f } [ "" "a+" <regexp> matches? ] unit-test
+{ t } [ "a" "a+" <regexp> matches? ] unit-test
+{ t } [ "aa" "a+" <regexp> matches? ] unit-test
+
+{ t } [ "" "a?" <regexp> matches? ] unit-test
+{ t } [ "a" "a?" <regexp> matches? ] unit-test
+{ f } [ "aa" "a?" <regexp> matches? ] unit-test
+
+{ f } [ "" "." <regexp> matches? ] unit-test
+{ t } [ "a" "." <regexp> matches? ] unit-test
+{ t } [ "." "." <regexp> matches? ] unit-test
! Dotall mode -- when on, . matches newlines.
! Off by default.
-[ f ] [ "\n" "." <regexp> matches? ] unit-test
-[ t ] [ "\n" "(?s:.)" <regexp> matches? ] unit-test
-[ t ] [ "\n" R/ ./s matches? ] unit-test
-[ f ] [ "\n\n" "(?s:.)." <regexp> matches? ] unit-test
-
-[ f ] [ "" ".+" <regexp> matches? ] unit-test
-[ t ] [ "a" ".+" <regexp> matches? ] unit-test
-[ t ] [ "ab" ".+" <regexp> matches? ] unit-test
-
-[ t ] [ " " "[\\s]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[\\s]" <regexp> matches? ] unit-test
-[ f ] [ " " "[\\S]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[\\S]" <regexp> matches? ] unit-test
-[ f ] [ " " "[\\w]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[\\w]" <regexp> matches? ] unit-test
-[ t ] [ " " "[\\W]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[\\W]" <regexp> matches? ] unit-test
-
-[ t ] [ "/" "\\/" <regexp> matches? ] unit-test
-
-[ t ] [ "a" R' a'i matches? ] unit-test
-
-[ t ] [ "" "a|b*|c+|d?" <regexp> matches? ] unit-test
-[ t ] [ "a" "a|b*|c+|d?" <regexp> matches? ] unit-test
-[ t ] [ "c" "a|b*|c+|d?" <regexp> matches? ] unit-test
-[ t ] [ "cc" "a|b*|c+|d?" <regexp> matches? ] unit-test
-[ f ] [ "ccd" "a|b*|c+|d?" <regexp> matches? ] unit-test
-[ t ] [ "d" "a|b*|c+|d?" <regexp> matches? ] unit-test
-
-[ t ] [ "foo" "foo|bar" <regexp> matches? ] unit-test
-[ t ] [ "bar" "foo|bar" <regexp> matches? ] unit-test
-[ f ] [ "foobar" "foo|bar" <regexp> matches? ] unit-test
-
-[ f ] [ "" "(a)" <regexp> matches? ] unit-test
-[ t ] [ "a" "(a)" <regexp> matches? ] unit-test
-[ f ] [ "aa" "(a)" <regexp> matches? ] unit-test
-[ t ] [ "aa" "(a*)" <regexp> matches? ] unit-test
-
-[ f ] [ "aababaaabbac" "(a|b)+" <regexp> matches? ] unit-test
-[ t ] [ "ababaaabba" "(a|b)+" <regexp> matches? ] unit-test
-
-[ f ] [ "" "a{1}" <regexp> matches? ] unit-test
-[ t ] [ "a" "a{1}" <regexp> matches? ] unit-test
-[ f ] [ "aa" "a{1}" <regexp> matches? ] unit-test
-
-[ f ] [ "a" "a{2,}" <regexp> matches? ] unit-test
-[ t ] [ "aaa" "a{2,}" <regexp> matches? ] unit-test
-[ t ] [ "aaaa" "a{2,}" <regexp> matches? ] unit-test
-[ t ] [ "aaaaa" "a{2,}" <regexp> matches? ] unit-test
-
-[ t ] [ "" "a{,2}" <regexp> matches? ] unit-test
-[ t ] [ "a" "a{,2}" <regexp> matches? ] unit-test
-[ t ] [ "aa" "a{,2}" <regexp> matches? ] unit-test
-[ f ] [ "aaa" "a{,2}" <regexp> matches? ] unit-test
-[ f ] [ "aaaa" "a{,2}" <regexp> matches? ] unit-test
-[ f ] [ "aaaaa" "a{,2}" <regexp> matches? ] unit-test
-
-[ f ] [ "" "a{1,3}" <regexp> matches? ] unit-test
-[ t ] [ "a" "a{1,3}" <regexp> matches? ] unit-test
-[ t ] [ "aa" "a{1,3}" <regexp> matches? ] unit-test
-[ t ] [ "aaa" "a{1,3}" <regexp> matches? ] unit-test
-[ f ] [ "aaaa" "a{1,3}" <regexp> matches? ] unit-test
-
-[ f ] [ "" "[a]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[a]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[abc]" <regexp> matches? ] unit-test
-[ f ] [ "b" "[a]" <regexp> matches? ] unit-test
-[ f ] [ "d" "[abc]" <regexp> matches? ] unit-test
-[ t ] [ "ab" "[abc]{1,2}" <regexp> matches? ] unit-test
-[ f ] [ "abc" "[abc]{1,2}" <regexp> matches? ] unit-test
-
-[ f ] [ "" "[^a]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[^a]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[^abc]" <regexp> matches? ] unit-test
-[ t ] [ "b" "[^a]" <regexp> matches? ] unit-test
-[ t ] [ "d" "[^abc]" <regexp> matches? ] unit-test
-[ f ] [ "ab" "[^abc]{1,2}" <regexp> matches? ] unit-test
-[ f ] [ "abc" "[^abc]{1,2}" <regexp> matches? ] unit-test
-
-[ t ] [ "]" "[]]" <regexp> matches? ] unit-test
-[ f ] [ "]" "[^]]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^]]" <regexp> matches? ] unit-test
+{ f } [ "\n" "." <regexp> matches? ] unit-test
+{ t } [ "\n" "(?s:.)" <regexp> matches? ] unit-test
+{ t } [ "\n" R/ ./s matches? ] unit-test
+{ f } [ "\n\n" "(?s:.)." <regexp> matches? ] unit-test
+
+{ f } [ "" ".+" <regexp> matches? ] unit-test
+{ t } [ "a" ".+" <regexp> matches? ] unit-test
+{ t } [ "ab" ".+" <regexp> matches? ] unit-test
+
+{ t } [ " " "[\\s]" <regexp> matches? ] unit-test
+{ f } [ "a" "[\\s]" <regexp> matches? ] unit-test
+{ f } [ " " "[\\S]" <regexp> matches? ] unit-test
+{ t } [ "a" "[\\S]" <regexp> matches? ] unit-test
+{ f } [ " " "[\\w]" <regexp> matches? ] unit-test
+{ t } [ "a" "[\\w]" <regexp> matches? ] unit-test
+{ t } [ " " "[\\W]" <regexp> matches? ] unit-test
+{ f } [ "a" "[\\W]" <regexp> matches? ] unit-test
+
+{ t } [ "/" "\\/" <regexp> matches? ] unit-test
+
+{ t } [ "a" R' a'i matches? ] unit-test
+
+{ t } [ "" "a|b*|c+|d?" <regexp> matches? ] unit-test
+{ t } [ "a" "a|b*|c+|d?" <regexp> matches? ] unit-test
+{ t } [ "c" "a|b*|c+|d?" <regexp> matches? ] unit-test
+{ t } [ "cc" "a|b*|c+|d?" <regexp> matches? ] unit-test
+{ f } [ "ccd" "a|b*|c+|d?" <regexp> matches? ] unit-test
+{ t } [ "d" "a|b*|c+|d?" <regexp> matches? ] unit-test
+
+{ t } [ "foo" "foo|bar" <regexp> matches? ] unit-test
+{ t } [ "bar" "foo|bar" <regexp> matches? ] unit-test
+{ f } [ "foobar" "foo|bar" <regexp> matches? ] unit-test
+
+{ f } [ "" "(a)" <regexp> matches? ] unit-test
+{ t } [ "a" "(a)" <regexp> matches? ] unit-test
+{ f } [ "aa" "(a)" <regexp> matches? ] unit-test
+{ t } [ "aa" "(a*)" <regexp> matches? ] unit-test
+
+{ f } [ "aababaaabbac" "(a|b)+" <regexp> matches? ] unit-test
+{ t } [ "ababaaabba" "(a|b)+" <regexp> matches? ] unit-test
+
+{ f } [ "" "a{1}" <regexp> matches? ] unit-test
+{ t } [ "a" "a{1}" <regexp> matches? ] unit-test
+{ f } [ "aa" "a{1}" <regexp> matches? ] unit-test
+
+{ f } [ "a" "a{2,}" <regexp> matches? ] unit-test
+{ t } [ "aaa" "a{2,}" <regexp> matches? ] unit-test
+{ t } [ "aaaa" "a{2,}" <regexp> matches? ] unit-test
+{ t } [ "aaaaa" "a{2,}" <regexp> matches? ] unit-test
+
+{ t } [ "" "a{,2}" <regexp> matches? ] unit-test
+{ t } [ "a" "a{,2}" <regexp> matches? ] unit-test
+{ t } [ "aa" "a{,2}" <regexp> matches? ] unit-test
+{ f } [ "aaa" "a{,2}" <regexp> matches? ] unit-test
+{ f } [ "aaaa" "a{,2}" <regexp> matches? ] unit-test
+{ f } [ "aaaaa" "a{,2}" <regexp> matches? ] unit-test
+
+{ f } [ "" "a{1,3}" <regexp> matches? ] unit-test
+{ t } [ "a" "a{1,3}" <regexp> matches? ] unit-test
+{ t } [ "aa" "a{1,3}" <regexp> matches? ] unit-test
+{ t } [ "aaa" "a{1,3}" <regexp> matches? ] unit-test
+{ f } [ "aaaa" "a{1,3}" <regexp> matches? ] unit-test
+
+{ f } [ "" "[a]" <regexp> matches? ] unit-test
+{ t } [ "a" "[a]" <regexp> matches? ] unit-test
+{ t } [ "a" "[abc]" <regexp> matches? ] unit-test
+{ f } [ "b" "[a]" <regexp> matches? ] unit-test
+{ f } [ "d" "[abc]" <regexp> matches? ] unit-test
+{ t } [ "ab" "[abc]{1,2}" <regexp> matches? ] unit-test
+{ f } [ "abc" "[abc]{1,2}" <regexp> matches? ] unit-test
+
+{ f } [ "" "[^a]" <regexp> matches? ] unit-test
+{ f } [ "a" "[^a]" <regexp> matches? ] unit-test
+{ f } [ "a" "[^abc]" <regexp> matches? ] unit-test
+{ t } [ "b" "[^a]" <regexp> matches? ] unit-test
+{ t } [ "d" "[^abc]" <regexp> matches? ] unit-test
+{ f } [ "ab" "[^abc]{1,2}" <regexp> matches? ] unit-test
+{ f } [ "abc" "[^abc]{1,2}" <regexp> matches? ] unit-test
+
+{ t } [ "]" "[]]" <regexp> matches? ] unit-test
+{ f } [ "]" "[^]]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^]]" <regexp> matches? ] unit-test
[ "^" "[^]" <regexp> matches? ] must-fail
-[ t ] [ "^" "[]^]" <regexp> matches? ] unit-test
-[ t ] [ "]" "[]^]" <regexp> matches? ] unit-test
-
-[ t ] [ "[" "[[]" <regexp> matches? ] unit-test
-[ f ] [ "^" "[^^]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^^]" <regexp> matches? ] unit-test
-
-[ t ] [ "-" "[-]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[-]" <regexp> matches? ] unit-test
-[ f ] [ "-" "[^-]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^-]" <regexp> matches? ] unit-test
-
-[ t ] [ "-" "[-a]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[-a]" <regexp> matches? ] unit-test
-[ t ] [ "-" "[a-]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[a-]" <regexp> matches? ] unit-test
-[ f ] [ "b" "[a-]" <regexp> matches? ] unit-test
-[ f ] [ "-" "[^-]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^-]" <regexp> matches? ] unit-test
-
-[ f ] [ "-" "[a-c]" <regexp> matches? ] unit-test
-[ t ] [ "-" "[^a-c]" <regexp> matches? ] unit-test
-[ t ] [ "b" "[a-c]" <regexp> matches? ] unit-test
-[ f ] [ "b" "[^a-c]" <regexp> matches? ] unit-test
-
-[ t ] [ "-" "[a-c-]" <regexp> matches? ] unit-test
-[ f ] [ "-" "[^a-c-]" <regexp> matches? ] unit-test
-
-[ t ] [ "\\" "[\\\\]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[\\\\]" <regexp> matches? ] unit-test
-[ f ] [ "\\" "[^\\\\]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^\\\\]" <regexp> matches? ] unit-test
-
-[ t ] [ "0" "[\\d]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[\\d]" <regexp> matches? ] unit-test
-[ f ] [ "0" "[^\\d]" <regexp> matches? ] unit-test
-[ t ] [ "a" "[^\\d]" <regexp> matches? ] unit-test
-
-[ t ] [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" <regexp> matches? ] unit-test
-[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" <regexp> matches? ] unit-test
-[ t ] [ "a" "[a-z]{1,2}|[A-Z]{3,3}" <regexp> matches? ] unit-test
-
-[ t ] [ "1000" "\\d{4,6}" <regexp> matches? ] unit-test
-[ t ] [ "1000" "[0-9]{4,6}" <regexp> matches? ] unit-test
-
-[ t ] [ "abc" "\\p{Lower}{3}" <regexp> matches? ] unit-test
-[ f ] [ "ABC" "\\p{Lower}{3}" <regexp> matches? ] unit-test
-[ t ] [ "ABC" "\\p{Upper}{3}" <regexp> matches? ] unit-test
-[ f ] [ "abc" "\\p{Upper}{3}" <regexp> matches? ] unit-test
-[ f ] [ "abc" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
-[ t ] [ "ABC" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
-
-[ t ] [ "" "\\Q\\E" <regexp> matches? ] unit-test
-[ f ] [ "a" "\\Q\\E" <regexp> matches? ] unit-test
-[ t ] [ "|*+" "\\Q|*+\\E" <regexp> matches? ] unit-test
-[ f ] [ "abc" "\\Q|*+\\E" <regexp> matches? ] unit-test
-[ t ] [ "s" "\\Qs\\E" <regexp> matches? ] unit-test
-
-[ t ] [ "S" "\\0123" <regexp> matches? ] unit-test
-[ t ] [ "SXY" "\\0123XY" <regexp> matches? ] unit-test
-[ t ] [ "x" "\\x78" <regexp> matches? ] unit-test
-[ f ] [ "y" "\\x78" <regexp> matches? ] unit-test
-[ t ] [ "x" "\\u0078" <regexp> matches? ] unit-test
-[ f ] [ "y" "\\u0078" <regexp> matches? ] unit-test
-
-[ t ] [ "ab" "a+b" <regexp> matches? ] unit-test
-[ f ] [ "b" "a+b" <regexp> matches? ] unit-test
-[ t ] [ "aab" "a+b" <regexp> matches? ] unit-test
-[ f ] [ "abb" "a+b" <regexp> matches? ] unit-test
-
-[ t ] [ "abbbb" "ab*" <regexp> matches? ] unit-test
-[ t ] [ "a" "ab*" <regexp> matches? ] unit-test
-[ f ] [ "abab" "ab*" <regexp> matches? ] unit-test
-
-[ f ] [ "x" "\\." <regexp> matches? ] unit-test
-[ t ] [ "." "\\." <regexp> matches? ] unit-test
-
-[ t ] [ "aaaab" "a+ab" <regexp> matches? ] unit-test
-[ f ] [ "aaaxb" "a+ab" <regexp> matches? ] unit-test
-[ t ] [ "aaacb" "a+cb" <regexp> matches? ] unit-test
-
-[ "aaa" ] [ "aaacb" "a*" <regexp> first-match >string ] unit-test
-[ "aa" ] [ "aaacb" "aa?" <regexp> first-match >string ] unit-test
-
-[ t ] [ "aaa" R/ AAA/i matches? ] unit-test
-[ f ] [ "aax" R/ AAA/i matches? ] unit-test
-[ t ] [ "aaa" R/ A*/i matches? ] unit-test
-[ f ] [ "aaba" R/ A*/i matches? ] unit-test
-[ t ] [ "b" R/ [AB]/i matches? ] unit-test
-[ f ] [ "c" R/ [AB]/i matches? ] unit-test
-[ t ] [ "c" R/ [A-Z]/i matches? ] unit-test
-[ f ] [ "3" R/ [A-Z]/i matches? ] unit-test
-
-[ t ] [ "a" "(?i:a)" <regexp> matches? ] unit-test
-[ t ] [ "a" "(?i:a)" <regexp> matches? ] unit-test
-[ t ] [ "A" "(?i:a)" <regexp> matches? ] unit-test
-[ t ] [ "A" "(?i:a)" <regexp> matches? ] unit-test
-
-[ t ] [ "a" R/ (?-i:a)/i matches? ] unit-test
-[ t ] [ "a" R/ (?-i:a)/i matches? ] unit-test
-[ f ] [ "A" R/ (?-i:a)/i matches? ] unit-test
-[ f ] [ "A" R/ (?-i:a)/i matches? ] unit-test
-
-[ f ] [ "A" "[a-z]" <regexp> matches? ] unit-test
-[ t ] [ "A" R/ [a-z]/i matches? ] unit-test
-
-[ f ] [ "A" "\\p{Lower}" <regexp> matches? ] unit-test
-[ t ] [ "A" R/ \p{Lower}/i matches? ] unit-test
-
-[ t ] [ "abc" R/ abc/r matches? ] unit-test
-[ t ] [ "abc" R/ a[bB][cC]/r matches? ] unit-test
-
-[ t ] [ 3 "xabc" R/ abc/r match-index-from >boolean ] unit-test
-[ t ] [ 3 "xabc" R/ a[bB][cC]/r match-index-from >boolean ] unit-test
-
-[ 2 ] [ 0 "llamallol" R/ ll/ match-index-from ] unit-test
-[ 5 ] [ 8 "lolmallol" R/ lol/r match-index-from ] unit-test
-
-[ t ] [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
-[ f ] [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
-[ t ] [ ".o" "\\.[a-z]" <regexp> matches? ] unit-test
-
-[ t ] [ "abc*" "[^\\*]*\\*" <regexp> matches? ] unit-test
-[ t ] [ "bca" "[^a]*a" <regexp> matches? ] unit-test
-
-[ ] [
+{ t } [ "^" "[]^]" <regexp> matches? ] unit-test
+{ t } [ "]" "[]^]" <regexp> matches? ] unit-test
+
+{ t } [ "[" "[[]" <regexp> matches? ] unit-test
+{ f } [ "^" "[^^]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^^]" <regexp> matches? ] unit-test
+
+{ t } [ "-" "[-]" <regexp> matches? ] unit-test
+{ f } [ "a" "[-]" <regexp> matches? ] unit-test
+{ f } [ "-" "[^-]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^-]" <regexp> matches? ] unit-test
+
+{ t } [ "-" "[-a]" <regexp> matches? ] unit-test
+{ t } [ "a" "[-a]" <regexp> matches? ] unit-test
+{ t } [ "-" "[a-]" <regexp> matches? ] unit-test
+{ t } [ "a" "[a-]" <regexp> matches? ] unit-test
+{ f } [ "b" "[a-]" <regexp> matches? ] unit-test
+{ f } [ "-" "[^-]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^-]" <regexp> matches? ] unit-test
+
+{ f } [ "-" "[a-c]" <regexp> matches? ] unit-test
+{ t } [ "-" "[^a-c]" <regexp> matches? ] unit-test
+{ t } [ "b" "[a-c]" <regexp> matches? ] unit-test
+{ f } [ "b" "[^a-c]" <regexp> matches? ] unit-test
+
+{ t } [ "-" "[a-c-]" <regexp> matches? ] unit-test
+{ f } [ "-" "[^a-c-]" <regexp> matches? ] unit-test
+
+{ t } [ "\\" "[\\\\]" <regexp> matches? ] unit-test
+{ f } [ "a" "[\\\\]" <regexp> matches? ] unit-test
+{ f } [ "\\" "[^\\\\]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^\\\\]" <regexp> matches? ] unit-test
+
+{ t } [ "0" "[\\d]" <regexp> matches? ] unit-test
+{ f } [ "a" "[\\d]" <regexp> matches? ] unit-test
+{ f } [ "0" "[^\\d]" <regexp> matches? ] unit-test
+{ t } [ "a" "[^\\d]" <regexp> matches? ] unit-test
+
+{ t } [ "a" "[a-z]{1,}|[A-Z]{2,4}|b*|c|(f|g)*" <regexp> matches? ] unit-test
+{ t } [ "a" "[a-z]{1,2}|[A-Z]{3,3}|b*|c|(f|g)*" <regexp> matches? ] unit-test
+{ t } [ "a" "[a-z]{1,2}|[A-Z]{3,3}" <regexp> matches? ] unit-test
+
+{ t } [ "1000" "\\d{4,6}" <regexp> matches? ] unit-test
+{ t } [ "1000" "[0-9]{4,6}" <regexp> matches? ] unit-test
+
+{ t } [ "abc" "\\p{Lower}{3}" <regexp> matches? ] unit-test
+{ f } [ "ABC" "\\p{Lower}{3}" <regexp> matches? ] unit-test
+{ t } [ "ABC" "\\p{Upper}{3}" <regexp> matches? ] unit-test
+{ f } [ "abc" "\\p{Upper}{3}" <regexp> matches? ] unit-test
+{ f } [ "abc" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
+{ t } [ "ABC" "[\\p{Upper}]{3}" <regexp> matches? ] unit-test
+
+{ t } [ "" "\\Q\\E" <regexp> matches? ] unit-test
+{ f } [ "a" "\\Q\\E" <regexp> matches? ] unit-test
+{ t } [ "|*+" "\\Q|*+\\E" <regexp> matches? ] unit-test
+{ f } [ "abc" "\\Q|*+\\E" <regexp> matches? ] unit-test
+{ t } [ "s" "\\Qs\\E" <regexp> matches? ] unit-test
+
+{ t } [ "S" "\\0123" <regexp> matches? ] unit-test
+{ t } [ "SXY" "\\0123XY" <regexp> matches? ] unit-test
+{ t } [ "x" "\\x78" <regexp> matches? ] unit-test
+{ f } [ "y" "\\x78" <regexp> matches? ] unit-test
+{ t } [ "x" "\\u0078" <regexp> matches? ] unit-test
+{ f } [ "y" "\\u0078" <regexp> matches? ] unit-test
+
+{ t } [ "ab" "a+b" <regexp> matches? ] unit-test
+{ f } [ "b" "a+b" <regexp> matches? ] unit-test
+{ t } [ "aab" "a+b" <regexp> matches? ] unit-test
+{ f } [ "abb" "a+b" <regexp> matches? ] unit-test
+
+{ t } [ "abbbb" "ab*" <regexp> matches? ] unit-test
+{ t } [ "a" "ab*" <regexp> matches? ] unit-test
+{ f } [ "abab" "ab*" <regexp> matches? ] unit-test
+
+{ f } [ "x" "\\." <regexp> matches? ] unit-test
+{ t } [ "." "\\." <regexp> matches? ] unit-test
+
+{ t } [ "aaaab" "a+ab" <regexp> matches? ] unit-test
+{ f } [ "aaaxb" "a+ab" <regexp> matches? ] unit-test
+{ t } [ "aaacb" "a+cb" <regexp> matches? ] unit-test
+
+{ "aaa" } [ "aaacb" "a*" <regexp> first-match >string ] unit-test
+{ "aa" } [ "aaacb" "aa?" <regexp> first-match >string ] unit-test
+
+{ t } [ "aaa" R/ AAA/i matches? ] unit-test
+{ f } [ "aax" R/ AAA/i matches? ] unit-test
+{ t } [ "aaa" R/ A*/i matches? ] unit-test
+{ f } [ "aaba" R/ A*/i matches? ] unit-test
+{ t } [ "b" R/ [AB]/i matches? ] unit-test
+{ f } [ "c" R/ [AB]/i matches? ] unit-test
+{ t } [ "c" R/ [A-Z]/i matches? ] unit-test
+{ f } [ "3" R/ [A-Z]/i matches? ] unit-test
+
+{ t } [ "a" "(?i:a)" <regexp> matches? ] unit-test
+{ t } [ "a" "(?i:a)" <regexp> matches? ] unit-test
+{ t } [ "A" "(?i:a)" <regexp> matches? ] unit-test
+{ t } [ "A" "(?i:a)" <regexp> matches? ] unit-test
+
+{ t } [ "a" R/ (?-i:a)/i matches? ] unit-test
+{ t } [ "a" R/ (?-i:a)/i matches? ] unit-test
+{ f } [ "A" R/ (?-i:a)/i matches? ] unit-test
+{ f } [ "A" R/ (?-i:a)/i matches? ] unit-test
+
+{ f } [ "A" "[a-z]" <regexp> matches? ] unit-test
+{ t } [ "A" R/ [a-z]/i matches? ] unit-test
+
+{ f } [ "A" "\\p{Lower}" <regexp> matches? ] unit-test
+{ t } [ "A" R/ \p{Lower}/i matches? ] unit-test
+
+{ t } [ "abc" R/ abc/r matches? ] unit-test
+{ t } [ "abc" R/ a[bB][cC]/r matches? ] unit-test
+
+{ t } [ 3 "xabc" R/ abc/r match-index-from >boolean ] unit-test
+{ t } [ 3 "xabc" R/ a[bB][cC]/r match-index-from >boolean ] unit-test
+
+{ 2 } [ 0 "llamallol" R/ ll/ match-index-from ] unit-test
+{ 5 } [ 8 "lolmallol" R/ lol/r match-index-from ] unit-test
+
+{ t } [ "s@f" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
+{ f } [ "a" "[a-z.-]@[a-z]" <regexp> matches? ] unit-test
+{ t } [ ".o" "\\.[a-z]" <regexp> matches? ] unit-test
+
+{ t } [ "abc*" "[^\\*]*\\*" <regexp> matches? ] unit-test
+{ t } [ "bca" "[^a]*a" <regexp> matches? ] unit-test
+
+{ } [
"(0[lL]?|[1-9]\\d{0,9}(\\d{0,9}[lL])?|0[xX]\\p{XDigit}{1,8}(\\p{XDigit}{0,8}[lL])?|0[0-7]{1,11}([0-7]{0,11}[lL])?|([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][+-]?[0-9]+)?[fFdD]?|[0-9]+([eE][+-]?[0-9]+[fFdD]?|([eE][+-]?[0-9]+)?[fFdD]))"
<regexp> drop
] unit-test
-[ ] [ "(\\$[\\p{XDigit}]|[\\p{Digit}])" <regexp> drop ] unit-test
+{ } [ "(\\$[\\p{XDigit}]|[\\p{Digit}])" <regexp> drop ] unit-test
! Comment inside a regular expression
-[ t ] [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test
+{ t } [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test
-[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval( -- ) ] unit-test
+{ } [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval( -- ) ] unit-test
-[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval( -- ) ] unit-test
+{ } [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval( -- ) ] unit-test
-[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval( -- ) ] unit-test
+{ } [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval( -- ) ] unit-test
-[ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
-[ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
+{ "ab" } [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
+{ "abc" } [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
-[ "ab" ] [ "ab" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
-[ "abc" ] [ "abc" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
+{ "ab" } [ "ab" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
+{ "abc" } [ "abc" "(ab|a)(bc)?" <regexp> first-match >string ] unit-test
-[ "b" ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
+{ "b" } [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match >string ] unit-test
-[ T{ slice { from 5 } { to 10 } { seq "hellohello" } } ]
+{ T{ slice { from 5 } { to 10 } { seq "hellohello" } } }
[ "hellohello" R/ hello/r first-match ]
unit-test
-[ { "1" "2" "3" "4" } ]
+{ { "1" "2" "3" "4" } }
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
-[ { "1" "2" "3" "4" "" } ]
+{ { "1" "2" "3" "4" "" } }
[ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ re-split [ >string ] map ] unit-test
-[ { "" } ] [ "" R/ =/ re-split [ >string ] map ] unit-test
+{ { "" } } [ "" R/ =/ re-split [ >string ] map ] unit-test
-[ { "a" "" } ] [ "a=" R/ =/ re-split [ >string ] map ] unit-test
+{ { "a" "" } } [ "a=" R/ =/ re-split [ >string ] map ] unit-test
-[ { "he" "o" } ] [ "hello" R/ l+/ re-split [ >string ] map ] unit-test
+{ { "he" "o" } } [ "hello" R/ l+/ re-split [ >string ] map ] unit-test
-[ { "h" "llo" } ] [ "hello" R/ e+/ re-split [ >string ] map ] unit-test
+{ { "h" "llo" } } [ "hello" R/ e+/ re-split [ >string ] map ] unit-test
-[ { "" "h" "" "l" "l" "o" "" } ] [ "hello" R/ e*/ re-split [ >string ] map ] unit-test
+{ { "" "h" "" "l" "l" "o" "" } } [ "hello" R/ e*/ re-split [ >string ] map ] unit-test
-[ { { 0 5 "hellohello" } { 5 10 "hellohello" } } ]
+{ { { 0 5 "hellohello" } { 5 10 "hellohello" } } }
[ "hellohello" R/ hello/ [ 3array ] map-matches ]
unit-test
-[ { { 5 10 "hellohello" } { 0 5 "hellohello" } } ]
+{ { { 5 10 "hellohello" } { 0 5 "hellohello" } } }
[ "hellohello" R/ hello/r [ 3array ] map-matches ]
unit-test
-[ { "ABC" "DEF" "GHI" } ]
+{ { "ABC" "DEF" "GHI" } }
[ "1ABC2DEF3GHI4" R/ [A-Z]+/ all-matching-subseqs ] unit-test
-[ { "ee" "e" } ] [ "heellohello" R/ e+/ all-matching-subseqs ] unit-test
-[ { "e" "ee" } ] [ "heellohello" R/ e+/r all-matching-subseqs ] unit-test
+{ { "ee" "e" } } [ "heellohello" R/ e+/ all-matching-subseqs ] unit-test
+{ { "e" "ee" } } [ "heellohello" R/ e+/r all-matching-subseqs ] unit-test
-[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
+{ 3 } [ "1ABC2DEF3GHI4" R/ [A-Z]+/ count-matches ] unit-test
-[ 3 ] [ "1ABC2DEF3GHI4" R/ [A-Z]+/r count-matches ] unit-test
+{ 3 } [ "1ABC2DEF3GHI4" R/ [A-Z]+/r count-matches ] unit-test
-[ 1 ] [ "" R/ / count-matches ] unit-test
+{ 1 } [ "" R/ / count-matches ] unit-test
-[ 1 ] [ "" R/ /r count-matches ] unit-test
+{ 1 } [ "" R/ /r count-matches ] unit-test
-[ 0 ] [ "123" R/ [A-Z]+/ count-matches ] unit-test
+{ 0 } [ "123" R/ [A-Z]+/ count-matches ] unit-test
-[ 0 ] [ "123" R/ [A-Z]+/r count-matches ] unit-test
+{ 0 } [ "123" R/ [A-Z]+/r count-matches ] unit-test
-[ 6 ] [ "hello" R/ e*/ count-matches ] unit-test
+{ 6 } [ "hello" R/ e*/ count-matches ] unit-test
-[ 6 ] [ "hello" R/ e*/r count-matches ] unit-test
+{ 6 } [ "hello" R/ e*/r count-matches ] unit-test
-[ 11 ] [ "hello world" R/ l*/ count-matches ] unit-test
+{ 11 } [ "hello world" R/ l*/ count-matches ] unit-test
-[ 11 ] [ "hello world" R/ l*/r count-matches ] unit-test
+{ 11 } [ "hello world" R/ l*/r count-matches ] unit-test
-[ 1 ] [ "hello" R/ e+/ count-matches ] unit-test
+{ 1 } [ "hello" R/ e+/ count-matches ] unit-test
-[ 2 ] [ "hello world" R/ l+/r count-matches ] unit-test
+{ 2 } [ "hello world" R/ l+/r count-matches ] unit-test
-[ "1.2.3.4." ] [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
-[ "XhXXlXlXoX XwXoXrXlXdX" ] [ "hello world" R/ e*/ "X" re-replace ] unit-test
-[ "-- title --" ] [ "== title ==" R/ =/ "-" re-replace ] unit-test
+{ "1.2.3.4." } [ "1ABC2DEF3GHI4JK" R/ [A-Z]+/ "." re-replace ] unit-test
+{ "XhXXlXlXoX XwXoXrXlXdX" } [ "hello world" R/ e*/ "X" re-replace ] unit-test
+{ "-- title --" } [ "== title ==" R/ =/ "-" re-replace ] unit-test
-[ "" ] [ "ab" "a(?!b)" <regexp> first-match >string ] unit-test
-[ "a" ] [ "ac" "a(?!b)" <regexp> first-match >string ] unit-test
-[ t ] [ "fxxbar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
-[ t ] [ "foobar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
-[ t ] [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
-[ f ] [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
-[ "a" ] [ "ab" "a(?=b)(?=b)" <regexp> first-match >string ] unit-test
-[ "a" ] [ "ba" "(?<=b)(?<=b)a" <regexp> first-match >string ] unit-test
-[ "a" ] [ "cab" "(?<=c)a(?=b)" <regexp> first-match >string ] unit-test
+{ "" } [ "ab" "a(?!b)" <regexp> first-match >string ] unit-test
+{ "a" } [ "ac" "a(?!b)" <regexp> first-match >string ] unit-test
+{ t } [ "fxxbar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
+{ t } [ "foobar" ".{3}(?!foo)bar" <regexp> matches? ] unit-test
+{ t } [ "fxxbar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
+{ f } [ "foobar" "(?!foo).{3}bar" <regexp> matches? ] unit-test
+{ "a" } [ "ab" "a(?=b)(?=b)" <regexp> first-match >string ] unit-test
+{ "a" } [ "ba" "(?<=b)(?<=b)a" <regexp> first-match >string ] unit-test
+{ "a" } [ "cab" "(?<=c)a(?=b)" <regexp> first-match >string ] unit-test
-[ 3 ] [ "foobar" "foo(?=bar)" <regexp> first-match length ] unit-test
-[ f ] [ "foobxr" "foo(?=bar)" <regexp> first-match ] unit-test
+{ 3 } [ "foobar" "foo(?=bar)" <regexp> first-match length ] unit-test
+{ f } [ "foobxr" "foo(?=bar)" <regexp> first-match ] unit-test
! Bug in parsing word
-[ t ] [ "a" R' a' matches? ] unit-test
+{ t } [ "a" R' a' matches? ] unit-test
! Testing negation
-[ f ] [ "a" R/ (?~a)/ matches? ] unit-test
-[ t ] [ "aa" R/ (?~a)/ matches? ] unit-test
-[ t ] [ "bb" R/ (?~a)/ matches? ] unit-test
-[ t ] [ "" R/ (?~a)/ matches? ] unit-test
+{ f } [ "a" R/ (?~a)/ matches? ] unit-test
+{ t } [ "aa" R/ (?~a)/ matches? ] unit-test
+{ t } [ "bb" R/ (?~a)/ matches? ] unit-test
+{ t } [ "" R/ (?~a)/ matches? ] unit-test
-[ f ] [ "a" R/ (?~a+|b)/ matches? ] unit-test
-[ f ] [ "aa" R/ (?~a+|b)/ matches? ] unit-test
-[ t ] [ "bb" R/ (?~a+|b)/ matches? ] unit-test
-[ f ] [ "b" R/ (?~a+|b)/ matches? ] unit-test
-[ t ] [ "" R/ (?~a+|b)/ matches? ] unit-test
+{ f } [ "a" R/ (?~a+|b)/ matches? ] unit-test
+{ f } [ "aa" R/ (?~a+|b)/ matches? ] unit-test
+{ t } [ "bb" R/ (?~a+|b)/ matches? ] unit-test
+{ f } [ "b" R/ (?~a+|b)/ matches? ] unit-test
+{ t } [ "" R/ (?~a+|b)/ matches? ] unit-test
! Intersecting classes
-[ t ] [ "ab" R/ ac|\p{Lower}b/ matches? ] unit-test
-[ t ] [ "ab" R/ ac|[a-z]b/ matches? ] unit-test
-[ t ] [ "ac" R/ ac|\p{Lower}b/ matches? ] unit-test
-[ t ] [ "ac" R/ ac|[a-z]b/ matches? ] unit-test
-[ t ] [ "ac" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
-[ t ] [ "ab" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
-[ t ] [ "Ï€b" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
-[ f ] [ "Ï€c" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
-[ f ] [ "Ab" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
-
-[ t ] [ "aaaa" R/ .*a./ matches? ] unit-test
-
-[ f ] [ "ab" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
-[ f ] [ "ab" R/ (?~ac|[a-z]b)/ matches? ] unit-test
-[ f ] [ "ac" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
-[ f ] [ "ac" R/ (?~ac|[a-z]b)/ matches? ] unit-test
-[ f ] [ "ac" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
-[ f ] [ "ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
-[ f ] [ "Ï€b" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
-[ t ] [ "Ï€c" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
-[ t ] [ "Ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
+{ t } [ "ab" R/ ac|\p{Lower}b/ matches? ] unit-test
+{ t } [ "ab" R/ ac|[a-z]b/ matches? ] unit-test
+{ t } [ "ac" R/ ac|\p{Lower}b/ matches? ] unit-test
+{ t } [ "ac" R/ ac|[a-z]b/ matches? ] unit-test
+{ t } [ "ac" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
+{ t } [ "ab" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
+{ t } [ "Ï€b" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
+{ f } [ "Ï€c" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
+{ f } [ "Ab" R/ [a-zA-Z]c|\p{Lower}b/ matches? ] unit-test
+
+{ t } [ "aaaa" R/ .*a./ matches? ] unit-test
+
+{ f } [ "ab" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
+{ f } [ "ab" R/ (?~ac|[a-z]b)/ matches? ] unit-test
+{ f } [ "ac" R/ (?~ac|\p{Lower}b)/ matches? ] unit-test
+{ f } [ "ac" R/ (?~ac|[a-z]b)/ matches? ] unit-test
+{ f } [ "ac" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
+{ f } [ "ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
+{ f } [ "Ï€b" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
+{ t } [ "Ï€c" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
+{ t } [ "Ab" R/ (?~[a-zA-Z]c|\p{Lower}b)/ matches? ] unit-test
! DFA is compiled when needed, or when literal
-[ regexp-initial-word ] [ "foo" <regexp> dfa>> ] unit-test
-[ f ] [ R/ foo/ dfa>> \ regexp-initial-word = ] unit-test
-
-[ t ] [ "a" R/ ^a/ matches? ] unit-test
-[ f ] [ "\na" R/ ^a/ matches? ] unit-test
-[ f ] [ "\r\na" R/ ^a/ matches? ] unit-test
-[ f ] [ "\ra" R/ ^a/ matches? ] unit-test
-
-[ 1 ] [ "a" R/ ^a/ count-matches ] unit-test
-[ 0 ] [ "\na" R/ ^a/ count-matches ] unit-test
-[ 0 ] [ "\r\na" R/ ^a/ count-matches ] unit-test
-[ 0 ] [ "\ra" R/ ^a/ count-matches ] unit-test
-
-[ t ] [ "a" R/ a$/ matches? ] unit-test
-[ f ] [ "a\n" R/ a$/ matches? ] unit-test
-[ f ] [ "a\r" R/ a$/ matches? ] unit-test
-[ f ] [ "a\r\n" R/ a$/ matches? ] unit-test
-
-[ 1 ] [ "a" R/ a$/ count-matches ] unit-test
-[ 0 ] [ "a\n" R/ a$/ count-matches ] unit-test
-[ 0 ] [ "a\r" R/ a$/ count-matches ] unit-test
-[ 0 ] [ "a\r\n" R/ a$/ count-matches ] unit-test
-
-[ t ] [ "a" R/ a$|b$/ matches? ] unit-test
-[ t ] [ "b" R/ a$|b$/ matches? ] unit-test
-[ f ] [ "ab" R/ a$|b$/ matches? ] unit-test
-[ t ] [ "ba" R/ ba$|b$/ matches? ] unit-test
-
-[ t ] [ "a" R/ \Aa/ matches? ] unit-test
-[ f ] [ "\na" R/ \Aaa/ matches? ] unit-test
-[ f ] [ "\r\na" R/ \Aa/ matches? ] unit-test
-[ f ] [ "\ra" R/ \Aa/ matches? ] unit-test
-
-[ t ] [ "a" R/ \Aa/m matches? ] unit-test
-[ f ] [ "\na" R/ \Aaa/m matches? ] unit-test
-[ f ] [ "\r\na" R/ \Aa/m matches? ] unit-test
-[ f ] [ "\ra" R/ \Aa/m matches? ] unit-test
-[ 0 ] [ "\ra" R/ \Aa/m count-matches ] unit-test
-
-[ f ] [ "\r\n\n\n\nam" R/ ^am/m matches? ] unit-test
-[ 1 ] [ "\r\n\n\n\nam" R/ ^am/m count-matches ] unit-test
-
-[ t ] [ "a" R/ \Aa\z/m matches? ] unit-test
-[ f ] [ "a\n" R/ \Aa\z/m matches? ] unit-test
-
-[ f ] [ "a\r\n" R/ \Aa\Z/m matches? ] unit-test
-[ f ] [ "a\n" R/ \Aa\Z/m matches? ] unit-test
-[ 1 ] [ "a\r\n" R/ \Aa\Z/m count-matches ] unit-test
-[ 1 ] [ "a\n" R/ \Aa\Z/m count-matches ] unit-test
-
-[ t ] [ "a" R/ \Aa\Z/m matches? ] unit-test
-[ f ] [ "\na" R/ \Aaa\Z/m matches? ] unit-test
-[ f ] [ "\r\na" R/ \Aa\Z/m matches? ] unit-test
-[ f ] [ "\ra" R/ \Aa\Z/m matches? ] unit-test
-
-[ 1 ] [ "a" R/ \Aa\Z/m count-matches ] unit-test
-[ 0 ] [ "\na" R/ \Aaa\Z/m count-matches ] unit-test
-[ 0 ] [ "\r\na" R/ \Aa\Z/m count-matches ] unit-test
-[ 0 ] [ "\ra" R/ \Aa\Z/m count-matches ] unit-test
-
-[ t ] [ "a" R/ ^a/m matches? ] unit-test
-[ f ] [ "\na" R/ ^a/m matches? ] unit-test
-[ 1 ] [ "\na" R/ ^a/m count-matches ] unit-test
-[ 1 ] [ "\r\na" R/ ^a/m count-matches ] unit-test
-[ 1 ] [ "\ra" R/ ^a/m count-matches ] unit-test
-
-[ t ] [ "a" R/ a$/m matches? ] unit-test
-[ f ] [ "a\n" R/ a$/m matches? ] unit-test
-[ 1 ] [ "a\n" R/ a$/m count-matches ] unit-test
-[ 1 ] [ "a\r" R/ a$/m count-matches ] unit-test
-[ 1 ] [ "a\r\n" R/ a$/m count-matches ] unit-test
-
-[ f ] [ "foobxr" "foo\\z" <regexp> first-match ] unit-test
-[ 3 ] [ "foo" "foo\\z" <regexp> first-match length ] unit-test
-
-[ t ] [ "a foo b" R/ foo/ re-contains? ] unit-test
-[ f ] [ "a bar b" R/ foo/ re-contains? ] unit-test
-[ t ] [ "foo" R/ foo/ re-contains? ] unit-test
-
-[ { "foo" "fxx" "fab" } ] [ "fab fxx foo" R/ f../r all-matching-subseqs ] unit-test
-
-[ t ] [ "foo" "\\bfoo\\b" <regexp> re-contains? ] unit-test
-[ t ] [ "afoob" "\\Bfoo\\B" <regexp> re-contains? ] unit-test
-[ f ] [ "afoob" "\\bfoo\\b" <regexp> re-contains? ] unit-test
-[ f ] [ "foo" "\\Bfoo\\B" <regexp> re-contains? ] unit-test
-
-[ 3 ] [ "foo bar" "foo\\b" <regexp> first-match length ] unit-test
-[ f ] [ "fooxbar" "foo\\b" <regexp> re-contains? ] unit-test
-[ t ] [ "foo" "foo\\b" <regexp> re-contains? ] unit-test
-[ t ] [ "foo bar" "foo\\b bar" <regexp> matches? ] unit-test
-[ f ] [ "fooxbar" "foo\\bxbar" <regexp> matches? ] unit-test
-[ f ] [ "foo" "foo\\bbar" <regexp> matches? ] unit-test
-
-[ f ] [ "foo bar" "foo\\B" <regexp> re-contains? ] unit-test
-[ 3 ] [ "fooxbar" "foo\\B" <regexp> first-match length ] unit-test
-[ f ] [ "foo" "foo\\B" <regexp> re-contains? ] unit-test
-[ f ] [ "foo bar" "foo\\B bar" <regexp> matches? ] unit-test
-[ t ] [ "fooxbar" "foo\\Bxbar" <regexp> matches? ] unit-test
-[ f ] [ "foo" "foo\\Bbar" <regexp> matches? ] unit-test
-
-[ t ] [ "ab" "a(?=b*)" <regexp> re-contains? ] unit-test
-[ t ] [ "abbbbbc" "a(?=b*c)" <regexp> re-contains? ] unit-test
-[ f ] [ "abbbbb" "a(?=b*c)" <regexp> re-contains? ] unit-test
-[ t ] [ "ab" "a(?=b*)" <regexp> re-contains? ] unit-test
-
-[ "az" ] [ "baz" "(?<=b)(az)" <regexp> first-match >string ] unit-test
-[ f ] [ "chaz" "(?<=b)(az)" <regexp> re-contains? ] unit-test
-[ "a" ] [ "cbaz" "(?<=b*)a" <regexp> first-match >string ] unit-test
-[ f ] [ "baz" "a(?<=b)" <regexp> re-contains? ] unit-test
-
-[ f ] [ "baz" "(?<!b)a" <regexp> re-contains? ] unit-test
-[ t ] [ "caz" "(?<!b)a" <regexp> re-contains? ] unit-test
-
-[ "abcd" ] [ "abcdefg" "a(?=bcdefg)bcd" <regexp> first-match >string ] unit-test
-[ t ] [ "abcdefg" "a(?#bcdefg)bcd" <regexp> re-contains? ] unit-test
-[ t ] [ "abcdefg" "a(?:bcdefg)" <regexp> matches? ] unit-test
-
-[ 3 ] [ "caba" "(?<=b)a" <regexp> first-match from>> ] unit-test
-
-[ t ] [ "\ra" R/ .^a/ms matches? ] unit-test
-[ f ] [ "\ra" R/ .^a/mds matches? ] unit-test
-[ t ] [ "\na" R/ .^a/ms matches? ] unit-test
-[ t ] [ "\na" R/ .^a/mds matches? ] unit-test
-
-[ t ] [ "a\r" R/ a$./ms matches? ] unit-test
-[ f ] [ "a\r" R/ a$./mds matches? ] unit-test
-[ t ] [ "a\n" R/ a$./ms matches? ] unit-test
-[ t ] [ "a\n" R/ a$./mds matches? ] unit-test
+{ regexp-initial-word } [ "foo" <regexp> dfa>> ] unit-test
+{ f } [ R/ foo/ dfa>> \ regexp-initial-word = ] unit-test
+
+{ t } [ "a" R/ ^a/ matches? ] unit-test
+{ f } [ "\na" R/ ^a/ matches? ] unit-test
+{ f } [ "\r\na" R/ ^a/ matches? ] unit-test
+{ f } [ "\ra" R/ ^a/ matches? ] unit-test
+
+{ 1 } [ "a" R/ ^a/ count-matches ] unit-test
+{ 0 } [ "\na" R/ ^a/ count-matches ] unit-test
+{ 0 } [ "\r\na" R/ ^a/ count-matches ] unit-test
+{ 0 } [ "\ra" R/ ^a/ count-matches ] unit-test
+
+{ t } [ "a" R/ a$/ matches? ] unit-test
+{ f } [ "a\n" R/ a$/ matches? ] unit-test
+{ f } [ "a\r" R/ a$/ matches? ] unit-test
+{ f } [ "a\r\n" R/ a$/ matches? ] unit-test
+
+{ 1 } [ "a" R/ a$/ count-matches ] unit-test
+{ 0 } [ "a\n" R/ a$/ count-matches ] unit-test
+{ 0 } [ "a\r" R/ a$/ count-matches ] unit-test
+{ 0 } [ "a\r\n" R/ a$/ count-matches ] unit-test
+
+{ t } [ "a" R/ a$|b$/ matches? ] unit-test
+{ t } [ "b" R/ a$|b$/ matches? ] unit-test
+{ f } [ "ab" R/ a$|b$/ matches? ] unit-test
+{ t } [ "ba" R/ ba$|b$/ matches? ] unit-test
+
+{ t } [ "a" R/ \Aa/ matches? ] unit-test
+{ f } [ "\na" R/ \Aaa/ matches? ] unit-test
+{ f } [ "\r\na" R/ \Aa/ matches? ] unit-test
+{ f } [ "\ra" R/ \Aa/ matches? ] unit-test
+
+{ t } [ "a" R/ \Aa/m matches? ] unit-test
+{ f } [ "\na" R/ \Aaa/m matches? ] unit-test
+{ f } [ "\r\na" R/ \Aa/m matches? ] unit-test
+{ f } [ "\ra" R/ \Aa/m matches? ] unit-test
+{ 0 } [ "\ra" R/ \Aa/m count-matches ] unit-test
+
+{ f } [ "\r\n\n\n\nam" R/ ^am/m matches? ] unit-test
+{ 1 } [ "\r\n\n\n\nam" R/ ^am/m count-matches ] unit-test
+
+{ t } [ "a" R/ \Aa\z/m matches? ] unit-test
+{ f } [ "a\n" R/ \Aa\z/m matches? ] unit-test
+
+{ f } [ "a\r\n" R/ \Aa\Z/m matches? ] unit-test
+{ f } [ "a\n" R/ \Aa\Z/m matches? ] unit-test
+{ 1 } [ "a\r\n" R/ \Aa\Z/m count-matches ] unit-test
+{ 1 } [ "a\n" R/ \Aa\Z/m count-matches ] unit-test
+
+{ t } [ "a" R/ \Aa\Z/m matches? ] unit-test
+{ f } [ "\na" R/ \Aaa\Z/m matches? ] unit-test
+{ f } [ "\r\na" R/ \Aa\Z/m matches? ] unit-test
+{ f } [ "\ra" R/ \Aa\Z/m matches? ] unit-test
+
+{ 1 } [ "a" R/ \Aa\Z/m count-matches ] unit-test
+{ 0 } [ "\na" R/ \Aaa\Z/m count-matches ] unit-test
+{ 0 } [ "\r\na" R/ \Aa\Z/m count-matches ] unit-test
+{ 0 } [ "\ra" R/ \Aa\Z/m count-matches ] unit-test
+
+{ t } [ "a" R/ ^a/m matches? ] unit-test
+{ f } [ "\na" R/ ^a/m matches? ] unit-test
+{ 1 } [ "\na" R/ ^a/m count-matches ] unit-test
+{ 1 } [ "\r\na" R/ ^a/m count-matches ] unit-test
+{ 1 } [ "\ra" R/ ^a/m count-matches ] unit-test
+
+{ t } [ "a" R/ a$/m matches? ] unit-test
+{ f } [ "a\n" R/ a$/m matches? ] unit-test
+{ 1 } [ "a\n" R/ a$/m count-matches ] unit-test
+{ 1 } [ "a\r" R/ a$/m count-matches ] unit-test
+{ 1 } [ "a\r\n" R/ a$/m count-matches ] unit-test
+
+{ f } [ "foobxr" "foo\\z" <regexp> first-match ] unit-test
+{ 3 } [ "foo" "foo\\z" <regexp> first-match length ] unit-test
+
+{ t } [ "a foo b" R/ foo/ re-contains? ] unit-test
+{ f } [ "a bar b" R/ foo/ re-contains? ] unit-test
+{ t } [ "foo" R/ foo/ re-contains? ] unit-test
+
+{ { "foo" "fxx" "fab" } } [ "fab fxx foo" R/ f../r all-matching-subseqs ] unit-test
+
+{ t } [ "foo" "\\bfoo\\b" <regexp> re-contains? ] unit-test
+{ t } [ "afoob" "\\Bfoo\\B" <regexp> re-contains? ] unit-test
+{ f } [ "afoob" "\\bfoo\\b" <regexp> re-contains? ] unit-test
+{ f } [ "foo" "\\Bfoo\\B" <regexp> re-contains? ] unit-test
+
+{ 3 } [ "foo bar" "foo\\b" <regexp> first-match length ] unit-test
+{ f } [ "fooxbar" "foo\\b" <regexp> re-contains? ] unit-test
+{ t } [ "foo" "foo\\b" <regexp> re-contains? ] unit-test
+{ t } [ "foo bar" "foo\\b bar" <regexp> matches? ] unit-test
+{ f } [ "fooxbar" "foo\\bxbar" <regexp> matches? ] unit-test
+{ f } [ "foo" "foo\\bbar" <regexp> matches? ] unit-test
+
+{ f } [ "foo bar" "foo\\B" <regexp> re-contains? ] unit-test
+{ 3 } [ "fooxbar" "foo\\B" <regexp> first-match length ] unit-test
+{ f } [ "foo" "foo\\B" <regexp> re-contains? ] unit-test
+{ f } [ "foo bar" "foo\\B bar" <regexp> matches? ] unit-test
+{ t } [ "fooxbar" "foo\\Bxbar" <regexp> matches? ] unit-test
+{ f } [ "foo" "foo\\Bbar" <regexp> matches? ] unit-test
+
+{ t } [ "ab" "a(?=b*)" <regexp> re-contains? ] unit-test
+{ t } [ "abbbbbc" "a(?=b*c)" <regexp> re-contains? ] unit-test
+{ f } [ "abbbbb" "a(?=b*c)" <regexp> re-contains? ] unit-test
+{ t } [ "ab" "a(?=b*)" <regexp> re-contains? ] unit-test
+
+{ "az" } [ "baz" "(?<=b)(az)" <regexp> first-match >string ] unit-test
+{ f } [ "chaz" "(?<=b)(az)" <regexp> re-contains? ] unit-test
+{ "a" } [ "cbaz" "(?<=b*)a" <regexp> first-match >string ] unit-test
+{ f } [ "baz" "a(?<=b)" <regexp> re-contains? ] unit-test
+
+{ f } [ "baz" "(?<!b)a" <regexp> re-contains? ] unit-test
+{ t } [ "caz" "(?<!b)a" <regexp> re-contains? ] unit-test
+
+{ "abcd" } [ "abcdefg" "a(?=bcdefg)bcd" <regexp> first-match >string ] unit-test
+{ t } [ "abcdefg" "a(?#bcdefg)bcd" <regexp> re-contains? ] unit-test
+{ t } [ "abcdefg" "a(?:bcdefg)" <regexp> matches? ] unit-test
+
+{ 3 } [ "caba" "(?<=b)a" <regexp> first-match from>> ] unit-test
+
+{ t } [ "\ra" R/ .^a/ms matches? ] unit-test
+{ f } [ "\ra" R/ .^a/mds matches? ] unit-test
+{ t } [ "\na" R/ .^a/ms matches? ] unit-test
+{ t } [ "\na" R/ .^a/mds matches? ] unit-test
+
+{ t } [ "a\r" R/ a$./ms matches? ] unit-test
+{ f } [ "a\r" R/ a$./mds matches? ] unit-test
+{ t } [ "a\n" R/ a$./ms matches? ] unit-test
+{ t } [ "a\n" R/ a$./mds matches? ] unit-test
! Unicode categories
-[ t ] [ "a" R/ \p{L}/ matches? ] unit-test
-[ t ] [ "A" R/ \p{L}/ matches? ] unit-test
-[ f ] [ " " R/ \p{L}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{L}/ matches? ] unit-test
-[ f ] [ "A" R/ \P{L}/ matches? ] unit-test
-[ t ] [ " " R/ \P{L}/ matches? ] unit-test
-
-[ t ] [ "a" R/ \p{Ll}/ matches? ] unit-test
-[ f ] [ "A" R/ \p{Ll}/ matches? ] unit-test
-[ f ] [ " " R/ \p{Ll}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{Ll}/ matches? ] unit-test
-[ t ] [ "A" R/ \P{Ll}/ matches? ] unit-test
-[ t ] [ " " R/ \P{Ll}/ matches? ] unit-test
-
-[ t ] [ "a" R/ \p{script=Latin}/ matches? ] unit-test
-[ f ] [ " " R/ \p{script=Latin}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{script=Latin}/ matches? ] unit-test
-[ t ] [ " " R/ \P{script=Latin}/ matches? ] unit-test
+{ t } [ "a" R/ \p{L}/ matches? ] unit-test
+{ t } [ "A" R/ \p{L}/ matches? ] unit-test
+{ f } [ " " R/ \p{L}/ matches? ] unit-test
+{ f } [ "a" R/ \P{L}/ matches? ] unit-test
+{ f } [ "A" R/ \P{L}/ matches? ] unit-test
+{ t } [ " " R/ \P{L}/ matches? ] unit-test
+
+{ t } [ "a" R/ \p{Ll}/ matches? ] unit-test
+{ f } [ "A" R/ \p{Ll}/ matches? ] unit-test
+{ f } [ " " R/ \p{Ll}/ matches? ] unit-test
+{ f } [ "a" R/ \P{Ll}/ matches? ] unit-test
+{ t } [ "A" R/ \P{Ll}/ matches? ] unit-test
+{ t } [ " " R/ \P{Ll}/ matches? ] unit-test
+
+{ t } [ "a" R/ \p{script=Latin}/ matches? ] unit-test
+{ f } [ " " R/ \p{script=Latin}/ matches? ] unit-test
+{ f } [ "a" R/ \P{script=Latin}/ matches? ] unit-test
+{ t } [ " " R/ \P{script=Latin}/ matches? ] unit-test
! These should be case-insensitive
-[ f ] [ " " R/ \p{l}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{l}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{ll}/ matches? ] unit-test
-[ t ] [ " " R/ \P{LL}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{sCriPt = latin}/ matches? ] unit-test
-[ t ] [ " " R/ \P{SCRIPT = laTIn}/ matches? ] unit-test
+{ f } [ " " R/ \p{l}/ matches? ] unit-test
+{ f } [ "a" R/ \P{l}/ matches? ] unit-test
+{ f } [ "a" R/ \P{ll}/ matches? ] unit-test
+{ t } [ " " R/ \P{LL}/ matches? ] unit-test
+{ f } [ "a" R/ \P{sCriPt = latin}/ matches? ] unit-test
+{ t } [ " " R/ \P{SCRIPT = laTIn}/ matches? ] unit-test
! Logical operators
-[ t ] [ "a" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
-[ t ] [ "Ï€" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
-[ t ] [ "A" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
-[ f ] [ "3" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
-
-[ t ] [ "a" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
-[ t ] [ "Ï€" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
-[ t ] [ "A" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
-[ f ] [ "3" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
-
-[ t ] [ "a" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
-[ f ] [ "Ï€" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
-[ f ] [ "A" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
-[ f ] [ "3" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
-
-[ f ] [ "a" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
-[ t ] [ "Ï€" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
-[ t ] [ "A" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
-[ f ] [ "3" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
-
-[ f ] [ "a" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
-[ f ] [ "Ï€" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
-[ t ] [ "A" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
-[ f ] [ "3" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
-
-[ t ] [ " " R/ \P{alpha}/ matches? ] unit-test
-[ f ] [ "" R/ \P{alpha}/ matches? ] unit-test
-[ f ] [ "a " R/ \P{alpha}/ matches? ] unit-test
-[ f ] [ "a" R/ \P{alpha}/ matches? ] unit-test
+{ t } [ "a" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
+{ t } [ "Ï€" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
+{ t } [ "A" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
+{ f } [ "3" R/ [\p{script=latin}\p{lower}]/ matches? ] unit-test
+
+{ t } [ "a" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
+{ t } [ "Ï€" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
+{ t } [ "A" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
+{ f } [ "3" R/ [\p{script=latin}||\p{lower}]/ matches? ] unit-test
+
+{ t } [ "a" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
+{ f } [ "Ï€" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
+{ f } [ "A" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
+{ f } [ "3" R/ [\p{script=latin}&&\p{lower}]/ matches? ] unit-test
+
+{ f } [ "a" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
+{ t } [ "Ï€" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
+{ t } [ "A" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
+{ f } [ "3" R/ [\p{script=latin}~~\p{lower}]/ matches? ] unit-test
+
+{ f } [ "a" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
+{ f } [ "Ï€" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
+{ t } [ "A" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
+{ f } [ "3" R/ [\p{script=latin}--\p{lower}]/ matches? ] unit-test
+
+{ t } [ " " R/ \P{alpha}/ matches? ] unit-test
+{ f } [ "" R/ \P{alpha}/ matches? ] unit-test
+{ f } [ "a " R/ \P{alpha}/ matches? ] unit-test
+{ f } [ "a" R/ \P{alpha}/ matches? ] unit-test
USING: arrays kernel math roman roman.private sequences tools.test ;
-[ "i" ] [ 1 >roman ] unit-test
-[ "ii" ] [ 2 >roman ] unit-test
-[ "iii" ] [ 3 >roman ] unit-test
-[ "iv" ] [ 4 >roman ] unit-test
-[ "v" ] [ 5 >roman ] unit-test
-[ "vi" ] [ 6 >roman ] unit-test
-[ "vii" ] [ 7 >roman ] unit-test
-[ "viii" ] [ 8 >roman ] unit-test
-[ "ix" ] [ 9 >roman ] unit-test
-[ "x" ] [ 10 >roman ] unit-test
-[ "mdclxvi" ] [ 1666 >roman ] unit-test
-[ "mmmcdxliv" ] [ 3444 >roman ] unit-test
-[ "mmmcmxcix" ] [ 3999 >roman ] unit-test
-[ "MMMCMXCIX" ] [ 3999 >ROMAN ] unit-test
-[ 3999 ] [ 3999 >ROMAN roman> ] unit-test
-[ 1 ] [ 1 >roman roman> ] unit-test
-[ 2 ] [ 2 >roman roman> ] unit-test
-[ 3 ] [ 3 >roman roman> ] unit-test
-[ 4 ] [ 4 >roman roman> ] unit-test
-[ 5 ] [ 5 >roman roman> ] unit-test
-[ 6 ] [ 6 >roman roman> ] unit-test
-[ 7 ] [ 7 >roman roman> ] unit-test
-[ 8 ] [ 8 >roman roman> ] unit-test
-[ 9 ] [ 9 >roman roman> ] unit-test
-[ 10 ] [ 10 >roman roman> ] unit-test
-[ 1666 ] [ 1666 >roman roman> ] unit-test
-[ 3444 ] [ 3444 >roman roman> ] unit-test
-[ 3999 ] [ 3999 >roman roman> ] unit-test
+{ "i" } [ 1 >roman ] unit-test
+{ "ii" } [ 2 >roman ] unit-test
+{ "iii" } [ 3 >roman ] unit-test
+{ "iv" } [ 4 >roman ] unit-test
+{ "v" } [ 5 >roman ] unit-test
+{ "vi" } [ 6 >roman ] unit-test
+{ "vii" } [ 7 >roman ] unit-test
+{ "viii" } [ 8 >roman ] unit-test
+{ "ix" } [ 9 >roman ] unit-test
+{ "x" } [ 10 >roman ] unit-test
+{ "mdclxvi" } [ 1666 >roman ] unit-test
+{ "mmmcdxliv" } [ 3444 >roman ] unit-test
+{ "mmmcmxcix" } [ 3999 >roman ] unit-test
+{ "MMMCMXCIX" } [ 3999 >ROMAN ] unit-test
+{ 3999 } [ 3999 >ROMAN roman> ] unit-test
+{ 1 } [ 1 >roman roman> ] unit-test
+{ 2 } [ 2 >roman roman> ] unit-test
+{ 3 } [ 3 >roman roman> ] unit-test
+{ 4 } [ 4 >roman roman> ] unit-test
+{ 5 } [ 5 >roman roman> ] unit-test
+{ 6 } [ 6 >roman roman> ] unit-test
+{ 7 } [ 7 >roman roman> ] unit-test
+{ 8 } [ 8 >roman roman> ] unit-test
+{ 9 } [ 9 >roman roman> ] unit-test
+{ 10 } [ 10 >roman roman> ] unit-test
+{ 1666 } [ 1666 >roman roman> ] unit-test
+{ 3444 } [ 3444 >roman roman> ] unit-test
+{ 3999 } [ 3999 >roman roman> ] unit-test
[ 0 >roman ] must-fail
[ 40000 >roman ] must-fail
-[ "vi" ] [ "iii" "iii" roman+ ] unit-test
-[ "viii" ] [ "x" "ii" roman- ] unit-test
-[ "ix" ] [ "iii" "iii" roman* ] unit-test
-[ "i" ] [ "iii" "ii" roman/i ] unit-test
-[ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test
+{ "vi" } [ "iii" "iii" roman+ ] unit-test
+{ "viii" } [ "x" "ii" roman- ] unit-test
+{ "ix" } [ "iii" "iii" roman* ] unit-test
+{ "i" } [ "iii" "ii" roman/i ] unit-test
+{ "i" "ii" } [ "v" "iii" roman/mod ] unit-test
[ "iii" "iii" roman- ] must-fail
-[ 30 ] [ ROMAN: xxx ] unit-test
+{ 30 } [ ROMAN: xxx ] unit-test
[ roman+ ] must-infer
[ roman- ] must-infer
<hashed-dlist> "h" set
-[ t ] [ "h" get deque-empty? ] unit-test
+{ t } [ "h" get deque-empty? ] unit-test
-[ ] [ 3 "h" get push-front* "1" set ] unit-test
-[ ] [ 1 "h" get push-front ] unit-test
-[ ] [ 3 "h" get push-front* "2" set ] unit-test
-[ ] [ 3 "h" get push-front* "3" set ] unit-test
-[ ] [ 7 "h" get push-front ] unit-test
+{ } [ 3 "h" get push-front* "1" set ] unit-test
+{ } [ 1 "h" get push-front ] unit-test
+{ } [ 3 "h" get push-front* "2" set ] unit-test
+{ } [ 3 "h" get push-front* "3" set ] unit-test
+{ } [ 7 "h" get push-front ] unit-test
-[ t ] [ "1" get "2" get eq? ] unit-test
-[ t ] [ "2" get "3" get eq? ] unit-test
+{ t } [ "1" get "2" get eq? ] unit-test
+{ t } [ "2" get "3" get eq? ] unit-test
-[ t ] [ 7 "h" get deque-member? ] unit-test
+{ t } [ 7 "h" get deque-member? ] unit-test
-[ 3 ] [ "1" get node-value ] unit-test
-[ ] [ "1" get "h" get delete-node ] unit-test
+{ 3 } [ "1" get node-value ] unit-test
+{ } [ "1" get "h" get delete-node ] unit-test
-[ 1 ] [ "h" get pop-back ] unit-test
-[ 7 ] [ "h" get pop-back ] unit-test
+{ 1 } [ "h" get pop-back ] unit-test
+{ 7 } [ "h" get pop-back ] unit-test
-[ f ] [ 7 "h" get deque-member? ] unit-test
+{ f } [ 7 "h" get deque-member? ] unit-test
-[ ] [
+{ } [
<hashed-dlist>
[ all-words swap [ push-front ] curry each ]
[ [ drop ] slurp-deque ]
CONSTANT: test-const 10
-[ "IN: see.tests\nCONSTANT: test-const 10 inline\n" ]
+{ "IN: see.tests\nCONSTANT: test-const 10 inline\n" }
[ [ \ test-const see ] with-string-writer ] unit-test
ALIAS: test-alias +
-[ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" ]
+{ "USING: math ;\nIN: see.tests\nALIAS: test-alias + inline\n" }
[ [ \ test-alias see ] with-string-writer ] unit-test
-[ "IN: see.tests ALIAS: test-alias ( x y -- z )" ]
+{ "IN: see.tests ALIAS: test-alias ( x y -- z )" }
[ \ test-alias summary ] unit-test
-[ ] [ gensym see ] unit-test
+{ } [ gensym see ] unit-test
binary [ serialize-cell ] with-byte-writer
binary [ deserialize-cell ] with-byte-reader = ;
-[ t ] [
+{ t } [
100 [
drop
{
first2 eq?
] if ;
-[ t ] [ objects [ check-serialize-1 ] all? ] unit-test
+{ t } [ objects [ check-serialize-1 ] all? ] unit-test
-[ t ] [ objects [ check-serialize-2 ] all? ] unit-test
+{ t } [ objects [ check-serialize-2 ] all? ] unit-test
-[ t ] [ pi check-serialize-1 ] unit-test
+{ t } [ pi check-serialize-1 ] unit-test
[ serialize ] must-infer
[ deserialize ] must-infer
-[ t ] [
+{ t } [
V{ } dup dup push
object>bytes
bytes>object
dup first eq?
] unit-test
-[ t ] [
+{ t } [
H{ } dup dup dup set-at
object>bytes
bytes>object
USING: shuffle tools.test ;
IN: shuffle.tests
-[ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test
+{ 1 2 3 4 } [ 3 4 1 2 2swap ] unit-test
-[ 4 2 3 ] [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test
+{ 4 2 3 } [ 1 2 3 4 shuffle( a b c d -- d b c ) ] unit-test
-[ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
-[ 1 2 3 4 ] [ 2 3 4 1 -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
"vocab:simple-flat-file/test1.txt" flat-file>biassoc ;
-[ 0 ] [ 0 <test1> at ] unit-test
-[ 0 ] [ 0 <test1> value-at ] unit-test
+{ 0 } [ 0 <test1> at ] unit-test
+{ 0 } [ 0 <test1> value-at ] unit-test
-[ 3 ] [ 3 <test1> at ] unit-test
-[ 3 ] [ 3 <test1> value-at ] unit-test
+{ 3 } [ 3 <test1> at ] unit-test
+{ 3 } [ 3 <test1> value-at ] unit-test
-[ 0xAD2A ] [ 0x8253 <test1> at ] unit-test
-[ 0x8253 ] [ 0xAD2A <test1> value-at ] unit-test
+{ 0xAD2A } [ 0x8253 <test1> at ] unit-test
+{ 0x8253 } [ 0xAD2A <test1> value-at ] unit-test
-[ 0xAD31 ] [ 0x8258 <test1> at ] unit-test
-[ 0x8258 ] [ 0xAD31 <test1> value-at ] unit-test
+{ 0xAD31 } [ 0x8258 <test1> at ] unit-test
+{ 0x8258 } [ 0xAD31 <test1> value-at ] unit-test
[ "" tokenize ] must-fail
[ " " tokenize ] must-fail
-[ V{ "a" } ] [ "a" tokenize ] unit-test
-[ V{ "abc" } ] [ "abc" tokenize ] unit-test
-[ V{ "abc" } ] [ "abc " tokenize ] unit-test
-[ V{ "abc" } ] [ " abc" tokenize ] unit-test
-[ V{ "abc" "def" } ] [ "abc def" tokenize ] unit-test
-[ V{ "abc def" } ] [ "abc\\ def" tokenize ] unit-test
-[ V{ "abc\\" "def" } ] [ "abc\\\\ def" tokenize ] unit-test
-[ V{ "abc\\ def" } ] [ "\"abc\\\\ def\"" tokenize ] unit-test
-[ V{ "abc\\ def" } ] [ " \"abc\\\\ def\"" tokenize ] unit-test
-[ V{ "abc\\ def" "hey" } ] [ "\"abc\\\\ def\" hey" tokenize ] unit-test
-[ V{ "abc def" "hey" } ] [ "\"abc def\" \"hey\"" tokenize ] unit-test
+{ V{ "a" } } [ "a" tokenize ] unit-test
+{ V{ "abc" } } [ "abc" tokenize ] unit-test
+{ V{ "abc" } } [ "abc " tokenize ] unit-test
+{ V{ "abc" } } [ " abc" tokenize ] unit-test
+{ V{ "abc" "def" } } [ "abc def" tokenize ] unit-test
+{ V{ "abc def" } } [ "abc\\ def" tokenize ] unit-test
+{ V{ "abc\\" "def" } } [ "abc\\\\ def" tokenize ] unit-test
+{ V{ "abc\\ def" } } [ "\"abc\\\\ def\"" tokenize ] unit-test
+{ V{ "abc\\ def" } } [ " \"abc\\\\ def\"" tokenize ] unit-test
+{ V{ "abc\\ def" "hey" } } [ "\"abc\\\\ def\" hey" tokenize ] unit-test
+{ V{ "abc def" "hey" } } [ "\"abc def\" \"hey\"" tokenize ] unit-test
[ "\"abc def\" \"hey" tokenize ] must-fail
[ "\"abc def" tokenize ] must-fail
-[ V{ "abc def" "h\"ey" } ] [ "\"abc def\" \"h\\\"ey\" " tokenize ] unit-test
+{ V{ "abc def" "h\"ey" } } [ "\"abc def\" \"h\\\"ey\" " tokenize ] unit-test
-[
+{
V{
"Hello world.app/Contents/MacOS/hello-ui"
"-i=boot.macosx-ppc.image"
"-no-stack-traces"
"-no-user-init"
}
-] [
+} [
"\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize
] unit-test
[ "hello\nworld" validate-address ] must-fail
-[ "slava@factorcode.org" ]
+{ "slava@factorcode.org" }
[ "slava@factorcode.org" validate-address ] unit-test
-[ "aGVsbG8Kd29ybGQ=\r\n.\r\n" ] [
+{ "aGVsbG8Kd29ybGQ=\r\n.\r\n" } [
T{ email { body "hello\nworld" } } [ send-body ] with-string-writer
] unit-test
[ { "500 syntax error" } <response> check-response ]
[ smtp-error? ] must-fail-with
-[ ] [ { "220 success" } <response> check-response ] unit-test
+{ } [ { "220 success" } <response> check-response ] unit-test
-[ T{ response f 220 { "220 success" } } ] [
+{ T{ response f 220 { "220 success" } } } [
"220 success" [ receive-response ] with-string-reader
] unit-test
-[
+{
T{ response f 220 {
"220-a multiline response"
"250-another line"
"220 the end"
} }
-] [
+} [
"220-a multiline response\r\n250-another line\r\n220 the end"
[ receive-response ] with-string-reader
] unit-test
-[ ] [
+{ } [
"220-a multiline response\r\n250-another line\r\n220 the end"
[ get-ok ] with-string-reader
] unit-test
"Subject:\r\nsecurity hole" validate-header
] must-fail
-[
+{
{
{ "Content-Transfer-Encoding" "base64" }
{ "Content-Type" "text/plain; charset=UTF-8" }
}
{ "slava@factorcode.org" "dharmatech@factorcode.org" }
"erg@factorcode.org"
-] [
+} [
[
<email>
"Factor rules" >>subject
] with-test-smtp-config
] unit-test
-[ ] [
+{ } [
<secure-config> f >>verify [
[
<email>
IN: soundex.tests
USING: soundex tools.test ;
-[ "S162" ] [ "supercalifrag" soundex ] unit-test
-[ "M000" ] [ "M" soundex ] unit-test
+{ "S162" } [ "supercalifrag" soundex ] unit-test
+{ "M000" } [ "M" soundex ] unit-test
SPECIALIZED-ARRAY: int
SPECIALIZED-ARRAYS: bool uchar ushort char uint float ulonglong ;
-[ t ] [ { 1 2 3 } int >c-array int-array? ] unit-test
+{ t } [ { 1 2 3 } int >c-array int-array? ] unit-test
-[ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
+{ t } [ int-array{ 1 2 3 } int-array? ] unit-test
-[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
+{ 2 } [ int-array{ 1 2 3 } second ] unit-test
-[ t ] [
+{ t } [
{ t f t } bool >c-array underlying>>
{ 1 0 1 } bool heap-size {
{ 1 [ char >c-array ] }
} case underlying>> =
] unit-test
-[ ushort-array{ 1234 } ] [
+{ ushort-array{ 1234 } } [
little-endian? B{ 210 4 } B{ 4 210 } ? ushort cast-array
] unit-test
[ B{ 210 4 1 } ushort cast-array ] must-fail
-[ { 3 1 3 3 7 } ] [
+{ { 3 1 3 3 7 } } [
int-array{ 3 1 3 3 7 } malloc-byte-array [ &free 5 int <c-direct-array> >array ] with-destructors
] unit-test
-[ float-array{ 0x1.222,222p0 0x1.111,112p0 } ]
+{ float-array{ 0x1.222,222p0 0x1.111,112p0 } }
[ float-array{ 0x1.222,222,2p0 0x1.111,111,1p0 } ] unit-test
-[ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
+{ f } [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
-[ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
+{ f } [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
-[ ushort-array{ 0 0 0 } ] [
+{ ushort-array{ 0 0 0 } } [
3 ALIEN: 123 100 <direct-ushort-array> new-sequence
[ drop 0 ] map!
] unit-test
SPECIALIZED-ARRAY: test-struct
-[ 1 ] [
+{ 1 } [
1 test-struct-array{ } new-sequence length
] unit-test
-[ V{ test-struct } ] [
+{ V{ test-struct } } [
[ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
] unit-test
: make-point ( x y -- struct )
test-struct <struct-boa> ;
-[ 5/4 ] [
+{ 5/4 } [
2 <test-struct-array>
1 2 make-point over set-first
3 4 make-point over set-second
0 [ [ x>> ] [ y>> ] bi / + ] reduce
] unit-test
-[ 5/4 ] [
+{ 5/4 } [
[
2 \ test-struct malloc-array
dup &free drop
] with-destructors
] unit-test
-[ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
+{ } [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
-[ ] [
+{ } [
[
10 \ test-struct malloc-array
&free drop
] with-destructors
] unit-test
-[ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
+{ 15 } [ 15 10 <test-struct-array> resize length ] unit-test
-[ S{ test-struct f 12 20 } ] [
+{ S{ test-struct f 12 20 } } [
test-struct-array{
S{ test-struct f 4 20 }
S{ test-struct f 12 20 }
} second
] unit-test
-[ ] [
+{ } [
[
test-struct specialized-array-vocab forget-vocab
] with-compilation-unit
SPECIALIZED-ARRAY: fixed-string
-[ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } ] [
+{ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } } [
ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
] unit-test
! Ensure that byte-length works with direct arrays
-[ 400 ] [
+{ 400 } [
ALIEN: 123 100 <direct-int-array> byte-length
] unit-test
-[ ] [
+{ } [
[
fixed-string specialized-array-vocab forget-vocab
] with-compilation-unit
] unit-test
! Test prettyprinting
-[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
-[ "c-array@ int f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
+{ "int-array{ 1 2 3 }" } [ int-array{ 1 2 3 } unparse ] unit-test
+{ "c-array@ int f 100" } [ f 100 <direct-int-array> unparse ] unit-test
! If the C type doesn't exist, don't generate a vocab
SYMBOL: __does_not_exist__
SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- )
] must-fail
-[ ] [
+{ } [
"""
IN: specialized-arrays.tests
USING: alien.c-types classes.struct specialized-arrays ;
""" eval( -- )
] unit-test
-[ f ] [
+{ f } [
"__does_not_exist__-array{"
__does_not_exist__ specialized-array-vocab lookup-word
deferred?
] unit-test
-[ ] [
+{ } [
[
\ __does_not_exist__ forget
__does_not_exist__ specialized-array-vocab forget-vocab
SPECIALIZED-ARRAY: struct-resize-test
-[ 40 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
+{ 40 } [ 10 <struct-resize-test-array> byte-length ] unit-test
: struct-resize-test-usage ( seq -- seq )
[ struct-resize-test <struct> swap >>x ] map
\ struct-resize-test >c-array
[ x>> ] { } map-as ;
-[ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
+{ { 10 20 30 } } [ { 10 20 30 } struct-resize-test-usage ] unit-test
-[ ] [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
+{ } [ "IN: specialized-arrays.tests USE: classes.struct USE: alien.c-types STRUCT: struct-resize-test { x int } { y int } ;" eval( -- ) ] unit-test
-[ 80 ] [ 10 <struct-resize-test-array> byte-length ] unit-test
+{ 80 } [ 10 <struct-resize-test-array> byte-length ] unit-test
-[ { 10 20 30 } ] [ { 10 20 30 } struct-resize-test-usage ] unit-test
+{ { 10 20 30 } } [ { 10 20 30 } struct-resize-test-usage ] unit-test
-[ ] [
+{ } [
[
struct-resize-test specialized-array-vocab forget-vocab
\ struct-resize-test-usage forget
] with-compilation-unit
] unit-test
-[ int-array{ 4 5 6 } ] [ 3 6 int-array{ 1 2 3 4 5 6 7 8 } direct-slice ] unit-test
-[ int-array{ 1 2 3 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head ] unit-test
-[ int-array{ 1 2 3 4 5 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head* ] unit-test
-[ int-array{ 4 5 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail ] unit-test
-[ int-array{ 6 7 8 } ] [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail* ] unit-test
+{ int-array{ 4 5 6 } } [ 3 6 int-array{ 1 2 3 4 5 6 7 8 } direct-slice ] unit-test
+{ int-array{ 1 2 3 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head ] unit-test
+{ int-array{ 1 2 3 4 5 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-head* ] unit-test
+{ int-array{ 4 5 6 7 8 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail ] unit-test
+{ int-array{ 6 7 8 } } [ int-array{ 1 2 3 4 5 6 7 8 } 3 direct-tail* ] unit-test
-[ uchar-array{ 0 1 255 } ] [ 3 6 B{ 1 1 1 0 1 255 2 2 2 } direct-slice ] unit-test
+{ uchar-array{ 0 1 255 } } [ 3 6 B{ 1 1 1 0 1 255 2 2 2 } direct-slice ] unit-test
-[ int-array{ 1 2 3 4 55555 6 7 8 } ] [
+{ int-array{ 1 2 3 4 55555 6 7 8 } } [
int-array{ 1 2 3 4 5 6 7 8 }
3 6 pick direct-slice [ 55555 1 ] dip set-nth
] unit-test
SPECIALIZED-ARRAY: float
SPECIALIZED-VECTORS: float double ;
-[ 3 ] [ double-vector{ 1 2 } 3 suffix! length ] unit-test
+{ 3 } [ double-vector{ 1 2 } 3 suffix! length ] unit-test
-[ t ] [ 10 float-array{ } new-resizable float-vector? ] unit-test
+{ t } [ 10 float-array{ } new-resizable float-vector? ] unit-test
GENERIC: potential-hang ( obj -- obj )
M: fixnum potential-hang dup [ potential-hang ] when ;
-[ ] [ [ 5 potential-hang ] infer drop ] unit-test
+{ } [ [ 5 potential-hang ] infer drop ] unit-test
TUPLE: funny-cons car cdr ;
GENERIC: iterate ( obj -- )
ERROR: custom-error ;
-[ T{ effect f { } { } t } ] [
+{ T{ effect f { } { } t } } [
[ custom-error ] infer
] unit-test
: funny-throw ( a -- * ) throw ; inline
-[ T{ effect f { } { } t } ] [
+{ T{ effect f { } { } t } } [
[ 3 funny-throw ] infer
] unit-test
-[ T{ effect f { } { } t } ] [
+{ T{ effect f { } { } t } } [
[ custom-error inference-error ] infer
] unit-test
-[ T{ effect f { "x" } { "x" "x" } t } ] [
+{ T{ effect f { "x" } { "x" "x" } t } } [
[ dup [ 3 throw ] dip ] infer
] unit-test
dup bad-recursion-6 call ; inline recursive
[ [ [ drop f ] bad-recursion-6 ] infer ] must-fail
-[ ] [ [ \ bad-recursion-6 forget ] with-compilation-unit ] unit-test
+{ } [ [ \ bad-recursion-6 forget ] with-compilation-unit ] unit-test
{ 3 0 } [ [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
{ 2 0 } [ drop f f [ 2drop "A" throw ] [ ] if 2drop ] must-infer-as
[ [ eee' ] infer ] [ inference-error? ] must-fail-with
-[ ] [ [ \ ddd' forget ] with-compilation-unit ] unit-test
-[ ] [ [ \ eee' forget ] with-compilation-unit ] unit-test
+{ } [ [ \ ddd' forget ] with-compilation-unit ] unit-test
+{ } [ [ \ eee' forget ] with-compilation-unit ] unit-test
: bogus-error ( x -- )
dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
: forget-test ( -- ) ;
[ forget-test ] must-infer
-[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
+{ } [ [ \ forget-test forget ] with-compilation-unit ] unit-test
[ forget-test ] must-infer
[ [ cond ] infer ] [ T{ unknown-macro-input f cond } = ] must-fail-with
[ [ execute-effect ] infer ] [ T{ unknown-macro-input f execute-effect } = ] must-fail-with
[ \ set-datastack def>> infer ] [ T{ do-not-compile f do-primitive } = ] must-fail-with
-[ ] [ [ \ set-datastack def>> infer ] try ] unit-test
+{ } [ [ \ set-datastack def>> infer ] try ] unit-test
! Make sure all primitives are covered
-[ { } ] [
+{ { } } [
all-words [ primitive? ] filter
[ "default-output-classes" word-prop ] reject
[ "special" word-prop ] reject
: inputs-test1 ( x -- n )
[ + ] curry inputs ;
-[ 1 ] [ inputs-test0 ] unit-test
-[ 1 ] [ 10 inputs-test1 ] unit-test
+{ 1 } [ inputs-test0 ] unit-test
+{ 1 } [ 10 inputs-test1 ] unit-test
IN: suffix-arrays.tests
! built from [ all-words 10 head [ name>> ] map ]
-[ ] [
+{ } [
{
"run-tests"
"must-fail-with"
} >suffix-array "suffix-array" set
] unit-test
-[ t ]
+{ t }
[ "suffix-array" get "" swap query empty? not ] unit-test
-[ { } ]
+{ { } }
[ SA{ } "something" swap query ] unit-test
-[ { "unit-test" "(unit-test)" } ]
+{ { "unit-test" "(unit-test)" } }
[ "suffix-array" get "unit-test" swap query ] unit-test
-[ t ]
+{ t }
[ "suffix-array" get "something else" swap query empty? ] unit-test
-[ { "rofl" } ] [ SA{ "rofl" } "r" swap query ] unit-test
-[ { "rofl" } ] [ SA{ "rofl" } "o" swap query ] unit-test
-[ { "rofl" } ] [ SA{ "rofl" } "f" swap query ] unit-test
-[ { "rofl" } ] [ SA{ "rofl" } "l" swap query ] unit-test
-[ { } ] [ SA{ "rofl" } "t" swap query ] unit-test
+{ { "rofl" } } [ SA{ "rofl" } "r" swap query ] unit-test
+{ { "rofl" } } [ SA{ "rofl" } "o" swap query ] unit-test
+{ { "rofl" } } [ SA{ "rofl" } "f" swap query ] unit-test
+{ { "rofl" } } [ SA{ "rofl" } "l" swap query ] unit-test
+{ { } } [ SA{ "rofl" } "t" swap query ] unit-test
#! it as an feed tuple.
binary file-contents parse-feed ;
-[ T{
+{ T{
feed
f
"Meerkat"
f
}
}
-} ] [ "vocab:syndication/test/rss1.xml" load-news-file ] unit-test
-[ T{
+} } [ "vocab:syndication/test/rss1.xml" load-news-file ] unit-test
+{ T{
feed
f
"dive into mark"
T{ timestamp f 2003 12 13 8 29 29 T{ duration f 0 0 0 -4 0 0 } }
}
}
-} ] [ "vocab:syndication/test/atom.xml" load-news-file ] unit-test
-[ t ] [ "vocab:syndication/test/atom.xml" load-news-file dup feed>xml xml>feed = ] unit-test
+} } [ "vocab:syndication/test/atom.xml" load-news-file ] unit-test
+{ t } [ "vocab:syndication/test/atom.xml" load-news-file dup feed>xml xml>feed = ] unit-test
3 "x" set
[ 2 "x" set ] "Test" spawn drop
-[ 2 ] [ yield "x" get ] unit-test
-[ ] [ [ flush ] "flush test" spawn drop flush ] unit-test
-[ ] [ [ "Errors, errors" throw ] "error test" spawn drop ] unit-test
+{ 2 } [ yield "x" get ] unit-test
+{ } [ [ flush ] "flush test" spawn drop flush ] unit-test
+{ } [ [ "Errors, errors" throw ] "error test" spawn drop ] unit-test
yield
-[ ] [ 0.3 sleep ] unit-test
+{ } [ 0.3 sleep ] unit-test
[ "hey" sleep ] must-fail
-[ 3 ] [ 3 self resume-with "Test suspend" suspend ] unit-test
+{ 3 } [ 3 self resume-with "Test suspend" suspend ] unit-test
-[ f ] [ f get-global ] unit-test
+{ f } [ f get-global ] unit-test
{ { 0 3 6 9 12 15 18 21 24 27 } } [
10 iota [
] with-variable
p ?promise g eq? ;
-[ t ] [ spawn-namespace-test ] unit-test
+{ t } [ spawn-namespace-test ] unit-test
[ "a" [ 1 1 + ] spawn 100 sleep ] must-fail
-[ ] [ 0.1 seconds sleep ] unit-test
+{ } [ 0.1 seconds sleep ] unit-test
! Test thread-local variables
<promise> "p" set
5 "x" tset
-[ 5 ] [ "x" tget ] unit-test
+{ 5 } [ "x" tget ] unit-test
-[ ] [ "x" [ 1 + ] tchange ] unit-test
+{ } [ "x" [ 1 + ] tchange ] unit-test
-[ 6 ] [ "x" tget ] unit-test
+{ 6 } [ "x" tget ] unit-test
! Are they truly thread-local?
[ "x" tget "p" get fulfill ] in-thread
-[ f ] [ "p" get ?promise ] unit-test
+{ f } [ "p" get ?promise ] unit-test
! Test system traps inside threads
-[ ] [ [ dup ] in-thread yield ] unit-test
+{ } [ [ dup ] in-thread yield ] unit-test
! The start-context-and-delete primitive wasn't rewinding the
! callstack properly.
! The unit test asserts that the callstack is empty from the
! quotation passed to start-context-and-delete.
-[ 3 ] [
+{ 3 } [
<promise> [
'[
_ [
threads tools.test tools.time ;
IN: timers.tests
-[ ] [
+{ } [
1 <count-down>
{ f } clone 2dup
[ first stop-timer count-down ] 2curry 1 seconds later
await
] unit-test
-[ ] [
+{ } [
self [ resume ] curry instant later drop
"test" suspend drop
] unit-test
-[ t ] [
+{ t } [
[
<promise>
[ '[ t _ fulfill ] 2 seconds later drop ]
] benchmark 1,500,000,000 2,500,000,000 between?
] unit-test
-[ { 3 } ] [
+{ { 3 } } [
{ 3 } dup
'[ 4 _ set-first ] 2 seconds later
1/2 seconds sleep
stop-timer
] unit-test
-[ { 1 } ] [
+{ { 1 } } [
{ 0 }
dup '[ 0 _ [ 1 + ] change-nth ] 3 seconds later
[ stop-timer ] [ start-timer ] bi
4 seconds sleep
] unit-test
-[ { 0 } ] [
+{ { 0 } } [
{ 0 }
dup '[ 3 seconds sleep 1 _ set-first ] 1 seconds later
2 seconds sleep stop-timer
1/2 seconds sleep
] unit-test
-[ { 0 } ] [
+{ { 0 } } [
{ 0 }
dup '[ 1 _ set-first ] 300 milliseconds later
150 milliseconds sleep
[ restart-timer ] [ 200 milliseconds sleep stop-timer ] bi
] unit-test
-[ { 1 } ] [
+{ { 1 } } [
{ 0 }
dup '[ 0 _ [ 1 + ] change-nth ] 200 milliseconds later
100 milliseconds sleep restart-timer 300 milliseconds sleep
] unit-test
-[ { 4 } ] [
+{ { 4 } } [
{ 0 }
dup '[ 0 _ [ 1 + ] change-nth ] 300 milliseconds 300 milliseconds
<timer> dup start-timer
TR: tr-test ch>upper "ABC" "XYZ" ;
-[ "XXYY" ] [ "aabb" tr-test ] unit-test
-[ "XXYY" ] [ "AABB" tr-test ] unit-test
-[ { 12345 } ] [ { 12345 } tr-test ] unit-test
+{ "XXYY" } [ "aabb" tr-test ] unit-test
+{ "XXYY" } [ "AABB" tr-test ] unit-test
+{ { 12345 } } [ { 12345 } tr-test ] unit-test
C: <foo> foo
TUPLE-ARRAY: foo
-[ 2 ] [ 2 <foo-array> dup mat set length ] unit-test
-[ T{ foo } ] [ mat get first ] unit-test
-[ T{ foo f 2 } ] [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test
-[ t ] [ { T{ foo f 1 } T{ foo f 2 } } >foo-array dup mat set foo-array? ] unit-test
-[ T{ foo f 3 } t ]
+{ 2 } [ 2 <foo-array> dup mat set length ] unit-test
+{ T{ foo } } [ mat get first ] unit-test
+{ T{ foo f 2 } } [ T{ foo f 2 } 0 mat get [ set-nth ] keep first ] unit-test
+{ t } [ { T{ foo f 1 } T{ foo f 2 } } >foo-array dup mat set foo-array? ] unit-test
+{ T{ foo f 3 } t }
[ mat get [ bar>> 2 + <foo> ] map [ first ] keep foo-array? ] unit-test
-[ 2 ] [ 2 <foo-array> dup mat set length ] unit-test
-[ T{ foo } ] [ mat get first ] unit-test
-[ T{ foo f 1 } ] [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test
+{ 2 } [ 2 <foo-array> dup mat set length ] unit-test
+{ T{ foo } } [ mat get first ] unit-test
+{ T{ foo f 1 } } [ T{ foo f 1 } 0 mat get [ set-nth ] keep first ] unit-test
TUPLE: baz { bing integer } bong ; final
TUPLE-ARRAY: baz
-[ 0 ] [ 1 <baz-array> first bing>> ] unit-test
-[ f ] [ 1 <baz-array> first bong>> ] unit-test
+{ 0 } [ 1 <baz-array> first bing>> ] unit-test
+{ f } [ 1 <baz-array> first bong>> ] unit-test
TUPLE: broken x ; final
: broken ( -- ) ;
TUPLE-ARRAY: broken
-[ 100 ] [ 100 <broken-array> length ] unit-test
+{ 100 } [ 100 <broken-array> length ] unit-test
! Can't define a tuple array for a non-tuple class
[ "IN: tuple-arrays.tests USING: tuple-arrays words ; TUPLE-ARRAY: word" eval( -- ) ]
TUPLE-ARRAY: empty-tuple
-[ 100 ] [ 100 <empty-tuple-array> length ] unit-test
-[ T{ empty-tuple } ] [ 100 <empty-tuple-array> first ] unit-test
-[ ] [ T{ empty-tuple } 100 <empty-tuple-array> set-first ] unit-test
+{ 100 } [ 100 <empty-tuple-array> length ] unit-test
+{ T{ empty-tuple } } [ 100 <empty-tuple-array> first ] unit-test
+{ } [ T{ empty-tuple } 100 <empty-tuple-array> set-first ] unit-test
! Changing a tuple into a struct shouldn't break the tuple array to the point
! of crashing Factor
TUPLE-ARRAY: tuple-to-struct
-[ f ] [ tuple-to-struct struct-class? ] unit-test
+{ f } [ tuple-to-struct struct-class? ] unit-test
! This shouldn't crash
-[ ] [
+{ } [
"IN: tuple-arrays.tests
USING: alien.c-types classes.struct ;
STRUCT: tuple-to-struct { x int } ;"
eval( -- )
] unit-test
-[ t ] [ tuple-to-struct struct-class? ] unit-test
+{ t } [ tuple-to-struct struct-class? ] unit-test
TYPED: f+ ( a: float b: float -- c: float )
+ ;
-[ 3.5 ]
+{ 3.5 }
[ 2 1+1/2 f+ ] unit-test
TYPED: fix+ ( a: fixnum b: fixnum -- c: fixnum )
TYPED:: f+locals ( a: float b: float -- c: float )
a b + ;
-[ 3.5 ] [ 2 1+1/2 f+locals ] unit-test
+{ 3.5 } [ 2 1+1/2 f+locals ] unit-test
TUPLE: unboxable
{ x fixnum read-only }
TYPED: unboxy ( in: unboxable -- out: unboxable2 )
dup [ x>> ] [ y>> ] bi - unboxable2 boa ;
-[ ( in: fixnum in: fixnum -- out: fixnum out: fixnum out: fixnum ) ]
+{ ( in: fixnum in: fixnum -- out: fixnum out: fixnum out: fixnum ) }
[ \ unboxy "typed-word" word-prop stack-effect ] unit-test
-[ T{ unboxable2 { u T{ unboxable { x 12 } { y 3 } } } { xy 9 } } ]
+{ T{ unboxable2 { u T{ unboxable { x 12 } { y 3 } } } { xy 9 } } }
[ T{ unboxable { x 12 } { y 3 } } unboxy ] unit-test
-[ 9 ]
+{ 9 }
[
"""
USING: kernel math ;
TYPED: no-inputs ( -- out: integer )
1 ;
-[ 1 ] [ no-inputs ] unit-test
+{ 1 } [ no-inputs ] unit-test
TUPLE: unboxable3
{ x read-only } ; final
TYPED: no-inputs-unboxable-output ( -- out: unboxable3 )
T{ unboxable3 } ;
-[ T{ unboxable3 } ] [ no-inputs-unboxable-output ] unit-test
+{ T{ unboxable3 } } [ no-inputs-unboxable-output ] unit-test
-[ f ] [ no-inputs-unboxable-output no-inputs-unboxable-output eq? ] unit-test
+{ f } [ no-inputs-unboxable-output no-inputs-unboxable-output eq? ] unit-test
SYMBOL: buh
TYPED: no-outputs ( x: integer -- )
buh set ;
-[ 2 ] [ 2 no-outputs buh get ] unit-test
+{ 2 } [ 2 no-outputs buh get ] unit-test
TYPED: no-outputs-unboxable-input ( x: unboxable3 -- )
buh set ;
-[ T{ unboxable3 } ] [ T{ unboxable3 } no-outputs-unboxable-input buh get ] unit-test
+{ T{ unboxable3 } } [ T{ unboxable3 } no-outputs-unboxable-input buh get ] unit-test
-[ f ] [
+{ f } [
T{ unboxable3 } no-outputs-unboxable-input buh get
T{ unboxable3 } no-outputs-unboxable-input buh get
eq?
TYPED: unbox-fail ( a: superclass -- ? ) subclass? ;
-[ t ] [ subclass new unbox-fail ] unit-test
+{ t } [ subclass new unbox-fail ] unit-test
! If a final class becomes non-final, typed words need to be recompiled
TYPED: recompile-fail ( a: subclass -- ? ) buh get eq? ;
-[ f ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
+{ f } [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
-[ ] [ "IN: typed.tests TUPLE: subclass < superclass { y read-only } ;" eval( -- ) ] unit-test
+{ } [ "IN: typed.tests TUPLE: subclass < superclass { y read-only } ;" eval( -- ) ] unit-test
-[ t ] [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
+{ t } [ subclass new [ buh set ] [ recompile-fail ] bi ] unit-test
! Make sure that foldable and flushable work on typed words
TYPED: add ( a: integer b: integer -- c: integer ) + ; foldable
-[ [ 3 ] ] [ [ 1 2 add ] cleaned-up-tree nodes>quot ] unit-test
+{ [ 3 ] } [ [ 1 2 add ] cleaned-up-tree nodes>quot ] unit-test
TYPED: flush-test ( s: symbol -- ? ) on t ; flushable
SYMBOL: a-symbol
-[ f ] [
+{ f } [
f a-symbol [
a-symbol flush-print-1
a-symbol get
] with-variable
] unit-test
-[ t ] [
+{ t } [
f a-symbol [
a-symbol flush-print-2
a-symbol get
TYPED: forget-fail ( a: forget-class -- ) drop ;
-[ ] [ [ \ forget-class forget ] with-compilation-unit ] unit-test
+{ } [ [ \ forget-class forget ] with-compilation-unit ] unit-test
-[ ] [ [ \ forget-fail forget ] with-compilation-unit ] unit-test
+{ } [ [ \ forget-fail forget ] with-compilation-unit ] unit-test
TYPED: typed-maybe ( x: maybe{ integer } -- ? ) >boolean ;
-[ f ] [ f typed-maybe ] unit-test
-[ t ] [ 30 typed-maybe ] unit-test
+{ f } [ f typed-maybe ] unit-test
+{ t } [ 30 typed-maybe ] unit-test
[ 30.0 typed-maybe ] [ input-mismatch-error? ] must-fail-with
TYPED: typed-union ( x: union{ integer string } -- ? ) >boolean ;
-[ t ] [ 3 typed-union ] unit-test
-[ t ] [ "asdf" typed-union ] unit-test
+{ t } [ 3 typed-union ] unit-test
+{ t } [ "asdf" typed-union ] unit-test
[ 3.3 typed-union ] [ input-mismatch-error? ] must-fail-with
TYPED: typed-intersection ( x: intersection{ integer bignum } -- ? ) >boolean ;
-[ t ] [ 5555555555555555555555555555555555555555555555555555 typed-intersection ] unit-test
+{ t } [ 5555555555555555555555555555555555555555555555555555 typed-intersection ] unit-test
[ 0 typed-intersection ] [ input-mismatch-error? ] must-fail-with
[
FactorServiceProvider -> alloc -> init
-> setServicesProvider: ;
-FUNCTION: void NSUpdateDynamicServices ;
+FUNCTION: void NSUpdateDynamicServices ( ) ;
[
install-app-delegate
random prettyprint grouping math ;
IN: unrolled-lists.tests
-[ 1 ] [ <unrolled-list> 1 over push-front pop-front ] unit-test
-[ 1 ] [ <unrolled-list> 1 over push-front pop-back ] unit-test
-[ 1 ] [ <unrolled-list> 1 over push-back pop-front ] unit-test
-[ 1 ] [ <unrolled-list> 1 over push-back pop-back ] unit-test
+{ 1 } [ <unrolled-list> 1 over push-front pop-front ] unit-test
+{ 1 } [ <unrolled-list> 1 over push-front pop-back ] unit-test
+{ 1 } [ <unrolled-list> 1 over push-back pop-front ] unit-test
+{ 1 } [ <unrolled-list> 1 over push-back pop-back ] unit-test
-[ 1 2 ] [
+{ 1 2 } [
<unrolled-list> 1 over push-back 2 over push-back
[ pop-front ] [ pop-front ] bi
] unit-test
-[ 2 1 ] [
+{ 2 1 } [
<unrolled-list> 1 over push-back 2 over push-back
[ pop-back ] [ pop-back ] bi
] unit-test
-[ 1 2 3 ] [
+{ 1 2 3 } [
<unrolled-list>
1 over push-back
2 over push-back
[ pop-front ] [ pop-front ] [ pop-front ] tri
] unit-test
-[ 3 2 1 ] [
+{ 3 2 1 } [
<unrolled-list>
1 over push-back
2 over push-back
[ pop-back ] [ pop-back ] [ pop-back ] tri
] unit-test
-[ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } ] [
+{ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } } [
<unrolled-list>
32 [ over push-front ] each-integer
32 [ dup pop-back ] replicate
nip
] unit-test
-[ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } ] [
+{ { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 } } [
<unrolled-list>
32 [ over push-front ] each-integer
32 [ dup pop-front ] replicate reverse
nip
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1000 [ 1000 random ] replicate
[ [ over push-front ] each ]
nip
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1000 [ 1000 random ] replicate
[
nip
] unit-test
-[ t ] [ <unrolled-list> deque-empty? ] unit-test
+{ t } [ <unrolled-list> deque-empty? ] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1 over push-front
dup pop-front*
deque-empty?
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1 over push-back
dup pop-front*
deque-empty?
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1 over push-front
dup pop-back*
deque-empty?
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
1 over push-back
dup pop-back*
deque-empty?
] unit-test
-[ t ] [
+{ t } [
<unrolled-list>
21 over push-front
22 over push-front
swap [ 1array ] [ [ present ] curry ] bi* unit-test
] assoc-each
-[ "b" ] [ "a" "b" url-append-path ] unit-test
+{ "b" } [ "a" "b" url-append-path ] unit-test
-[ "a/b" ] [ "a/c" "b" url-append-path ] unit-test
+{ "a/b" } [ "a/c" "b" url-append-path ] unit-test
-[ "a/b" ] [ "a/" "b" url-append-path ] unit-test
+{ "a/b" } [ "a/" "b" url-append-path ] unit-test
-[ "/b" ] [ "a" "/b" url-append-path ] unit-test
+{ "/b" } [ "a" "/b" url-append-path ] unit-test
-[ "/b" ] [ "a/b/" "/b" url-append-path ] unit-test
+{ "/b" } [ "a/b/" "/b" url-append-path ] unit-test
-[ "/xxx/bar" ] [ "/xxx/baz" "bar" url-append-path ] unit-test
+{ "/xxx/bar" } [ "/xxx/baz" "bar" url-append-path ] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "www.apple.com" }
{ port 1234 }
{ path "/a/path" }
}
-] [
+} [
T{ url
{ protocol "http" }
{ host "www.apple.com" }
derive-url
] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "www.apple.com" }
{ query H{ { "a" "b" } } }
{ anchor "foo" }
}
-] [
+} [
T{ url
{ protocol "http" }
{ host "www.apple.com" }
derive-url
] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "www.apple.com" }
{ query H{ { "a" "b" } } }
{ anchor "foo" }
}
-] [
+} [
T{ url
{ protocol "http" }
{ host "www.apple.com" }
derive-url
] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "www.apple.com" }
{ path "/xxx/baz" }
}
-] [
+} [
T{ url
{ protocol "http" }
{ host "www.apple.com" }
derive-url
] unit-test
-[
+{
T{ url
{ protocol "https" }
{ host "www.apple.com" }
}
-] [
+} [
T{ url
{ protocol "http" }
{ host "www.apple.com" }
] unit-test
! Support //foo.com, which has the same protocol as the url we derive from
-[ URL" http://foo.com" ]
+{ URL" http://foo.com" }
[ URL" http://google.com" URL" //foo.com" derive-url ] unit-test
-[ URL" https://foo.com" ]
+{ URL" https://foo.com" }
[ URL" https://google.com" URL" //foo.com" derive-url ] unit-test
-[ "a" ] [
+{ "a" } [
<url> "a" "b" set-query-param "b" query-param
] unit-test
-[ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test
+{ "foo#3" } [ URL" foo" clone 3 >>anchor present ] unit-test
-[ "http://www.foo.com/" ] [ "http://www.foo.com:80" >url present ] unit-test
+{ "http://www.foo.com/" } [ "http://www.foo.com:80" >url present ] unit-test
-[ f ] [ URL" /gp/redirect.html/002-7009742-0004012?location=http://advantage.amazon.com/gp/vendor/public/join%26token%3d77E3769AB3A5B6CF611699E150DC33010761CE12" protocol>> ] unit-test
+{ f } [ URL" /gp/redirect.html/002-7009742-0004012?location=http://advantage.amazon.com/gp/vendor/public/join%26token%3d77E3769AB3A5B6CF611699E150DC33010761CE12" protocol>> ] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "localhost" }
{ query H{ { "foo" "bar" } } }
{ path "/" }
}
-]
+}
[ "http://localhost?foo=bar" >url ] unit-test
-[
+{
T{ url
{ protocol "http" }
{ host "localhost" }
{ query H{ { "foo" "bar" } } }
{ path "/" }
}
-]
+}
[ "http://localhost/?foo=bar" >url ] unit-test
-[ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
+{ "/" } [ "http://www.jedit.org" >url path>> ] unit-test
-[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
+{ "USING: urls ;\nURL\" foo\"" } [ URL" foo" unparse-use ] unit-test
-[ T{ inet { host "google.com" } { port 80 } } ]
+{ T{ inet { host "google.com" } { port 80 } } }
[ URL" http://google.com/" url-addr ] unit-test
-[
+{
T{ secure
{ addrspec T{ inet { host "google.com" } { port 443 } } }
}
-]
+}
[ URL" https://google.com/" url-addr ] unit-test
IN: uuid.tests
-[ t ] [ NAMESPACE_DNS [ uuid-parse uuid-unparse ] keep = ] unit-test
-[ t ] [ NAMESPACE_URL [ uuid-parse uuid-unparse ] keep = ] unit-test
-[ t ] [ NAMESPACE_OID [ uuid-parse uuid-unparse ] keep = ] unit-test
-[ t ] [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
+{ t } [ NAMESPACE_DNS [ uuid-parse uuid-unparse ] keep = ] unit-test
+{ t } [ NAMESPACE_URL [ uuid-parse uuid-unparse ] keep = ] unit-test
+{ t } [ NAMESPACE_OID [ uuid-parse uuid-unparse ] keep = ] unit-test
+{ t } [ NAMESPACE_X500 [ uuid-parse uuid-unparse ] keep = ] unit-test
-[ t ] [ NAMESPACE_URL "ABCD" uuid3
+{ t } [ NAMESPACE_URL "ABCD" uuid3
"2e10e403-d7fa-3ffb-808f-ab834a46890e" = ] unit-test
-[ t ] [ NAMESPACE_URL "ABCD" uuid5
+{ t } [ NAMESPACE_URL "ABCD" uuid5
"0aa883d6-7953-57e7-a8f0-66db29ce5a91" = ] unit-test
USING: kernel sequences tools.test validators accessors
namespaces assocs ;
-[ t ] [ "on" v-checkbox ] unit-test
-[ f ] [ "off" v-checkbox ] unit-test
+{ t } [ "on" v-checkbox ] unit-test
+{ f } [ "off" v-checkbox ] unit-test
-[ "default test" ] [ "" "default test" v-default ] unit-test
-[ "blah" ] [ "blah" "default test" v-default ] unit-test
+{ "default test" } [ "" "default test" v-default ] unit-test
+{ "blah" } [ "blah" "default test" v-default ] unit-test
[ "foo" v-number ] must-fail
-[ 123 ] [ "123" v-number ] unit-test
-[ 123 ] [ "123" v-integer ] unit-test
+{ 123 } [ "123" v-number ] unit-test
+{ 123 } [ "123" v-integer ] unit-test
[ "1.0" v-integer ] [ "must be an integer" = ] must-fail-with
-[ "slava@factorcode.org" ] [
+{ "slava@factorcode.org" } [
"slava@factorcode.org" v-email
] unit-test
-[ "slava+foo@factorcode.org" ] [
+{ "slava+foo@factorcode.org" } [
"slava+foo@factorcode.org" v-email
] unit-test
[ "slava@factorcodeorg" v-email ]
[ "invalid e-mail" = ] must-fail-with
-[ "http://www.factorcode.org" ]
+{ "http://www.factorcode.org" }
[ "http://www.factorcode.org" v-url ] unit-test
[ "http:/www.factorcode.org" v-url ]
[ "invalid URL" = ] must-fail-with
[ "" v-one-line ] must-fail
-[ "hello world" ] [ "hello world" v-one-line ] unit-test
+{ "hello world" } [ "hello world" v-one-line ] unit-test
[ "hello\nworld" v-one-line ] must-fail
[ "" v-one-word ] must-fail
-[ "hello" ] [ "hello" v-one-word ] unit-test
+{ "hello" } [ "hello" v-one-word ] unit-test
[ "hello world" v-one-word ] must-fail
-[ 4561261212345467 ] [ "4561261212345467" v-credit-card ] unit-test
+{ 4561261212345467 } [ "4561261212345467" v-credit-card ] unit-test
-[ 4561261212345467 ] [ "4561-2612-1234-5467" v-credit-card ] unit-test
+{ 4561261212345467 } [ "4561-2612-1234-5467" v-credit-card ] unit-test
-[ 0 ] [ "0000000000000000" v-credit-card ] unit-test
+{ 0 } [ "0000000000000000" v-credit-card ] unit-test
[ "000000000" v-credit-card ] must-fail
[ "4561-2621-1234-5467" v-credit-card ] must-fail
-[ t ] [ "http://double.co.nz/w?v=foo" dup v-url = ] unit-test
+{ t } [ "http://double.co.nz/w?v=foo" dup v-url = ] unit-test
namespaces accessors sequences assocs ;
IN: vlists.tests
-[ { "hi" "there" } ]
+{ { "hi" "there" } }
[ VL{ } "hi" swap ppush "there" swap ppush >array ] unit-test
-[ VL{ "hi" "there" "foo" } VL{ "hi" "there" "bar" } t ]
+{ VL{ "hi" "there" "foo" } VL{ "hi" "there" "bar" } t }
[
VL{ } "hi" swap ppush "there" swap ppush "v" set
"foo" "v" get ppush
dup "baz" over ppush [ vector>> ] bi@ eq?
] unit-test
-[ "foo" VL{ "hi" "there" } t ]
+{ "foo" VL{ "hi" "there" } t }
[
VL{ "hi" "there" "foo" } dup "v" set
[ last ] [ ppop ] bi
[ 4 VL{ "hi" } set-first ] must-fail
-[ 5 t ] [
+{ 5 t } [
"rice" VA{ { "rice" 5 } { "beans" 10 } } at*
] unit-test
-[ 6 t ] [
+{ 6 t } [
"rice" VA{ { "rice" 5 } { "beans" 10 } { "rice" 6 } } at*
] unit-test
-[ 3 ] [
+{ 3 } [
VA{ { "rice" 5 } { "beans" 10 } { "rice" 6 } } assoc-size
] unit-test
-[ f f ] [
+{ f f } [
"meat" VA{ { "rice" 5 } { "beans" 10 } { "rice" 6 } } at*
] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: wrap tools.test ;
-[ { } ] [ { } 10 10 wrap ] unit-test
+{ { } } [ { } 10 10 wrap ] unit-test
USING: xml-rpc tools.test ;
-[ T{ rpc-method f "blah" { 1 H{ { "2" 3 } { "5" t } } } } ]
+{ T{ rpc-method f "blah" { 1 H{ { "2" 3 } { "5" t } } } } }
[ "blah" { 1 H{ { "2" 3 } { "5" t } } }
<rpc-method> send-rpc receive-rpc ] unit-test
FROM: namespaces => set ;
IN: alien.tests
-
[ t ] [ -1 <alien> alien-address 0 > ] unit-test
+
{ t } [ -1 <alien> alien-address 0 > ] unit-test
-
[ t ] [ 0 <alien> 0 <alien> = ] unit-test
-
[ f ] [ 0 <alien> 1024 <alien> = ] unit-test
-
[ f ] [ "hello" 1024 <alien> = ] unit-test
-
[ f ] [ 0 <alien> ] unit-test
-[ f ] [ 0 f <displaced-alien> ] unit-test
+
{ t } [ 0 <alien> 0 <alien> = ] unit-test
+
{ f } [ 0 <alien> 1024 <alien> = ] unit-test
+
{ f } [ "hello" 1024 <alien> = ] unit-test
+
{ f } [ 0 <alien> ] unit-test
+{ f } [ 0 f <displaced-alien> ] unit-test
! Testing the various bignum accessor
10 <byte-array> "dump" set
[ "dump" get alien-address ] must-fail
-[ 123 ] [
+{ 123 } [
123 "dump" get 0 set-alien-signed-1
"dump" get 0 alien-signed-1
] unit-test
-[ 12345 ] [
+{ 12345 } [
12345 "dump" get 0 set-alien-signed-2
"dump" get 0 alien-signed-2
] unit-test
-[ 12345678 ] [
+{ 12345678 } [
12345678 "dump" get 0 set-alien-signed-4
"dump" get 0 alien-signed-4
] unit-test
-[ 12345678901234567 ] [
+{ 12345678901234567 } [
12345678901234567 "dump" get 0 set-alien-signed-8
"dump" get 0 alien-signed-8
] unit-test
-[ -1 ] [
+{ -1 } [
-1 "dump" get 0 set-alien-signed-8
"dump" get 0 alien-signed-8
] unit-test
] unit-test
] when
-
[ "ALIEN: 1234" ] [ 0x1234 <alien> unparse ] unit-test
+
{ "ALIEN: 1234" } [ 0x1234 <alien> unparse ] unit-test
-[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
+{ } [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
[ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
[ 1 1 <displaced-alien> ] must-fail
-[ f ] [ 1 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
+{ f } [ 1 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
-[ f ] [ 2 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
+{ f } [ 2 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
-[ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
+{ t } [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
-[ "( displaced alien )" ] [ 1 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
+{ "( displaced alien )" } [ 1 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
SYMBOL: initialize-test
f initialize-test set-global
-[ 31337 ] [ initialize-test [ 31337 ] initialize-alien ] unit-test
+{ 31337 } [ initialize-test [ 31337 ] initialize-alien ] unit-test
-[ 31337 ] [ initialize-test [ 69 ] initialize-alien ] unit-test
+{ 31337 } [ initialize-test [ 69 ] initialize-alien ] unit-test
-[ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
+{ } [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
-[ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
+{ 7575 } [ initialize-test [ 7575 ] initialize-alien ] unit-test
-[ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test
+{ { BAD-ALIEN } } [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test
! Generate callbacks until the whole callback-heap is full, then free
! them. Do it ten times in a row for good measure.
io.encodings.ascii alien io.encodings.string io.encodings.8-bit.latin1 ;
IN: alien.strings.tests
-[ "\u0000ff" ]
+{ "\u0000ff" }
[ "\u0000ff" latin1 string>alien latin1 alien>string ]
unit-test
-[ "hello world" ]
+{ "hello world" }
[ "hello world" latin1 string>alien latin1 alien>string ]
unit-test
-[ "hello\u00abcdworld" ]
+{ "hello\u00abcdworld" }
[ "hello\u00abcdworld" utf16le string>alien utf16le alien>string ]
unit-test
-[ t ] [ f expired? ] unit-test
+{ t } [ f expired? ] unit-test
-[ "hello world" ] [
+{ "hello world" } [
"hello world" ascii malloc-string
dup ascii alien>string swap free
] unit-test
-[ "hello world" ] [
+{ "hello world" } [
"hello world" utf16n malloc-string
dup utf16n alien>string swap free
] unit-test
-[ f ] [ f utf8 alien>string ] unit-test
+{ f } [ f utf8 alien>string ] unit-test
-[ "hello" ] [ "hello" utf16 encode utf16 decode ] unit-test
+{ "hello" } [ "hello" utf16 encode utf16 decode ] unit-test
-[ "hello" ] [ "hello" utf16 string>alien utf16 alien>string ] unit-test
+{ "hello" } [ "hello" utf16 string>alien utf16 alien>string ] unit-test
[ 10 { "a" "b" "c" } nth ] must-fail
[ "hi" -2 { "a" "b" "c" } set-nth ] must-fail
[ "hi" 10 { "a" "b" "c" } set-nth ] must-fail
-[ f ] [ { "a" "b" "c" } dup clone eq? ] 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
-[ f ] [ { "a" "b" "c" } dup >array eq? ] unit-test
-[ t ] [ { "a" "b" "c" } dup { } like eq? ] unit-test
-[ t ] [ { "a" "b" "c" } dup dup length vector boa underlying>> eq? ] unit-test
-[ V{ "a" "b" "c" } ] [ { "a" "b" "c" } V{ } like ] unit-test
-[ { "a" "b" "c" } ] [ { "a" } { "b" "c" } append ] unit-test
-[ { "a" "b" "c" "d" "e" } ]
+{ f } [ { "a" "b" "c" } dup clone eq? ] 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
+{ f } [ { "a" "b" "c" } dup >array eq? ] unit-test
+{ t } [ { "a" "b" "c" } dup { } like eq? ] unit-test
+{ t } [ { "a" "b" "c" } dup dup length vector boa underlying>> eq? ] unit-test
+{ V{ "a" "b" "c" } } [ { "a" "b" "c" } V{ } like ] unit-test
+{ { "a" "b" "c" } } [ { "a" } { "b" "c" } append ] unit-test
+{ { "a" "b" "c" "d" "e" } }
[ { "a" } { "b" "c" } { "d" "e" } 3append ] unit-test
[ -1 f <array> ] must-fail
SPECIALIZED-ARRAY: double
IN: assocs.tests
-[ t ] [ H{ } dup assoc-subset? ] unit-test
-[ f ] [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test
-[ t ] [ H{ } H{ { 1 3 } } assoc-subset? ] unit-test
-[ t ] [ H{ { 1 3 } } H{ { 1 3 } } assoc-subset? ] unit-test
-[ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } assoc-subset? ] unit-test
-[ f ] [ H{ { 1 f } } H{ } assoc-subset? ] unit-test
-[ t ] [ H{ { 1 f } } H{ { 1 f } } assoc-subset? ] unit-test
+{ t } [ H{ } dup assoc-subset? ] unit-test
+{ f } [ H{ { 1 3 } } H{ } assoc-subset? ] unit-test
+{ t } [ H{ } H{ { 1 3 } } assoc-subset? ] unit-test
+{ t } [ H{ { 1 3 } } H{ { 1 3 } } assoc-subset? ] unit-test
+{ f } [ H{ { 1 3 } } H{ { 1 "hey" } } assoc-subset? ] unit-test
+{ f } [ H{ { 1 f } } H{ } assoc-subset? ] unit-test
+{ t } [ H{ { 1 f } } H{ { 1 f } } assoc-subset? ] unit-test
! Test some combinators
-[
+{
{ 4 14 32 }
-] [
+} [
[
H{
{ 1 2 }
] { } make
] unit-test
-[ t ] [ H{ } [ 2drop f ] assoc-all? ] unit-test
-[ t ] [ H{ { 1 1 } } [ = ] assoc-all? ] unit-test
-[ f ] [ H{ { 1 2 } } [ = ] assoc-all? ] unit-test
-[ t ] [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test
-[ f ] [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test
+{ t } [ H{ } [ 2drop f ] assoc-all? ] unit-test
+{ t } [ H{ { 1 1 } } [ = ] assoc-all? ] unit-test
+{ f } [ H{ { 1 2 } } [ = ] assoc-all? ] unit-test
+{ t } [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test
+{ f } [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test
-[ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test
-[ H{ } ] [ H{ { t f } { f t } } clone dup [ 2drop f ] assoc-filter! drop ] unit-test
-[ H{ } ] [ H{ { t f } { f t } } clone [ 2drop f ] assoc-filter! ] unit-test
+{ H{ } } [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test
+{ H{ } } [ H{ { t f } { f t } } clone dup [ 2drop f ] assoc-filter! drop ] unit-test
+{ H{ } } [ H{ { t f } { f t } } clone [ 2drop f ] assoc-filter! ] unit-test
-[ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
+{ H{ { 3 4 } { 4 5 } { 6 7 } } } [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
[ drop 3 >= ] assoc-filter
] unit-test
-[ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
+{ H{ { 3 4 } { 4 5 } { 6 7 } } } [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone
[ drop 3 >= ] assoc-filter!
] unit-test
-[ H{ { 3 4 } { 4 5 } { 6 7 } } ] [
+{ H{ { 3 4 } { 4 5 } { 6 7 } } } [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone dup
[ drop 3 >= ] assoc-filter! drop
] unit-test
-[ H{ { 1 2 } { 2 3 } } ] [
+{ H{ { 1 2 } { 2 3 } } } [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } }
[ drop 3 >= ] assoc-reject
] unit-test
-[ H{ { 1 2 } { 2 3 } } ] [
+{ H{ { 1 2 } { 2 3 } } } [
H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } clone
[ drop 3 >= ] assoc-reject!
] unit-test
-[ 21 ] [
+{ 21 } [
0 H{
{ 1 2 }
{ 3 4 }
H{ } clone "cache-test" set
-[ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
-[ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
-[ 4 ] [ 1 "cache-test" get [ 3 + ] cache ] unit-test
-[ 5 ] [ 2 "cache-test" get [ 3 + ] cache ] unit-test
+{ 4 } [ 1 "cache-test" get [ 3 + ] cache ] unit-test
+{ 5 } [ 2 "cache-test" get [ 3 + ] cache ] unit-test
+{ 4 } [ 1 "cache-test" get [ 3 + ] cache ] unit-test
+{ 5 } [ 2 "cache-test" get [ 3 + ] cache ] unit-test
-[
+{
H{ { "factor" "rocks" } { 3 4 } }
-] [
+} [
H{ { "factor" "rocks" } { "dup" "sq" } { 3 4 } }
H{ { "factor" "rocks" } { 1 2 } { 2 3 } { 3 4 } }
assoc-intersect
] unit-test
-[
+{
H{ { 1 2 } { 2 3 } { 6 5 } }
-] [
+} [
H{ { 2 4 } { 6 5 } } H{ { 1 2 } { 2 3 } }
assoc-union
] unit-test
-[
+{
H{ { 1 2 } { 2 3 } { 6 5 } }
-] [
+} [
H{ { 2 4 } { 6 5 } } clone dup H{ { 1 2 } { 2 3 } }
assoc-union! drop
] unit-test
-[
+{
H{ { 1 2 } { 2 3 } { 6 5 } }
-] [
+} [
H{ { 2 4 } { 6 5 } } clone H{ { 1 2 } { 2 3 } }
assoc-union!
] unit-test
-[ H{ { 1 2 } { 2 3 } } t ] [
+{ H{ { 1 2 } { 2 3 } } t } [
f H{ { 1 2 } { 2 3 } } [ assoc-union ] 2keep swap assoc-union dupd =
] unit-test
-[
+{
H{ { 1 f } }
-] [
+} [
H{ { 1 f } } H{ { 1 f } } assoc-intersect
] unit-test
-[
+{
H{ { 3 4 } }
-] [
+} [
H{ { 1 2 } { 3 4 } } H{ { 1 3 } } assoc-diff
] unit-test
-[
+{
H{ { 3 4 } }
-] [
+} [
H{ { 1 2 } { 3 4 } } clone dup H{ { 1 3 } } assoc-diff! drop
] unit-test
-[
+{
H{ { 3 4 } }
-] [
+} [
H{ { 1 2 } { 3 4 } } clone H{ { 1 3 } } assoc-diff!
] unit-test
-[ H{ { "hi" 2 } { 3 4 } } ]
+{ H{ { "hi" 2 } { 3 4 } } }
[ "hi" 1 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
unit-test
-[ H{ { 1 2 } { 3 4 } } ]
+{ H{ { 1 2 } { 3 4 } } }
[ "hi" 5 H{ { 1 2 } { 3 4 } } clone [ rename-at ] keep ]
unit-test
-[
+{
H{ { 1.0 1.0 } { 2.0 2.0 } }
-] [
+} [
double-array{ 1.0 2.0 } [ dup ] H{ } map>assoc
] unit-test
-[ { 3 } ] [
+{ { 3 } } [
[
3
H{ } clone
] { } make
] unit-test
-[
+{
H{
{ "bangers" "mash" }
{ "fries" "onion rings" }
}
-] [
+} [
{ "bangers" "fries" } H{
{ "fish" "chips" }
{ "bangers" "mash" }
} extract-keys
] unit-test
-[ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } ] [
+{ H{ { "b" [ 2 ] } { "d" [ 4 ] } } H{ { "a" [ 1 ] } { "c" [ 3 ] } } } [
H{
{ "a" [ 1 ] }
{ "b" [ 2 ] }
} [ nip first even? ] assoc-partition
] unit-test
-[ 1 f ] [ 1 H{ } ?at ] unit-test
-[ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test
+{ 1 f } [ 1 H{ } ?at ] unit-test
+{ 2 t } [ 1 H{ { 1 2 } } ?at ] unit-test
-[ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
-[ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
-[ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
+{ f } [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
+{ t } [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
+{ t } [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
-[ H{ { 1 2 } { 2 3 } } ] [
+{ H{ { 1 2 } { 2 3 } } } [
{
H{ { 1 3 } }
H{ { 2 3 } }
} assoc-combine
] unit-test
-[ H{ { 1 7 } } ] [
+{ H{ { 1 7 } } } [
{
H{ { 1 2 } { 2 4 } { 5 6 } }
H{ { 1 3 } { 2 5 } }
} assoc-refine
] unit-test
-[ f ] [ "a" { } assoc-stack ] unit-test
-[ 1 ] [ "a" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
-[ 2 ] [ "b" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
-[ f ] [ "c" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
+{ f } [ "a" { } assoc-stack ] unit-test
+{ 1 } [ "a" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
+{ 2 } [ "b" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
+{ f } [ "c" { H{ { "a" 1 } } H{ { "b" 2 } } } assoc-stack ] unit-test
{
tools.test ;
IN: byte-arrays.tests
-[ 6 B{ 1 2 3 } ] [
+{ 6 B{ 1 2 3 } } [
6 B{ 1 2 3 } resize-byte-array
[ length ] [ 3 head ] bi
] unit-test
-[ 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 ] must-fail
-[ B{ 123 } ] [ 123 1byte-array ] unit-test
+{ B{ 123 } } [ 123 1byte-array ] unit-test
-[ B{ 123 } ] [ 123 0 B{ 0 } [ set-nth ] keep ] unit-test
+{ B{ 123 } } [ 123 0 B{ 0 } [ set-nth ] keep ] unit-test
-[ B{ 123 } ] [ 123 >bignum 0 B{ 0 } [ set-nth ] keep ] unit-test
+{ B{ 123 } } [ 123 >bignum 0 B{ 0 } [ set-nth ] keep ] unit-test
[ 1.5 B{ 1 2 3 } nth-unsafe ] must-fail
[ 0 1.5 B{ 1 2 3 } set-nth-unsafe ] must-fail
prettyprint math ;
IN: byte-vectors.tests
-[ 0 ] [ 123 <byte-vector> length ] unit-test
+{ 0 } [ 123 <byte-vector> length ] unit-test
: do-it ( seq -- seq )
123 [ suffix! ] each-integer ;
-[ t ] [
+{ t } [
3 <byte-vector> do-it
3 <vector> do-it sequence=
] unit-test
-[ t ] [ BV{ } byte-vector? ] unit-test
+{ t } [ BV{ } byte-vector? ] unit-test
-[ "BV{ }" ] [ BV{ } unparse ] unit-test
+{ "BV{ }" } [ BV{ } unparse ] unit-test
USING: checksums checksums.crc32 kernel math tools.test namespaces ;
-[ B{ 0 0 0 0 } ] [ "" crc32 checksum-bytes ] unit-test
+{ B{ 0 0 0 0 } } [ "" crc32 checksum-bytes ] unit-test
-[ B{ 0xcb 0xf4 0x39 0x26 } ] [ "123456789" crc32 checksum-bytes ] unit-test
+{ B{ 0xcb 0xf4 0x39 0x26 } } [ "123456789" crc32 checksum-bytes ] unit-test
INSTANCE: union-with-one-member mixin-with-one-member
! class<=
-[ t ] [ \ fixnum \ integer class<= ] unit-test
-[ t ] [ \ fixnum \ fixnum class<= ] unit-test
-[ f ] [ \ integer \ fixnum class<= ] unit-test
-[ t ] [ \ integer \ object class<= ] unit-test
-[ f ] [ \ integer \ null class<= ] unit-test
-[ t ] [ \ null \ object class<= ] unit-test
+{ t } [ \ fixnum \ integer class<= ] unit-test
+{ t } [ \ fixnum \ fixnum class<= ] unit-test
+{ f } [ \ integer \ fixnum class<= ] unit-test
+{ t } [ \ integer \ object class<= ] unit-test
+{ f } [ \ integer \ null class<= ] unit-test
+{ t } [ \ null \ object class<= ] unit-test
-[ t ] [ \ generic \ word class<= ] unit-test
-[ f ] [ \ word \ generic class<= ] unit-test
+{ t } [ \ generic \ word class<= ] unit-test
+{ f } [ \ word \ generic class<= ] unit-test
-[ f ] [ \ reversed \ slice class<= ] unit-test
-[ f ] [ \ slice \ reversed class<= ] unit-test
+{ f } [ \ reversed \ slice class<= ] unit-test
+{ f } [ \ slice \ reversed class<= ] unit-test
-[ t ] [ no-docs no-docs-union class<= ] unit-test
-[ f ] [ no-docs-union no-docs class<= ] unit-test
+{ t } [ no-docs no-docs-union class<= ] unit-test
+{ f } [ no-docs-union no-docs class<= ] unit-test
-[ t ] [ \ c \ tuple class<= ] unit-test
-[ f ] [ \ tuple \ c class<= ] unit-test
+{ t } [ \ c \ tuple class<= ] unit-test
+{ f } [ \ tuple \ c class<= ] unit-test
-[ t ] [ \ tuple-class \ class class<= ] unit-test
-[ f ] [ \ class \ tuple-class class<= ] unit-test
+{ t } [ \ tuple-class \ class class<= ] unit-test
+{ f } [ \ class \ tuple-class class<= ] unit-test
-[ t ] [ \ null \ tuple-example class<= ] unit-test
-[ f ] [ \ object \ tuple-example class<= ] unit-test
-[ f ] [ \ object \ tuple-example class<= ] unit-test
-[ t ] [ \ tuple-example \ tuple class<= ] unit-test
-[ f ] [ \ tuple \ tuple-example class<= ] unit-test
+{ t } [ \ null \ tuple-example class<= ] unit-test
+{ f } [ \ object \ tuple-example class<= ] unit-test
+{ f } [ \ object \ tuple-example class<= ] unit-test
+{ t } [ \ tuple-example \ tuple class<= ] unit-test
+{ f } [ \ tuple \ tuple-example class<= ] unit-test
-[ f ] [ z1 x1 y1 class-and class<= ] unit-test
+{ f } [ z1 x1 y1 class-and class<= ] unit-test
-[ t ] [ x1 y1 class-and a1 class<= ] unit-test
+{ t } [ x1 y1 class-and a1 class<= ] unit-test
-[ f ] [ b1 c1 class-or a1 b1 class-or a1 c1 class-and class-and class<= ] unit-test
+{ f } [ b1 c1 class-or a1 b1 class-or a1 c1 class-and class-and class<= ] unit-test
-[ t ] [ a1 b1 class-or a1 c1 class-or class-and a1 class<= ] unit-test
+{ t } [ a1 b1 class-or a1 c1 class-or class-and a1 class<= ] unit-test
-[ f ] [ growable tuple sequence class-and class<= ] unit-test
+{ f } [ growable tuple sequence class-and class<= ] unit-test
-[ f ] [ growable assoc class-and tuple class<= ] unit-test
+{ f } [ growable assoc class-and tuple class<= ] unit-test
-[ t ] [ object \ f \ f class-not class-or class<= ] unit-test
+{ t } [ object \ f \ f class-not class-or class<= ] unit-test
-[ t ] [ fixnum class-not integer class-and bignum class= ] unit-test
+{ t } [ fixnum class-not integer class-and bignum class= ] unit-test
-[ t ] [ array number class-not class<= ] unit-test
+{ t } [ array number class-not class<= ] unit-test
-[ f ] [ bignum number class-not class<= ] unit-test
+{ f } [ bignum number class-not class<= ] unit-test
-[ t ] [ fixnum fixnum bignum class-or class<= ] unit-test
+{ t } [ fixnum fixnum bignum class-or class<= ] unit-test
-[ f ] [ fixnum class-not integer class-and array class<= ] unit-test
+{ f } [ fixnum class-not integer class-and array class<= ] unit-test
-[ f ] [ fixnum class-not integer class<= ] unit-test
+{ f } [ fixnum class-not integer class<= ] unit-test
-[ f ] [ number class-not array class<= ] unit-test
+{ f } [ number class-not array class<= ] unit-test
-[ f ] [ fixnum class-not array class<= ] unit-test
+{ f } [ fixnum class-not array class<= ] unit-test
-[ t ] [ number class-not integer class-not class<= ] unit-test
+{ t } [ number class-not integer class-not class<= ] unit-test
-[ f ] [ fixnum class-not integer class<= ] unit-test
+{ f } [ fixnum class-not integer class<= ] unit-test
-[ t ] [ object empty-intersection class<= ] unit-test
-[ t ] [ empty-intersection object class<= ] unit-test
-[ t ] [ \ f class-not empty-intersection class<= ] unit-test
-[ f ] [ empty-intersection \ f class-not class<= ] unit-test
-[ t ] [ \ number empty-intersection class<= ] unit-test
-[ t ] [ empty-intersection class-not null class<= ] unit-test
-[ t ] [ null empty-intersection class-not class<= ] unit-test
+{ t } [ object empty-intersection class<= ] unit-test
+{ t } [ empty-intersection object class<= ] unit-test
+{ t } [ \ f class-not empty-intersection class<= ] unit-test
+{ f } [ empty-intersection \ f class-not class<= ] unit-test
+{ t } [ \ number empty-intersection class<= ] unit-test
+{ t } [ empty-intersection class-not null class<= ] unit-test
+{ t } [ null empty-intersection class-not class<= ] unit-test
-[ t ] [ \ f class-not \ f class-or empty-intersection class<= ] unit-test
-[ t ] [ empty-intersection \ f class-not \ f class-or class<= ] unit-test
+{ t } [ \ f class-not \ f class-or empty-intersection class<= ] unit-test
+{ t } [ empty-intersection \ f class-not \ f class-or class<= ] unit-test
-[ t ] [ object \ f class-not \ f class-or class<= ] unit-test
+{ t } [ object \ f class-not \ f class-or class<= ] unit-test
-[ t ] [
+{ t } [
fixnum class-not
fixnum fixnum class-not class-or
class<=
] unit-test
-[ t ] [ generic-class generic class<= ] unit-test
-[ t ] [ generic-class \ class class<= ] unit-test
+{ t } [ generic-class generic class<= ] unit-test
+{ t } [ generic-class \ class class<= ] unit-test
-[ t ] [ a union-with-one-member class<= ] unit-test
-[ f ] [ union-with-one-member class-not integer class<= ] unit-test
+{ t } [ a union-with-one-member class<= ] unit-test
+{ f } [ union-with-one-member class-not integer class<= ] unit-test
MIXIN: empty-mixin
-[ f ] [ empty-mixin class-not null class<= ] unit-test
-[ f ] [ empty-mixin null class<= ] unit-test
+{ f } [ empty-mixin class-not null class<= ] unit-test
+{ f } [ empty-mixin null class<= ] unit-test
-[ t ] [ empty-mixin class-not object class<= ] unit-test
-[ t ] [ empty-mixin object class<= ] unit-test
+{ t } [ empty-mixin class-not object class<= ] unit-test
+{ t } [ empty-mixin object class<= ] unit-test
-[ t ] [ empty-mixin class-not object class<= ] unit-test
-[ t ] [ empty-mixin object class<= ] unit-test
+{ t } [ empty-mixin class-not object class<= ] unit-test
+{ t } [ empty-mixin object class<= ] unit-test
-[ t ] [ object empty-mixin class-not class<= ] unit-test
+{ t } [ object empty-mixin class-not class<= ] unit-test
-[ t ] [ array sequence vector class-not class-and class<= ] unit-test
-[ f ] [ vector sequence vector class-not class-and class<= ] unit-test
+{ t } [ array sequence vector class-not class-and class<= ] unit-test
+{ f } [ vector sequence vector class-not class-and class<= ] unit-test
! class-and
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
-[ t ] [ object object object class-and* ] unit-test
-[ t ] [ fixnum object fixnum class-and* ] unit-test
-[ t ] [ object fixnum fixnum class-and* ] unit-test
-[ t ] [ fixnum fixnum fixnum class-and* ] unit-test
-[ t ] [ fixnum integer fixnum class-and* ] unit-test
-[ t ] [ integer fixnum fixnum class-and* ] unit-test
+{ t } [ object object object class-and* ] unit-test
+{ t } [ fixnum object fixnum class-and* ] unit-test
+{ t } [ object fixnum fixnum class-and* ] unit-test
+{ t } [ fixnum fixnum fixnum class-and* ] unit-test
+{ t } [ fixnum integer fixnum class-and* ] unit-test
+{ t } [ integer fixnum fixnum class-and* ] unit-test
-[ t ] [ vector fixnum null class-and* ] unit-test
-[ t ] [ number object number class-and* ] unit-test
-[ t ] [ object number number class-and* ] unit-test
-[ t ] [ slice reversed null class-and* ] unit-test
-[ t ] [ \ f class-not \ f null class-and* ] unit-test
+{ t } [ vector fixnum null class-and* ] unit-test
+{ t } [ number object number class-and* ] unit-test
+{ t } [ object number number class-and* ] unit-test
+{ t } [ slice reversed null class-and* ] unit-test
+{ t } [ \ f class-not \ f null class-and* ] unit-test
-[ t ] [ vector array class-not vector class-and* ] unit-test
+{ t } [ vector array class-not vector class-and* ] unit-test
-[ object ] [ object empty-mixin class-not class-and ] unit-test
-[ object ] [ empty-mixin class-not object class-and ] unit-test
+{ object } [ object empty-mixin class-not class-and ] unit-test
+{ object } [ empty-mixin class-not object class-and ] unit-test
! class-or
: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;
-[ t ] [ \ f class-not \ f object class-or* ] unit-test
+{ t } [ \ f class-not \ f object class-or* ] unit-test
-[ object ] [ object empty-mixin class-not class-or ] unit-test
-[ object ] [ empty-mixin class-not object class-or ] unit-test
+{ object } [ object empty-mixin class-not class-or ] unit-test
+{ object } [ empty-mixin class-not object class-or ] unit-test
! class-not
-[ vector ] [ vector class-not class-not ] unit-test
+{ vector } [ vector class-not class-not ] unit-test
! classes-intersect?
-[ t ] [ both tuple classes-intersect? ] unit-test
-[ t ] [ tuple both classes-intersect? ] unit-test
+{ t } [ both tuple classes-intersect? ] unit-test
+{ t } [ tuple both classes-intersect? ] unit-test
-[ f ] [ vector virtual-sequence classes-intersect? ] unit-test
-[ f ] [ virtual-sequence vector classes-intersect? ] unit-test
+{ f } [ vector virtual-sequence classes-intersect? ] unit-test
+{ f } [ virtual-sequence vector classes-intersect? ] unit-test
-[ t ] [ number vector class-or sequence classes-intersect? ] unit-test
-[ t ] [ sequence number vector class-or classes-intersect? ] unit-test
+{ t } [ number vector class-or sequence classes-intersect? ] unit-test
+{ t } [ sequence number vector class-or classes-intersect? ] unit-test
-[ f ] [ number vector class-and sequence classes-intersect? ] unit-test
-[ f ] [ sequence number vector class-and classes-intersect? ] unit-test
+{ f } [ number vector class-and sequence classes-intersect? ] unit-test
+{ f } [ sequence number vector class-and classes-intersect? ] unit-test
-[ f ] [ y1 z1 class-and x1 classes-intersect? ] unit-test
-[ f ] [ x1 y1 z1 class-and classes-intersect? ] unit-test
+{ f } [ y1 z1 class-and x1 classes-intersect? ] unit-test
+{ f } [ x1 y1 z1 class-and classes-intersect? ] unit-test
-[ f ] [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test
-[ f ] [ a1 b1 class-or a1 c1 class-or b1 c1 class-or class-and classes-intersect? ] unit-test
+{ f } [ a1 c1 class-or b1 c1 class-or class-and a1 b1 class-or classes-intersect? ] unit-test
+{ f } [ a1 b1 class-or a1 c1 class-or b1 c1 class-or class-and classes-intersect? ] unit-test
-[ f ] [ integer integer class-not classes-intersect? ] unit-test
-[ f ] [ integer class-not integer classes-intersect? ] unit-test
+{ f } [ integer integer class-not classes-intersect? ] unit-test
+{ f } [ integer class-not integer classes-intersect? ] unit-test
-[ f ] [ fixnum class-not number class-and array classes-intersect? ] unit-test
-[ f ] [ array fixnum class-not number class-and classes-intersect? ] unit-test
+{ f } [ fixnum class-not number class-and array classes-intersect? ] unit-test
+{ f } [ array fixnum class-not number class-and classes-intersect? ] unit-test
-[ t ] [ \ word generic-class classes-intersect? ] unit-test
-[ t ] [ generic-class \ word classes-intersect? ] unit-test
-[ f ] [ number generic-class classes-intersect? ] unit-test
-[ f ] [ generic-class number classes-intersect? ] unit-test
+{ t } [ \ word generic-class classes-intersect? ] unit-test
+{ t } [ generic-class \ word classes-intersect? ] unit-test
+{ f } [ number generic-class classes-intersect? ] unit-test
+{ f } [ generic-class number classes-intersect? ] unit-test
-[ f ] [ sa sb classes-intersect? ] unit-test
-[ f ] [ sb sa classes-intersect? ] unit-test
+{ f } [ sa sb classes-intersect? ] unit-test
+{ f } [ sb sa classes-intersect? ] unit-test
-[ t ] [ a union-with-one-member classes-intersect? ] unit-test
-[ f ] [ fixnum union-with-one-member classes-intersect? ] unit-test
-[ t ] [ object union-with-one-member classes-intersect? ] unit-test
+{ t } [ a union-with-one-member classes-intersect? ] unit-test
+{ f } [ fixnum union-with-one-member classes-intersect? ] unit-test
+{ t } [ object union-with-one-member classes-intersect? ] unit-test
-[ t ] [ union-with-one-member a classes-intersect? ] unit-test
-[ f ] [ union-with-one-member fixnum classes-intersect? ] unit-test
-[ t ] [ union-with-one-member object classes-intersect? ] unit-test
+{ t } [ union-with-one-member a classes-intersect? ] unit-test
+{ f } [ union-with-one-member fixnum classes-intersect? ] unit-test
+{ t } [ union-with-one-member object classes-intersect? ] unit-test
-[ t ] [ a mixin-with-one-member classes-intersect? ] unit-test
-[ f ] [ fixnum mixin-with-one-member classes-intersect? ] unit-test
-[ t ] [ object mixin-with-one-member classes-intersect? ] unit-test
+{ t } [ a mixin-with-one-member classes-intersect? ] unit-test
+{ f } [ fixnum mixin-with-one-member classes-intersect? ] unit-test
+{ t } [ object mixin-with-one-member classes-intersect? ] unit-test
-[ t ] [ mixin-with-one-member a classes-intersect? ] unit-test
-[ f ] [ mixin-with-one-member fixnum classes-intersect? ] unit-test
-[ t ] [ mixin-with-one-member object classes-intersect? ] unit-test
+{ t } [ mixin-with-one-member a classes-intersect? ] unit-test
+{ f } [ mixin-with-one-member fixnum classes-intersect? ] unit-test
+{ t } [ mixin-with-one-member object classes-intersect? ] unit-test
-[ f ] [ null object classes-intersect? ] unit-test
-[ f ] [ object null classes-intersect? ] unit-test
+{ f } [ null object classes-intersect? ] unit-test
+{ f } [ object null classes-intersect? ] unit-test
-[ t ] [ null class-not object class= ] unit-test
+{ t } [ null class-not object class= ] unit-test
-[ t ] [ object class-not null class= ] unit-test
+{ t } [ object class-not null class= ] unit-test
-[ f ] [ object class-not object class= ] unit-test
+{ f } [ object class-not object class= ] unit-test
-[ f ] [ null class-not null class= ] unit-test
+{ f } [ null class-not null class= ] unit-test
! smallest-class etc
-[ real ] [ { real sequence } smallest-class ] unit-test
-[ real ] [ { sequence real } smallest-class ] unit-test
+{ real } [ { real sequence } smallest-class ] unit-test
+{ real } [ { sequence real } smallest-class ] unit-test
: min-class ( class classes -- class/f )
interesting-classes smallest-class ;
-[ f ] [ fixnum { } min-class ] unit-test
+{ f } [ fixnum { } min-class ] unit-test
-[ string ] [
+{ string } [
\ string
[ integer string array reversed sbuf
slice vector quotation ]
sort-classes min-class
] unit-test
-[ fixnum ] [
+{ fixnum } [
\ fixnum
[ fixnum integer object ]
sort-classes min-class
] unit-test
-[ integer ] [
+{ integer } [
\ fixnum
[ integer float object ]
sort-classes min-class
] unit-test
-[ object ] [
+{ object } [
\ word
[ integer float object ]
sort-classes min-class
] unit-test
-[ reversed ] [
+{ reversed } [
\ reversed
[ integer reversed slice ]
sort-classes min-class
] unit-test
-[ f ] [ null { number fixnum null } min-class ] unit-test
+{ f } [ null { number fixnum null } min-class ] unit-test
! Test for hangs?
: random-class ( -- class ) classes random ;
SINGLETON: xxx
UNION: yyy xxx ;
-[ { yyy xxx } ] [ { xxx yyy } sort-classes ] unit-test
-[ { yyy xxx } ] [ { yyy xxx } sort-classes ] unit-test
+{ { yyy xxx } } [ { xxx yyy } sort-classes ] unit-test
+{ { yyy xxx } } [ { yyy xxx } sort-classes ] unit-test
-[ { number ratio integer } ] [ { ratio number integer } sort-classes ] unit-test
-[ { sequence number ratio } ] [ { ratio number sequence } sort-classes ] unit-test
+{ { number ratio integer } } [ { ratio number integer } sort-classes ] unit-test
+{ { sequence number ratio } } [ { ratio number sequence } sort-classes ] unit-test
TUPLE: xa ;
TUPLE: xb ;
TUPLE: xg < xb ;
TUPLE: xh < xb ;
-[ t ] [ { xa xb xc xd xe xf xg xh } sort-classes dup sort-classes = ] unit-test
+{ t } [ { xa xb xc xd xe xf xg xh } sort-classes dup sort-classes = ] unit-test
-[ H{ { word word } } ] [
+{ H{ { word word } } } [
generic-class flatten-class
] unit-test
-[ sa ] [ sa { sa sb sc } min-class ] unit-test
+{ sa } [ sa { sa sb sc } min-class ] unit-test
[ \ + flatten-class ] must-fail
USING: tools.test words sequences kernel memory accessors ;
IN: classes.builtin.tests
-[ f ] [
+{ f } [
[ word? ] instances
[
[ name>> "f?" = ]
kernel.private sorting vocabs memory eval accessors sets ;
IN: classes.tests
-[ t ] [ 3 object instance? ] unit-test
-[ t ] [ 3 fixnum instance? ] unit-test
-[ f ] [ 3 float instance? ] unit-test
-[ t ] [ 3 number instance? ] unit-test
-[ f ] [ 3 null instance? ] unit-test
+{ t } [ 3 object instance? ] unit-test
+{ t } [ 3 fixnum instance? ] unit-test
+{ f } [ 3 float instance? ] unit-test
+{ t } [ 3 number instance? ] unit-test
+{ f } [ 3 null instance? ] unit-test
! Regression
GENERIC: method-forget-test ( obj -- obj )
TUPLE: method-forget-class ;
M: method-forget-class method-forget-test ;
-[ f ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
-[ ] [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
-[ t ] [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
+{ f } [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
+{ } [ [ \ method-forget-class forget ] with-compilation-unit ] unit-test
+{ t } [ \ method-forget-test "methods" word-prop assoc-empty? ] unit-test
-[ { } { } ] [
+{ { } { } } [
all-words [ class? ] filter
implementors-map get keys
[ natural-sort ] bi@
USE: multiline
! So the user has some code...
-[ ] [
+{ } [
"""IN: classes.test.a
GENERIC: g ( a -- b )
TUPLE: x ;
] unit-test
! Note that q inlines M: x g ;
-[ ] [
+{ } [
"""IN: classes.test.b
USE: classes.test.a
USE: kernel
] unit-test
! Now, the user removes the z class and adds a method,
-[ ] [
+{ } [
"""IN: classes.test.a
GENERIC: g ( a -- b )
TUPLE: x ;
] unit-test
! And changes the definition of q
-[ ] [
+{ } [
"""IN: classes.test.b
USE: classes.test.a
USE: kernel
] unit-test
! Similar problem, but with anonymous classes
-[ ] [
+{ } [
"""IN: classes.test.c
USE: kernel
GENERIC: g ( a -- b )
"class-intersect-no-method-c" parse-stream drop
] unit-test
-[ ] [
+{ } [
"""IN: classes.test.d
USE: classes.test.c
USE: kernel
] unit-test
! Now, the user removes the z class and adds a method,
-[ ] [
+{ } [
"""IN: classes.test.c
USE: kernel
GENERIC: g ( a -- b )
TUPLE: forgotten-predicate-test ;
-[ ] [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
-[ f ] [ \ forgotten-predicate-test? predicate? ] unit-test
+{ } [ [ \ forgotten-predicate-test forget ] with-compilation-unit ] unit-test
+{ f } [ \ forgotten-predicate-test? predicate? ] unit-test
GENERIC: generic-predicate? ( a -- b )
-[ ] [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tests TUPLE: generic-predicate ;" eval( -- ) ] unit-test
-[ f ] [ \ generic-predicate? generic? ] unit-test
+{ f } [ \ generic-predicate? generic? ] unit-test
M: c x drop c ;
M: a x drop a ;
-[ a ] [ T{ a } x ] unit-test
-[ a ] [ T{ a1 } x ] unit-test
-[ a ] [ T{ a2 } x ] unit-test
+{ a } [ T{ a } x ] unit-test
+{ a } [ T{ a1 } x ] unit-test
+{ a } [ T{ a2 } x ] unit-test
-[ t ] [ T{ a3 } c? ] unit-test
-[ t ] [ T{ a3 } \ x effective-method M\ c x eq? nip ] unit-test
-[ c ] [ T{ a3 } x ] unit-test
+{ t } [ T{ a3 } c? ] unit-test
+{ t } [ T{ a3 } \ x effective-method M\ c x eq? nip ] unit-test
+{ c } [ T{ a3 } x ] unit-test
! More complex case
TUPLE: t1 ;
M: i g drop i ;
M: t4 g drop t4 ;
-[ t4 ] [ T{ t4 } g ] unit-test
-[ i ] [ T{ t5 } g ] unit-test
+{ t4 } [ T{ t4 } g ] unit-test
+{ i } [ T{ t5 } g ] unit-test
PREDICATE: odd-integer < integer odd? ;
TUPLE: omg { a intersection{ fixnum odd-integer } initial: 1 } ;
-[ 1 ] [ omg new a>> ] unit-test
-[ 3 ] [ omg new 3 >>a a>> ] unit-test
+{ 1 } [ omg new a>> ] unit-test
+{ 3 } [ omg new 3 >>a a>> ] unit-test
[ omg new 1.2 >>a a>> ] [ bad-slot-value? ] must-fail-with
PREDICATE: odd/float-between-10-20 < union{ odd-integer float }
10 20 between? ;
-[ t ] [ 17 odd/float-between-10-20? ] unit-test
-[ t ] [ 17.4 odd/float-between-10-20? ] unit-test
-[ f ] [ 18 odd/float-between-10-20? ] unit-test
-[ f ] [ 5 odd/float-between-10-20? ] unit-test
-[ f ] [ 5.75 odd/float-between-10-20? ] unit-test
+{ t } [ 17 odd/float-between-10-20? ] unit-test
+{ t } [ 17.4 odd/float-between-10-20? ] unit-test
+{ f } [ 18 odd/float-between-10-20? ] unit-test
+{ f } [ 5 odd/float-between-10-20? ] unit-test
+{ f } [ 5.75 odd/float-between-10-20? ] unit-test
classes.algebra.private ;
IN: classes.maybe.tests
-[ t ] [ 3 maybe{ integer } instance? ] unit-test
-[ t ] [ f maybe{ integer } instance? ] unit-test
-[ f ] [ 3.0 maybe{ integer } instance? ] unit-test
+{ t } [ 3 maybe{ integer } instance? ] unit-test
+{ t } [ f maybe{ integer } instance? ] unit-test
+{ f } [ 3.0 maybe{ integer } instance? ] unit-test
TUPLE: maybe-integer-container { something maybe{ integer } } ;
-[ f ] [ maybe-integer-container new something>> ] unit-test
-[ 3 ] [ maybe-integer-container new 3 >>something something>> ] unit-test
+{ f } [ maybe-integer-container new something>> ] unit-test
+{ 3 } [ maybe-integer-container new 3 >>something something>> ] unit-test
[ maybe-integer-container new 3.0 >>something ] [ bad-slot-value? ] must-fail-with
TUPLE: self-pointer { next maybe{ self-pointer } } ;
-[ T{ self-pointer { next T{ self-pointer } } } ]
+{ T{ self-pointer { next T{ self-pointer } } } }
[ self-pointer new self-pointer new >>next ] unit-test
-[ t ] [ f maybe{ POSTPONE: f } instance? ] unit-test
+{ t } [ f maybe{ POSTPONE: f } instance? ] unit-test
PREDICATE: natural < maybe{ integer }
0 > ;
-[ f ] [ -1 natural? ] unit-test
-[ f ] [ 0 natural? ] unit-test
-[ t ] [ 1 natural? ] unit-test
+{ f } [ -1 natural? ] unit-test
+{ f } [ 0 natural? ] unit-test
+{ t } [ 1 natural? ] unit-test
-[ t ] [ f maybe{ maybe{ integer } } instance? ] unit-test
-[ t ] [ 3 maybe{ maybe{ integer } } instance? ] unit-test
-[ f ] [ 3.03 maybe{ maybe{ integer } } instance? ] unit-test
+{ t } [ f maybe{ maybe{ integer } } instance? ] unit-test
+{ t } [ 3 maybe{ maybe{ integer } } instance? ] unit-test
+{ f } [ 3.03 maybe{ maybe{ integer } } instance? ] unit-test
INTERSECTION: only-f maybe{ integer } POSTPONE: f ;
-[ t ] [ f only-f instance? ] unit-test
-[ f ] [ t only-f instance? ] unit-test
-[ f ] [ 30 only-f instance? ] unit-test
+{ t } [ f only-f instance? ] unit-test
+{ f } [ t only-f instance? ] unit-test
+{ f } [ 30 only-f instance? ] unit-test
UNION: ?integer-float maybe{ integer } maybe{ float } ;
-[ t ] [ 30 ?integer-float instance? ] unit-test
-[ t ] [ 30.0 ?integer-float instance? ] unit-test
-[ t ] [ f ?integer-float instance? ] unit-test
-[ f ] [ t ?integer-float instance? ] unit-test
+{ t } [ 30 ?integer-float instance? ] unit-test
+{ t } [ 30.0 ?integer-float instance? ] unit-test
+{ t } [ f ?integer-float instance? ] unit-test
+{ f } [ t ?integer-float instance? ] unit-test
TUPLE: foo ;
GENERIC: lol ( obj -- string )
M: maybe{ foo } lol drop "lol" ;
-[ "lol" ] [ foo new lol ] unit-test
-[ "lol" ] [ f lol ] unit-test
+{ "lol" } [ foo new lol ] unit-test
+{ "lol" } [ f lol ] unit-test
[ 3 lol ] [ no-method? ] must-fail-with
TUPLE: foo2 a ;
M: maybe{ foo } lol2 drop "lol2" ;
M: f lol2 drop "lol22" ;
-[ "lol2" ] [ foo new lol2 ] unit-test
-[ "lol22" ] [ f lol2 ] unit-test
+{ "lol2" } [ foo new lol2 ] unit-test
+{ "lol22" } [ f lol2 ] unit-test
[ 3 lol2 ] [ no-method? ] must-fail-with
-[ t ] [ \ + <maybe> classoid? ] unit-test
-[ f ] [ \ + <maybe> valid-classoid? ] unit-test
+{ t } [ \ + <maybe> classoid? ] unit-test
+{ f } [ \ + <maybe> valid-classoid? ] unit-test
[ "IN: classes-tests maybe{ 1 2 3 }" eval( -- ) ]
[ error>> not-classoids? ] must-fail-with
M: assoc-mixin collection-size assoc-size ;
-[ t ] [ array sequence-mixin class<= ] unit-test
-[ t ] [ { 1 2 3 } sequence-mixin? ] unit-test
-[ 3 ] [ { 1 2 3 } collection-size ] unit-test
-[ f ] [ H{ { 1 2 } { 2 3 } } sequence-mixin? ] unit-test
-[ t ] [ H{ { 1 2 } { 2 3 } } assoc-mixin? ] unit-test
-[ 2 ] [ H{ { 1 2 } { 2 3 } } collection-size ] unit-test
+{ t } [ array sequence-mixin class<= ] unit-test
+{ t } [ { 1 2 3 } sequence-mixin? ] unit-test
+{ 3 } [ { 1 2 3 } collection-size ] unit-test
+{ f } [ H{ { 1 2 } { 2 3 } } sequence-mixin? ] unit-test
+{ t } [ H{ { 1 2 } { 2 3 } } assoc-mixin? ] unit-test
+{ 2 } [ H{ { 1 2 } { 2 3 } } collection-size ] unit-test
! Test mixing in of new classes after the fact
DEFER: mx1
INSTANCE: integer mx1
-[ t ] [ integer mx1 class<= ] unit-test
-[ f ] [ mx1 integer class<= ] unit-test
-[ f ] [ mx1 number class<= ] unit-test
+{ t } [ integer mx1 class<= ] unit-test
+{ f } [ mx1 integer class<= ] unit-test
+{ f } [ mx1 number class<= ] unit-test
"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval( -- )
-[ t ] [ array mx1 class<= ] unit-test
-[ f ] [ mx1 number class<= ] unit-test
+{ t } [ array mx1 class<= ] unit-test
+{ f } [ mx1 number class<= ] unit-test
[ \ mx1 forget ] with-compilation-unit
MIXIN: flat-mx-2 INSTANCE: flat-mx-2 flat-mx-1
TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
-[ t ] [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
+{ t } [ T{ flat-mx-2-1 } flat-mx-1? ] unit-test
! Too eager with reset-class
-[ ] [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
+{ } [ "IN: classes.mixin.tests MIXIN: blah SINGLETON: boo INSTANCE: boo blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
-[ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
+{ t } [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
-[ ] [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
+{ } [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
-[ t ] [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
+{ t } [ "blah" "classes.mixin.tests" lookup-word mixin-class? ] unit-test
MIXIN: empty-mixin
-[ f ] [ "hi" empty-mixin? ] unit-test
+{ f } [ "hi" empty-mixin? ] unit-test
MIXIN: move-instance-declaration-mixin
-[ ] [ "IN: classes.mixin.tests.a USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
+{ } [ "IN: classes.mixin.tests.a USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
-[ ] [ "IN: classes.mixin.tests.b USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-2" parse-stream drop ] unit-test
+{ } [ "IN: classes.mixin.tests.b USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" <string-reader> "move-mixin-test-2" parse-stream drop ] unit-test
-[ ] [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
+{ } [ "IN: classes.mixin.tests.a" <string-reader> "move-mixin-test-1" parse-stream drop ] unit-test
-[ { string } ] [ move-instance-declaration-mixin members ] unit-test
+{ { string } } [ move-instance-declaration-mixin members ] unit-test
MIXIN: silly-mixin
SYMBOL: not-a-class
M: metaclass-change-mixin metaclass-change-generic ;
-[ T{ metaclass-change } ] [ T{ metaclass-change } metaclass-change-generic ] unit-test
+{ T{ metaclass-change } } [ T{ metaclass-change } metaclass-change-generic ] unit-test
-[ ] [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.mixin.tests USE: math UNION: metaclass-change integer ;" eval( -- ) ] unit-test
-[ 0 ] [ 0 metaclass-change-generic ] unit-test
+{ 0 } [ 0 metaclass-change-generic ] unit-test
! Forgetting a mixin member class should remove it from the mixin
-[ ] [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
+{ } [ [ metaclass-change forget-class ] with-compilation-unit ] unit-test
-[ t ] [ metaclass-change-mixin members empty? ] unit-test
+{ t } [ metaclass-change-mixin members empty? ] unit-test
PREDICATE: negative < integer 0 < ;
PREDICATE: positive < integer 0 > ;
-[ t ] [ negative integer class< ] unit-test
-[ t ] [ positive integer class< ] unit-test
-[ f ] [ integer negative class< ] unit-test
-[ f ] [ integer positive class< ] unit-test
-[ f ] [ negative negative class< ] unit-test
-[ f ] [ positive negative class< ] unit-test
+{ t } [ negative integer class< ] unit-test
+{ t } [ positive integer class< ] unit-test
+{ f } [ integer negative class< ] unit-test
+{ f } [ integer positive class< ] unit-test
+{ f } [ negative negative class< ] unit-test
+{ f } [ positive negative class< ] unit-test
GENERIC: abs ( n -- n )
M: integer abs ;
M: negative abs -1 * ;
M: positive abs ;
-[ 10 ] [ -10 abs ] unit-test
-[ 10 ] [ 10 abs ] unit-test
-[ 0 ] [ 0 abs ] unit-test
+{ 10 } [ -10 abs ] unit-test
+{ 10 } [ 10 abs ] unit-test
+{ 0 } [ 0 abs ] unit-test
! Bug report from Bruno Deferrari
TUPLE: tuple-a slot ;
M: tuple-a ptest drop tuple-a ;
M: tuple-c ptest drop tuple-c ;
-[ tuple-a ] [ tuple-b new ptest ] unit-test
-[ tuple-c ] [ tuple-b new t >>slot ptest ] unit-test
+{ tuple-a } [ tuple-b new ptest ] unit-test
+{ tuple-c } [ tuple-b new t >>slot ptest ] unit-test
PREDICATE: tuple-d < tuple-a slot>> ;
M: tuple-a ptest' drop tuple-a ;
M: tuple-d ptest' drop tuple-d ;
-[ tuple-a ] [ tuple-b new ptest' ] unit-test
-[ tuple-d ] [ tuple-b new t >>slot ptest' ] unit-test
+{ tuple-a } [ tuple-b new ptest' ] unit-test
+{ tuple-d } [ tuple-b new t >>slot ptest' ] unit-test
PREDICATE: bad-inheritance-predicate < string ;
[
PREDICATE: tup < string ;
UNION: u tup ;
-[ ] [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.predicate.tests PREDICATE: u < tup ;" eval( -- ) ] unit-test
! Changing the metaclass of the predicate superclass should work
GENERIC: change-meta-test ( a -- b )
M: change-meta-test-predicate change-meta-test length>> ;
-[ f ] [ \ change-meta-test "methods" word-prop assoc-empty? ] unit-test
+{ f } [ \ change-meta-test "methods" word-prop assoc-empty? ] unit-test
[ T{ change-meta-test-class f 0 } change-meta-test ] [ no-method? ] must-fail-with
-[ 7 ] [ T{ change-meta-test-class f 7 } change-meta-test ] unit-test
+{ 7 } [ T{ change-meta-test-class f 7 } change-meta-test ] unit-test
-[ ] [ "IN: classes.predicate.tests USE: arrays UNION: change-meta-test-class array ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.predicate.tests USE: arrays UNION: change-meta-test-class array ;" eval( -- ) ] unit-test
! Should not have changed
-[ change-meta-test-class ] [ change-meta-test-predicate superclass ] unit-test
+{ change-meta-test-class } [ change-meta-test-predicate superclass ] unit-test
[ { } change-meta-test ] [ no-method? ] must-fail-with
-[ 4 ] [ { 1 2 3 4 } change-meta-test ] unit-test
+{ 4 } [ { 1 2 3 4 } change-meta-test ] unit-test
-[ ] [ [ \ change-meta-test-class forget-class ] with-compilation-unit ] unit-test
+{ } [ [ \ change-meta-test-class forget-class ] with-compilation-unit ] unit-test
-[ f ] [ change-meta-test-predicate class? ] unit-test
+{ f } [ change-meta-test-predicate class? ] unit-test
-[ t ] [ \ change-meta-test "methods" word-prop assoc-empty? ] unit-test
+{ t } [ \ change-meta-test "methods" word-prop assoc-empty? ] unit-test
USING: kernel classes.singleton tools.test prettyprint io.streams.string see ;
IN: classes.singleton.tests
-[ ] [ SINGLETON: bzzt ] unit-test
-[ t ] [ bzzt bzzt? ] unit-test
-[ t ] [ bzzt bzzt eq? ] unit-test
+{ } [ SINGLETON: bzzt ] unit-test
+{ t } [ bzzt bzzt? ] unit-test
+{ t } [ bzzt bzzt eq? ] unit-test
GENERIC: zammo ( obj -- str )
-[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
-[ "yes!" ] [ bzzt zammo ] unit-test
-[ ] [ SINGLETON: omg ] unit-test
-[ t ] [ omg singleton-class? ] unit-test
-[ "IN: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test
+{ } [ M: bzzt zammo drop "yes!" ; ] unit-test
+{ "yes!" } [ bzzt zammo ] unit-test
+{ } [ SINGLETON: omg ] unit-test
+{ t } [ omg singleton-class? ] unit-test
+{ "IN: classes.singleton.tests\nSINGLETON: omg\n" } [ [ omg see ] with-string-writer ] unit-test
SINGLETON: word-and-singleton
: word-and-singleton ( -- x ) 3 ;
-[ t ] [ \ word-and-singleton word-and-singleton? ] unit-test
-[ 3 ] [ word-and-singleton ] unit-test
+{ t } [ \ word-and-singleton word-and-singleton? ] unit-test
+{ 3 } [ word-and-singleton ] unit-test
TUPLE: test-1 ;
-[ t ] [ test-1 "slots" word-prop empty? ] unit-test
+{ t } [ test-1 "slots" word-prop empty? ] unit-test
TUPLE: test-2 < test-1 ;
-[ t ] [ test-2 "slots" word-prop empty? ] unit-test
-[ test-1 ] [ test-2 superclass ] unit-test
+{ t } [ test-2 "slots" word-prop empty? ] unit-test
+{ test-1 } [ test-2 superclass ] unit-test
TUPLE: test-3 a ;
-[ { "a" } ] [ test-3 "slots" word-prop [ name>> ] map ] unit-test
+{ { "a" } } [ test-3 "slots" word-prop [ name>> ] map ] unit-test
-[ object ] [ "a" test-3 "slots" word-prop slot-named class>> ] unit-test
+{ object } [ "a" test-3 "slots" word-prop slot-named class>> ] unit-test
TUPLE: test-4 < test-3 b ;
-[ { "b" } ] [ test-4 "slots" word-prop [ name>> ] map ] unit-test
+{ { "b" } } [ test-4 "slots" word-prop [ name>> ] map ] unit-test
TUPLE: test-5 { a integer } ;
-[ { { "a" integer } } ]
+{ { { "a" integer } } }
[
test-5 "slots" word-prop
[ [ name>> ] [ class>> ] bi 2array ] map
TUPLE: test-6 < test-5 { b integer } ;
-[ integer ] [ "b" test-6 "slots" word-prop slot-named class>> ] unit-test
+{ integer } [ "b" test-6 "slots" word-prop slot-named class>> ] unit-test
-[ { { "b" integer } } ]
+{ { { "b" integer } } }
[
test-6 "slots" word-prop
[ [ name>> ] [ class>> ] bi 2array ] map
TUPLE: test-7 { b integer initial: 3 } ;
-[ 3 ] [ "b" test-7 "slots" word-prop slot-named initial>> ] unit-test
+{ 3 } [ "b" test-7 "slots" word-prop slot-named initial>> ] unit-test
TUPLE: test-8 { b integer read-only } ;
-[ t ] [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
+{ t } [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
DEFER: foo
[ error>> duplicate-slot-names? ]
must-fail-with
-[ f ] [ \ foo tuple-class? ] unit-test
+{ f } [ \ foo tuple-class? ] unit-test
-[ ] [
+{ } [
[
{ test-1 test-2 test-3 test-4 test-5 test-6 test-7 test-8 foo }
[ dup class? [ forget-class ] [ drop ] if ] each
TUPLE: syntax-test bar baz ;
-[ T{ syntax-test } ] [ T{ syntax-test } ] unit-test
-[ T{ syntax-test f { 2 3 } { 4 { 5 } } } ]
+{ T{ syntax-test } } [ T{ syntax-test } ] unit-test
+{ T{ syntax-test f { 2 3 } { 4 { 5 } } } }
[ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test
! Corner case
TUPLE: parsing-corner-case x ;
-[ T{ parsing-corner-case f 3 } ] [
+{ T{ parsing-corner-case f 3 } } [
{
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case"
} "\n" join eval( -- tuple )
] unit-test
-[ T{ parsing-corner-case f 3 } ] [
+{ T{ parsing-corner-case f 3 } } [
{
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case"
} "\n" join eval( -- tuple )
] unit-test
-[ T{ parsing-corner-case f 3 } ] [
+{ T{ parsing-corner-case f 3 } } [
{
"USE: classes.tuple.parser.tests"
"T{ parsing-corner-case {"
TUPLE: tup ;
UNION: u tup ;
-[ ] [ "IN: classes.tuple.parser.tests TUPLE: u < tup ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.parser.tests TUPLE: u < tup ;" eval( -- ) ] unit-test
-[ t ] [ u new tup? ] unit-test
+{ t } [ u new tup? ] unit-test
: move ( x rect -- rect )
[ + ] change-x ;
-[ f ] [ 10 20 30 40 <rect> dup clone 5 swap move = ] unit-test
+{ f } [ 10 20 30 40 <rect> dup clone 5 swap move = ] unit-test
-[ t ] [ 10 20 30 40 <rect> dup clone 0 swap move = ] unit-test
+{ t } [ 10 20 30 40 <rect> dup clone 0 swap move = ] unit-test
! Make sure we handle tuple class redefinition
TUPLE: redefinition-test ;
<redefinition-test> "redefinition-test" set
-[ t ] [ "redefinition-test" get redefinition-test? ] unit-test
+{ t } [ "redefinition-test" get redefinition-test? ] unit-test
"IN: classes.tuple.tests TUPLE: redefinition-test ;" eval( -- )
-[ t ] [ "redefinition-test" get redefinition-test? ] unit-test
+{ t } [ "redefinition-test" get redefinition-test? ] unit-test
! Make sure we handle changing shapes!
TUPLE: point x y ;
-[ ] [ 100 200 point boa "p" set ] unit-test
+{ } [ 100 200 point boa "p" set ] unit-test
! Use eval to sequence parsing explicitly
-[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval( -- ) ] unit-test
-[ 100 ] [ "p" get x>> ] unit-test
-[ 200 ] [ "p" get y>> ] unit-test
-[ f ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
+{ 100 } [ "p" get x>> ] unit-test
+{ 200 } [ "p" get y>> ] unit-test
+{ f } [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
-[ ] [ "p" get 300 ">>z" "accessors" lookup-word execute drop ] unit-test
+{ } [ "p" get 300 ">>z" "accessors" lookup-word execute drop ] unit-test
-[ 3 ] [ "p" get tuple-size ] unit-test
+{ 3 } [ "p" get tuple-size ] unit-test
-[ 300 ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
+{ 300 } [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: point z y ;" eval( -- ) ] unit-test
-[ 2 ] [ "p" get tuple-size ] unit-test
+{ 2 } [ "p" get tuple-size ] unit-test
[ "p" get x>> ] must-fail
-[ 200 ] [ "p" get y>> ] unit-test
-[ 300 ] [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
+{ 200 } [ "p" get y>> ] unit-test
+{ 300 } [ "p" get "z>>" "accessors" lookup-word execute ] unit-test
TUPLE: slotty a b c ;
-[ T{ slotty } ] [ H{ } slotty from-slots ] unit-test
-[ T{ slotty f 1 2 f } ] [ H{ { "a" 1 } { "b" 2 } } slotty from-slots ] unit-test
+{ T{ slotty } } [ H{ } slotty from-slots ] unit-test
+{ T{ slotty f 1 2 f } } [ H{ { "a" 1 } { "b" 2 } } slotty from-slots ] unit-test
[ H{ { "d" 0 } } slotty new set-slots ] must-fail
TUPLE: predicate-test ;
: predicate-test ( a -- ? ) drop f ;
-
[ t ] [ <predicate-test> predicate-test? ] unit-test
+
{ t } [ <predicate-test> predicate-test? ] unit-test
PREDICATE: silly-pred < tuple
class-of \ rect = ;
TUPLE: circle radius ;
M: circle area radius>> sq pi * ;
-[ 200 ] [ T{ rect f 0 0 10 20 } area ] unit-test
+{ 200 } [ T{ rect f 0 0 10 20 } area ] unit-test
! Hashcode breakage
TUPLE: empty ;
C: <empty> empty
-[ t ] [ <empty> hashcode fixnum? ] unit-test
+{ t } [ <empty> hashcode fixnum? ] unit-test
! Compiler regression
[ t length ] [ object>> t eq? ] must-fail-with
-[ "<constructor-test>" ]
+{ "<constructor-test>" }
[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval( -- ) last-word name>> ] unit-test
TUPLE: size-test a b c d ;
-[ t ] [
+{ t } [
T{ size-test } tuple-size
size-test tuple-layout second =
] unit-test
TUPLE: yo-momma ;
-[ ] [ "IN: classes.tuple.tests C: <yo-momma> yo-momma" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests C: <yo-momma> yo-momma" eval( -- ) ] unit-test
-[ f ] [ \ <yo-momma> generic? ] unit-test
+{ f } [ \ <yo-momma> generic? ] unit-test
! Test forget
[
TUPLE: loc-recording ;
-[ f ] [ \ loc-recording where not ] unit-test
+{ f } [ \ loc-recording where not ] unit-test
! 'forget' wasn't robust enough
C: <t4> t4
-[ 1 ] [ 1 <t4> m1 ] unit-test
-[ 1 ] [ <t4> 1 m2 ] unit-test
+{ 1 } [ 1 <t4> m1 ] unit-test
+{ 1 } [ <t4> 1 m2 ] unit-test
! another combination issue
GENERIC: silly ( obj -- obj obj )
M: vector silly "z" ;
-[ "zz" ] [ 123 <reversed> silly nip ] unit-test
+{ "zz" } [ 123 <reversed> silly nip ] unit-test
! Typo
SYMBOL: not-a-tuple-class
TUPLE: computer cpu ram ;
C: <computer> computer
-[ "TUPLE: computer cpu ram ;" ] [
+{ "TUPLE: computer cpu ram ;" } [
[ \ computer see ] with-string-writer string-lines second
] unit-test
TUPLE: laptop < computer battery ;
C: <laptop> laptop
-[ t ] [ laptop tuple-class? ] unit-test
-[ t ] [ laptop tuple class<= ] unit-test
-[ t ] [ laptop computer class<= ] unit-test
-[ t ] [ laptop computer classes-intersect? ] unit-test
+{ t } [ laptop tuple-class? ] unit-test
+{ t } [ laptop tuple class<= ] unit-test
+{ t } [ laptop computer class<= ] unit-test
+{ t } [ laptop computer classes-intersect? ] unit-test
-[ ] [ "Pentium" 128 3 hours <laptop> "laptop" set ] unit-test
-[ t ] [ "laptop" get laptop? ] unit-test
-[ t ] [ "laptop" get computer? ] unit-test
-[ t ] [ "laptop" get tuple? ] unit-test
+{ } [ "Pentium" 128 3 hours <laptop> "laptop" set ] unit-test
+{ t } [ "laptop" get laptop? ] unit-test
+{ t } [ "laptop" get computer? ] unit-test
+{ t } [ "laptop" get tuple? ] unit-test
: test-laptop-slot-values ( -- )
[ laptop ] [ "laptop" get class-of ] unit-test
test-laptop-slot-values
-[ "TUPLE: laptop < computer battery ;" ] [
+{ "TUPLE: laptop < computer battery ;" } [
[ \ laptop see ] with-string-writer string-lines second
] unit-test
-[ { tuple computer laptop } ] [ laptop superclasses ] unit-test
+{ { tuple computer laptop } } [ laptop superclasses ] unit-test
TUPLE: server < computer rackmount ;
C: <server> server
-[ t ] [ server tuple-class? ] unit-test
-[ t ] [ server tuple class<= ] unit-test
-[ t ] [ server computer class<= ] unit-test
-[ t ] [ server computer classes-intersect? ] unit-test
+{ t } [ server tuple-class? ] unit-test
+{ t } [ server tuple class<= ] unit-test
+{ t } [ server computer class<= ] unit-test
+{ t } [ server computer classes-intersect? ] unit-test
-[ ] [ "PowerPC" 64 "1U" <server> "server" set ] unit-test
-[ t ] [ "server" get server? ] unit-test
-[ t ] [ "server" get computer? ] unit-test
-[ t ] [ "server" get tuple? ] unit-test
+{ } [ "PowerPC" 64 "1U" <server> "server" set ] unit-test
+{ t } [ "server" get server? ] unit-test
+{ t } [ "server" get computer? ] unit-test
+{ t } [ "server" get tuple? ] unit-test
: test-server-slot-values ( -- )
[ server ] [ "server" get class-of ] unit-test
test-server-slot-values
-[ f ] [ "server" get laptop? ] unit-test
-[ f ] [ "laptop" get server? ] unit-test
+{ f } [ "server" get laptop? ] unit-test
+{ f } [ "laptop" get server? ] unit-test
-[ f ] [ server laptop class<= ] unit-test
-[ f ] [ laptop server class<= ] unit-test
-[ f ] [ laptop server classes-intersect? ] unit-test
+{ f } [ server laptop class<= ] unit-test
+{ f } [ laptop server class<= ] unit-test
+{ f } [ laptop server classes-intersect? ] unit-test
-[ f ] [ 1 2 <computer> laptop? ] unit-test
-[ f ] [ \ + server? ] unit-test
+{ f } [ 1 2 <computer> laptop? ] unit-test
+{ f } [ \ + server? ] unit-test
-[ "TUPLE: server < computer rackmount ;" ] [
+{ "TUPLE: server < computer rackmount ;" } [
[ \ server see ] with-string-writer string-lines second
] unit-test
: computer?' ( a -- b ) computer? ;
-[ t ] [ laptop new computer?' ] unit-test
+{ t } [ laptop new computer?' ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
-[ t ] [ laptop new computer?' ] unit-test
+{ t } [ laptop new computer?' ] unit-test
-[ f ] [ electronic-device laptop class<= ] unit-test
-[ t ] [ server electronic-device class<= ] unit-test
-[ t ] [ laptop server class-or electronic-device class<= ] unit-test
+{ f } [ electronic-device laptop class<= ] unit-test
+{ t } [ server electronic-device class<= ] unit-test
+{ t } [ laptop server class-or electronic-device class<= ] unit-test
-[ t ] [ "laptop" get electronic-device? ] unit-test
-[ t ] [ "laptop" get computer? ] unit-test
-[ t ] [ "laptop" get laptop? ] unit-test
-[ f ] [ "laptop" get server? ] unit-test
+{ t } [ "laptop" get electronic-device? ] unit-test
+{ t } [ "laptop" get computer? ] unit-test
+{ t } [ "laptop" get laptop? ] unit-test
+{ f } [ "laptop" get server? ] unit-test
-[ t ] [ "server" get electronic-device? ] unit-test
-[ t ] [ "server" get computer? ] unit-test
-[ f ] [ "server" get laptop? ] unit-test
-[ t ] [ "server" get server? ] unit-test
+{ t } [ "server" get electronic-device? ] unit-test
+{ t } [ "server" get computer? ] unit-test
+{ f } [ "server" get laptop? ] unit-test
+{ t } [ "server" get server? ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: computer cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
-[ f ] [ "laptop" get electronic-device? ] unit-test
-[ t ] [ "laptop" get computer? ] unit-test
+{ f } [ "laptop" get electronic-device? ] unit-test
+{ t } [ "laptop" get computer? ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
TUPLE: make-me-some-accessors voltage grounded? ;
-[ f ] [ "laptop" get voltage>> ] unit-test
-[ f ] [ "server" get voltage>> ] unit-test
+{ f } [ "laptop" get voltage>> ] unit-test
+{ f } [ "server" get voltage>> ] unit-test
-[ ] [ "laptop" get 220 >>voltage drop ] unit-test
-[ ] [ "server" get 110 >>voltage drop ] unit-test
+{ } [ "laptop" get 220 >>voltage drop ] unit-test
+{ } [ "server" get 110 >>voltage drop ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ; C: <computer> computer" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ; C: <computer> computer" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
-[ 220 ] [ "laptop" get voltage>> ] unit-test
-[ 110 ] [ "server" get voltage>> ] unit-test
+{ 220 } [ "laptop" get voltage>> ] unit-test
+{ 110 } [ "server" get voltage>> ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
-[ 220 ] [ "laptop" get voltage>> ] unit-test
-[ 110 ] [ "server" get voltage>> ] unit-test
+{ 220 } [ "laptop" get voltage>> ] unit-test
+{ 110 } [ "server" get voltage>> ] unit-test
! Reshaping superclass and subclass simultaneously
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ; C: <computer> computer C: <laptop> laptop C: <server> server" eval( -- ) ] unit-test
test-laptop-slot-values
test-server-slot-values
-[ 220 ] [ "laptop" get voltage>> ] unit-test
-[ 110 ] [ "server" get voltage>> ] unit-test
+{ 220 } [ "laptop" get voltage>> ] unit-test
+{ 110 } [ "server" get voltage>> ] unit-test
! Reshape crash
TUPLE: test1 a ; TUPLE: test2 < test1 b ;
test-a/b
-[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval( -- ) ] unit-test
test-a/b
-[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval( -- ) ] unit-test
test-a/b
test-move-up
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval( -- ) ] unit-test
test-move-up
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval( -- ) ] unit-test
test-move-up
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval( -- ) ] unit-test
test-move-up
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval( -- ) ] unit-test
! Constructors must be recompiled when changing superclass
TUPLE: constructor-update-1 xxx ;
{ 3 1 } [ <constructor-update-2> ] must-infer-as
-[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval( -- ) ] unit-test
{ 3 1 } [ <constructor-update-2> ] must-infer-as
[ 1 2 3 4 5 <constructor-update-2> ] [ not-compiled? ] must-fail-with
-[ ] [ [ \ <constructor-update-2> forget ] with-compilation-unit ] unit-test
+{ } [ [ \ <constructor-update-2> forget ] with-compilation-unit ] unit-test
! Redefinition problem
TUPLE: redefinition-problem ;
UNION: redefinition-problem' redefinition-problem integer ;
-[ t ] [ 3 redefinition-problem'? ] unit-test
+{ t } [ 3 redefinition-problem'? ] unit-test
TUPLE: redefinition-problem-2 ;
"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval( -- )
-[ t ] [ 3 redefinition-problem'? ] unit-test
+{ t } [ 3 redefinition-problem'? ] unit-test
! Hardcore unit tests
\ thread "slots" word-prop "slots" set
-[ ] [
+{ } [
[
\ thread tuple { "xxx" } "slots" get append
define-tuple-class
\ vocab "slots" word-prop "slots" set
-[ ] [
+{ } [
[
\ vocab identity-tuple { "xxx" } "slots" get append
define-tuple-class
must-fail-with
! Accessors not being forgotten...
-[ [ ] ] [
+{ [ ] } [
"IN: classes.tuple.tests TUPLE: forget-accessors-test x y z ;"
<string-reader>
"forget-accessors-test" parse-stream
] unit-test
-[ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
+{ t } [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
: accessor-exists? ( name -- ? )
[ "forget-accessors-test" "classes.tuple.tests" lookup-word ] dip
">>" append "accessors" lookup-word ?lookup-method >boolean ;
-[ t ] [ "x" accessor-exists? ] unit-test
-[ t ] [ "y" accessor-exists? ] unit-test
-[ t ] [ "z" accessor-exists? ] unit-test
+{ t } [ "x" accessor-exists? ] unit-test
+{ t } [ "y" accessor-exists? ] unit-test
+{ t } [ "z" accessor-exists? ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b )"
<string-reader>
"forget-accessors-test" parse-stream
] unit-test
-[ f ] [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
+{ f } [ "forget-accessors-test" "classes.tuple.tests" lookup-word class? ] unit-test
-[ f ] [ "x" accessor-exists? ] unit-test
-[ f ] [ "y" accessor-exists? ] unit-test
-[ f ] [ "z" accessor-exists? ] unit-test
+{ f } [ "x" accessor-exists? ] unit-test
+{ f } [ "y" accessor-exists? ] unit-test
+{ f } [ "z" accessor-exists? ] unit-test
TUPLE: another-forget-accessors-test ;
-[ [ ] ] [
+{ [ ] } [
"IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b )"
<string-reader>
"another-forget-accessors-test" parse-stream
] unit-test
-[ t ] [ \ another-forget-accessors-test class? ] unit-test
+{ t } [ \ another-forget-accessors-test class? ] unit-test
! Shadowing test
-[ f ] [
+{ f } [
f parser-quiet? [
[
"IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval( -- )
! Check type declarations
TUPLE: declared-types { n fixnum } { m string } ;
-[ T{ declared-types f 0 "hi" } ]
+{ T{ declared-types f 0 "hi" } }
[ { declared-types 0 "hi" } >tuple ]
unit-test
[ declared-types new 0.0 >>n n>> ] [ T{ no-method f 0.0 integer>fixnum-strict } = ] must-fail-with
-[ T{ declared-types f 33333 "asdf" } ]
+{ T{ declared-types f 33333 "asdf" } }
[ 33333 >bignum "asdf" declared-types boa ] unit-test
[ 444444444444444444444444444444444444444444444444433333 >bignum "asdf" declared-types boa ]
! Check bignum coercer
TUPLE: bignum-coercer { n bignum initial: $[ 0 >bignum ] } ;
-[ 13 bignum ] [ 13.5 bignum-coercer boa n>> dup class-of ] unit-test
+{ 13 bignum } [ 13.5 bignum-coercer boa n>> dup class-of ] unit-test
-[ 13 bignum ] [ bignum-coercer new 13.5 >>n n>> dup class-of ] unit-test
+{ 13 bignum } [ bignum-coercer new 13.5 >>n n>> dup class-of ] unit-test
! Check float coercer
TUPLE: float-coercer { n float } ;
-[ 13.0 float ] [ 13 float-coercer boa n>> dup class-of ] unit-test
+{ 13.0 float } [ 13 float-coercer boa n>> dup class-of ] unit-test
-[ 13.0 float ] [ float-coercer new 13 >>n n>> dup class-of ] unit-test
+{ 13.0 float } [ float-coercer new 13 >>n n>> dup class-of ] unit-test
! Check integer coercer
TUPLE: integer-coercer { n integer } ;
[ T{ bad-slot-value f { } string } = ]
must-fail-with
-[ T{ declared-types f 0 "" } ] [ declared-types new ] unit-test
+{ T{ declared-types f 0 "" } } [ declared-types new ] unit-test
: blah ( -- vec ) vector new ;
[ vector new ] must-infer
-[ V{ } ] [ blah ] unit-test
+{ V{ } } [ blah ] unit-test
! Test reshaping with type declarations and slot attributes
TUPLE: reshape-test x ;
T{ reshape-test f "hi" } "tuple" set
-[ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval( -- ) ] unit-test
-[ f ] [ \ reshape-test \ x<< ?lookup-method ] unit-test
+{ f } [ \ reshape-test \ x<< ?lookup-method ] unit-test
[ "tuple" get 5 >>x ] must-fail
-[ "hi" ] [ "tuple" get x>> ] unit-test
+{ "hi" } [ "tuple" get x>> ] unit-test
-[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval( -- ) ] unit-test
-[ 0 ] [ "tuple" get x>> ] unit-test
+{ 0 } [ "tuple" get x>> ] unit-test
-[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval( -- ) ] unit-test
-[ 0 ] [ "tuple" get x>> ] unit-test
+{ 0 } [ "tuple" get x>> ] unit-test
TUPLE: boa-coercer-test { x array-capacity } ;
-[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class-of ] unit-test
+{ fixnum } [ 0 >bignum boa-coercer-test boa x>> class-of ] unit-test
-[ T{ boa-coercer-test f 0 } ] [ T{ boa-coercer-test } ] unit-test
+{ T{ boa-coercer-test f 0 } } [ T{ boa-coercer-test } ] unit-test
! Test error classes
ERROR: error-class-test a b c ;
-[ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test
-[ f ] [ \ error-class-test "inline" word-prop ] unit-test
+{ "( a b c -- * )" } [ \ error-class-test stack-effect effect>string ] unit-test
+{ f } [ \ error-class-test "inline" word-prop ] unit-test
[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ]
[ error>> error>> redefine-error? ] must-fail-with
DEFER: error-y
-[ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
+{ } [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
-[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval( -- ) ] unit-test
-[ f ] [ \ error-y tuple-class? ] unit-test
+{ f } [ \ error-y tuple-class? ] unit-test
-[ f ] [ \ error-y error-class? ] unit-test
+{ f } [ \ error-y error-class? ] unit-test
-[ t ] [ \ error-y generic? ] unit-test
+{ t } [ \ error-y generic? ] unit-test
-[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests ERROR: error-y ;" eval( -- ) ] unit-test
-[ t ] [ \ error-y tuple-class? ] unit-test
+{ t } [ \ error-y tuple-class? ] unit-test
-[ t ] [ \ error-y error-class? ] unit-test
+{ t } [ \ error-y error-class? ] unit-test
-[ f ] [ \ error-y generic? ] unit-test
+{ f } [ \ error-y generic? ] unit-test
-[ ] [
+{ } [
"IN: classes.tuple.tests TUPLE: forget-subclass-test ; TUPLE: forget-subclass-test' < forget-subclass-test ;"
<string-reader> "forget-subclass-test" parse-stream
drop
] unit-test
-[ ] [ "forget-subclass-test'" "classes.tuple.tests" lookup-word new "bad-object" set ] unit-test
+{ } [ "forget-subclass-test'" "classes.tuple.tests" lookup-word new "bad-object" set ] unit-test
-[ ] [
+{ } [
"IN: classes.tuple.tests TUPLE: forget-subclass-test a ;"
<string-reader> "forget-subclass-test" parse-stream
drop
] unit-test
-[ ] [
+{ } [
"IN: sequences TUPLE: reversed { seq read-only } ;" eval( -- )
] unit-test
M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ;
-[ ] [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test
+{ } [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test
DEFER: change-slot-test
SLOT: kex
-[ ] [
+{ } [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
-[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
+{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
-[ ] [
+{ } [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test kex ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
-[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
+{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
-[ ] [
+{ } [
"IN: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
<string-reader> "change-slot-test" parse-stream
drop
] unit-test
-[ t ] [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
-[ f ] [ \ change-slot-test \ kex>> ?lookup-method "reading" word-prop ] unit-test
+{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
+{ f } [ \ change-slot-test \ kex>> ?lookup-method "reading" word-prop ] unit-test
DEFER: redefine-tuple-twice
-[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
-[ t ] [ \ redefine-tuple-twice symbol? ] unit-test
+{ t } [ \ redefine-tuple-twice symbol? ] unit-test
-[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval( -- ) ] unit-test
-[ t ] [ \ redefine-tuple-twice deferred? ] unit-test
+{ t } [ \ redefine-tuple-twice deferred? ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
-[ t ] [ \ redefine-tuple-twice symbol? ] unit-test
+{ t } [ \ redefine-tuple-twice symbol? ] unit-test
ERROR: base-error x y ;
ERROR: derived-error < base-error z ;
-[ ( x y z -- * ) ] [ \ derived-error stack-effect ] unit-test
+{ ( x y z -- * ) } [ \ derived-error stack-effect ] unit-test
! Make sure that tuple reshaping updates code heap roots
TUPLE: code-heap-ref ;
: code-heap-ref' ( -- a ) T{ code-heap-ref } ;
! Push foo's literal to tenured space
-[ ] [ gc ] unit-test
+{ } [ gc ] unit-test
! Reshape!
-[ ] [ "IN: classes.tuple.tests USE: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests USE: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
! Code heap reference
-[ t ] [ code-heap-ref' code-heap-ref? ] unit-test
-[ 5 ] [ code-heap-ref' x>> ] unit-test
+{ t } [ code-heap-ref' code-heap-ref? ] unit-test
+{ 5 } [ code-heap-ref' x>> ] unit-test
! Data heap reference
-[ t ] [ \ code-heap-ref' def>> first code-heap-ref? ] unit-test
-[ 5 ] [ \ code-heap-ref' def>> first x>> ] unit-test
+{ t } [ \ code-heap-ref' def>> first code-heap-ref? ] unit-test
+{ 5 } [ \ code-heap-ref' def>> first x>> ] unit-test
! If the metaclass of a superclass changes into something other
! than a tuple class, the tuple needs to have its superclass reset
TUPLE: metaclass-change ;
TUPLE: metaclass-change-subclass < metaclass-change ;
-[ metaclass-change ] [ metaclass-change-subclass superclass ] unit-test
+{ metaclass-change } [ metaclass-change-subclass superclass ] unit-test
-[ ] [ "IN: classes.tuple.tests MIXIN: metaclass-change" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests MIXIN: metaclass-change" eval( -- ) ] unit-test
-[ t ] [ metaclass-change-subclass tuple-class? ] unit-test
-[ tuple ] [ metaclass-change-subclass superclass ] unit-test
+{ t } [ metaclass-change-subclass tuple-class? ] unit-test
+{ tuple } [ metaclass-change-subclass superclass ] unit-test
! Reshaping bug related to the above
TUPLE: a-g ;
TUPLE: g < a-g ;
-[ ] [ g new "g" set ] unit-test
+{ } [ g new "g" set ] unit-test
-[ ] [ "IN: classes.tuple.tests MIXIN: a-g TUPLE: g ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests MIXIN: a-g TUPLE: g ;" eval( -- ) ] unit-test
-[ t ] [ g new layout-of "g" get layout-of eq? ] unit-test
+{ t } [ g new layout-of "g" get layout-of eq? ] unit-test
! Joe Groff discovered this bug
DEFER: factor-crashes-anymore
-[ ] [
+{ } [
"IN: classes.tuple.tests
TUPLE: unsafe-slot-access ;
CONSTANT: unsafe-slot-access' T{ unsafe-slot-access }" eval( -- )
] unit-test
-[ ] [
+{ } [
"IN: classes.tuple.tests
USE: accessors
TUPLE: unsafe-slot-access { x read-only initial: 31337 } ;
: factor-crashes-anymore ( -- x ) unsafe-slot-access' x>> ;" eval( -- )
] unit-test
-[ 31337 ] [ factor-crashes-anymore ] unit-test
+{ 31337 } [ factor-crashes-anymore ] unit-test
TUPLE: tuple-predicate-redefine-test ;
-[ ] [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: tuple-predicate-redefine-test ;" eval( -- ) ] unit-test
-[ t ] [ \ tuple-predicate-redefine-test? predicate? ] unit-test
+{ t } [ \ tuple-predicate-redefine-test? predicate? ] unit-test
! Final classes
TUPLE: final-superclass ;
TUPLE: final-subclass < final-superclass ;
-[ final-superclass ] [ final-subclass superclass ] unit-test
+{ final-superclass } [ final-subclass superclass ] unit-test
! Making the superclass final should change the superclass of the subclass
-[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass ; final" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: final-superclass ; final" eval( -- ) ] unit-test
-[ tuple ] [ final-subclass superclass ] unit-test
+{ tuple } [ final-subclass superclass ] unit-test
-[ f ] [ \ final-subclass final-class? ] unit-test
+{ f } [ \ final-subclass final-class? ] unit-test
! Subclassing a final class should fail
[ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ;" eval( -- ) ]
[ error>> bad-superclass? ] must-fail-with
! Making a final class non-final should work
-[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: final-superclass ;" eval( -- ) ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ; final" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: final-subclass < final-superclass ; final" eval( -- ) ] unit-test
! Changing a superclass should not change the final status of a subclass
-[ ] [ "IN: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
-[ t ] [ \ final-subclass final-class? ] unit-test
+{ t } [ \ final-subclass final-class? ] unit-test
! Test reset-class on tuples
! Should forget all accessors on rclasstest
TUPLE: rclasstest a b ;
-[ ] [ [ \ rclasstest reset-class ] with-compilation-unit ] unit-test
-[ f ] [ \ rclasstest \ a>> ?lookup-method ] unit-test
-[ f ] [ \ rclasstest \ a<< ?lookup-method ] unit-test
-[ f ] [ \ rclasstest \ b>> ?lookup-method ] unit-test
-[ f ] [ \ rclasstest \ b<< ?lookup-method ] unit-test
+{ } [ [ \ rclasstest reset-class ] with-compilation-unit ] unit-test
+{ f } [ \ rclasstest \ a>> ?lookup-method ] unit-test
+{ f } [ \ rclasstest \ a<< ?lookup-method ] unit-test
+{ f } [ \ rclasstest \ b>> ?lookup-method ] unit-test
+{ f } [ \ rclasstest \ b<< ?lookup-method ] unit-test
<< \ rclasstest forget >>
DEFER: initial-slot
-[ ] [ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class } ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class } ;" eval( -- ) ] unit-test
-[ t ] [ initial-slot new x>> initial-class? ] unit-test
+{ t } [ initial-slot new x>> initial-class? ] unit-test
[ "IN: classes.tuple.tests TUPLE: initial-slot { x initial-class initial: f } ;" eval( -- ) ]
[ error>> T{ bad-initial-value f "x" f initial-class } = ] must-fail-with
! DEFER: bah
! FORGET: bah
UNION: bah fixnum alien ;
-[ bah ] [ \ bah? "predicating" word-prop ] unit-test
+{ bah } [ \ bah? "predicating" word-prop ] unit-test
-[ "USING: alien math ;\nIN: classes.union.tests\nUNION: bah fixnum alien ;\n" ]
+{ "USING: alien math ;\nIN: classes.union.tests\nUNION: bah fixnum alien ;\n" }
[ [ \ bah see ] with-string-writer ] unit-test
! Test redefinition of classes
M: union-1 generic-update-test drop "union-1" ;
-[ f ] [ bignum union-1 class<= ] unit-test
-[ t ] [ union-1 number class<= ] unit-test
-[ "union-1" ] [ 1.0 generic-update-test ] unit-test
+{ f } [ bignum union-1 class<= ] unit-test
+{ t } [ union-1 number class<= ] unit-test
+{ "union-1" } [ 1.0 generic-update-test ] unit-test
"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" eval( -- )
-[ t ] [ bignum union-1 class<= ] unit-test
-[ f ] [ union-1 number class<= ] unit-test
-[ "union-1" ] [ { 1.0 } generic-update-test ] unit-test
+{ t } [ bignum union-1 class<= ] unit-test
+{ f } [ union-1 number class<= ] unit-test
+{ "union-1" } [ { 1.0 } generic-update-test ] unit-test
"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" eval( -- )
-[ f ] [ union-1 union-class? ] unit-test
-[ t ] [ union-1 predicate-class? ] unit-test
-[ "union-1" ] [ 8 generic-update-test ] unit-test
+{ f } [ union-1 union-class? ] unit-test
+{ t } [ union-1 predicate-class? ] unit-test
+{ "union-1" } [ 8 generic-update-test ] unit-test
[ -7 generic-update-test ] must-fail
! Empty unions were causing problems
M: empty-union-2 empty-union-test ;
-[ [ drop f ] ] [ \ empty-union-1? def>> ] unit-test
+{ [ drop f ] } [ \ empty-union-1? def>> ] unit-test
! Redefining a class didn't update containing unions
UNION: redefine-bug-1 fixnum ;
UNION: redefine-bug-2 redefine-bug-1 quotation ;
-[ t ] [ fixnum redefine-bug-2 class<= ] unit-test
-[ t ] [ quotation redefine-bug-2 class<= ] unit-test
+{ t } [ fixnum redefine-bug-2 class<= ] unit-test
+{ t } [ quotation redefine-bug-2 class<= ] unit-test
-[ ] [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" eval( -- ) ] unit-test
-[ t ] [ bignum redefine-bug-1 class<= ] unit-test
-[ f ] [ fixnum redefine-bug-2 class<= ] unit-test
-[ t ] [ bignum redefine-bug-2 class<= ] unit-test
+{ t } [ bignum redefine-bug-1 class<= ] unit-test
+{ f } [ fixnum redefine-bug-2 class<= ] unit-test
+{ t } [ bignum redefine-bug-2 class<= ] unit-test
! Too eager with reset-class
-[ ] [ "IN: classes.union.tests SINGLETON: foo UNION: blah foo ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
+{ } [ "IN: classes.union.tests SINGLETON: foo UNION: blah foo ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
-[ t ] [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
+{ t } [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
-[ t ] [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
+{ t } [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
-[ ] [ "IN: classes.union.tests USE: math UNION: blah integer ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
+{ } [ "IN: classes.union.tests USE: math UNION: blah integer ;" <string-reader> "union-reset-test" parse-stream drop ] unit-test
-[ t ] [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
+{ t } [ "blah" "classes.union.tests" lookup-word union-class? ] unit-test
-[ f ] [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
+{ f } [ "foo?" "classes.union.tests" lookup-word predicate? ] unit-test
GENERIC: test-generic ( x -- y )
M: a-union test-generic ;
-[ f ] [ \ test-generic "methods" word-prop assoc-empty? ] unit-test
+{ f } [ \ test-generic "methods" word-prop assoc-empty? ] unit-test
-[ ] [ [ \ a-tuple forget-class ] with-compilation-unit ] unit-test
+{ } [ [ \ a-tuple forget-class ] with-compilation-unit ] unit-test
-[ t ] [ \ test-generic "methods" word-prop assoc-empty? ] unit-test
+{ t } [ \ test-generic "methods" word-prop assoc-empty? ] unit-test
! Fast union predicates
-[ t ] [ integer union-of-builtins? ] unit-test
+{ t } [ integer union-of-builtins? ] unit-test
-[ t ] [ \ integer? def>> \ fixnum-bitand swap member? ] unit-test
+{ t } [ \ integer? def>> \ fixnum-bitand swap member? ] unit-test
-[ ] [ "IN: classes.union.tests USE: math UNION: fast-union-1 fixnum ; UNION: fast-union-2 fast-union-1 bignum ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.union.tests USE: math UNION: fast-union-1 fixnum ; UNION: fast-union-2 fast-union-1 bignum ;" eval( -- ) ] unit-test
-[ t ] [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
+{ t } [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
-[ ] [ "IN: classes.union.tests USE: vectors UNION: fast-union-1 vector ;" eval( -- ) ] unit-test
+{ } [ "IN: classes.union.tests USE: vectors UNION: fast-union-1 vector ;" eval( -- ) ] unit-test
-[ f ] [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
+{ f } [ "fast-union-2?" "classes.union.tests" lookup-word def>> \ fixnum-bitand swap member? ] unit-test
! Test union{
TUPLE: stuff { a union{ integer string } } ;
-[ 0 ] [ stuff new a>> ] unit-test
-[ 3 ] [ stuff new 3 >>a a>> ] unit-test
-[ "asdf" ] [ stuff new "asdf" >>a a>> ] unit-test
+{ 0 } [ stuff new a>> ] unit-test
+{ 3 } [ stuff new 3 >>a a>> ] unit-test
+{ "asdf" } [ stuff new "asdf" >>a a>> ] unit-test
[ stuff new 3.4 >>a a>> ] [ bad-slot-value? ] must-fail-with
TUPLE: things { a union{ integer float } } ;
-[ 0 ] [ stuff new a>> ] unit-test
-[ 3 ] [ stuff new 3 >>a a>> ] unit-test
-[ "asdf" ] [ stuff new "asdf" >>a a>> ] unit-test
+{ 0 } [ stuff new a>> ] unit-test
+{ 3 } [ stuff new 3 >>a a>> ] unit-test
+{ "asdf" } [ stuff new "asdf" >>a a>> ] unit-test
[ stuff new 3.4 >>a a>> ] [ bad-slot-value? ] must-fail-with
PREDICATE: numba-ova-10 < union{ float integer }
10 > ;
-[ f ] [ 100/3 numba-ova-10? ] unit-test
-[ t ] [ 100 numba-ova-10? ] unit-test
-[ t ] [ 100.0 numba-ova-10? ] unit-test
-[ f ] [ 5 numba-ova-10? ] unit-test
-[ f ] [ 5.75 numba-ova-10? ] unit-test
+{ f } [ 100/3 numba-ova-10? ] unit-test
+{ t } [ 100 numba-ova-10? ] unit-test
+{ t } [ 100.0 numba-ova-10? ] unit-test
+{ f } [ 5 numba-ova-10? ] unit-test
+{ f } [ 5.75 numba-ova-10? ] unit-test
! Issue #420 lol
[ "IN: issue-420 UNION: omg omg ;" eval( -- ) ]
math.functions arrays combinators.private stack-checker ;
IN: combinators.tests
-[ 3 ] [ 1 2 [ + ] call( x y -- z ) ] unit-test
+{ 3 } [ 1 2 [ + ] call( x y -- z ) ] unit-test
[ 1 2 [ + ] call( -- z ) ] must-fail
[ 1 2 [ + ] call( x y -- z a ) ] must-fail
-[ 1 2 3 { 1 2 3 4 } ] [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
+{ 1 2 3 { 1 2 3 4 } } [ 1 2 3 4 [ datastack nip ] call( x -- y ) ] unit-test
[ [ + ] call( x y -- z ) ] must-infer
-[ 3 ] [ 1 2 \ + execute( x y -- z ) ] unit-test
+{ 3 } [ 1 2 \ + execute( x y -- z ) ] unit-test
[ 1 2 \ + execute( -- z ) ] must-fail
[ 1 2 \ + execute( x y -- z a ) ] must-fail
[ \ + execute( x y -- z ) ] must-infer
: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
-[ t ] [ \ compile-execute(-test-1 optimized? ] unit-test
-[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
+{ t } [ \ compile-execute(-test-1 optimized? ] unit-test
+{ 4 } [ 1 3 compile-execute(-test-1 ] unit-test
: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
-[ t ] [ \ compile-execute(-test-2 optimized? ] unit-test
-[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
-[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
-[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
+{ t } [ \ compile-execute(-test-2 optimized? ] unit-test
+{ 4 } [ 1 3 \ + compile-execute(-test-2 ] unit-test
+{ 5 } [ 1 4 \ + compile-execute(-test-2 ] unit-test
+{ -3 } [ 1 4 \ - compile-execute(-test-2 ] unit-test
+{ 5 } [ 1 4 \ + compile-execute(-test-2 ] unit-test
: compile-call(-test-1 ( a b q -- c ) call( a b -- c ) ;
-[ t ] [ \ compile-call(-test-1 optimized? ] unit-test
-[ 4 ] [ 1 3 [ + ] compile-call(-test-1 ] unit-test
-[ 7 ] [ 1 3 2 [ * + ] curry compile-call(-test-1 ] unit-test
-[ 7 ] [ 1 3 [ 2 * ] [ + ] compose compile-call(-test-1 ] unit-test
-[ 4 ] [ 1 3 [ { + } [ ] like call ] compile-call(-test-1 ] unit-test
+{ t } [ \ compile-call(-test-1 optimized? ] unit-test
+{ 4 } [ 1 3 [ + ] compile-call(-test-1 ] unit-test
+{ 7 } [ 1 3 2 [ * + ] curry compile-call(-test-1 ] unit-test
+{ 7 } [ 1 3 [ 2 * ] [ + ] compose compile-call(-test-1 ] unit-test
+{ 4 } [ 1 3 [ { + } [ ] like call ] compile-call(-test-1 ] unit-test
[ [ ] call( -- * ) ] must-fail
\ cond-test-1 def>> must-infer
-[ "even" ] [ 2 cond-test-1 ] unit-test
-[ "even" ] [ 2 \ cond-test-1 def>> call ] unit-test
-[ "odd" ] [ 3 cond-test-1 ] unit-test
-[ "odd" ] [ 3 \ cond-test-1 def>> call ] unit-test
+{ "even" } [ 2 cond-test-1 ] unit-test
+{ "even" } [ 2 \ cond-test-1 def>> call ] unit-test
+{ "odd" } [ 3 cond-test-1 ] unit-test
+{ "odd" } [ 3 \ cond-test-1 def>> call ] unit-test
: cond-test-2 ( obj -- str )
{
\ cond-test-2 def>> must-infer
-[ "true" ] [ t cond-test-2 ] unit-test
-[ "true" ] [ t \ cond-test-2 def>> call ] unit-test
-[ "false" ] [ f cond-test-2 ] unit-test
-[ "false" ] [ f \ cond-test-2 def>> call ] unit-test
-[ "something else" ] [ "ohio" cond-test-2 ] unit-test
-[ "something else" ] [ "ohio" \ cond-test-2 def>> call ] unit-test
+{ "true" } [ t cond-test-2 ] unit-test
+{ "true" } [ t \ cond-test-2 def>> call ] unit-test
+{ "false" } [ f cond-test-2 ] unit-test
+{ "false" } [ f \ cond-test-2 def>> call ] unit-test
+{ "something else" } [ "ohio" cond-test-2 ] unit-test
+{ "something else" } [ "ohio" \ cond-test-2 def>> call ] unit-test
: cond-test-3 ( obj -- str )
{
\ cond-test-3 def>> must-infer
-[ "something else" ] [ t cond-test-3 ] unit-test
-[ "something else" ] [ t \ cond-test-3 def>> call ] unit-test
-[ "something else" ] [ f cond-test-3 ] unit-test
-[ "something else" ] [ f \ cond-test-3 def>> call ] unit-test
-[ "something else" ] [ "ohio" cond-test-3 ] unit-test
-[ "something else" ] [ "ohio" \ cond-test-3 def>> call ] unit-test
+{ "something else" } [ t cond-test-3 ] unit-test
+{ "something else" } [ t \ cond-test-3 def>> call ] unit-test
+{ "something else" } [ f cond-test-3 ] unit-test
+{ "something else" } [ f \ cond-test-3 def>> call ] unit-test
+{ "something else" } [ "ohio" cond-test-3 ] unit-test
+{ "something else" } [ "ohio" \ cond-test-3 def>> call ] unit-test
: cond-test-4 ( -- )
{
{ [ dup 2 mod 0 = ] [ drop "even" ] }
} cond ;
-[ "early" ] [ 2 cond-test-5 ] unit-test
-[ "early" ] [ 2 \ cond-test-5 def>> call ] unit-test
+{ "early" } [ 2 cond-test-5 ] unit-test
+{ "early" } [ 2 \ cond-test-5 def>> call ] unit-test
: cond-test-6 ( a -- b )
{
{ [ dup 2 mod 0 = ] [ drop "even" ] }
} cond ;
-[ "really early" ] [ 2 cond-test-6 ] unit-test
-[ "really early" ] [ 2 \ cond-test-6 def>> call ] unit-test
+{ "really early" } [ 2 cond-test-6 ] unit-test
+{ "really early" } [ 2 \ cond-test-6 def>> call ] unit-test
! Case
: case-test-1 ( obj -- obj' )
\ case-test-1 def>> must-infer
-[ "two" ] [ 2 case-test-1 ] unit-test
-[ "two" ] [ 2 \ case-test-1 def>> call ] unit-test
+{ "two" } [ 2 case-test-1 ] unit-test
+{ "two" } [ 2 \ case-test-1 def>> call ] unit-test
[ "x" case-test-1 ] must-fail
[ "x" \ case-test-1 def>> call ] must-fail
\ case-test-2 def>> must-infer
-[ 25 ] [ 5 case-test-2 ] unit-test
-[ 25 ] [ 5 \ case-test-2 def>> call ] unit-test
+{ 25 } [ 5 case-test-2 ] unit-test
+{ 25 } [ 5 \ case-test-2 def>> call ] unit-test
: case-test-3 ( obj -- obj' )
{
\ case-test-3 def>> must-infer
-[ "an array" ] [ { 1 2 3 } case-test-3 ] unit-test
-[ "an array" ] [ { 1 2 3 } \ case-test-3 def>> call ] unit-test
+{ "an array" } [ { 1 2 3 } case-test-3 ] unit-test
+{ "an array" } [ { 1 2 3 } \ case-test-3 def>> call ] unit-test
CONSTANT: case-const-1 1
CONSTANT: case-const-2 2
\ case-test-4 def>> must-infer
-[ "uno" ] [ 1 case-test-4 ] unit-test
-[ "dos" ] [ 2 case-test-4 ] unit-test
-[ "tres" ] [ 3 case-test-4 ] unit-test
-[ "demasiado" ] [ 100 case-test-4 ] unit-test
+{ "uno" } [ 1 case-test-4 ] unit-test
+{ "dos" } [ 2 case-test-4 ] unit-test
+{ "tres" } [ 3 case-test-4 ] unit-test
+{ "demasiado" } [ 100 case-test-4 ] unit-test
-[ "uno" ] [ 1 \ case-test-4 def>> call ] unit-test
-[ "dos" ] [ 2 \ case-test-4 def>> call ] unit-test
-[ "tres" ] [ 3 \ case-test-4 def>> call ] unit-test
-[ "demasiado" ] [ 100 \ case-test-4 def>> call ] unit-test
+{ "uno" } [ 1 \ case-test-4 def>> call ] unit-test
+{ "dos" } [ 2 \ case-test-4 def>> call ] unit-test
+{ "tres" } [ 3 \ case-test-4 def>> call ] unit-test
+{ "demasiado" } [ 100 \ case-test-4 def>> call ] unit-test
: case-test-5 ( obj -- )
{
\ case-test-5 def>> must-infer
-[ ] [ 1 case-test-5 ] unit-test
-[ ] [ 1 \ case-test-5 def>> call ] unit-test
+{ } [ 1 case-test-5 ] unit-test
+{ } [ 1 \ case-test-5 def>> call ] unit-test
: do-not-call ( -- * ) "do not call" throw ;
\ test-case-6 def>> must-infer
-[ "three" ] [ 3 test-case-6 ] unit-test
-[ "do-not-call" ] [ \ do-not-call test-case-6 ] unit-test
+{ "three" } [ 3 test-case-6 ] unit-test
+{ "do-not-call" } [ \ do-not-call test-case-6 ] unit-test
-[ t ] [ { 1 3 2 } contiguous-range? ] unit-test
-[ f ] [ { 1 2 2 4 } contiguous-range? ] unit-test
-[ f ] [ { + 3 2 } contiguous-range? ] unit-test
-[ f ] [ { 1 0 7 } contiguous-range? ] unit-test
-[ f ] [ { 1 1 3 7 } contiguous-range? ] unit-test
-[ t ] [ { 7 6 4 8 5 } contiguous-range? ] unit-test
+{ t } [ { 1 3 2 } contiguous-range? ] unit-test
+{ f } [ { 1 2 2 4 } contiguous-range? ] unit-test
+{ f } [ { + 3 2 } contiguous-range? ] unit-test
+{ f } [ { 1 0 7 } contiguous-range? ] unit-test
+{ f } [ { 1 1 3 7 } contiguous-range? ] unit-test
+{ t } [ { 7 6 4 8 5 } contiguous-range? ] unit-test
: test-case-7 ( obj -- str )
\ test-case-7 def>> must-infer
-[ "plus" ] [ \ + test-case-7 ] unit-test
-[ "plus" ] [ \ + \ test-case-7 def>> call ] unit-test
+{ "plus" } [ \ + test-case-7 ] unit-test
+{ "plus" } [ \ + \ test-case-7 def>> call ] unit-test
DEFER: corner-case-1
<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry ( a -- b ) define-declared >>
-[ t ] [ \ corner-case-1 optimized? ] unit-test
+{ t } [ \ corner-case-1 optimized? ] unit-test
-[ 4 ] [ 2 corner-case-1 ] unit-test
-[ 4 ] [ 2 \ corner-case-1 def>> call ] unit-test
+{ 4 } [ 2 corner-case-1 ] unit-test
+{ 4 } [ 2 \ corner-case-1 def>> call ] unit-test
: test-case-8 ( n -- string )
{
{ \ - [ "minus 2" ] }
} case ;
-[ "plus" ] [ \ + test-case-9 ] unit-test
-[ "plus" ] [ \ + \ test-case-9 def>> call ] unit-test
+{ "plus" } [ \ + test-case-9 ] unit-test
+{ "plus" } [ \ + \ test-case-9 def>> call ] unit-test
-[ "minus" ] [ \ - test-case-9 ] unit-test
-[ "minus" ] [ \ - \ test-case-9 def>> call ] unit-test
+{ "minus" } [ \ - test-case-9 ] unit-test
+{ "minus" } [ \ - \ test-case-9 def>> call ] unit-test
: test-case-10 ( a -- b )
{
{ 5 [ "cinco" ] }
} case ;
-[ "dos" ] [ 2 test-case-10 ] unit-test
-[ "dos" ] [ 2 \ test-case-10 def>> call ] unit-test
+{ "dos" } [ 2 test-case-10 ] unit-test
+{ "dos" } [ 2 \ test-case-10 def>> call ] unit-test
: test-case-11 ( a -- b )
{
{ 55 [ "cinco" ] }
} case ;
-[ "dos" ] [ 22 test-case-11 ] unit-test
-[ "dos" ] [ 22 \ test-case-11 def>> call ] unit-test
+{ "dos" } [ 22 test-case-11 ] unit-test
+{ "dos" } [ 22 \ test-case-11 def>> call ] unit-test
: test-case-12 ( a -- b )
{
{ 55 [ "cinco" ] }
} case ;
-[ "nachos" ] [ 33 test-case-12 ] unit-test
-[ "nachos" ] [ 33 \ test-case-12 def>> call ] unit-test
+{ "nachos" } [ 33 test-case-12 ] unit-test
+{ "nachos" } [ 33 \ test-case-12 def>> call ] unit-test
-[ ( x x -- x x ) ] [
+{ ( x x -- x x ) } [
[ { [ ] [ ] } spread ] infer
] unit-test
[ [ [ ] define-temp ] with-nested-compilation-unit ] must-infer
! Non-optimizing compiler bugs
-[ 1 1 ] [
+{ 1 1 } [
"A" <uninterned-word> [ [ [ 1 ] dip ] 2array 1array t t modify-code-heap ] keep
1 swap execute
] unit-test
-[ "A" "B" ] [
+{ "A" "B" } [
disable-optimizer
gensym "a" set
[ gensym [ ] ( -- ) define-declared ] with-compilation-unit
-[ 1 ] [ counter get-global ] unit-test
+{ 1 } [ counter get-global ] unit-test
observer remove-definition-observer
DEFER: nesting-test
-[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" eval( -- ) ] unit-test
+{ } [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" eval( -- ) ] unit-test
observer remove-definition-observer
<< [ uncompiled-generic-test ] [ jit-compile ] [ suffix! ] bi >>
"q" set
-[ 4 ] [ 3 "q" get call ] unit-test
+{ 4 } [ 3 "q" get call ] unit-test
-[ ] [ [ \ uncompiled-generic-test forget ] with-compilation-unit ] unit-test
+{ } [ [ \ uncompiled-generic-test forget ] with-compilation-unit ] unit-test
] with-scope
] callcc0 "x" get 5 = ;
-[ t ] [ 10 callcc1-test 10 iota reverse >vector = ] unit-test
-[ t ] [ callcc-namespace-test ] unit-test
+{ t } [ 10 callcc1-test 10 iota reverse >vector = ] unit-test
+{ t } [ callcc-namespace-test ] unit-test
[ 5 throw ] [ 5 = ] must-fail-with
-[ t ] [
+{ t } [
[ "Hello" throw ] ignore-errors
error get-global
"Hello" =
"!!! The following error is part of the test" print
-[ ] [ [ 6 [ 12 [ "2 car" ] ] ] print-error ] unit-test
+{ } [ [ 6 [ 12 [ "2 car" ] ] ] print-error ] unit-test
"!!! The following error is part of the test" print
-[ ] [ [ [ "2 car" ] eval ] try ] unit-test
+{ } [ [ [ "2 car" ] eval ] try ] unit-test
[ f throw ] must-fail
! Weird PowerPC bug.
-[ ] [
+{ } [
[ "4" throw ] ignore-errors
gc
gc
<< { don't-compile-me foo bar } [ t "no-compile" set-word-prop ] each >>
-[ 1 2 ] [ bar ] unit-test
+{ 1 2 } [ bar ] unit-test
-[ t ] [ \ bar def>> "c" get innermost-frame-executing = ] unit-test
+{ t } [ \ bar def>> "c" get innermost-frame-executing = ] unit-test
-[ 1 ] [ "c" get innermost-frame-scan ] unit-test
+{ 1 } [ "c" get innermost-frame-scan ] unit-test
SYMBOL: always-counter
SYMBOL: error-counter
[ 1 ] [ error-counter get ] unit-test
] with-scope
-[ ] [ [ return ] with-return ] unit-test
+{ } [ [ return ] with-return ] unit-test
[ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with
-[ { 4 } ] [ { 2 2 } [ + ] with-datastack ] unit-test
+{ { 4 } } [ { 2 2 } [ + ] with-datastack ] unit-test
[ with-datastack ] must-infer
M: some-class some-generic ;
-[ ] [
+{ } [
[
\ some-generic
\ some-class
T{ dispose-error } "a" set
T{ dispose-dummy } "b" set
-[ f ] [ "b" get disposed?>> ] unit-test
+{ f } [ "b" get disposed?>> ] unit-test
[ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
-[ t ] [ "b" get disposed?>> ] unit-test
+{ t } [ "b" get disposed?>> ] unit-test
TUPLE: dummy-obj destroyed? ;
: destroy-later ( obj -- )
<dummy-destructor> |dispose drop ;
-[ t ] [
+{ t } [
[
<dummy-obj> dup destroy-always
] with-destructors destroyed?>>
] unit-test
-[ f ] [
+{ f } [
[
<dummy-obj> dup destroy-later
] with-destructors destroyed?>>
] unit-test
-[ t ] [
+{ t } [
<dummy-obj> [
[
dup destroy-always
] ignore-errors destroyed?>>
] unit-test
-[ t ] [
+{ t } [
<dummy-obj> [
[
dup destroy-later
quotations sequences ;
IN: effects.tests
-[ t ] [ { "a" } { "a" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
-[ f ] [ { "a" } { } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
-[ t ] [ { "a" "b" } { "a" "b" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
-[ f ] [ { "a" "b" "c" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
-[ f ] [ { "a" "b" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
-[ 2 ] [ ( a b -- c ) in>> length ] unit-test
-[ 1 ] [ ( a b -- c ) out>> length ] unit-test
-
-[ t ] [ ( a b -- c ) ( ... a b -- ... c ) effect<= ] unit-test
-[ t ] [ ( b -- ) ( ... a b -- ... c ) effect<= ] unit-test
-[ f ] [ ( ... a b -- ... c ) ( a b -- c ) effect<= ] unit-test
-[ f ] [ ( ... b -- ... ) ( a b -- c ) effect<= ] unit-test
-[ f ] [ ( a b -- c ) ( ... a b -- c ) effect<= ] unit-test
-[ f ] [ ( a b -- c ) ( ..x a b -- ..y c ) effect<= ] unit-test
-
-[ "( object -- object )" ] [ { f } { f } <effect> unparse ] unit-test
-[ "( a b -- c d )" ] [ { "a" "b" } { "c" "d" } <effect> unparse ] unit-test
-[ "( -- c d )" ] [ { } { "c" "d" } <effect> unparse ] unit-test
-[ "( a b -- )" ] [ { "a" "b" } { } <effect> unparse ] unit-test
-[ "( -- )" ] [ { } { } <effect> unparse ] unit-test
-[ "( a b -- c )" ] [ ( a b -- c ) unparse ] unit-test
-
-[ { "x" "y" } ] [ { "y" "x" } ( a b -- b a ) shuffle ] unit-test
-[ { "y" "x" "y" } ] [ { "y" "x" } ( a b -- a b a ) shuffle ] unit-test
-[ { } ] [ { "y" "x" } ( a b -- ) shuffle ] unit-test
-
-[ t ] [ ( -- ) ( -- ) compose-effects ( -- ) effect= ] unit-test
-[ t ] [ ( -- * ) ( -- ) compose-effects ( -- * ) effect= ] unit-test
-[ t ] [ ( -- ) ( -- * ) compose-effects ( -- * ) effect= ] unit-test
-
-[ { object object } ] [ ( a b -- ) effect-in-types ] unit-test
-[ { object sequence } ] [ ( a b: sequence -- ) effect-in-types ] unit-test
-
-[ f ] [ ( a b c -- d ) in-var>> ] unit-test
-[ f ] [ ( -- d ) in-var>> ] unit-test
-[ "a" ] [ ( ..a b c -- d ) in-var>> ] unit-test
-[ { "b" "c" } ] [ ( ..a b c -- d ) in>> ] unit-test
-
-[ f ] [ ( ..a b c -- e ) out-var>> ] unit-test
-[ "d" ] [ ( ..a b c -- ..d e ) out-var>> ] unit-test
-[ { "e" } ] [ ( ..a b c -- ..d e ) out>> ] unit-test
+{ t } [ { "a" } { "a" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
+{ f } [ { "a" } { } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
+{ t } [ { "a" "b" } { "a" "b" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
+{ f } [ { "a" "b" "c" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
+{ f } [ { "a" "b" } { "a" "b" "c" } <effect> { "a" "b" } { "a" "b" } <effect> effect<= ] unit-test
+{ 2 } [ ( a b -- c ) in>> length ] unit-test
+{ 1 } [ ( a b -- c ) out>> length ] unit-test
+
+{ t } [ ( a b -- c ) ( ... a b -- ... c ) effect<= ] unit-test
+{ t } [ ( b -- ) ( ... a b -- ... c ) effect<= ] unit-test
+{ f } [ ( ... a b -- ... c ) ( a b -- c ) effect<= ] unit-test
+{ f } [ ( ... b -- ... ) ( a b -- c ) effect<= ] unit-test
+{ f } [ ( a b -- c ) ( ... a b -- c ) effect<= ] unit-test
+{ f } [ ( a b -- c ) ( ..x a b -- ..y c ) effect<= ] unit-test
+
+{ "( object -- object )" } [ { f } { f } <effect> unparse ] unit-test
+{ "( a b -- c d )" } [ { "a" "b" } { "c" "d" } <effect> unparse ] unit-test
+{ "( -- c d )" } [ { } { "c" "d" } <effect> unparse ] unit-test
+{ "( a b -- )" } [ { "a" "b" } { } <effect> unparse ] unit-test
+{ "( -- )" } [ { } { } <effect> unparse ] unit-test
+{ "( a b -- c )" } [ ( a b -- c ) unparse ] unit-test
+
+{ { "x" "y" } } [ { "y" "x" } ( a b -- b a ) shuffle ] unit-test
+{ { "y" "x" "y" } } [ { "y" "x" } ( a b -- a b a ) shuffle ] unit-test
+{ { } } [ { "y" "x" } ( a b -- ) shuffle ] unit-test
+
+{ t } [ ( -- ) ( -- ) compose-effects ( -- ) effect= ] unit-test
+{ t } [ ( -- * ) ( -- ) compose-effects ( -- * ) effect= ] unit-test
+{ t } [ ( -- ) ( -- * ) compose-effects ( -- * ) effect= ] unit-test
+
+{ { object object } } [ ( a b -- ) effect-in-types ] unit-test
+{ { object sequence } } [ ( a b: sequence -- ) effect-in-types ] unit-test
+
+{ f } [ ( a b c -- d ) in-var>> ] unit-test
+{ f } [ ( -- d ) in-var>> ] unit-test
+{ "a" } [ ( ..a b c -- d ) in-var>> ] unit-test
+{ { "b" "c" } } [ ( ..a b c -- d ) in>> ] unit-test
+
+{ f } [ ( ..a b c -- e ) out-var>> ] unit-test
+{ "d" } [ ( ..a b c -- ..d e ) out-var>> ] unit-test
+{ { "e" } } [ ( ..a b c -- ..d e ) out>> ] unit-test
[ "( a ..b c -- d )" eval( -- effect ) ]
[ error>> invalid-row-variable? ] must-fail-with
[ error>> row-variable-can't-have-type? ] must-fail-with
! test curry-effect
-[ ( -- x ) ] [ ( c -- d ) curry-effect ] unit-test
-[ ( -- x x ) ] [ ( -- d ) curry-effect ] unit-test
-[ ( x -- ) ] [ ( a b -- ) curry-effect ] unit-test
+{ ( -- x ) } [ ( c -- d ) curry-effect ] unit-test
+{ ( -- x x ) } [ ( -- d ) curry-effect ] unit-test
+{ ( x -- ) } [ ( a b -- ) curry-effect ] unit-test
M: integer my-hook "an integer" ;
M: string my-hook "a string" ;
-[ "an integer" ] [ 3 my-var set my-hook ] unit-test
-[ "a string" ] [ my-hook 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
[ 1.0 my-var set my-hook ] [ T{ no-method f 1.0 my-hook } = ] must-fail-with
HOOK: call-next-hooker my-var ( -- x )
M: growable call-next-hooker call-next-method "growable " prepend ;
-[ "vector growable sequence" ] [
+{ "vector growable sequence" } [
V{ } my-var [ call-next-hooker ] with-variable
] unit-test
-[ t ] [
+{ t } [
{ } \ nth effective-method nip M\ sequence nth eq?
] unit-test
-[ t ] [
+{ t } [
\ + \ nth effective-method nip dup \ nth "default-method" word-prop eq? and
] unit-test
IN: generic.math.tests
! Test math-combination
-[ [ [ >float ] dip ] ] [ \ real \ float math-upgrade ] unit-test
-[ [ >float ] ] [ \ float \ real math-upgrade ] unit-test
-[ [ [ >bignum ] dip ] ] [ \ fixnum \ bignum math-upgrade ] unit-test
-[ [ >float ] ] [ \ float \ integer math-upgrade ] unit-test
+{ [ [ >float ] dip ] } [ \ real \ float math-upgrade ] unit-test
+{ [ >float ] } [ \ float \ real math-upgrade ] unit-test
+{ [ [ >bignum ] dip ] } [ \ fixnum \ bignum math-upgrade ] unit-test
+{ [ >float ] } [ \ float \ integer math-upgrade ] unit-test
-[ number ] [ number float math-class-max ] unit-test
-[ number ] [ float number math-class-max ] unit-test
-[ float ] [ real float math-class-max ] unit-test
-[ float ] [ float real math-class-max ] unit-test
-[ fixnum ] [ fixnum null math-class-max ] unit-test
-[ fixnum ] [ null fixnum math-class-max ] unit-test
-[ bignum ] [ fixnum bignum math-class-max ] unit-test
-[ bignum ] [ bignum fixnum math-class-max ] unit-test
-[ number ] [ fixnum number math-class-max ] unit-test
-[ number ] [ number fixnum math-class-max ] unit-test
+{ number } [ number float math-class-max ] unit-test
+{ number } [ float number math-class-max ] unit-test
+{ float } [ real float math-class-max ] unit-test
+{ float } [ float real math-class-max ] unit-test
+{ fixnum } [ fixnum null math-class-max ] unit-test
+{ fixnum } [ null fixnum math-class-max ] unit-test
+{ bignum } [ fixnum bignum math-class-max ] unit-test
+{ bignum } [ bignum fixnum math-class-max ] unit-test
+{ number } [ fixnum number math-class-max ] unit-test
+{ number } [ number fixnum math-class-max ] unit-test
-[ t ] [ \ + math-generic? ] unit-test
+{ t } [ \ + math-generic? ] unit-test
IN: generic.parser.tests
-[ t ] [ ( -- ) ( -- ) method-effect= ] unit-test
-[ t ] [ ( a -- b ) ( x -- y ) method-effect= ] unit-test
-[ f ] [ ( a b -- c ) ( x -- y ) method-effect= ] unit-test
-[ f ] [ ( a -- b ) ( x y -- z ) method-effect= ] unit-test
+{ t } [ ( -- ) ( -- ) method-effect= ] unit-test
+{ t } [ ( a -- b ) ( x -- y ) method-effect= ] unit-test
+{ f } [ ( a b -- c ) ( x -- y ) method-effect= ] unit-test
+{ f } [ ( a -- b ) ( x y -- z ) method-effect= ] unit-test
-[ t ] [ ( -- * ) ( -- ) method-effect= ] unit-test
-[ f ] [ ( -- * ) ( x -- y ) method-effect= ] unit-test
-[ t ] [ ( x -- * ) ( x -- y ) method-effect= ] unit-test
-[ t ] [ ( x -- * ) ( x -- y z ) method-effect= ] unit-test
+{ t } [ ( -- * ) ( -- ) method-effect= ] unit-test
+{ f } [ ( -- * ) ( x -- y ) method-effect= ] unit-test
+{ t } [ ( x -- * ) ( x -- y ) method-effect= ] unit-test
+{ t } [ ( x -- * ) ( x -- y z ) method-effect= ] unit-test
M: fixnum class-of drop "fixnum" ;
M: word class-of drop "word" ;
-[ "fixnum" ] [ 5 class-of ] unit-test
-[ "word" ] [ \ class-of class-of ] unit-test
+{ "fixnum" } [ 5 class-of ] unit-test
+{ "word" } [ \ class-of class-of ] unit-test
[ 3.4 class-of ] must-fail
GENERIC: foobar ( x -- y )
M: object foobar drop "Hello world" ;
M: fixnum foobar drop "Goodbye cruel world" ;
-[ "Hello world" ] [ 4 foobar foobar ] unit-test
-[ "Goodbye cruel world" ] [ 4 foobar ] unit-test
+{ "Hello world" } [ 4 foobar foobar ] unit-test
+{ "Goodbye cruel world" } [ 4 foobar ] unit-test
GENERIC: lo-tag-test ( obj -- obj' )
M: rational lo-tag-test 2 - ;
M: complex lo-tag-test sq ;
-[ 8 ] [ 5 >bignum lo-tag-test ] unit-test
-[ 0.0 ] [ 4.0 lo-tag-test ] unit-test
-[ -1/2 ] [ 1+1/2 lo-tag-test ] unit-test
-[ -16 ] [ C{ 0 4 } lo-tag-test ] unit-test
+{ 8 } [ 5 >bignum lo-tag-test ] unit-test
+{ 0.0 } [ 4.0 lo-tag-test ] unit-test
+{ -1/2 } [ 1+1/2 lo-tag-test ] unit-test
+{ -16 } [ C{ 0 4 } lo-tag-test ] unit-test
GENERIC: hi-tag-test ( obj -- obj' )
M: array hi-tag-test [ hi-tag-test ] map ;
M: sequence hi-tag-test reverse ;
-[ B{ 3 2 1 } ] [ B{ 1 2 3 } hi-tag-test ] unit-test
+{ B{ 3 2 1 } } [ B{ 1 2 3 } hi-tag-test ] unit-test
-[ { 6 9 12 } ] [ { 3 6 9 } hi-tag-test ] unit-test
+{ { 6 9 12 } } [ { 3 6 9 } hi-tag-test ] unit-test
-[ "i like monkeys, in bed" ] [ "i like monkeys" hi-tag-test ] unit-test
+{ "i like monkeys, in bed" } [ "i like monkeys" hi-tag-test ] unit-test
UNION: funnies quotation float complex ;
M: integer union-containment drop 1 ;
M: number union-containment drop 2 ;
-[ 1 ] [ 1 union-containment ] unit-test
-[ 2 ] [ 1.0 union-containment ] unit-test
+{ 1 } [ 1 union-containment ] unit-test
+{ 2 } [ 1.0 union-containment ] unit-test
-[ 2 ] [ [ { } ] funny ] unit-test
-[ 0 ] [ { } funny ] unit-test
+{ 2 } [ [ { } ] funny ] unit-test
+{ 0 } [ { } funny ] unit-test
TUPLE: shape ;
M: circle area radius>> sq pi * ;
-[ 12 ] [ 4 3 <rectangle> area ] unit-test
-
[ 12 ] [ 4 3 2 <parallelogram> area ] unit-test
-[ t ] [ 2 <circle> area 4 pi * = ] unit-test
+{ 12 } [ 4 3 <rectangle> area ] unit-test
+
{ 12 } [ 4 3 2 <parallelogram> area ] unit-test
+{ t } [ 2 <circle> area 4 pi * = ] unit-test
GENERIC: perimeter ( shape -- n )
M: circle perimeter 2 * pi * ;
-[ 14 ] [ 4 3 <rectangle> perimeter ] unit-test
-
[ 30.0 ] [ 10 4 3 <parallelogram> perimeter ] unit-test
+{ 14 } [ 4 3 <rectangle> perimeter ] unit-test
+
{ 30.0 } [ 10 4 3 <parallelogram> perimeter ] unit-test
PREDICATE: very-funny < funnies number? ;
GENERIC: gooey ( x -- y )
M: very-funny gooey sq ;
-[ 0.25 ] [ 0.5 gooey ] unit-test
+{ 0.25 } [ 0.5 gooey ] unit-test
GENERIC: empty-method-test ( x -- y )
M: object empty-method-test ;
TUPLE: another-one ;
C: <another-one> another-one
-[ "Hi" ] [ <for-arguments-sake> empty-method-test empty-method-test ] unit-test
-
[ T{ another-one f } ] [ <another-one> empty-method-test ] unit-test
+{ "Hi" } [ <for-arguments-sake> empty-method-test empty-method-test ] unit-test
+
{ T{ another-one f } } [ <another-one> empty-method-test ] unit-test
GENERIC: big-mix-test ( obj -- obj' )
M: circle big-mix-test drop "circle" ;
-[ "integer" ] [ 3 big-mix-test ] unit-test
-[ "float" ] [ 5.0 big-mix-test ] unit-test
-[ "complex" ] [ -1 sqrt big-mix-test ] unit-test
-[ "sequence" ] [ B{ 1 2 3 } big-mix-test ] unit-test
-[ "sequence" ] [ ?{ t f t } big-mix-test ] unit-test
-[ "sequence" ] [ SBUF" hello world" big-mix-test ] unit-test
-[ "sequence" ] [ V{ "a" "b" } big-mix-test ] unit-test
-[ "sequence" ] [ BV{ 1 2 } big-mix-test ] unit-test
-[ "sequence" ] [ ?V{ t t f f } big-mix-test ] unit-test
-[ "string" ] [ "hello" big-mix-test ] unit-test
-[ "rectangle" ] [ 1 2 <rectangle> big-mix-test ] unit-test
-
[ "parallelogram" ] [ 10 4 3 <parallelogram> big-mix-test ] unit-test
-[ "circle" ] [ 100 <circle> big-mix-test ] unit-test
-[ "tuple" ] [ H{ } big-mix-test ] unit-test
-[ "object" ] [ \ + big-mix-test ] unit-test
+{ "integer" } [ 3 big-mix-test ] unit-test
+{ "float" } [ 5.0 big-mix-test ] unit-test
+{ "complex" } [ -1 sqrt big-mix-test ] unit-test
+{ "sequence" } [ B{ 1 2 3 } big-mix-test ] unit-test
+{ "sequence" } [ ?{ t f t } big-mix-test ] unit-test
+{ "sequence" } [ SBUF" hello world" big-mix-test ] unit-test
+{ "sequence" } [ V{ "a" "b" } big-mix-test ] unit-test
+{ "sequence" } [ BV{ 1 2 } big-mix-test ] unit-test
+{ "sequence" } [ ?V{ t t f f } big-mix-test ] unit-test
+{ "string" } [ "hello" big-mix-test ] unit-test
+{ "rectangle" } [ 1 2 <rectangle> big-mix-test ] unit-test
+
{ "parallelogram" } [ 10 4 3 <parallelogram> big-mix-test ] unit-test
+{ "circle" } [ 100 <circle> big-mix-test ] unit-test
+{ "tuple" } [ H{ } big-mix-test ] unit-test
+{ "object" } [ \ + big-mix-test ] unit-test
GENERIC: small-lo-tag ( obj -- obj )
M: byte-array small-lo-tag drop "byte-array" ;
-[ "fixnum" ] [ 3 small-lo-tag ] unit-test
+{ "fixnum" } [ 3 small-lo-tag ] unit-test
-[ "double-array" ] [ double-array{ 1.0 } small-lo-tag ] unit-test
+{ "double-array" } [ double-array{ 1.0 } small-lo-tag ] unit-test
! Testing recovery from bad method definitions
"IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- )
[
"IN: generic.standard.tests M: dictionary unhappy ;" eval( -- )
] must-fail
-[ ] [ "IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests GENERIC: unhappy ( x -- x )" eval( -- ) ] unit-test
GENERIC# complex-combination 1 ( a b -- c )
M: string complex-combination drop ;
M: object complex-combination nip ;
-[ "hi" ] [ "hi" 3 complex-combination ] unit-test
-[ "hi" ] [ 3 "hi" complex-combination ] unit-test
+{ "hi" } [ "hi" 3 complex-combination ] unit-test
+{ "hi" } [ 3 "hi" complex-combination ] unit-test
! Regression
TUPLE: first-one ;
M: tuple-class wii drop 5 ;
M: integer wii drop 6 ;
-[ 3 ] [ T{ first-one } wii ] unit-test
+{ 3 } [ T{ first-one } wii ] unit-test
GENERIC: tag-and-f ( x -- x x )
M: f tag-and-f 4 ;
-[ f 4 ] [ f tag-and-f ] unit-test
+{ f 4 } [ f tag-and-f ] unit-test
-[ 3.4 3 ] [ 3.4 tag-and-f ] unit-test
+{ 3.4 3 } [ 3.4 tag-and-f ] unit-test
! Issues with forget
GENERIC: generic-forget-test ( a -- b )
M: f generic-forget-test ;
-[ ] [ \ f \ generic-forget-test lookup-method "m" set ] unit-test
+{ } [ \ f \ generic-forget-test lookup-method "m" set ] unit-test
-[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
+{ } [ [ "m" get forget ] with-compilation-unit ] unit-test
-[ ] [ "IN: generic.standard.tests M: f generic-forget-test ;" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests M: f generic-forget-test ;" eval( -- ) ] unit-test
-[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
+{ } [ [ "m" get forget ] with-compilation-unit ] unit-test
-[ f ] [ f generic-forget-test ] unit-test
+{ f } [ f generic-forget-test ] unit-test
! erg's regression
-[ ] [
+{ } [
"""IN: generic.standard.tests
GENERIC: jeah ( a -- b )
[ salary ] must-infer
-[ 24000 ] [ employee boa salary ] unit-test
+{ 24000 } [ employee boa salary ] unit-test
-[ 24000 ] [ tape-monkey boa salary ] unit-test
+{ 24000 } [ tape-monkey boa salary ] unit-test
-[ 36000 ] [ junior-manager boa salary ] unit-test
+{ 36000 } [ junior-manager boa salary ] unit-test
-[ 41000 ] [ middle-manager boa salary ] unit-test
+{ 41000 } [ middle-manager boa salary ] unit-test
-[ 51000 ] [ senior-manager boa salary ] unit-test
+{ 51000 } [ senior-manager boa salary ] unit-test
-[ 102000 ] [ executive boa salary ] unit-test
+{ 102000 } [ executive boa salary ] unit-test
[ ceo boa salary ]
[ T{ inconsistent-next-method f ceo salary } = ] must-fail-with
: funky ( obj -- seq ) [ funky* ] { } make ;
-[ { "b" "x" "z" } ] [ T{ b } funky ] unit-test
+{ { "b" "x" "z" } } [ T{ b } funky ] unit-test
-[ { "c" "y" "z" } ] [ T{ c } funky ] unit-test
+{ { "c" "y" "z" } } [ T{ c } funky ] unit-test
-[ t ] [
+{ t } [
T{ a } funky
{ { "a" "x" "z" } { "a" "y" "z" } } member?
] unit-test
! Changing method combination should not fail
-[ ] [ "IN: generic.standard.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test
-[ ] [ "IN: generic.standard.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests GENERIC: xyz ( a -- b )" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests MATH: xyz ( a b -- c )" eval( -- ) ] unit-test
-[ f ] [ "xyz" "generic.standard.tests" lookup-word pic-def>> ] unit-test
-[ f ] [ "xyz" "generic.standard.tests" lookup-word "decision-tree" word-prop ] unit-test
+{ f } [ "xyz" "generic.standard.tests" lookup-word pic-def>> ] unit-test
+{ f } [ "xyz" "generic.standard.tests" lookup-word "decision-tree" word-prop ] unit-test
! Corner case
[ "IN: generic.standard.tests GENERIC# broken-generic# -1 ( a -- b )" eval( -- ) ]
must-fail-with
! Generic words cannot be inlined
-[ ] [ "IN: generic.standard.tests GENERIC: foo ( -- x )" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests GENERIC: foo ( -- x )" eval( -- ) ] unit-test
[ "IN: generic.standard.tests GENERIC: foo ( -- x ) inline" eval( -- ) ] must-fail
! Moving a method from one vocab to another didn't always work
GENERIC: move-method-generic ( a -- b )
-[ ] [ "IN: generic.standard.tests.a USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
+{ } [ "IN: generic.standard.tests.a USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
-[ ] [ "IN: generic.standard.tests.b USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-2" parse-stream drop ] unit-test
+{ } [ "IN: generic.standard.tests.b USE: strings USE: generic.standard.tests M: string move-method-generic ;" <string-reader> "move-method-test-2" parse-stream drop ] unit-test
-[ ] [ "IN: generic.standard.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
+{ } [ "IN: generic.standard.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
-[ { string } ] [ \ move-method-generic order ] unit-test
+{ { string } } [ \ move-method-generic order ] unit-test
! FORGET: on method wrappers
GENERIC: forget-test ( a -- b )
M: integer forget-test 3 + ;
-[ ] [ "IN: generic.standard.tests USE: math FORGET: M\\ integer forget-test" eval( -- ) ] unit-test
+{ } [ "IN: generic.standard.tests USE: math FORGET: M\\ integer forget-test" eval( -- ) ] unit-test
-[ { } ] [
+{ { } } [
\ + effect-dependencies-of keys [ method? ] filter
[ "method-generic" word-prop \ forget-test eq? ] filter
] unit-test
GENERIC: flushable-generic ( a -- b ) flushable
M: integer flushable-generic ;
-[ t ] [ \ flushable-generic flushable? ] unit-test
-[ t ] [ M\ integer flushable-generic flushable? ] unit-test
+{ t } [ \ flushable-generic flushable? ] unit-test
+{ t } [ M\ integer flushable-generic flushable? ] unit-test
GENERIC: non-flushable-generic ( a -- b )
M: integer non-flushable-generic ; flushable
-[ f ] [ \ non-flushable-generic flushable? ] unit-test
-[ t ] [ M\ integer non-flushable-generic flushable? ] unit-test
+{ f } [ \ non-flushable-generic flushable? ] unit-test
+{ t } [ M\ integer non-flushable-generic flushable? ] unit-test
! method-for-object, method-for-class, effective-method
GENERIC: foozul ( a -- b )
M: integer foozul ;
M: slice foozul ;
-[ ] [ reversed \ foozul method-for-class M\ reversed foozul assert= ] unit-test
-[ ] [ { 1 2 3 } <reversed> \ foozul method-for-object M\ reversed foozul assert= ] unit-test
-[ ] [ { 1 2 3 } <reversed> \ foozul effective-method M\ reversed foozul assert= drop ] unit-test
+{ } [ reversed \ foozul method-for-class M\ reversed foozul assert= ] unit-test
+{ } [ { 1 2 3 } <reversed> \ foozul method-for-object M\ reversed foozul assert= ] unit-test
+{ } [ { 1 2 3 } <reversed> \ foozul effective-method M\ reversed foozul assert= drop ] unit-test
-[ ] [ fixnum \ foozul method-for-class M\ integer foozul assert= ] unit-test
-[ ] [ 13 \ foozul method-for-object M\ integer foozul assert= ] unit-test
-[ ] [ 13 \ foozul effective-method M\ integer foozul assert= drop ] unit-test
+{ } [ fixnum \ foozul method-for-class M\ integer foozul assert= ] unit-test
+{ } [ 13 \ foozul method-for-object M\ integer foozul assert= ] unit-test
+{ } [ 13 \ foozul effective-method M\ integer foozul assert= drop ] unit-test
! Ensure dynamic and static dispatch match in ambiguous cases
UNION: amb-union-1a integer float ;
M: amb-union-1a amb-generic-1 drop "a" ;
M: amb-union-1b amb-generic-1 drop "b" ;
-[ ] [
+{ } [
5.0 amb-generic-1
5.0 \ amb-generic-1 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
5.0 amb-generic-1
5.0 float \ amb-generic-1 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-union-2a amb-generic-2 drop "a" ;
M: amb-union-2b amb-generic-2 drop "b" ;
-[ ] [
+{ } [
5.0 amb-generic-1
5.0 \ amb-generic-1 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
5.0 amb-generic-1
5.0 float \ amb-generic-1 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-tuple-b amb-generic-3 drop "b" ;
M: amb-tuple-c amb-generic-3 drop "c" ;
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-3
T{ amb-tuple-b f 3 } \ amb-generic-3 effective-method execute( a -- b ) assert=
] unit-test
M: amb-tuple-b amb-generic-4 drop "b" ;
M: amb-union-4 amb-generic-4 drop "4" ;
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-4
T{ amb-tuple-b f 3 } \ amb-generic-4 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-4
T{ amb-tuple-b f 3 } amb-tuple-b \ amb-generic-4 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-tuple-b amb-generic-5 drop "b" ;
M: amb-mixin-5 amb-generic-5 drop "5" ;
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-5
T{ amb-tuple-b f 3 } \ amb-generic-5 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-5
T{ amb-tuple-b f 3 } amb-tuple-b \ amb-generic-5 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-tuple-a amb-generic-6 drop "a" ;
M: amb-union-6 amb-generic-6 drop "6" ;
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-6
T{ amb-tuple-b f 3 } \ amb-generic-6 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-6
T{ amb-tuple-b f 3 } amb-tuple-b \ amb-generic-6 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-tuple-a amb-generic-7 drop "a" ;
M: amb-mixin-7 amb-generic-7 drop "7" ;
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-7
T{ amb-tuple-b f 3 } \ amb-generic-7 effective-method execute( a -- b ) assert=
] unit-test
-[ ] [
+{ } [
T{ amb-tuple-b f 3 } amb-generic-7
T{ amb-tuple-b f 3 } amb-tuple-b \ amb-generic-7 method-for-class execute( a -- b ) assert=
] unit-test
M: amb-union-8 amb-generic-8 drop "8" ;
M: amb-predicate-a amb-generic-8 drop "a" ;
-[ ] [
+{ } [
4 amb-generic-8
4 \ amb-generic-8 effective-method execute( a -- b ) assert=
] unit-test
IN: growable.tests
! erg found this one
-[ fixnum ] [
+{ fixnum } [
2 >bignum V{ } [ set-length ] keep length class-of
] unit-test
USING: sets tools.test kernel sorting prettyprint hash-sets ;
IN: hash-sets.tests
-[ { 1 2 3 } ] [ HS{ 1 2 3 } members natural-sort ] unit-test
+{ { 1 2 3 } } [ HS{ 1 2 3 } members natural-sort ] unit-test
-[ "HS{ 1 2 3 4 }" ] [ HS{ 1 2 3 4 } unparse ] unit-test
+{ "HS{ 1 2 3 4 }" } [ HS{ 1 2 3 4 } unparse ] unit-test
-[ t ] [ 1 HS{ 0 1 2 } in? ] unit-test
-[ f ] [ 3 HS{ 0 1 2 } in? ] unit-test
-[ HS{ 1 2 3 } ] [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ HS{ 1 2 } ] [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ HS{ 1 2 3 } ] [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
-[ HS{ 1 2 } ] [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
-[ HS{ 1 2 } ] [ HS{ 1 2 } fast-set ] unit-test
-[ { 1 2 } ] [ HS{ 1 2 } members natural-sort ] unit-test
+{ t } [ 1 HS{ 0 1 2 } in? ] unit-test
+{ f } [ 3 HS{ 0 1 2 } in? ] unit-test
+{ HS{ 1 2 3 } } [ 3 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
+{ HS{ 1 2 } } [ 2 HS{ 1 2 } clone [ adjoin ] keep ] unit-test
+{ HS{ 1 2 3 } } [ 4 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
+{ HS{ 1 2 } } [ 3 HS{ 1 2 3 } clone [ delete ] keep ] unit-test
+{ HS{ 1 2 } } [ HS{ 1 2 } fast-set ] unit-test
+{ { 1 2 } } [ HS{ 1 2 } members natural-sort ] unit-test
-[ HS{ 1 2 3 4 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
-[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 3 4 } intersects? ] unit-test
-[ f ] [ HS{ 1 } HS{ 2 3 4 } intersects? ] unit-test
-[ f ] [ HS{ 1 } HS{ 2 3 4 } subset? ] unit-test
-[ f ] [ HS{ 1 2 3 } HS{ 2 3 4 } subset? ] unit-test
-[ t ] [ HS{ 2 3 } HS{ 2 3 4 } subset? ] unit-test
-[ t ] [ HS{ } HS{ 2 3 4 } subset? ] unit-test
-[ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 4 } diff ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } set= ] unit-test
-[ t ] [ HS{ 1 2 3 } HS{ 2 1 3 } = ] unit-test
-[ f ] [ HS{ 2 3 } HS{ 2 1 3 } set= ] unit-test
-[ f ] [ HS{ 1 2 3 } HS{ 2 3 } set= ] unit-test
+{ HS{ 1 2 3 4 } } [ HS{ 1 2 3 } HS{ 2 3 4 } union ] unit-test
+{ HS{ 2 3 } } [ HS{ 1 2 3 } HS{ 2 3 4 } intersect ] unit-test
+{ t } [ HS{ 1 2 3 } HS{ 2 3 4 } intersects? ] unit-test
+{ f } [ HS{ 1 } HS{ 2 3 4 } intersects? ] unit-test
+{ f } [ HS{ 1 } HS{ 2 3 4 } subset? ] unit-test
+{ f } [ HS{ 1 2 3 } HS{ 2 3 4 } subset? ] unit-test
+{ t } [ HS{ 2 3 } HS{ 2 3 4 } subset? ] unit-test
+{ t } [ HS{ } HS{ 2 3 4 } subset? ] unit-test
+{ HS{ 1 } } [ HS{ 1 2 3 } HS{ 2 3 4 } diff ] unit-test
+{ t } [ HS{ 1 2 3 } HS{ 2 1 3 } set= ] unit-test
+{ t } [ HS{ 1 2 3 } HS{ 2 1 3 } = ] unit-test
+{ f } [ HS{ 2 3 } HS{ 2 1 3 } set= ] unit-test
+{ f } [ HS{ 1 2 3 } HS{ 2 3 } set= ] unit-test
-[ HS{ 1 2 } HS{ 1 2 3 } ] [ HS{ 1 2 } clone dup clone [ 3 swap adjoin ] keep ] unit-test
+{ HS{ 1 2 } HS{ 1 2 3 } } [ HS{ 1 2 } clone dup clone [ 3 swap adjoin ] keep ] unit-test
-[ t ] [ HS{ } null? ] unit-test
-[ f ] [ HS{ 1 } null? ] unit-test
+{ t } [ HS{ } null? ] unit-test
+{ f } [ HS{ 1 } null? ] unit-test
{ { } } [ { 1 2 3 } duplicates ] unit-test
{ f } [ { 1 2 3 } >hash-set duplicates ] unit-test
tools.test vectors ;
IN: hashtables.tests
-[ H{ } ] [ { } [ dup ] H{ } map>assoc ] unit-test
+{ H{ } } [ { } [ dup ] H{ } map>assoc ] unit-test
-[ ] [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
+{ } [ 1000 iota [ dup sq ] H{ } map>assoc "testhash" set ] unit-test
-[ V{ } ]
+{ V{ } }
[ 1000 iota [ dup sq swap "testhash" get at = ] reject ]
unit-test
-[ t ]
+{ t }
[ "testhash" get hashtable? ]
unit-test
-[ f ]
+{ f }
[ { 1 { 2 3 } } hashtable? ]
unit-test
! Test some hashcodes.
-[ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
-[ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
+{ t } [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
+{ t } [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
-[ t ] [ 12 hashcode 12 hashcode = ] unit-test
-[ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
+{ t } [ 12 hashcode 12 hashcode = ] unit-test
+{ t } [ 12 >bignum hashcode 12 hashcode = ] unit-test
! Test various odd keys to see if they work.
f 100000000000000000000000000 "testhash" get set-at
{ } { [ { } ] } "testhash" get set-at
-[ t ] [ { 2 3 } "testhash" get at ] unit-test
-[ f ] [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
-[ { } ] [ { [ { } ] } clone "testhash" get at* drop ] unit-test
+{ t } [ { 2 3 } "testhash" get at ] unit-test
+{ f } [ 100000000000000000000000000 "testhash" get at* drop ] unit-test
+{ { } } [ { [ { } ] } clone "testhash" get at* drop ] unit-test
! Regression
3 <hashtable> "broken-remove" set
2 W{ \ = } dup "y" set "broken-remove" get set-at
"x" get "broken-remove" get delete-at
2 "y" get "broken-remove" get set-at
-[ 1 ] [ "broken-remove" get keys length ] unit-test
+{ 1 } [ "broken-remove" get keys length ] unit-test
{
{ "salmon" "fish" }
{ "visual basic" "language" }
} >hashtable "testhash" set
-[ f f ] [
+{ f f } [
"visual basic" "testhash" get delete-at
"visual basic" "testhash" get at*
] unit-test
-[ t ] [ H{ } dup = ] unit-test
-[ f ] [ "xyz" H{ } = ] unit-test
-[ t ] [ H{ } H{ } = ] unit-test
-[ f ] [ H{ { 1 3 } } H{ } = ] unit-test
-[ f ] [ H{ } H{ { 1 3 } } = ] unit-test
-[ t ] [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
-[ f ] [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
+{ t } [ H{ } dup = ] unit-test
+{ f } [ "xyz" H{ } = ] unit-test
+{ t } [ H{ } H{ } = ] unit-test
+{ f } [ H{ { 1 3 } } H{ } = ] unit-test
+{ f } [ H{ } H{ { 1 3 } } = ] unit-test
+{ t } [ H{ { 1 3 } } H{ { 1 3 } } = ] unit-test
+{ f } [ H{ { 1 3 } } H{ { 1 "hey" } } = ] unit-test
! Testing the hash element counting
H{ } clone "counting" set
"value" "key" "counting" get set-at
-[ 1 ] [ "counting" get assoc-size ] unit-test
+{ 1 } [ "counting" get assoc-size ] unit-test
"value" "key" "counting" get set-at
-[ 1 ] [ "counting" get assoc-size ] unit-test
+{ 1 } [ "counting" get assoc-size ] unit-test
"key" "counting" get delete-at
-[ 0 ] [ "counting" get assoc-size ] unit-test
+{ 0 } [ "counting" get assoc-size ] unit-test
"key" "counting" get delete-at
-[ 0 ] [ "counting" get assoc-size ] unit-test
+{ 0 } [ "counting" get assoc-size ] unit-test
! Test rehashing
5 5 "rehash" get set-at
6 6 "rehash" get set-at
-[ 6 ] [ "rehash" get assoc-size ] unit-test
+{ 6 } [ "rehash" get assoc-size ] unit-test
-[ 6 ] [ "rehash" get clone assoc-size ] unit-test
+{ 6 } [ "rehash" get clone assoc-size ] unit-test
"rehash" get clear-assoc
-[ 0 ] [ "rehash" get assoc-size ] unit-test
+{ 0 } [ "rehash" get assoc-size ] unit-test
-[
+{
3
-] [
+} [
2 H{
{ 1 2 }
{ 2 3 }
10 [ f f "f-hash-test" get set-at ] times
-[ 1 ] [ "f-hash-test" get assoc-size ] unit-test
+{ 1 } [ "f-hash-test" get assoc-size ] unit-test
! Resource leak...
H{ } "x" set
100 [ drop "x" get clear-assoc ] each-integer
! Crash discovered by erg
-[ t ] [ 0.75 <hashtable> dup clone = ] unit-test
+{ t } [ 0.75 <hashtable> dup clone = ] unit-test
! Another crash discovered by erg
-[ ] [
+{ } [
H{ } clone
[ 1 swap set-at ] ignore-errors
[ 2 swap set-at ] ignore-errors
drop
] unit-test
-[ H{ { -1 4 } { -3 16 } { -5 36 } } ] [
+{ H{ { -1 4 } { -3 16 } { -5 36 } } } [
H{ { 1 2 } { 3 4 } { 5 6 } }
[ [ neg ] dip sq ] assoc-map
] unit-test
! Bug discovered by littledan
-[ { 5 5 5 5 } ] [
+{ { 5 5 5 5 } } [
[
H{
{ 1 2 }
] { } make
] unit-test
-[ { "one" "two" 3 } ] [
+{ { "one" "two" 3 } } [
{ 1 2 3 } H{ { 1 "one" } { 2 "two" } } substitute
] unit-test
! We want this to work
-[ ] [ hashtable new "h" set ] unit-test
+{ } [ hashtable new "h" set ] unit-test
-[ 0 ] [ "h" get assoc-size ] unit-test
+{ 0 } [ "h" get assoc-size ] unit-test
-[ f f ] [ "goo" "h" get at* ] unit-test
+{ f f } [ "goo" "h" get at* ] unit-test
-[ ] [ 1 2 "h" get set-at ] unit-test
+{ } [ 1 2 "h" get set-at ] unit-test
-[ 1 ] [ "h" get assoc-size ] unit-test
+{ 1 } [ "h" get assoc-size ] unit-test
-[ 1 ] [ 2 "h" get at ] unit-test
+{ 1 } [ 2 "h" get at ] unit-test
! Random test case
-[ "A" ] [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test
+{ "A" } [ 100 iota [ dup ] H{ } map>assoc 32 over delete-at "A" 32 pick set-at 32 of ] unit-test
USING: tools.test io.backend kernel ;
IN: io.backend.tests
-[ ] [ "a" normalize-path drop ] unit-test
+{ } [ "a" normalize-path drop ] unit-test
USING: io.binary tools.test classes math ;
IN: io.binary.tests
-[ 0x03020100 ] [ B{ 0 1 2 3 } le> ] unit-test
-[ 0x00010203 ] [ B{ 0 1 2 3 } be> ] unit-test
+{ 0x03020100 } [ B{ 0 1 2 3 } le> ] unit-test
+{ 0x00010203 } [ B{ 0 1 2 3 } be> ] unit-test
-[ 0x332211 ] [
+{ 0x332211 } [
B{ 0x11 0x22 0x33 } le>
] unit-test
{ -12 } [ B{ 0xf4 0xff 0xff 0xff } signed-le> ] unit-test
{ -12 } [ B{ 0xff 0xff 0xff 0xf4 } signed-be> ] unit-test
-[ 0x7a2c793b2ff08554 ] [
+{ 0x7a2c793b2ff08554 } [
B{ 0x54 0x85 0xf0 0x2f 0x3b 0x79 0x2c 0x7a } le>
] unit-test
-[ 0x988a259c3433f237 ] [
+{ 0x988a259c3433f237 } [
B{ 0x37 0xf2 0x33 0x34 0x9c 0x25 0x8a 0x98 } le>
] unit-test
-[ B{ 0 0 4 0xd2 } ] [ 1234 4 >be ] unit-test
-[ B{ 0 0 0 0 0 0 4 0xd2 } ] [ 1234 8 >be ] unit-test
-[ B{ 0xd2 4 0 0 } ] [ 1234 4 >le ] unit-test
-[ B{ 0xd2 4 0 0 0 0 0 0 } ] [ 1234 8 >le ] unit-test
+{ B{ 0 0 4 0xd2 } } [ 1234 4 >be ] unit-test
+{ B{ 0 0 0 0 0 0 4 0xd2 } } [ 1234 8 >be ] unit-test
+{ B{ 0xd2 4 0 0 } } [ 1234 4 >le ] unit-test
+{ B{ 0xd2 4 0 0 0 0 0 0 } } [ 1234 8 >le ] unit-test
-[ 1234 ] [ 1234 4 >be be> ] unit-test
-[ 1234 ] [ 1234 4 >le le> ] unit-test
+{ 1234 } [ 1234 4 >be be> ] unit-test
+{ 1234 } [ 1234 4 >le le> ] unit-test
-[ fixnum ] [ B{ 0 0 0 0 0 0 0 0 0 0 } be> class-of ] unit-test
+{ fixnum } [ B{ 0 0 0 0 0 0 0 0 0 0 } be> class-of ] unit-test
-[ 0x56780000 0x12340000 ] [ 0x1234000056780000 d>w/w ] unit-test
-[ 0x5678 0x1234 ] [ 0x12345678 w>h/h ] unit-test
-[ 0x34 0x12 ] [ 0x1234 h>b/b ] unit-test
+{ 0x56780000 0x12340000 } [ 0x1234000056780000 d>w/w ] unit-test
+{ 0x5678 0x1234 } [ 0x12345678 w>h/h ] unit-test
+{ 0x34 0x12 } [ 0x1234 h>b/b ] unit-test
USING: io.encodings.string io.encodings.ascii tools.test strings arrays ;
IN: io.encodings.ascii.tests
-[ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" ascii encode ] unit-test
+{ B{ CHAR: f CHAR: o CHAR: o } } [ "foo" ascii encode ] unit-test
[ { 128 } >string ascii encode ] must-fail
-[ B{ 127 } ] [ { 127 } >string ascii encode ] unit-test
+{ B{ 127 } } [ { 127 } >string ascii encode ] unit-test
-[ "bar" ] [ "bar" ascii decode ] unit-test
-[ { CHAR: b 0xfffd CHAR: r } ] [ B{ CHAR: b 233 CHAR: r } ascii decode >array ] unit-test
+{ "bar" } [ "bar" ascii decode ] unit-test
+{ { CHAR: b 0xfffd CHAR: r } } [ B{ CHAR: b 233 CHAR: r } ascii decode >array ] unit-test
tools.test ;
IN: io.encodings.tests
-[ { } ]
+{ { } }
[ "vocab:io/test/empty-file.txt" ascii file-lines ]
unit-test
: lines-test ( file encoding -- line1 line2 )
[ readln readln ] with-file-reader ;
-[
+{
"This is a line."
"This is another line."
-] [
+} [
"vocab:io/test/windows-eol.txt"
ascii lines-test
] unit-test
-[
+{
"This is a line."
"This is another line."
-] [
+} [
"vocab:io/test/mac-os-eol.txt"
ascii lines-test
] unit-test
-[
+{
"This is a line."
"This is another line."
-] [
+} [
"vocab:io/test/unix-eol.txt"
ascii lines-test
] unit-test
-[
+{
"1234"
-] [
+} [
"Hello world\r\n1234" <string-reader>
dup stream-readln drop
4 swap stream-read
] unit-test
-[
+{
"1234"
-] [
+} [
"Hello world\r\n1234" <string-reader>
dup stream-readln drop
4 swap stream-read-partial
] unit-test
-[
+{
CHAR: 1
-] [
+} [
"Hello world\r\n1234" <string-reader>
dup stream-readln drop
stream-read1
] unit-test
-[ utf8 ascii ] [
+{ utf8 ascii } [
"foo" utf8 [
input-stream get code>>
ascii decode-input
] with-byte-reader
] unit-test
-[ utf8 ascii ] [
+{ utf8 ascii } [
utf8 [
output-stream get code>>
ascii encode-output
io.encodings.string alien.c-types alien.strings accessors classes ;
IN: io.encodings.utf16.tests
-[ { CHAR: x } ] [ B{ 0 CHAR: x } utf16be decode >array ] unit-test
-[ { 0x1D11E } ] [ B{ 0xD8 0x34 0xDD 0x1E } utf16be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ B{ 0b11011111 CHAR: q } utf16be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ B{ 0b11011011 CHAR: x 0b11011011 CHAR: x } utf16be decode >array ] unit-test
+{ { CHAR: x } } [ B{ 0 CHAR: x } utf16be decode >array ] unit-test
+{ { 0x1D11E } } [ B{ 0xD8 0x34 0xDD 0x1E } utf16be decode >array ] unit-test
+{ { CHAR: replacement-character } } [ B{ 0b11011111 CHAR: q } utf16be decode >array ] unit-test
+{ { CHAR: replacement-character } } [ B{ 0b11011011 CHAR: x 0b11011011 CHAR: x } utf16be decode >array ] unit-test
-[ { 0 120 216 52 221 30 } ] [ { CHAR: x 0x1d11e } >string utf16be encode >array ] unit-test
+{ { 0 120 216 52 221 30 } } [ { CHAR: x 0x1d11e } >string utf16be encode >array ] unit-test
-[ { CHAR: x } ] [ B{ CHAR: x 0 } utf16le decode >array ] unit-test
-[ { 119070 } ] [ B{ 0x34 0xD8 0x1E 0xDD } >string utf16le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 0b11011111 } >string utf16le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 0b11011011 0 0 } >string utf16le decode >array ] unit-test
+{ { CHAR: x } } [ B{ CHAR: x 0 } utf16le decode >array ] unit-test
+{ { 119070 } } [ B{ 0x34 0xD8 0x1E 0xDD } >string utf16le decode >array ] unit-test
+{ { CHAR: replacement-character } } [ { 0 0b11011111 } >string utf16le decode >array ] unit-test
+{ { CHAR: replacement-character } } [ { 0 0b11011011 0 0 } >string utf16le decode >array ] unit-test
-[ { 120 0 52 216 30 221 } ] [ { CHAR: x 0x1d11e } >string utf16le encode >array ] unit-test
+{ { 120 0 52 216 30 221 } } [ { CHAR: x 0x1d11e } >string utf16le encode >array ] unit-test
-[ { CHAR: x } ] [ B{ 0xff 0xfe CHAR: x 0 } utf16 decode >array ] unit-test
-[ { CHAR: x } ] [ B{ 0xfe 0xff 0 CHAR: x } utf16 decode >array ] unit-test
+{ { CHAR: x } } [ B{ 0xff 0xfe CHAR: x 0 } utf16 decode >array ] unit-test
+{ { CHAR: x } } [ B{ 0xfe 0xff 0 CHAR: x } utf16 decode >array ] unit-test
-[ { 0xff 0xfe 120 0 52 216 30 221 } ] [ { CHAR: x 0x1d11e } >string utf16 encode >array ] unit-test
+{ { 0xff 0xfe 120 0 52 216 30 221 } } [ { CHAR: x 0x1d11e } >string utf16 encode >array ] unit-test
! test ascii encoding path
-[ B{ CHAR: a 0 CHAR: b 0 CHAR: c 0 } ] [ "abc" utf16le encode ] unit-test
-[ B{ 0 CHAR: a 0 CHAR: b 0 CHAR: c } ] [ "abc" utf16be encode ] unit-test
+{ B{ CHAR: a 0 CHAR: b 0 CHAR: c 0 } } [ "abc" utf16le encode ] unit-test
+{ B{ 0 CHAR: a 0 CHAR: b 0 CHAR: c } } [ "abc" utf16be encode ] unit-test
: correct-endian ( obj -- ? )
code>> little-endian? [ utf16le = ] [ utf16be = ] if ;
-[ t ] [ B{ } utf16n <byte-reader> correct-endian ] unit-test
-[ t ] [ utf16n <byte-writer> correct-endian ] unit-test
+{ t } [ B{ } utf16n <byte-reader> correct-endian ] unit-test
+{ t } [ utf16n <byte-writer> correct-endian ] unit-test
: encode-utf8-w/stream ( array -- newarray )
>string utf8 encode >array ;
-[ { CHAR: replacement-character } ] [ { 0b11110,101 0b10,111111 0b10,000000 0b11111111 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b11110,101 0b10,111111 0b10,000000 0b11111111 } decode-utf8-w/stream ] unit-test
-[ "x" ] [ "x" decode-utf8-w/stream >string ] unit-test
+{ "x" } [ "x" decode-utf8-w/stream >string ] unit-test
-[ { 0b11111000000 } ] [ { 0b110,11111 0b10,000000 } decode-utf8-w/stream >array ] unit-test
+{ { 0b11111000000 } } [ { 0b110,11111 0b10,000000 } decode-utf8-w/stream >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b10000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b10000000 } decode-utf8-w/stream ] unit-test
-[ { 0b1111000000111111 } ] [ { 0b1110,1111 0b10,000000 0b10,111111 } decode-utf8-w/stream >array ] unit-test
+{ { 0b1111000000111111 } } [ { 0b1110,1111 0b10,000000 0b10,111111 } decode-utf8-w/stream >array ] unit-test
-[ { 0b11110,101 0b10,111111 0b10,000000 0b10,111111 0b1110,1111 0b10,000000 0b10,111111 0b110,11111 0b10,000000 CHAR: x } ]
+{ { 0b11110,101 0b10,111111 0b10,000000 0b10,111111 0b1110,1111 0b10,000000 0b10,111111 0b110,11111 0b10,000000 CHAR: x } }
[ { 0b101111111000000111111 0b1111000000111111 0b11111000000 CHAR: x } encode-utf8-w/stream ] unit-test
-[ 3 ] [ 1 "日本語" >utf8-index ] unit-test
-[ 3 ] [ 9 "日本語" utf8-index> ] unit-test
+{ 3 } [ 1 "日本語" >utf8-index ] unit-test
+{ 3 } [ 9 "日本語" utf8-index> ] unit-test
-[ 3 ] [ 2 "lápis" >utf8-index ] unit-test
+{ 3 } [ 2 "lápis" >utf8-index ] unit-test
-[ V{ } ] [ 100000 iota [ [ code-point-length ] [ 1string utf8 encode length ] bi = ] reject ] unit-test
+{ V{ } } [ 100000 iota [ [ code-point-length ] [ 1string utf8 encode length ] bi = ] reject ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b110,00000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b110,00001 0b10,111111 } decode-utf8-w/stream ] unit-test
-[ { 0x80 } ] [ { 0b110,00010 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b110,00000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b110,00001 0b10,111111 } decode-utf8-w/stream ] unit-test
+{ { 0x80 } } [ { 0b110,00010 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b1110,0000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b1110,0000 0b10,011111 0b10,111111 } decode-utf8-w/stream ] unit-test
-[ { 0x800 } ] [ { 0b1110,0000 0b10,100000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b1110,0000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b1110,0000 0b10,011111 0b10,111111 } decode-utf8-w/stream ] unit-test
+{ { 0x800 } } [ { 0b1110,0000 0b10,100000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b11110,000 0b10,000000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b11110,000 0b10,001111 0b10,111111 0b10,111111 } decode-utf8-w/stream ] unit-test
-[ { CHAR: replacement-character } ] [ { 0b11110,100 0b10,010000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { 0x10000 } ] [ { 0b11110,000 0b10,010000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
-[ { 0x10FFFF } ] [ { 0b11110,100 0b10,001111 0b10,111111 0b10,111111 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b11110,000 0b10,000000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b11110,000 0b10,001111 0b10,111111 0b10,111111 } decode-utf8-w/stream ] unit-test
+{ { CHAR: replacement-character } } [ { 0b11110,100 0b10,010000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { 0x10000 } } [ { 0b11110,000 0b10,010000 0b10,000000 0b10,000000 } decode-utf8-w/stream ] unit-test
+{ { 0x10FFFF } } [ { 0b11110,100 0b10,001111 0b10,111111 0b10,111111 } decode-utf8-w/stream ] unit-test
SPECIALIZED-ARRAY: int
IN: io.files.tests
-[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
+{ } [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
-[ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
+{ } [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
-[
+{
"This is a line.\rThis is another line.\r"
-] [
+} [
"vocab:io/test/mac-os-eol.txt" latin1
[ 500 read ] with-file-reader
] unit-test
-[
+{
255
-] [
+} [
"vocab:io/test/binary.txt" latin1
[ read1 ] with-file-reader >fixnum
] unit-test
-[
+{
"This" CHAR: \s
-] [
+} [
"vocab:io/test/read-until-test.txt" ascii
[ " " read-until ] with-file-reader
] unit-test
-[
+{
"This" CHAR: \s
-] [
+} [
"vocab:io/test/read-until-test.txt" binary
[ " " read-until [ ascii decode ] dip ] with-file-reader
] unit-test
-[ ] [
+{ } [
"It seems Jobs has lost his grasp on reality again.\n"
"separator-test.txt" temp-file latin1 set-file-contents
] unit-test
-[
+{
{
{ "It seems " CHAR: J }
{ "obs has lost h" CHAR: i }
{ "s grasp on reality again.\n" f }
}
-] [
+} [
[
"separator-test.txt" temp-file
latin1 [
] { } make
] unit-test
-[ ] [
+{ } [
image binary [
10 [ 65536 read drop ] times
] with-file-reader
] unit-test
! Writing specialized arrays to binary streams should work
-[ ] [
+{ } [
"test.txt" temp-file binary [
int-array{ 1 2 3 } write
] with-file-writer
] unit-test
-[ int-array{ 1 2 3 } ] [
+{ int-array{ 1 2 3 } } [
"test.txt" temp-file binary [
3 4 * read
] with-file-reader
int cast-array
] unit-test
-[ ] [
+{ } [
BV{ 0 1 2 } "test.txt" temp-file binary set-file-contents
] unit-test
-[ t ] [
+{ t } [
"test.txt" temp-file binary file-contents
B{ 0 1 2 } =
] unit-test
CONSTANT: pt-array-1
pt-array{ S{ pt f 1 1 } S{ pt f 2 2 } S{ pt f 3 3 } }
-[ ] [
+{ } [
pt-array-1
"test.txt" temp-file binary set-file-contents
] unit-test
-[ t ] [
+{ t } [
"test.txt" temp-file binary file-contents
pt-array-1 >c-ptr sequence=
] unit-test
! Slices should support >c-ptr and byte-length
-[ ] [
+{ } [
pt-array-1 rest-slice
"test.txt" temp-file binary set-file-contents
] unit-test
-[ t ] [
+{ t } [
"test.txt" temp-file binary file-contents
pt cast-array
pt-array-1 rest-slice sequence=
] unit-test
-[ ] [
+{ } [
[
pt specialized-array-vocab forget-vocab
] with-compilation-unit
] must-fail
! Test EOF behavior
-[ 10 ] [
+{ 10 } [
image binary [
0 read drop
10 read length
] unit-test
! Make sure that writing to a closed stream from another thread doesn't crash
-[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+{ } [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" temp-file delete-file ] unit-test
+{ } [ "test-quux.txt" temp-file delete-file ] unit-test
-[ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
+{ } [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
-[ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
+{ } [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
-[ t ] [ "quux-test.txt" temp-file exists? ] unit-test
+{ t } [ "quux-test.txt" temp-file exists? ] unit-test
-[ ] [ "quux-test.txt" temp-file delete-file ] unit-test
+{ } [ "quux-test.txt" temp-file delete-file ] unit-test
! File seeking tests
-[ B{ 3 2 3 4 5 } ]
+{ B{ 3 2 3 4 5 } }
[
"seek-test1" unique-file binary
[
] 2bi
] unit-test
-[ B{ 1 2 3 4 3 } ]
+{ B{ 1 2 3 4 3 } }
[
"seek-test2" unique-file binary
[
] 2bi
] unit-test
-[ B{ 1 2 3 4 5 0 3 } ]
+{ B{ 1 2 3 4 5 0 3 } }
[
"seek-test3" unique-file binary
[
] 2bi
] unit-test
-[ B{ 3 } ]
+{ B{ 3 } }
[
B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
set-file-contents
] 2bi
] unit-test
-[ B{ 2 } ]
+{ B{ 2 } }
[
B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
set-file-contents
] with-file-reader
] must-fail
-[ ] [
+{ } [
"resource:license.txt" binary [
44 read drop
tell-input 44 assert=
] [ no-method? ] must-fail-with
! What happens if we close a file twice?
-[ ] [
+{ } [
"closing-twice" unique-file ascii <file-writer>
[ dispose ] [ dispose ] bi
] unit-test
{ SBUF" asdf" }
[ "asdf" <string-reader> 4 <sbuf> [ stream-copy ] keep ] unit-test
-[ "asdf" ]
+{ "asdf" }
[
[
[ "asdf" error-stream get stream-write ] with-error>output
] with-string-writer
] unit-test
-[ "asdf" ]
+{ "asdf" }
[
<string-writer> [
[
io.backend io.pathnames.private ;
IN: io.pathnames.tests
-[ "passwd" ] [ "/etc/passwd" file-name ] unit-test
-[ "awk" ] [ "/usr/libexec/awk/" file-name ] unit-test
-[ "awk" ] [ "/usr/libexec/awk///" file-name ] unit-test
-[ "" ] [ "" file-name ] unit-test
-
-[ "freetype6.dll" ] [ "resource:freetype6.dll" file-name ] unit-test
-[ "freetype6.dll" ] [ "resource:/freetype6.dll" file-name ] unit-test
-
-[ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
-[ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
-[ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
-[ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
-[ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
-[ "/lib/" ] [ "/usr" "../lib/" append-path ] unit-test
-
-[ "" ] [ "" "." append-path ] unit-test
+{ "passwd" } [ "/etc/passwd" file-name ] unit-test
+{ "awk" } [ "/usr/libexec/awk/" file-name ] unit-test
+{ "awk" } [ "/usr/libexec/awk///" file-name ] unit-test
+{ "" } [ "" file-name ] unit-test
+
+{ "freetype6.dll" } [ "resource:freetype6.dll" file-name ] unit-test
+{ "freetype6.dll" } [ "resource:/freetype6.dll" file-name ] unit-test
+
+{ "/usr/lib" } [ "/usr" "lib" append-path ] unit-test
+{ "/usr/lib" } [ "/usr/" "lib" append-path ] unit-test
+{ "/usr/lib" } [ "/usr" "./lib" append-path ] unit-test
+{ "/usr/lib/" } [ "/usr" "./lib/" append-path ] unit-test
+{ "/lib" } [ "/usr" "../lib" append-path ] unit-test
+{ "/lib/" } [ "/usr" "../lib/" append-path ] unit-test
+
+{ "" } [ "" "." append-path ] unit-test
[ "" ".." append-path ] must-fail
-[ "/" ] [ "/" "./." append-path ] unit-test
-[ "/" ] [ "/" "././" append-path ] unit-test
-[ "/a/b/lib" ] [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
-[ "/a/b/lib/" ] [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
+{ "/" } [ "/" "./." append-path ] unit-test
+{ "/" } [ "/" "././" append-path ] unit-test
+{ "/a/b/lib" } [ "/a/b/c/d/e/f/" "../../../../lib" append-path ] unit-test
+{ "/a/b/lib/" } [ "/a/b/c/d/e/f/" "../../../../lib/" append-path ] unit-test
[ "" "../lib/" append-path ] must-fail
-[ "lib" ] [ "" "lib" append-path ] unit-test
-[ "lib" ] [ "" "./lib" append-path ] unit-test
+{ "lib" } [ "" "lib" append-path ] unit-test
+{ "lib" } [ "" "./lib" append-path ] unit-test
[ "foo/bar/." parent-directory ] must-fail
[ "foo/bar/./" parent-directory ] must-fail
[ "foo/.." parent-directory ] must-fail
[ "foo/../" parent-directory ] must-fail
[ "" parent-directory ] must-fail
-[ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
+{ "." } [ "boot.x86.64.image" parent-directory ] unit-test
-[ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
-[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
-[ "bar/foo" ] [ "bar/baz" "./..//foo" append-path ] unit-test
-[ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
+{ "bar/foo" } [ "bar/baz" "..///foo" append-path ] unit-test
+{ "bar/baz/foo" } [ "bar/baz" ".///foo" append-path ] unit-test
+{ "bar/foo" } [ "bar/baz" "./..//foo" append-path ] unit-test
+{ "bar/foo" } [ "bar/baz" "./../././././././///foo" append-path ] unit-test
-[ t ] [ "resource:core" absolute-path? ] unit-test
-[ f ] [ "" absolute-path? ] unit-test
+{ t } [ "resource:core" absolute-path? ] unit-test
+{ f } [ "" absolute-path? ] unit-test
[ "touch-twice-test" temp-file delete-file ] ignore-errors
-[ ] [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
+{ } [ 2 [ "touch-twice-test" temp-file touch-file ] times ] unit-test
! aum's bug
[
unit-test
] with-scope
-[ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
+{ t } [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
! Regression test for bug in file-extension
-[ f ] [ "/funny.directory/file-with-no-extension" file-extension ] unit-test
-[ "" ] [ "/funny.directory/file-with-no-extension." file-extension ] unit-test
+{ f } [ "/funny.directory/file-with-no-extension" file-extension ] unit-test
+{ "" } [ "/funny.directory/file-with-no-extension." file-extension ] unit-test
! Testing ~ special pathname
-[ t ] [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test
-[ t ] [ "~/" home [ normalize-path ] same? ] unit-test
+{ t } [ os windows? "~\\" "~/" ? absolute-path home = ] unit-test
+{ t } [ "~/" home [ normalize-path ] same? ] unit-test
-[ t ] [ "~" absolute-path home = ] unit-test
-[ t ] [ "~" home [ normalize-path ] same? ] unit-test
+{ t } [ "~" absolute-path home = ] unit-test
+{ t } [ "~" home [ normalize-path ] same? ] unit-test
-[ t ] [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] same? ] unit-test
-[ t ] [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] same? ] unit-test
+{ t } [ "~" home [ "foo" append-path ] bi@ [ normalize-path ] same? ] unit-test
+{ t } [ os windows? "~\\~/" "~/~/" ? "~" "~" append-path [ path-components ] same? ] unit-test
SPECIALIZED-ARRAY: int
IN: io.streams.byte-array.tests
-[ B{ } ] [ B{ } binary [ contents ] with-byte-reader ] unit-test
+{ B{ } } [ B{ } binary [ contents ] with-byte-reader ] unit-test
! Issue #70 github
-[ f ] [ B{ } binary [ 0 read ] with-byte-reader ] unit-test
-[ f ] [ B{ } binary [ 1 read ] with-byte-reader ] unit-test
-[ f ] [ B{ } ascii [ 0 read ] with-byte-reader ] unit-test
-[ f ] [ B{ } ascii [ readln ] with-byte-reader ] unit-test
-[ f f ] [ B{ } ascii [ "a" read-until ] with-byte-reader ] unit-test
-[ f f ] [ B{ } binary [ { 2 } read-until ] with-byte-reader ] unit-test
+{ f } [ B{ } binary [ 0 read ] with-byte-reader ] unit-test
+{ f } [ B{ } binary [ 1 read ] with-byte-reader ] unit-test
+{ f } [ B{ } ascii [ 0 read ] with-byte-reader ] unit-test
+{ f } [ B{ } ascii [ readln ] with-byte-reader ] unit-test
+{ f f } [ B{ } ascii [ "a" read-until ] with-byte-reader ] unit-test
+{ f f } [ B{ } binary [ { 2 } read-until ] with-byte-reader ] unit-test
-[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
-[ B{ 1 2 3 4 5 6 } ] [ binary [ B{ 1 2 3 } write B{ 4 5 6 } write ] with-byte-writer ] unit-test
-[ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
+{ B{ 1 2 3 } } [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
+{ B{ 1 2 3 4 5 6 } } [ binary [ B{ 1 2 3 } write B{ 4 5 6 } write ] with-byte-writer ] unit-test
+{ B{ 1 2 3 } } [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
-[ B{ 0b11110101 0b10111111 0b10000000 0b10111111 0b11101111 0b10000000 0b10111111 0b11011111 0b10000000 CHAR: x } ]
+{ B{ 0b11110101 0b10111111 0b10000000 0b10111111 0b11101111 0b10000000 0b10111111 0b11011111 0b10000000 CHAR: x } }
[ { 0b101111111000000111111 0b1111000000111111 0b11111000000 CHAR: x } >string utf8 [ write ] with-byte-writer ] unit-test
-[ { 0b1111111000000111111 } t ] [ { 0b11110001 0b10111111 0b10000000 0b10111111 } utf8 <byte-reader> stream-contents dup >array swap string? ] unit-test
+{ { 0b1111111000000111111 } t } [ { 0b11110001 0b10111111 0b10000000 0b10111111 } utf8 <byte-reader> stream-contents dup >array swap string? ] unit-test
-[ B{ 121 120 } 0 ] [
+{ B{ 121 120 } 0 } [
B{ 0 121 120 0 0 0 0 0 0 } binary
[ 1 read drop "\0" read-until ] with-byte-reader
] unit-test
B{ } binary [ B{ 0 } read-until ] with-byte-reader
] unit-test
-[ 1 1 4 11 f ] [
+{ 1 1 4 11 f } [
B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary
[
read1
] with-byte-reader
] unit-test
-[ 0 ] [
+{ 0 } [
B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary [ tell-input ] with-byte-reader
] unit-test
! Overly aggressive compiler optimizations
-[ B{ 123 } ] [
+{ B{ 123 } } [
binary [ 123 >bignum write1 ] with-byte-writer
] unit-test
! Writing specialized arrays to byte writers
-[ int-array{ 1 2 3 } ] [
+{ int-array{ 1 2 3 } } [
binary [ int-array{ 1 2 3 } write ] with-byte-writer
int cast-array
] unit-test
SPECIALIZED-ARRAY: int
IN: io.streams.c.tests
-[ "hello world" ] [
+{ "hello world" } [
"hello world" "test.txt" temp-file ascii set-file-contents
"test.txt" temp-file "rb" fopen <c-reader> stream-contents
] unit-test
! Writing specialized arrays to binary streams
-[ ] [
+{ } [
"test.txt" temp-file "wb" fopen <c-writer> [
int-array{ 1 2 3 } write
] with-output-stream
] unit-test
-[ int-array{ 1 2 3 } ] [
+{ int-array{ 1 2 3 } } [
"test.txt" temp-file "rb" fopen <c-reader> [
3 4 * read
] with-input-stream
system alien alien.accessors kernel.private ;
IN: kernel.tests
-[ 0 ] [ f size ] unit-test
-[ t ] [ [ \ = \ = ] all-equal? ] unit-test
+{ 0 } [ f size ] unit-test
+{ t } [ [ \ = \ = ] all-equal? ] unit-test
-[
+{
{
{ 1 2 0 }
{ 1 2 1 }
{ 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 [ [ 3 throw ] ignore-errors ] times ] unit-test
-
[ ] [ 1000 [ [ -1 f <array> ] ignore-errors ] times ] unit-test
+
{ } [ 1000 [ [ -1 f <array> ] ignore-errors ] times ] unit-test
! Make sure we report the correct error on stack underflow
[ clear drop ] [
${ "kernel-error" ERROR-DATASTACK-UNDERFLOW f f } =
] must-fail-with
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
[
3 [ { } set-retainstack ] dip ]
[ ${ "kernel-error" ERROR-RETAINSTACK-UNDERFLOW f f } =
] must-fail-with
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
: overflow-d ( -- ) 3 overflow-d ;
${ "kernel-error" ERROR-DATASTACK-OVERFLOW f f } =
] must-fail-with
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
[ overflow-d-alt ] [
${ "kernel-error" ERROR-DATASTACK-OVERFLOW f f } =
] must-fail-with
-[ ] [ [ :c ] with-string-writer drop ] unit-test
+{ } [ [ :c ] with-string-writer drop ] unit-test
[ overflow-r ] [
${ "kernel-error" ERROR-RETAINSTACK-OVERFLOW f f } =
] must-fail-with
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
: overflow-c ( -- ) overflow-c overflow-c ;
[ -7 <byte-array> ] must-fail
-[ 3 ] [ t 3 and ] unit-test
-[ f ] [ f 3 and ] unit-test
-[ f ] [ 3 f and ] unit-test
-[ 4 ] [ 4 6 or ] unit-test
-[ 6 ] [ f 6 or ] unit-test
-[ f ] [ 1 2 xor ] unit-test
-[ 1 ] [ 1 f xor ] unit-test
-[ 2 ] [ f 2 xor ] unit-test
-[ f ] [ f f xor ] unit-test
+{ 3 } [ t 3 and ] unit-test
+{ f } [ f 3 and ] unit-test
+{ f } [ 3 f and ] unit-test
+{ 4 } [ 4 6 or ] unit-test
+{ 6 } [ f 6 or ] unit-test
+{ f } [ 1 2 xor ] unit-test
+{ 1 } [ 1 f xor ] unit-test
+{ 2 } [ f 2 xor ] unit-test
+{ f } [ f f xor ] unit-test
[ dip ] must-fail
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
[ 1 [ call ] dip ] must-fail
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
[ 1 2 [ call ] dip ] must-fail
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
-[ 5 ] [ 1 [ 2 2 + ] dip + ] unit-test
+{ 5 } [ 1 [ 2 2 + ] dip + ] unit-test
[ [ ] keep ] must-fail
-[ 6 ] [ 2 [ sq ] keep + ] unit-test
+{ 6 } [ 2 [ sq ] keep + ] unit-test
[ [ ] 2keep ] must-fail
[ 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
-[ 4 ] [ 2 [ sq ] [ 0 ] if* ] unit-test
+{ 0 } [ f [ sq ] [ 0 ] if* ] unit-test
+{ 4 } [ 2 [ sq ] [ 0 ] if* ] unit-test
-[ 0 ] [ f [ 0 ] unless* ] unit-test
-[ t ] [ t [ "Hello" ] unless* ] unit-test
+{ 0 } [ f [ 0 ] unless* ] unit-test
+{ t } [ t [ "Hello" ] unless* ] unit-test
-[ "2\n" ] [ [ 1 2 [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
-[ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
+{ "2\n" } [ [ 1 2 [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
+{ "9\n" } [ [ 3 f [ . ] [ sq . ] ?if ] with-string-writer ] unit-test
-[ f ] [ f (clone) ] unit-test
-[ -123 ] [ -123 (clone) ] unit-test
+{ f } [ f (clone) ] unit-test
+{ -123 } [ -123 (clone) ] unit-test
-[ 6 2 ] [ 1 2 [ 5 + ] dip ] unit-test
+{ 6 2 } [ 1 2 [ 5 + ] dip ] unit-test
-[ ] [ callstack set-callstack ] unit-test
+{ } [ callstack set-callstack ] unit-test
[ 3drop datastack ] must-fail
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
! Doesn't compile; important
: foo ( a -- b ) ;
<< \ foo t "no-compile" set-word-prop >>
[ drop foo ] must-fail
-[ ] [ :c ] unit-test
+{ } [ :c ] unit-test
! Regression
: (loop) ( a b c d -- )
[ 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
+{ 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
-[ 4 ] [ 1 { [ 1 ] [ 2 ] } dispatch sq ] unit-test
+{ 4 } [ 1 { [ 1 ] [ 2 ] } dispatch sq ] unit-test
! Test traceback accuracy
: last-frame ( -- pair )
error-continuation get call>> callstack>array 6 head* 3 tail* ;
-[
+{
{ [ 1 2 [ 3 throw ] call 4 ] [ 1 2 [ 3 throw ] call 4 ] 3 }
-] [
+} [
[ [ 1 2 [ 3 throw ] call 4 ] call ] ignore-errors
last-frame
] unit-test
-[
+{
{ [ 1 2 [ 3 throw ] dip 4 ] [ 1 2 [ 3 throw ] dip 4 ] 3 }
-] [
+} [
[ [ 1 2 [ 3 throw ] dip 4 ] call ] ignore-errors
last-frame
] unit-test
-[
+{
{ [ 1 2 3 throw [ ] call 4 ] [ 1 2 3 throw [ ] call 4 ] 3 }
-] [
+} [
[ [ 1 2 3 throw [ ] call 4 ] call ] ignore-errors
last-frame
] unit-test
-[
+{
{ [ 1 2 3 throw [ ] dip 4 ] [ 1 2 3 throw [ ] dip 4 ] 3 }
-] [
+} [
[ [ 1 2 3 throw [ ] dip 4 ] call ] ignore-errors
last-frame
] unit-test
-[
+{
{ [ 1 2 3 throw [ ] [ ] if 4 ] [ 1 2 3 throw [ ] [ ] if 4 ] 3 }
-] [
+} [
[ [ 1 2 3 throw [ ] [ ] if 4 ] call ] ignore-errors
last-frame
] unit-test
-[ 10 2 3 4 5 ] [ 1 2 3 4 5 [ 10 * ] 4dip ] unit-test
+{ 10 2 3 4 5 } [ 1 2 3 4 5 [ 10 * ] 4dip ] unit-test
-[ 3 -1 5/6 ] [ 1 2 3 4 5 6 [ + ] [ - ] [ / ] 2tri* ] unit-test
+{ 3 -1 5/6 } [ 1 2 3 4 5 6 [ + ] [ - ] [ / ] 2tri* ] unit-test
-[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 2tri@ ] unit-test
+{ { 1 2 } { 3 4 } { 5 6 } } [ 1 2 3 4 5 6 [ 2array ] 2tri@ ] unit-test
-[ t ] [ { } identity-hashcode fixnum? ] unit-test
-[ 123 ] [ 123 identity-hashcode ] unit-test
-[ t ] [ f identity-hashcode fixnum? ] unit-test
+{ t } [ { } identity-hashcode fixnum? ] unit-test
+{ 123 } [ 123 identity-hashcode ] unit-test
+{ t } [ f identity-hashcode fixnum? ] unit-test
! Make sure memory protection faults work
[ f 0 alien-unsigned-1 ] [ vm-error? ] must-fail-with
USING: layouts math tools.test ;
IN: system.tests
-[ t ] [ cell integer? ] unit-test
-[ t ] [ bootstrap-cell integer? ] unit-test
+{ t } [ cell integer? ] unit-test
+{ t } [ bootstrap-cell integer? ] unit-test
! Smoke test
-[ t ] [ max-array-capacity cell-bits 2^ < ] unit-test
+{ t } [ max-array-capacity cell-bits 2^ < ] unit-test
-[ t ] [ most-negative-fixnum fixnum? ] unit-test
-[ t ] [ most-positive-fixnum fixnum? ] unit-test
+{ t } [ most-negative-fixnum fixnum? ] unit-test
+{ t } [ most-positive-fixnum fixnum? ] unit-test
grouping ;
IN: math.floats.tests
-[ t ] [ 0.0 float? ] unit-test
-[ t ] [ 3.1415 number? ] unit-test
-[ f ] [ 12 float? ] unit-test
+{ t } [ 0.0 float? ] unit-test
+{ t } [ 3.1415 number? ] unit-test
+{ f } [ 12 float? ] unit-test
-[ f ] [ 1 1.0 = ] unit-test
-[ t ] [ 1 1.0 number= ] unit-test
+{ f } [ 1 1.0 = ] unit-test
+{ t } [ 1 1.0 number= ] unit-test
-[ f ] [ 1 >bignum 1.0 = ] unit-test
-[ t ] [ 1 >bignum 1.0 number= ] unit-test
+{ f } [ 1 >bignum 1.0 = ] unit-test
+{ t } [ 1 >bignum 1.0 number= ] unit-test
-[ f ] [ 1.0 1 = ] unit-test
-[ t ] [ 1.0 1 number= ] unit-test
+{ f } [ 1.0 1 = ] unit-test
+{ t } [ 1.0 1 number= ] unit-test
-[ f ] [ 1.0 1 >bignum = ] unit-test
-[ t ] [ 1.0 1 >bignum number= ] unit-test
+{ f } [ 1.0 1 >bignum = ] unit-test
+{ t } [ 1.0 1 >bignum number= ] unit-test
-[ f ] [ 1 1.3 = ] unit-test
-[ f ] [ 1 >bignum 1.3 = ] unit-test
-[ f ] [ 1.3 1 = ] unit-test
-[ f ] [ 1.3 1 >bignum = ] unit-test
+{ f } [ 1 1.3 = ] unit-test
+{ f } [ 1 >bignum 1.3 = ] unit-test
+{ f } [ 1.3 1 = ] unit-test
+{ f } [ 1.3 1 >bignum = ] unit-test
-[ t ] [ 134.3 >fixnum 134 = ] unit-test
+{ t } [ 134.3 >fixnum 134 = ] unit-test
-[ 3 ] [ 3.5 >bignum ] unit-test
-[ -3 ] [ -3.5 >bignum ] unit-test
+{ 3 } [ 3.5 >bignum ] unit-test
+{ -3 } [ -3.5 >bignum ] unit-test
-[ 3 ] [ 3.5 >fixnum ] unit-test
-[ -3 ] [ -3.5 >fixnum ] unit-test
+{ 3 } [ 3.5 >fixnum ] unit-test
+{ -3 } [ -3.5 >fixnum ] unit-test
-[ 2.1 ] [ -2.1 neg ] unit-test
+{ 2.1 } [ -2.1 neg ] unit-test
-[ 3 ] [ 3.1415 >fixnum ] unit-test
-[ 3 ] [ 3.1415 >bignum ] unit-test
+{ 3 } [ 3.1415 >fixnum ] unit-test
+{ 3 } [ 3.1415 >bignum ] unit-test
-[ t ] [ pi 3 > ] unit-test
-[ f ] [ e 2 <= ] unit-test
+{ t } [ pi 3 > ] unit-test
+{ f } [ e 2 <= ] unit-test
-[ t ] [ 1.0 dup float>bits bits>float = ] unit-test
-[ t ] [ pi double>bits bits>double pi = ] unit-test
-[ t ] [ e double>bits bits>double e = ] unit-test
+{ t } [ 1.0 dup float>bits bits>float = ] unit-test
+{ t } [ pi double>bits bits>double pi = ] unit-test
+{ t } [ e double>bits bits>double e = ] unit-test
-[ 0b11111111111000000000000000000000000000000000000000000000000000 ]
+{ 0b11111111111000000000000000000000000000000000000000000000000000 }
[ 1.5 double>bits ] unit-test
-[ 1.5 ]
+{ 1.5 }
[ 0b11111111111000000000000000000000000000000000000000000000000000 bits>double ]
unit-test
-[ 2.0 ] [ 1.0 1 + ] unit-test
-[ 0.0 ] [ 1.0 1 - ] unit-test
+{ 2.0 } [ 1.0 1 + ] unit-test
+{ 0.0 } [ 1.0 1 - ] unit-test
-[ t ] [ 0.0 zero? ] unit-test
-[ t ] [ -0.0 zero? ] unit-test
+{ t } [ 0.0 zero? ] unit-test
+{ t } [ -0.0 zero? ] unit-test
-[ 0 ] [ 1/0. >bignum ] unit-test
+{ 0 } [ 1/0. >bignum ] unit-test
-[ t ] [ 64 iota [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
+{ t } [ 64 iota [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
-[ 5 ] [ 10.5 1.9 /i ] unit-test
+{ 5 } [ 10.5 1.9 /i ] unit-test
-[ t ] [ 0 0 /f fp-nan? ] unit-test
-[ t ] [ 0.0 0.0 /f fp-nan? ] unit-test
-[ t ] [ 0.0 0.0 / fp-nan? ] unit-test
-[ t ] [ 0 0 [ >bignum ] bi@ /f fp-nan? ] unit-test
+{ t } [ 0 0 /f fp-nan? ] unit-test
+{ t } [ 0.0 0.0 /f fp-nan? ] unit-test
+{ t } [ 0.0 0.0 / fp-nan? ] unit-test
+{ t } [ 0 0 [ >bignum ] bi@ /f fp-nan? ] unit-test
-[ 1/0. ] [ 1 0 /f ] unit-test
-[ 1/0. ] [ 1.0 0.0 /f ] unit-test
-[ 1/0. ] [ 1.0 0.0 / ] unit-test
-[ 1/0. ] [ 1 0 [ >bignum ] bi@ /f ] unit-test
+{ 1/0. } [ 1 0 /f ] unit-test
+{ 1/0. } [ 1.0 0.0 /f ] unit-test
+{ 1/0. } [ 1.0 0.0 / ] unit-test
+{ 1/0. } [ 1 0 [ >bignum ] bi@ /f ] unit-test
-[ -1/0. ] [ -1 0 /f ] unit-test
-[ -1/0. ] [ -1.0 0.0 /f ] unit-test
-[ -1/0. ] [ -1.0 0.0 / ] unit-test
-[ -1/0. ] [ -1 0 [ >bignum ] bi@ /f ] unit-test
+{ -1/0. } [ -1 0 /f ] unit-test
+{ -1/0. } [ -1.0 0.0 /f ] unit-test
+{ -1/0. } [ -1.0 0.0 / ] unit-test
+{ -1/0. } [ -1 0 [ >bignum ] bi@ /f ] unit-test
-[ t ] [ 0/0. 0/0. unordered? ] unit-test
-[ t ] [ 1.0 0/0. unordered? ] unit-test
-[ t ] [ 0/0. 1.0 unordered? ] unit-test
-[ f ] [ 1.0 1.0 unordered? ] unit-test
+{ t } [ 0/0. 0/0. unordered? ] unit-test
+{ t } [ 1.0 0/0. unordered? ] unit-test
+{ t } [ 0/0. 1.0 unordered? ] unit-test
+{ f } [ 1.0 1.0 unordered? ] unit-test
-[ t ] [ -0.0 fp-sign ] unit-test
-[ t ] [ -1.0 fp-sign ] unit-test
-[ f ] [ 0.0 fp-sign ] unit-test
-[ f ] [ 1.0 fp-sign ] unit-test
+{ t } [ -0.0 fp-sign ] unit-test
+{ t } [ -1.0 fp-sign ] unit-test
+{ f } [ 0.0 fp-sign ] unit-test
+{ f } [ 1.0 fp-sign ] unit-test
-[ t ] [ -0.0 abs 0.0 fp-bitwise= ] unit-test
-[ 1.5 ] [ -1.5 abs ] unit-test
-[ 1.5 ] [ 1.5 abs ] unit-test
+{ t } [ -0.0 abs 0.0 fp-bitwise= ] unit-test
+{ 1.5 } [ -1.5 abs ] unit-test
+{ 1.5 } [ 1.5 abs ] unit-test
-[ 5.0 ] [ 3 5.0 max ] unit-test
-[ 3 ] [ 3 5.0 min ] unit-test
+{ 5.0 } [ 3 5.0 max ] unit-test
+{ 3 } [ 3 5.0 min ] unit-test
{ 39 0x1.999999999998ap-4 } [ 4.0 .1 /mod ] unit-test
{ 38 0x1.9999999999984p-4 } [ 3.9 .1 /mod ] unit-test
[ "-8" ] [ -8 unparse ] unit-test
] with-variable
-[ t ] [ 0 fixnum? ] unit-test
-[ t ] [ 31415 number? ] unit-test
-[ t ] [ 31415 >bignum number? ] unit-test
-[ t ] [ 2345621 fixnum? ] unit-test
+{ t } [ 0 fixnum? ] unit-test
+{ t } [ 31415 number? ] unit-test
+{ t } [ 31415 >bignum number? ] unit-test
+{ t } [ 2345621 fixnum? ] unit-test
-[ t ] [ 2345621 dup >bignum >fixnum = ] unit-test
+{ t } [ 2345621 dup >bignum >fixnum = ] unit-test
-[ t ] [ 0 >fixnum 0 >bignum = ] unit-test
-[ f ] [ 0 >fixnum 1 >bignum = ] unit-test
-[ f ] [ 1 >bignum 0 >bignum = ] unit-test
-[ t ] [ 0 >bignum 0 >fixnum = ] unit-test
+{ t } [ 0 >fixnum 0 >bignum = ] unit-test
+{ f } [ 0 >fixnum 1 >bignum = ] unit-test
+{ f } [ 1 >bignum 0 >bignum = ] unit-test
+{ t } [ 0 >bignum 0 >fixnum = ] unit-test
-[ t ] [ 0 >bignum bignum? ] unit-test
-[ f ] [ 0 >fixnum bignum? ] unit-test
-[ f ] [ 0 >fixnum bignum? ] unit-test
-[ t ] [ 0 >fixnum fixnum? ] unit-test
+{ t } [ 0 >bignum bignum? ] unit-test
+{ f } [ 0 >fixnum bignum? ] unit-test
+{ f } [ 0 >fixnum bignum? ] unit-test
+{ t } [ 0 >fixnum fixnum? ] unit-test
-[ -1 ] [ 1 neg ] unit-test
-[ -1 ] [ 1 >bignum neg ] unit-test
-[ 134217728 ] [ -134217728 >fixnum -1 * ] unit-test
-[ 134217728 ] [ -134217728 >fixnum neg ] unit-test
+{ -1 } [ 1 neg ] unit-test
+{ -1 } [ 1 >bignum neg ] unit-test
+{ 134217728 } [ -134217728 >fixnum -1 * ] unit-test
+{ 134217728 } [ -134217728 >fixnum neg ] unit-test
-[ 9 3 ] [ 93 10 /mod ] unit-test
-[ 9 3 ] [ 93 >bignum 10 /mod ] unit-test
+{ 9 3 } [ 93 10 /mod ] unit-test
+{ 9 3 } [ 93 >bignum 10 /mod ] unit-test
-[ 5 ] [ 2 >bignum 3 >bignum + ] unit-test
+{ 5 } [ 2 >bignum 3 >bignum + ] unit-test
-[ -10000000001981284352 ] [
+{ -10000000001981284352 } [
-10000000000000000000
-0x100000000 bitand
] unit-test
-[ 9999999997686317056 ] [
+{ 9999999997686317056 } [
10000000000000000000
-0x100000000 bitand
] unit-test
-[ 4294967296 ] [
+{ 4294967296 } [
-10000000000000000000
0x100000000 bitand
] unit-test
-[ 0 ] [
+{ 0 } [
10000000000000000000
0x100000000 bitand
] unit-test
-[ -1 ] [ -1 >bignum >fixnum ] unit-test
+{ -1 } [ -1 >bignum >fixnum ] unit-test
10 number-base [
[ "8589934592" ]
unit-test
] with-variable
-[ 7 ] [ 255 log2 ] unit-test
-[ 8 ] [ 256 log2 ] unit-test
-[ 8 ] [ 257 log2 ] unit-test
-[ 0 ] [ 1 log2 ] unit-test
-
-[ 7 ] [ 255 >bignum log2 ] unit-test
-[ 8 ] [ 256 >bignum log2 ] unit-test
-[ 8 ] [ 257 >bignum log2 ] unit-test
-[ 0 ] [ 1 >bignum log2 ] unit-test
-
-[ f ] [ 0b1101 -1 bit? ] unit-test
-[ t ] [ 0b1101 0 bit? ] unit-test
-[ f ] [ 0b1101 1 bit? ] unit-test
-[ t ] [ 0b1101 2 bit? ] unit-test
-[ t ] [ 0b1101 3 bit? ] unit-test
-[ f ] [ 0b1101 4 bit? ] unit-test
-[ f ] [ 0b1101 1000 bit? ] unit-test
-
-[ f ] [ 0b1101 >bignum -1 bit? ] unit-test
-[ t ] [ 0b1101 >bignum 0 bit? ] unit-test
-[ f ] [ 0b1101 >bignum 1 bit? ] unit-test
-[ t ] [ 0b1101 >bignum 2 bit? ] unit-test
-[ t ] [ 0b1101 >bignum 3 bit? ] unit-test
-[ f ] [ 0b1101 >bignum 4 bit? ] unit-test
-[ f ] [ 0b1101 >bignum 1000 bit? ] unit-test
-
-[ t ] [ -0b1101 -1 bit? ] unit-test
-[ t ] [ -0b1101 0 bit? ] unit-test
-[ t ] [ -0b1101 1 bit? ] unit-test
-[ f ] [ -0b1101 2 bit? ] unit-test
-[ f ] [ -0b1101 3 bit? ] unit-test
-[ t ] [ -0b1101 4 bit? ] unit-test
-[ t ] [ -0b1101 1000 bit? ] unit-test
-
-[ t ] [ -0b1101 >bignum -1 bit? ] unit-test
-[ t ] [ -0b1101 >bignum 0 bit? ] unit-test
-[ t ] [ -0b1101 >bignum 1 bit? ] unit-test
-[ f ] [ -0b1101 >bignum 2 bit? ] unit-test
-[ f ] [ -0b1101 >bignum 3 bit? ] unit-test
-[ t ] [ -0b1101 >bignum 4 bit? ] unit-test
-[ t ] [ -0b1101 >bignum 1000 bit? ] unit-test
-
-[ t ] [ 1067811677921310779 >bignum 59 bit? ] unit-test
-
-[ 2 ] [ 0 next-power-of-2 ] unit-test
-[ 2 ] [ 1 next-power-of-2 ] unit-test
-[ 2 ] [ 2 next-power-of-2 ] unit-test
-[ 4 ] [ 3 next-power-of-2 ] unit-test
-[ 16 ] [ 13 next-power-of-2 ] unit-test
-[ 16 ] [ 16 next-power-of-2 ] unit-test
-
-[ 134217728 ] [ -134217728 >fixnum -1 /i ] unit-test
-[ 134217728 0 ] [ -134217728 >fixnum -1 /mod ] unit-test
-[ 0 ] [ -1 -134217728 >fixnum /i ] unit-test
-[ 4420880996869850977 ] [ 13262642990609552931 3 /i ] unit-test
-[ 0 -1 ] [ -1 -134217728 >fixnum /mod ] unit-test
-[ 0 -1 ] [ -1 -134217728 >bignum /mod ] unit-test
-[ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
-[ 8 530505719624382123 ] [ 13262642990609552931 1591517158873146351 /mod ] unit-test
-[ 8 ] [ 13262642990609552931 1591517158873146351 /i ] unit-test
-[ 530505719624382123 ] [ 13262642990609552931 1591517158873146351 mod ] unit-test
-
-[ -351382792 ] [ -43922849 3 shift ] unit-test
-
-[ t ] [ 0 zero? ] unit-test
-[ f ] [ 30 zero? ] unit-test
-[ t ] [ 0 >bignum zero? ] unit-test
-
-[ 2147483632 ] [ 134217727 >fixnum 16 fixnum* ] unit-test
-
-[ 23603949310011464311086123800853779733506160743636399259558684142844552151041 ]
+{ 7 } [ 255 log2 ] unit-test
+{ 8 } [ 256 log2 ] unit-test
+{ 8 } [ 257 log2 ] unit-test
+{ 0 } [ 1 log2 ] unit-test
+
+{ 7 } [ 255 >bignum log2 ] unit-test
+{ 8 } [ 256 >bignum log2 ] unit-test
+{ 8 } [ 257 >bignum log2 ] unit-test
+{ 0 } [ 1 >bignum log2 ] unit-test
+
+{ f } [ 0b1101 -1 bit? ] unit-test
+{ t } [ 0b1101 0 bit? ] unit-test
+{ f } [ 0b1101 1 bit? ] unit-test
+{ t } [ 0b1101 2 bit? ] unit-test
+{ t } [ 0b1101 3 bit? ] unit-test
+{ f } [ 0b1101 4 bit? ] unit-test
+{ f } [ 0b1101 1000 bit? ] unit-test
+
+{ f } [ 0b1101 >bignum -1 bit? ] unit-test
+{ t } [ 0b1101 >bignum 0 bit? ] unit-test
+{ f } [ 0b1101 >bignum 1 bit? ] unit-test
+{ t } [ 0b1101 >bignum 2 bit? ] unit-test
+{ t } [ 0b1101 >bignum 3 bit? ] unit-test
+{ f } [ 0b1101 >bignum 4 bit? ] unit-test
+{ f } [ 0b1101 >bignum 1000 bit? ] unit-test
+
+{ t } [ -0b1101 -1 bit? ] unit-test
+{ t } [ -0b1101 0 bit? ] unit-test
+{ t } [ -0b1101 1 bit? ] unit-test
+{ f } [ -0b1101 2 bit? ] unit-test
+{ f } [ -0b1101 3 bit? ] unit-test
+{ t } [ -0b1101 4 bit? ] unit-test
+{ t } [ -0b1101 1000 bit? ] unit-test
+
+{ t } [ -0b1101 >bignum -1 bit? ] unit-test
+{ t } [ -0b1101 >bignum 0 bit? ] unit-test
+{ t } [ -0b1101 >bignum 1 bit? ] unit-test
+{ f } [ -0b1101 >bignum 2 bit? ] unit-test
+{ f } [ -0b1101 >bignum 3 bit? ] unit-test
+{ t } [ -0b1101 >bignum 4 bit? ] unit-test
+{ t } [ -0b1101 >bignum 1000 bit? ] unit-test
+
+{ t } [ 1067811677921310779 >bignum 59 bit? ] unit-test
+
+{ 2 } [ 0 next-power-of-2 ] unit-test
+{ 2 } [ 1 next-power-of-2 ] unit-test
+{ 2 } [ 2 next-power-of-2 ] unit-test
+{ 4 } [ 3 next-power-of-2 ] unit-test
+{ 16 } [ 13 next-power-of-2 ] unit-test
+{ 16 } [ 16 next-power-of-2 ] unit-test
+
+{ 134217728 } [ -134217728 >fixnum -1 /i ] unit-test
+{ 134217728 0 } [ -134217728 >fixnum -1 /mod ] unit-test
+{ 0 } [ -1 -134217728 >fixnum /i ] unit-test
+{ 4420880996869850977 } [ 13262642990609552931 3 /i ] unit-test
+{ 0 -1 } [ -1 -134217728 >fixnum /mod ] unit-test
+{ 0 -1 } [ -1 -134217728 >bignum /mod ] unit-test
+{ 14355 } [ 1591517158873146351817850880000000 32769 mod ] unit-test
+{ 8 530505719624382123 } [ 13262642990609552931 1591517158873146351 /mod ] unit-test
+{ 8 } [ 13262642990609552931 1591517158873146351 /i ] unit-test
+{ 530505719624382123 } [ 13262642990609552931 1591517158873146351 mod ] unit-test
+
+{ -351382792 } [ -43922849 3 shift ] unit-test
+
+{ t } [ 0 zero? ] unit-test
+{ f } [ 30 zero? ] unit-test
+{ t } [ 0 >bignum zero? ] unit-test
+
+{ 2147483632 } [ 134217727 >fixnum 16 fixnum* ] unit-test
+
+{ 23603949310011464311086123800853779733506160743636399259558684142844552151041 }
[
1957739506503920732625800353008742584087090810400921800808997218266517557963281171906190947801528098188887586755474449585677502695226712388326288208691204
79562815144503850065234921197651376510595262628033069372760833939060637564931
! We don't care if this fails or returns 0 (its CPU-specific)
! as long as it doesn't crash
-[ ] [ [ 0 0 /i drop ] ignore-errors ] unit-test
-[ ] [ [ 100000000000000000 0 /i drop ] ignore-errors ] unit-test
-
-[ -2 ] [ 1 bitnot ] unit-test
-[ -2 ] [ 1 >bignum bitnot ] unit-test
-[ -2 ] [ 1 >bignum bitnot ] unit-test
-[ 0 ] [ 123 dup bitnot bitand ] unit-test
-[ 0 ] [ 123 >bignum dup bitnot bitand ] unit-test
-[ 0 ] [ 123 dup bitnot >bignum bitand ] unit-test
-[ 0 ] [ 123 dup bitnot bitand >bignum ] unit-test
-[ -1 ] [ 123 dup bitnot bitor ] unit-test
-[ -1 ] [ 123 >bignum dup bitnot bitor ] unit-test
-[ -1 ] [ 123 dup bitnot >bignum bitor ] unit-test
-[ -1 ] [ 123 dup bitnot bitor >bignum ] unit-test
-[ -1 ] [ 123 dup bitnot bitxor ] unit-test
-[ -1 ] [ 123 >bignum dup bitnot bitxor ] unit-test
-[ -1 ] [ 123 dup bitnot >bignum bitxor ] unit-test
-[ -1 ] [ 123 dup bitnot bitxor >bignum ] unit-test
-[ 4 ] [ 4 7 bitand ] unit-test
-
-[ 256 ] [ 65536 -8 shift ] unit-test
-[ 256 ] [ 65536 >bignum -8 shift ] unit-test
-[ 256 ] [ 65536 -8 >bignum shift ] unit-test
-[ 256 ] [ 65536 >bignum -8 >bignum shift ] unit-test
-[ 4294967296 ] [ 1 16 shift 16 shift ] unit-test
-[ 4294967296 ] [ 1 32 shift ] unit-test
-[ 1267650600228229401496703205376 ] [ 1 100 shift ] unit-test
-
-[ t ] [ 1 26 shift fixnum? ] unit-test
-
-[ t ] [
+{ } [ [ 0 0 /i drop ] ignore-errors ] unit-test
+{ } [ [ 100000000000000000 0 /i drop ] ignore-errors ] unit-test
+
+{ -2 } [ 1 bitnot ] unit-test
+{ -2 } [ 1 >bignum bitnot ] unit-test
+{ -2 } [ 1 >bignum bitnot ] unit-test
+{ 0 } [ 123 dup bitnot bitand ] unit-test
+{ 0 } [ 123 >bignum dup bitnot bitand ] unit-test
+{ 0 } [ 123 dup bitnot >bignum bitand ] unit-test
+{ 0 } [ 123 dup bitnot bitand >bignum ] unit-test
+{ -1 } [ 123 dup bitnot bitor ] unit-test
+{ -1 } [ 123 >bignum dup bitnot bitor ] unit-test
+{ -1 } [ 123 dup bitnot >bignum bitor ] unit-test
+{ -1 } [ 123 dup bitnot bitor >bignum ] unit-test
+{ -1 } [ 123 dup bitnot bitxor ] unit-test
+{ -1 } [ 123 >bignum dup bitnot bitxor ] unit-test
+{ -1 } [ 123 dup bitnot >bignum bitxor ] unit-test
+{ -1 } [ 123 dup bitnot bitxor >bignum ] unit-test
+{ 4 } [ 4 7 bitand ] unit-test
+
+{ 256 } [ 65536 -8 shift ] unit-test
+{ 256 } [ 65536 >bignum -8 shift ] unit-test
+{ 256 } [ 65536 -8 >bignum shift ] unit-test
+{ 256 } [ 65536 >bignum -8 >bignum shift ] unit-test
+{ 4294967296 } [ 1 16 shift 16 shift ] unit-test
+{ 4294967296 } [ 1 32 shift ] unit-test
+{ 1267650600228229401496703205376 } [ 1 100 shift ] unit-test
+
+{ t } [ 1 26 shift fixnum? ] unit-test
+
+{ t } [
t
[ 27 28 29 30 31 32 59 60 61 62 63 64 ]
[
] each
] unit-test
-[ t ] [
+{ t } [
t
[ 27 28 29 30 31 32 59 60 61 62 63 64 ]
[
] each
] unit-test
-[ 12 ] [ 11 4 align ] unit-test
-[ 12 ] [ 12 4 align ] unit-test
-[ 10 ] [ 10 2 align ] unit-test
-[ 14 ] [ 13 2 align ] unit-test
-[ 11 ] [ 11 1 align ] unit-test
+{ 12 } [ 11 4 align ] unit-test
+{ 12 } [ 12 4 align ] unit-test
+{ 10 } [ 10 2 align ] unit-test
+{ 14 } [ 13 2 align ] unit-test
+{ 11 } [ 11 1 align ] unit-test
-[ t ] [ 256 power-of-2? ] unit-test
-[ f ] [ 123 power-of-2? ] unit-test
+{ t } [ 256 power-of-2? ] unit-test
+{ f } [ 123 power-of-2? ] unit-test
-[ f ] [ -128 power-of-2? ] unit-test
-[ f ] [ 0 power-of-2? ] unit-test
-[ t ] [ 1 power-of-2? ] unit-test
+{ f } [ -128 power-of-2? ] unit-test
+{ f } [ 0 power-of-2? ] unit-test
+{ t } [ 1 power-of-2? ] unit-test
: ratio>float ( a b -- f ) [ >bignum ] bi@ /f ;
-[ 5. ] [ 5 1 ratio>float ] unit-test
-[ 4. ] [ 4 1 ratio>float ] unit-test
-[ 2. ] [ 2 1 ratio>float ] unit-test
-[ .5 ] [ 1 2 ratio>float ] unit-test
-[ .75 ] [ 3 4 ratio>float ] unit-test
-[ 1. ] [ 2000 2^ 2000 2^ 1 + ratio>float ] unit-test
-[ -1. ] [ 2000 2^ neg 2000 2^ 1 + ratio>float ] unit-test
-[ 0.4 ] [ 6 15 ratio>float ] unit-test
+{ 5. } [ 5 1 ratio>float ] unit-test
+{ 4. } [ 4 1 ratio>float ] unit-test
+{ 2. } [ 2 1 ratio>float ] unit-test
+{ .5 } [ 1 2 ratio>float ] unit-test
+{ .75 } [ 3 4 ratio>float ] unit-test
+{ 1. } [ 2000 2^ 2000 2^ 1 + ratio>float ] unit-test
+{ -1. } [ 2000 2^ neg 2000 2^ 1 + ratio>float ] unit-test
+{ 0.4 } [ 6 15 ratio>float ] unit-test
-[ 0x3fe553522d230931 ]
+{ 0x3fe553522d230931 }
[ 61967020039 92984792073 ratio>float double>bits ] unit-test
: random-integer ( -- n )
{ t f } random [ neg ] when
{ t f } random [ >bignum ] when ;
-[ t ] [
+{ t } [
10000 [
drop
random-integer
] unit-test
! Ensure that /f is accurate for fixnums > 2^53 on 64-bit platforms
-[ 0x1.758bec11492f9p-54 ] [ 1 12345678901234567 /f ] unit-test
-[ -0x1.758bec11492f9p-54 ] [ 1 -12345678901234567 /f ] unit-test
+{ 0x1.758bec11492f9p-54 } [ 1 12345678901234567 /f ] unit-test
+{ -0x1.758bec11492f9p-54 } [ 1 -12345678901234567 /f ] unit-test
! Ensure that /f rounds to nearest and not to zero
-[ 0x1.0p55 ] [ 0x7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
-[ 0x1.0p55 ] [ -0x7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
-[ -0x1.0p55 ] [ -0x7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
-[ -0x1.0p55 ] [ 0x7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
-
-[ 0x1.0000,0000,0000,0p56 ] [ 0x100,0000,0000,0007 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,0p56 ] [ -0x100,0000,0000,0007 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,0p120 ] [ 0x100,0000,0000,0007,FFFF,FFFF,FFFF,FFFF >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,0p120 ] [ -0x100,0000,0000,0007,FFFF,FFFF,FFFF,FFFF >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,0p56 ] [ 0x100,0000,0000,0008 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,0p56 ] [ -0x100,0000,0000,0008 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p56 ] [ 0x100,0000,0000,0009 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p56 ] [ -0x100,0000,0000,0009 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p120 ] [ 0x100,0000,0000,0008,0000,0000,0000,0001 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p120 ] [ -0x100,0000,0000,0008,0000,0000,0000,0001 >bignum -1 /f ] unit-test
+{ 0x1.0p55 } [ 0x7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
+{ 0x1.0p55 } [ -0x7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
+{ -0x1.0p55 } [ -0x7f,ffff,ffff,ffff >bignum 1 /f ] unit-test
+{ -0x1.0p55 } [ 0x7f,ffff,ffff,ffff >bignum -1 /f ] unit-test
+
+{ 0x1.0000,0000,0000,0p56 } [ 0x100,0000,0000,0007 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,0p56 } [ -0x100,0000,0000,0007 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,0p120 } [ 0x100,0000,0000,0007,FFFF,FFFF,FFFF,FFFF >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,0p120 } [ -0x100,0000,0000,0007,FFFF,FFFF,FFFF,FFFF >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,0p56 } [ 0x100,0000,0000,0008 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,0p56 } [ -0x100,0000,0000,0008 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p56 } [ 0x100,0000,0000,0009 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p56 } [ -0x100,0000,0000,0009 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p120 } [ 0x100,0000,0000,0008,0000,0000,0000,0001 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p120 } [ -0x100,0000,0000,0008,0000,0000,0000,0001 >bignum -1 /f ] unit-test
! Ensure that /f rounds to even on tie
-[ 0x1.0000,0000,0000,1p56 ] [ 0x100,0000,0000,0017 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p56 ] [ -0x100,0000,0000,0017 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p120 ] [ 0x100,0000,0000,0017,FFFF,FFFF,FFFF,FFFF >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,1p120 ] [ -0x100,0000,0000,0017,FFFF,FFFF,FFFF,FFFF >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p56 ] [ 0x100,0000,0000,0018 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p56 ] [ -0x100,0000,0000,0018 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p56 ] [ 0x100,0000,0000,0019 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p56 ] [ -0x100,0000,0000,0019 >bignum -1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p120 ] [ 0x100,0000,0000,0018,0000,0000,0000,0001 >bignum 1 /f ] unit-test
-[ 0x1.0000,0000,0000,2p120 ] [ -0x100,0000,0000,0018,0000,0000,0000,0001 >bignum -1 /f ] unit-test
-
-[ 17 ] [ 17 >bignum 5 max ] unit-test
-[ 5 ] [ 17 >bignum 5 min ] unit-test
-
-[ 1 ] [ 1 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
-[ 12 ] [ 3 50600563326827654588123836679729326762389162441035529589225339506857584891998836722990095925359281123796769466079202977847452184346448369216753349985184627480379356069141590341116726935523304085309941919618186267140501870856173174654525838912289889085202514128089692388083353653807625633046581877161501565826926935273373696 /f double>bits ] unit-test
-[ 123 ] [ 123 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
-[ 1234 ] [ 617 101201126653655309176247673359458653524778324882071059178450679013715169783997673445980191850718562247593538932158405955694904368692896738433506699970369254960758712138283180682233453871046608170619883839236372534281003741712346349309051677824579778170405028256179384776166707307615251266093163754323003131653853870546747392 /f double>bits ] unit-test
-[ 1/0. ] [ 2048 2^ 1 /f ] unit-test
-[ -1/0. ] [ 2048 2^ -1 /f ] unit-test
-[ -1/0. ] [ 2048 2^ neg 1 /f ] unit-test
-[ 1/0. ] [ 2048 2^ neg -1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p56 } [ 0x100,0000,0000,0017 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p56 } [ -0x100,0000,0000,0017 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p120 } [ 0x100,0000,0000,0017,FFFF,FFFF,FFFF,FFFF >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,1p120 } [ -0x100,0000,0000,0017,FFFF,FFFF,FFFF,FFFF >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p56 } [ 0x100,0000,0000,0018 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p56 } [ -0x100,0000,0000,0018 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p56 } [ 0x100,0000,0000,0019 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p56 } [ -0x100,0000,0000,0019 >bignum -1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p120 } [ 0x100,0000,0000,0018,0000,0000,0000,0001 >bignum 1 /f ] unit-test
+{ 0x1.0000,0000,0000,2p120 } [ -0x100,0000,0000,0018,0000,0000,0000,0001 >bignum -1 /f ] unit-test
+
+{ 17 } [ 17 >bignum 5 max ] unit-test
+{ 5 } [ 17 >bignum 5 min ] unit-test
+
+{ 1 } [ 1 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
+{ 12 } [ 3 50600563326827654588123836679729326762389162441035529589225339506857584891998836722990095925359281123796769466079202977847452184346448369216753349985184627480379356069141590341116726935523304085309941919618186267140501870856173174654525838912289889085202514128089692388083353653807625633046581877161501565826926935273373696 /f double>bits ] unit-test
+{ 123 } [ 123 202402253307310618352495346718917307049556649764142118356901358027430339567995346891960383701437124495187077864316811911389808737385793476867013399940738509921517424276566361364466907742093216341239767678472745068562007483424692698618103355649159556340810056512358769552333414615230502532186327508646006263307707741093494784 /f double>bits ] unit-test
+{ 1234 } [ 617 101201126653655309176247673359458653524778324882071059178450679013715169783997673445980191850718562247593538932158405955694904368692896738433506699970369254960758712138283180682233453871046608170619883839236372534281003741712346349309051677824579778170405028256179384776166707307615251266093163754323003131653853870546747392 /f double>bits ] unit-test
+{ 1/0. } [ 2048 2^ 1 /f ] unit-test
+{ -1/0. } [ 2048 2^ -1 /f ] unit-test
+{ -1/0. } [ 2048 2^ neg 1 /f ] unit-test
+{ 1/0. } [ 2048 2^ neg -1 /f ] unit-test
USING: kernel layouts math math.private namespaces make tools.test ;
IN: math.tests
-[ ] [ 5 [ ] times ] unit-test
-[ ] [ 0 [ ] times ] unit-test
-[ ] [ -1 [ ] times ] unit-test
-
-[ ] [ 5 [ drop ] each-integer ] unit-test
-[ [ 0 1 2 3 4 ] ] [ [ 5 [ , ] each-integer ] [ ] make ] unit-test
-[ [ ] ] [ [ -1 [ , ] each-integer ] [ ] make ] unit-test
-
-[ f ] [ 1/0. fp-nan? ] unit-test
-[ f ] [ -1/0. fp-nan? ] unit-test
-[ t ] [ -0/0. fp-nan? ] unit-test
-[ t ] [ 1 <fp-nan> fp-nan? ] unit-test
+{ } [ 5 [ ] times ] unit-test
+{ } [ 0 [ ] times ] unit-test
+{ } [ -1 [ ] times ] unit-test
+
+{ } [ 5 [ drop ] each-integer ] unit-test
+{ [ 0 1 2 3 4 ] } [ [ 5 [ , ] each-integer ] [ ] make ] unit-test
+{ [ ] } [ [ -1 [ , ] each-integer ] [ ] make ] unit-test
+
+{ f } [ 1/0. fp-nan? ] unit-test
+{ f } [ -1/0. fp-nan? ] unit-test
+{ t } [ -0/0. fp-nan? ] unit-test
+{ t } [ 1 <fp-nan> fp-nan? ] unit-test
! [ t ] [ 1 <fp-nan> fp-snan? ] unit-test
! [ f ] [ 1 <fp-nan> fp-qnan? ] unit-test
-[ t ] [ 0x8000000000001 <fp-nan> fp-nan? ] unit-test
-[ f ] [ 0x8000000000001 <fp-nan> fp-snan? ] unit-test
-[ t ] [ 0x8000000000001 <fp-nan> fp-qnan? ] unit-test
-
-[ t ] [ 1/0. fp-infinity? ] unit-test
-[ t ] [ -1/0. fp-infinity? ] unit-test
-[ f ] [ -0/0. fp-infinity? ] unit-test
-
-[ f ] [ 0 <fp-nan> fp-nan? ] unit-test
-[ t ] [ 0 <fp-nan> fp-infinity? ] unit-test
-
-[ t ] [ 0.0 neg -0.0 fp-bitwise= ] unit-test
-[ t ] [ -0.0 neg 0.0 fp-bitwise= ] unit-test
-
-[ 0.0 ] [ -0.0 next-float ] unit-test
-[ t ] [ 1.0 dup next-float < ] unit-test
-[ t ] [ -1.0 dup next-float < ] unit-test
-
-[ -0.0 ] [ 0.0 prev-float ] unit-test
-[ t ] [ 1.0 dup prev-float > ] unit-test
-[ t ] [ -1.0 dup prev-float > ] unit-test
-
-[ f ] [ 0/0. 0/0. = ] unit-test
-[ f ] [ 0/0. 1.0 = ] unit-test
-[ f ] [ 0/0. 1/0. = ] unit-test
-[ f ] [ 0/0. -1/0. = ] unit-test
-
-[ f ] [ 0/0. 0/0. = ] unit-test
-[ f ] [ 1.0 0/0. = ] unit-test
-[ f ] [ -1/0. 0/0. = ] unit-test
-[ f ] [ 1/0. 0/0. = ] unit-test
-
-[ f ] [ 0/0. 0/0. < ] unit-test
-[ f ] [ 0/0. 1.0 < ] unit-test
-[ f ] [ 0/0. 1/0. < ] unit-test
-[ f ] [ 0/0. -1/0. < ] unit-test
-
-[ f ] [ 0/0. 0/0. <= ] unit-test
-[ f ] [ 0/0. 1.0 <= ] unit-test
-[ f ] [ 0/0. 1/0. <= ] unit-test
-[ f ] [ 0/0. -1/0. <= ] unit-test
-
-[ f ] [ 0/0. 0/0. > ] unit-test
-[ f ] [ 1.0 0/0. > ] unit-test
-[ f ] [ -1/0. 0/0. > ] unit-test
-[ f ] [ 1/0. 0/0. > ] unit-test
-
-[ f ] [ 0/0. 0/0. >= ] unit-test
-[ f ] [ 1.0 0/0. >= ] unit-test
-[ f ] [ -1/0. 0/0. >= ] unit-test
-[ f ] [ 1/0. 0/0. >= ] unit-test
-
-[ f ] [ 0 neg? ] unit-test
-[ f ] [ 1/2 neg? ] unit-test
-[ f ] [ 1 neg? ] unit-test
-[ t ] [ -1/2 neg? ] unit-test
-[ t ] [ -1 neg? ] unit-test
-
-[ f ] [ 0.0 neg? ] unit-test
-[ f ] [ 1.0 neg? ] unit-test
-[ f ] [ 1/0. neg? ] unit-test
-[ t ] [ -0.0 neg? ] unit-test
-[ t ] [ -1.0 neg? ] unit-test
-[ t ] [ -1/0. neg? ] unit-test
+{ t } [ 0x8000000000001 <fp-nan> fp-nan? ] unit-test
+{ f } [ 0x8000000000001 <fp-nan> fp-snan? ] unit-test
+{ t } [ 0x8000000000001 <fp-nan> fp-qnan? ] unit-test
+
+{ t } [ 1/0. fp-infinity? ] unit-test
+{ t } [ -1/0. fp-infinity? ] unit-test
+{ f } [ -0/0. fp-infinity? ] unit-test
+
+{ f } [ 0 <fp-nan> fp-nan? ] unit-test
+{ t } [ 0 <fp-nan> fp-infinity? ] unit-test
+
+{ t } [ 0.0 neg -0.0 fp-bitwise= ] unit-test
+{ t } [ -0.0 neg 0.0 fp-bitwise= ] unit-test
+
+{ 0.0 } [ -0.0 next-float ] unit-test
+{ t } [ 1.0 dup next-float < ] unit-test
+{ t } [ -1.0 dup next-float < ] unit-test
+
+{ -0.0 } [ 0.0 prev-float ] unit-test
+{ t } [ 1.0 dup prev-float > ] unit-test
+{ t } [ -1.0 dup prev-float > ] unit-test
+
+{ f } [ 0/0. 0/0. = ] unit-test
+{ f } [ 0/0. 1.0 = ] unit-test
+{ f } [ 0/0. 1/0. = ] unit-test
+{ f } [ 0/0. -1/0. = ] unit-test
+
+{ f } [ 0/0. 0/0. = ] unit-test
+{ f } [ 1.0 0/0. = ] unit-test
+{ f } [ -1/0. 0/0. = ] unit-test
+{ f } [ 1/0. 0/0. = ] unit-test
+
+{ f } [ 0/0. 0/0. < ] unit-test
+{ f } [ 0/0. 1.0 < ] unit-test
+{ f } [ 0/0. 1/0. < ] unit-test
+{ f } [ 0/0. -1/0. < ] unit-test
+
+{ f } [ 0/0. 0/0. <= ] unit-test
+{ f } [ 0/0. 1.0 <= ] unit-test
+{ f } [ 0/0. 1/0. <= ] unit-test
+{ f } [ 0/0. -1/0. <= ] unit-test
+
+{ f } [ 0/0. 0/0. > ] unit-test
+{ f } [ 1.0 0/0. > ] unit-test
+{ f } [ -1/0. 0/0. > ] unit-test
+{ f } [ 1/0. 0/0. > ] unit-test
+
+{ f } [ 0/0. 0/0. >= ] unit-test
+{ f } [ 1.0 0/0. >= ] unit-test
+{ f } [ -1/0. 0/0. >= ] unit-test
+{ f } [ 1/0. 0/0. >= ] unit-test
+
+{ f } [ 0 neg? ] unit-test
+{ f } [ 1/2 neg? ] unit-test
+{ f } [ 1 neg? ] unit-test
+{ t } [ -1/2 neg? ] unit-test
+{ t } [ -1 neg? ] unit-test
+
+{ f } [ 0.0 neg? ] unit-test
+{ f } [ 1.0 neg? ] unit-test
+{ f } [ 1/0. neg? ] unit-test
+{ t } [ -0.0 neg? ] unit-test
+{ t } [ -1.0 neg? ] unit-test
+{ t } [ -1/0. neg? ] unit-test
{ -0x3fffffff } [ 0x3ffffffe >bignum bitnot ] unit-test
{ -0x40000000 } [ 0x3fffffff >bignum bitnot ] unit-test
USING: kernel math.order tools.test ;
IN: math.order.tests
-[ +lt+ ] [ "ab" "abc" <=> ] unit-test
-[ +gt+ ] [ "abc" "ab" <=> ] unit-test
-[ +lt+ ] [ 3 4 <=> ] unit-test
-[ +eq+ ] [ 4 4 <=> ] unit-test
-[ +gt+ ] [ 4 3 <=> ] unit-test
+{ +lt+ } [ "ab" "abc" <=> ] unit-test
+{ +gt+ } [ "abc" "ab" <=> ] unit-test
+{ +lt+ } [ 3 4 <=> ] unit-test
+{ +eq+ } [ 4 4 <=> ] unit-test
+{ +gt+ } [ 4 3 <=> ] unit-test
-[ 20 ] [ 20 0 100 clamp ] unit-test
-[ 0 ] [ -20 0 100 clamp ] unit-test
-[ 100 ] [ 120 0 100 clamp ] unit-test
+{ 20 } [ 20 0 100 clamp ] unit-test
+{ 0 } [ -20 0 100 clamp ] unit-test
+{ 100 } [ 120 0 100 clamp ] unit-test
USING: kernel literals math math.parser sequences tools.test ;
IN: math.parser.tests
-[ f ]
+{ f }
[ f string>number ]
unit-test
-[ f ]
+{ f }
[ ";" string>number ]
unit-test
-[ f ]
+{ f }
[ "<>" string>number ]
unit-test
-[ f ]
+{ f }
[ "^" string>number ]
unit-test
-[ f ]
+{ f }
[ "789:;<=>?@" string>number ]
unit-test
-[ f ]
+{ f }
[ "12345abcdef" string>number ]
unit-test
-[ 12 ]
+{ 12 }
[ "+12" string>number ]
unit-test
-[ -12 ]
+{ -12 }
[ "-12" string>number ]
unit-test
-[ f ]
+{ f }
[ "-+12" string>number ]
unit-test
-[ f ]
+{ f }
[ "+-12" string>number ]
unit-test
-[ f ]
+{ f }
[ "--12" string>number ]
unit-test
-[ f ]
+{ f }
[ "-" string>number ]
unit-test
-[ f ]
+{ f }
[ "e" string>number ]
unit-test
-[ 1/2 ] [ "1/2" string>number ] unit-test
-[ -1/2 ] [ "-1/2" string>number ] unit-test
-[ 2 ] [ "4/2" string>number ] unit-test
-[ f ] [ "1/-2" string>number ] unit-test
-[ f ] [ "1/2/3" string>number ] unit-test
-[ 1+1/2 ] [ "1+1/2" string>number ] unit-test
-[ 1+1/2 ] [ "+1+1/2" string>number ] unit-test
-[ f ] [ "1-1/2" string>number ] unit-test
-[ -1-1/2 ] [ "-1-1/2" string>number ] unit-test
-[ f ] [ "-1+1/2" string>number ] unit-test
-[ f ] [ "1+2" string>number ] unit-test
-[ f ] [ "1+" string>number ] unit-test
-[ f ] [ "1-" string>number ] unit-test
-[ f ] [ "1+1/2+2" string>number ] unit-test
-
-[ 100000 ] [ "100,000" string>number ] unit-test
-
-[ 100000.0 ] [ "100,000.0" string>number ] unit-test
-
-[ f ] [ "," string>number ] unit-test
-[ f ] [ "-," string>number ] unit-test
-[ f ] [ "1," string>number ] unit-test
-[ f ] [ "-1," string>number ] unit-test
-[ f ] [ ",2" string>number ] unit-test
-[ f ] [ "-,2" string>number ] unit-test
-
-[ 2.0 ] [ "2." string>number ] unit-test
-[ 2.0 ] [ "+2." string>number ] unit-test
-[ 0.25 ] [ ".25" string>number ] unit-test
-[ -2.0 ] [ "-2." string>number ] unit-test
-[ -0.25 ] [ "-.25" string>number ] unit-test
-[ f ] [ "-." string>number ] unit-test
-
-[ 255 ] [ "ff" hex> ] unit-test
-
-[ 100.0 ] [ "1.0e2" string>number ] unit-test
-[ 100.0 ] [ "100.0" string>number ] unit-test
-[ 100.0 ] [ "100." string>number ] unit-test
-
-[ 100.0 ] [ "1e2" string>number ] unit-test
-[ 100.0 ] [ "1e+2" string>number ] unit-test
-[ 0x1e2 ] [ "1e2" hex> ] unit-test
-
-[ 0x1.999999999999ap-3 ] [ "0.2" string>number ] unit-test
-[ 0x1.3333333333333p0 ] [ "1.2" string>number ] unit-test
-[ 0x1.5555555555555p0 ] [ "1.333,333,333,333,333,333" string>number ] unit-test
-[ 0x1.aaaaaaaaaaaabp0 ] [ "1.666,666,666,666,666,666" string>number ] unit-test
-
-[ "100.0" ]
+{ 1/2 } [ "1/2" string>number ] unit-test
+{ -1/2 } [ "-1/2" string>number ] unit-test
+{ 2 } [ "4/2" string>number ] unit-test
+{ f } [ "1/-2" string>number ] unit-test
+{ f } [ "1/2/3" string>number ] unit-test
+{ 1+1/2 } [ "1+1/2" string>number ] unit-test
+{ 1+1/2 } [ "+1+1/2" string>number ] unit-test
+{ f } [ "1-1/2" string>number ] unit-test
+{ -1-1/2 } [ "-1-1/2" string>number ] unit-test
+{ f } [ "-1+1/2" string>number ] unit-test
+{ f } [ "1+2" string>number ] unit-test
+{ f } [ "1+" string>number ] unit-test
+{ f } [ "1-" string>number ] unit-test
+{ f } [ "1+1/2+2" string>number ] unit-test
+
+{ 100000 } [ "100,000" string>number ] unit-test
+
+{ 100000.0 } [ "100,000.0" string>number ] unit-test
+
+{ f } [ "," string>number ] unit-test
+{ f } [ "-," string>number ] unit-test
+{ f } [ "1," string>number ] unit-test
+{ f } [ "-1," string>number ] unit-test
+{ f } [ ",2" string>number ] unit-test
+{ f } [ "-,2" string>number ] unit-test
+
+{ 2.0 } [ "2." string>number ] unit-test
+{ 2.0 } [ "+2." string>number ] unit-test
+{ 0.25 } [ ".25" string>number ] unit-test
+{ -2.0 } [ "-2." string>number ] unit-test
+{ -0.25 } [ "-.25" string>number ] unit-test
+{ f } [ "-." string>number ] unit-test
+
+{ 255 } [ "ff" hex> ] unit-test
+
+{ 100.0 } [ "1.0e2" string>number ] unit-test
+{ 100.0 } [ "100.0" string>number ] unit-test
+{ 100.0 } [ "100." string>number ] unit-test
+
+{ 100.0 } [ "1e2" string>number ] unit-test
+{ 100.0 } [ "1e+2" string>number ] unit-test
+{ 0x1e2 } [ "1e2" hex> ] unit-test
+
+{ 0x1.999999999999ap-3 } [ "0.2" string>number ] unit-test
+{ 0x1.3333333333333p0 } [ "1.2" string>number ] unit-test
+{ 0x1.5555555555555p0 } [ "1.333,333,333,333,333,333" string>number ] unit-test
+{ 0x1.aaaaaaaaaaaabp0 } [ "1.666,666,666,666,666,666" string>number ] unit-test
+
+{ "100.0" }
[ "1.0e2" string>number number>string ]
unit-test
-[ -100.0 ] [ "-1.0e2" string>number ] unit-test
-[ -100.0 ] [ "-100.0" string>number ] unit-test
-[ -100.0 ] [ "-100." string>number ] unit-test
+{ -100.0 } [ "-1.0e2" string>number ] unit-test
+{ -100.0 } [ "-100.0" string>number ] unit-test
+{ -100.0 } [ "-100." string>number ] unit-test
-[ "-100.0" ]
+{ "-100.0" }
[ "-1.0e2" string>number number>string ]
unit-test
-[ -100.0 ] [ "-1.e2" string>number ] unit-test
+{ -100.0 } [ "-1.e2" string>number ] unit-test
-[ "0.01" ]
+{ "0.01" }
[ "1.0e-2" string>number number>string ]
unit-test
-[ 0.01 ] [ "1.0e-2" string>number ] unit-test
+{ 0.01 } [ "1.0e-2" string>number ] unit-test
-[ "-0.01" ]
+{ "-0.01" }
[ "-1.0e-2" string>number number>string ]
unit-test
-[ -0.01 ] [ "-1.0e-2" string>number ] unit-test
+{ -0.01 } [ "-1.0e-2" string>number ] unit-test
-[ "-0.01" ]
+{ "-0.01" }
[ "-1.e-2" string>number number>string ]
unit-test
-[ -1.0e-12 ] [ "-1.0e-12" string>number ] unit-test
+{ -1.0e-12 } [ "-1.0e-12" string>number ] unit-test
-[ t ]
+{ t }
[ "-1.0e-12" string>number number>string { "-1.0e-12" "-1.0e-012" } member? ]
unit-test
-[ f ]
+{ f }
[ "-1e-2e4" string>number ]
unit-test
-[ "3.14" ]
+{ "3.14" }
[ "3.14" string>number number>string ]
unit-test
-[ f ]
+{ f }
[ "." string>number ]
unit-test
-[ f ]
+{ f }
[ ".e" string>number ]
unit-test
-[ "101.0" ]
+{ "101.0" }
[ "1.01e2" string>number number>string ]
unit-test
-[ "-101.0" ]
+{ "-101.0" }
[ "-1.01e2" string>number number>string ]
unit-test
-[ "1.01" ]
+{ "1.01" }
[ "101.0e-2" string>number number>string ]
unit-test
-[ "-1.01" ]
+{ "-1.01" }
[ "-101.0e-2" string>number number>string ]
unit-test
-[ f ]
+{ f }
[ "1e1/2" string>number ]
unit-test
-[ f ]
+{ f }
[ "1e1.2" string>number ]
unit-test
-[ f ]
+{ f }
[ "e/2" string>number ]
unit-test
-[ f ] [ "12" bin> ] unit-test
-[ f ] [ "fdsf" bin> ] unit-test
-[ 3 ] [ "11" bin> ] unit-test
+{ f } [ "12" bin> ] unit-test
+{ f } [ "fdsf" bin> ] unit-test
+{ 3 } [ "11" bin> ] unit-test
-[ f ] [ "\0." string>number ] unit-test
+{ f } [ "\0." string>number ] unit-test
[ 1 1 >base ] must-fail
[ 1 0 >base ] must-fail
[ 123.456 8 >base ] [ invalid-radix? ] must-fail-with
[ 123.456 2 >base ] [ invalid-radix? ] must-fail-with
-[ "0/0." ] [ 0.0 0.0 / number>string ] unit-test
-
-[ "1/0." ] [ 1.0 0.0 / number>string ] unit-test
-
-[ "-1/0." ] [ -1.0 0.0 / number>string ] unit-test
-
-[ t ] [ "0/0." string>number fp-nan? ] unit-test
-
-[ 1/0. ] [ "1/0." string>number ] unit-test
-
-[ -1/0. ] [ "-1/0." string>number ] unit-test
-
-[ -0.5 ] [ "-1/2." string>number ] unit-test
-
-[ "-0.0" ] [ -0.0 number>string ] unit-test
-
-[ "-3/4" ] [ -3/4 number>string ] unit-test
-[ "-1-1/4" ] [ -5/4 number>string ] unit-test
-
-[ "1.0p0" ] [ 1.0 >hex ] unit-test
-[ "1.8p2" ] [ 6.0 >hex ] unit-test
-[ "1.08p2" ] [ 4.125 >hex ] unit-test
-[ "1.8p-2" ] [ 0.375 >hex ] unit-test
-[ "-1.8p2" ] [ -6.0 >hex ] unit-test
-[ "1.8p10" ] [ 1536.0 >hex ] unit-test
-[ "0.0" ] [ 0.0 >hex ] unit-test
-[ "1.0p-1074" ] [ 1 bits>double >hex ] unit-test
-[ "-0.0" ] [ -0.0 >hex ] unit-test
-
-[ 1.0 ] [ "1.0p0" hex> ] unit-test
-[ 1.5 ] [ "1.8p0" hex> ] unit-test
-[ 1.875 ] [ "1.ep0" hex> ] unit-test
-[ 1.90625 ] [ "1.e8p0" hex> ] unit-test
-[ 1.03125 ] [ "1.08p0" hex> ] unit-test
-[ 15.5 ] [ "f.8p0" hex> ] unit-test
-[ 15.53125 ] [ "f.88p0" hex> ] unit-test
-[ -15.5 ] [ "-f.8p0" hex> ] unit-test
-[ 15.5 ] [ "f.8p0" hex> ] unit-test
-[ -15.5 ] [ "-f.8p0" hex> ] unit-test
-[ 62.0 ] [ "f.8p2" hex> ] unit-test
-[ 3.875 ] [ "f.8p-2" hex> ] unit-test
-[ $[ 1 bits>double ] ] [ "1.0p-1074" hex> ] unit-test
-[ 0.0 ] [ "1.0p-1075" hex> ] unit-test
-[ 1/0. ] [ "1.0p1024" hex> ] unit-test
-[ -1/0. ] [ "-1.0p1024" hex> ] unit-test
-
-[ 0 ] [ "0" string>number ] unit-test
-[ 0 ] [ "00" string>number ] unit-test
-[ 0 ] [ "0,000" string>number ] unit-test
-[ 0.0 ] [ "0." string>number ] unit-test
-[ 0.0 ] [ "0.0" string>number ] unit-test
-[ 0.0 ] [ "0x0.0p0" string>number ] unit-test
-[ 0 ] [ "0x0" string>number ] unit-test
-[ 0 ] [ "0o0" string>number ] unit-test
-[ 0 ] [ "0b0" string>number ] unit-test
-
-[ 10 ] [ "010" string>number ] unit-test
-[ 16 ] [ "0x10" string>number ] unit-test
-[ 8 ] [ "0o10" string>number ] unit-test
-[ 2 ] [ "0b10" string>number ] unit-test
-
-[ -10 ] [ "-010" string>number ] unit-test
-[ -16 ] [ "-0x10" string>number ] unit-test
-[ -8 ] [ "-0o10" string>number ] unit-test
-[ -2 ] [ "-0b10" string>number ] unit-test
-
-[ f ] [ "01a" string>number ] unit-test
-[ f ] [ "0x1g" string>number ] unit-test
-[ f ] [ "0o18" string>number ] unit-test
-[ f ] [ "0b12" string>number ] unit-test
-
-[ 11 ] [ "0x0b" string>number ] unit-test
-[ f ] [ "0x0o0" string>number ] unit-test
-
-[ 0x7FFF,ABCD ] [ "0x7FFF,ABCD" string>number ] unit-test
-
-[ 1.0 ] [ "0x1.0p0" string>number ] unit-test
-[ 6.0 ] [ "0x1.8p2" string>number ] unit-test
-[ 0.375 ] [ "0x1.8p-2" string>number ] unit-test
-[ -6.0 ] [ "-0x1.8p2" string>number ] unit-test
-[ -0.375 ] [ "-0x1.8p-2" string>number ] unit-test
-
-[ f ] [ "0x" string>number ] unit-test
-[ f ] [ "0b" string>number ] unit-test
-[ f ] [ "0o" string>number ] unit-test
-[ f ] [ "0x," string>number ] unit-test
-[ f ] [ "0b," string>number ] unit-test
-[ f ] [ "0o," string>number ] unit-test
-[ f ] [ "0x,1" string>number ] unit-test
-[ f ] [ "0b,1" string>number ] unit-test
-[ f ] [ "0o,1" string>number ] unit-test
-[ f ] [ "0x1," string>number ] unit-test
-[ f ] [ "0b1," string>number ] unit-test
-[ f ] [ "0o1," string>number ] unit-test
+{ "0/0." } [ 0.0 0.0 / number>string ] unit-test
+
+{ "1/0." } [ 1.0 0.0 / number>string ] unit-test
+
+{ "-1/0." } [ -1.0 0.0 / number>string ] unit-test
+
+{ t } [ "0/0." string>number fp-nan? ] unit-test
+
+{ 1/0. } [ "1/0." string>number ] unit-test
+
+{ -1/0. } [ "-1/0." string>number ] unit-test
+
+{ -0.5 } [ "-1/2." string>number ] unit-test
+
+{ "-0.0" } [ -0.0 number>string ] unit-test
+
+{ "-3/4" } [ -3/4 number>string ] unit-test
+{ "-1-1/4" } [ -5/4 number>string ] unit-test
+
+{ "1.0p0" } [ 1.0 >hex ] unit-test
+{ "1.8p2" } [ 6.0 >hex ] unit-test
+{ "1.08p2" } [ 4.125 >hex ] unit-test
+{ "1.8p-2" } [ 0.375 >hex ] unit-test
+{ "-1.8p2" } [ -6.0 >hex ] unit-test
+{ "1.8p10" } [ 1536.0 >hex ] unit-test
+{ "0.0" } [ 0.0 >hex ] unit-test
+{ "1.0p-1074" } [ 1 bits>double >hex ] unit-test
+{ "-0.0" } [ -0.0 >hex ] unit-test
+
+{ 1.0 } [ "1.0p0" hex> ] unit-test
+{ 1.5 } [ "1.8p0" hex> ] unit-test
+{ 1.875 } [ "1.ep0" hex> ] unit-test
+{ 1.90625 } [ "1.e8p0" hex> ] unit-test
+{ 1.03125 } [ "1.08p0" hex> ] unit-test
+{ 15.5 } [ "f.8p0" hex> ] unit-test
+{ 15.53125 } [ "f.88p0" hex> ] unit-test
+{ -15.5 } [ "-f.8p0" hex> ] unit-test
+{ 15.5 } [ "f.8p0" hex> ] unit-test
+{ -15.5 } [ "-f.8p0" hex> ] unit-test
+{ 62.0 } [ "f.8p2" hex> ] unit-test
+{ 3.875 } [ "f.8p-2" hex> ] unit-test
+{ $[ 1 bits>double ] } [ "1.0p-1074" hex> ] unit-test
+{ 0.0 } [ "1.0p-1075" hex> ] unit-test
+{ 1/0. } [ "1.0p1024" hex> ] unit-test
+{ -1/0. } [ "-1.0p1024" hex> ] unit-test
+
+{ 0 } [ "0" string>number ] unit-test
+{ 0 } [ "00" string>number ] unit-test
+{ 0 } [ "0,000" string>number ] unit-test
+{ 0.0 } [ "0." string>number ] unit-test
+{ 0.0 } [ "0.0" string>number ] unit-test
+{ 0.0 } [ "0x0.0p0" string>number ] unit-test
+{ 0 } [ "0x0" string>number ] unit-test
+{ 0 } [ "0o0" string>number ] unit-test
+{ 0 } [ "0b0" string>number ] unit-test
+
+{ 10 } [ "010" string>number ] unit-test
+{ 16 } [ "0x10" string>number ] unit-test
+{ 8 } [ "0o10" string>number ] unit-test
+{ 2 } [ "0b10" string>number ] unit-test
+
+{ -10 } [ "-010" string>number ] unit-test
+{ -16 } [ "-0x10" string>number ] unit-test
+{ -8 } [ "-0o10" string>number ] unit-test
+{ -2 } [ "-0b10" string>number ] unit-test
+
+{ f } [ "01a" string>number ] unit-test
+{ f } [ "0x1g" string>number ] unit-test
+{ f } [ "0o18" string>number ] unit-test
+{ f } [ "0b12" string>number ] unit-test
+
+{ 11 } [ "0x0b" string>number ] unit-test
+{ f } [ "0x0o0" string>number ] unit-test
+
+{ 0x7FFF,ABCD } [ "0x7FFF,ABCD" string>number ] unit-test
+
+{ 1.0 } [ "0x1.0p0" string>number ] unit-test
+{ 6.0 } [ "0x1.8p2" string>number ] unit-test
+{ 0.375 } [ "0x1.8p-2" string>number ] unit-test
+{ -6.0 } [ "-0x1.8p2" string>number ] unit-test
+{ -0.375 } [ "-0x1.8p-2" string>number ] unit-test
+
+{ f } [ "0x" string>number ] unit-test
+{ f } [ "0b" string>number ] unit-test
+{ f } [ "0o" string>number ] unit-test
+{ f } [ "0x," string>number ] unit-test
+{ f } [ "0b," string>number ] unit-test
+{ f } [ "0o," string>number ] unit-test
+{ f } [ "0x,1" string>number ] unit-test
+{ f } [ "0b,1" string>number ] unit-test
+{ f } [ "0o,1" string>number ] unit-test
+{ f } [ "0x1," string>number ] unit-test
+{ f } [ "0b1," string>number ] unit-test
+{ f } [ "0o1," string>number ] unit-test
! #372
! hex float requires exponent
-[ f ] [ "0x1.0" string>number ] unit-test
+{ f } [ "0x1.0" string>number ] unit-test
! hex float rounds to even on half
-[ 0x1.0000,0000,0000,0p0 ] [ "0x1.0000,0000,0000,0,8p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,2p0 ] [ "0x1.0000,0000,0000,1,8p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,0p0 ] [ "0x8.0000,0000,0000,4p-3" string>number ] unit-test
-[ 0x1.0000,0000,0000,2p0 ] [ "0x8.0000,0000,0000,Cp-3" string>number ] unit-test
+{ 0x1.0000,0000,0000,0p0 } [ "0x1.0000,0000,0000,0,8p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,2p0 } [ "0x1.0000,0000,0000,1,8p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,0p0 } [ "0x8.0000,0000,0000,4p-3" string>number ] unit-test
+{ 0x1.0000,0000,0000,2p0 } [ "0x8.0000,0000,0000,Cp-3" string>number ] unit-test
-[ -0x1.0000,0000,0000,0p0 ] [ "-0x1.0000,0000,0000,0,8p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,2p0 ] [ "-0x1.0000,0000,0000,1,8p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,0p0 ] [ "-0x8.0000,0000,0000,4p-3" string>number ] unit-test
-[ -0x1.0000,0000,0000,2p0 ] [ "-0x8.0000,0000,0000,Cp-3" string>number ] unit-test
+{ -0x1.0000,0000,0000,0p0 } [ "-0x1.0000,0000,0000,0,8p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,2p0 } [ "-0x1.0000,0000,0000,1,8p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,0p0 } [ "-0x8.0000,0000,0000,4p-3" string>number ] unit-test
+{ -0x1.0000,0000,0000,2p0 } [ "-0x8.0000,0000,0000,Cp-3" string>number ] unit-test
! hex float rounds to nearest with tiny epsilons
-[ 0x1.0000,0000,0000,0p0 ] [ "0x1.0000,0000,0000,0,4p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,0p0 ] [ "0x1.0000,0000,0000,0,7Fp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,0p0 ] [ "0x1.0000,0000,0000,0,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,0p0 } [ "0x1.0000,0000,0000,0,4p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,0p0 } [ "0x1.0000,0000,0000,0,7Fp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,0p0 } [ "0x1.0000,0000,0000,0,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,0,Cp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,0,81p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,0,8000,0000,0000,0001p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,0,Cp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,0,81p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,0,8000,0000,0000,0001p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,1,4p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,1,7Fp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,1p0 ] [ "0x1.0000,0000,0000,1,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,1,4p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,1,7Fp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,1p0 } [ "0x1.0000,0000,0000,1,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,2p0 ] [ "0x1.0000,0000,0000,1,Cp0" string>number ] unit-test
-[ 0x1.0000,0000,0000,2p0 ] [ "0x1.0000,0000,0000,1,81p0" string>number ] unit-test
-[ 0x1.0000,0000,0000,2p0 ] [ "0x1.0000,0000,0000,1,8000,0000,0000,0001p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,2p0 } [ "0x1.0000,0000,0000,1,Cp0" string>number ] unit-test
+{ 0x1.0000,0000,0000,2p0 } [ "0x1.0000,0000,0000,1,81p0" string>number ] unit-test
+{ 0x1.0000,0000,0000,2p0 } [ "0x1.0000,0000,0000,1,8000,0000,0000,0001p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,0p0 ] [ "-0x1.0000,0000,0000,0,4p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,0p0 ] [ "-0x1.0000,0000,0000,0,7Fp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,0p0 ] [ "-0x1.0000,0000,0000,0,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,0p0 } [ "-0x1.0000,0000,0000,0,4p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,0p0 } [ "-0x1.0000,0000,0000,0,7Fp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,0p0 } [ "-0x1.0000,0000,0000,0,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,0,Cp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,0,81p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,0,8000,0000,0000,0001p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,0,Cp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,0,81p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,0,8000,0000,0000,0001p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,1,4p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,1,7Fp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,1p0 ] [ "-0x1.0000,0000,0000,1,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,1,4p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,1,7Fp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,1p0 } [ "-0x1.0000,0000,0000,1,7FFF,FFFF,FFFF,FFFFp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,2p0 ] [ "-0x1.0000,0000,0000,1,Cp0" string>number ] unit-test
-[ -0x1.0000,0000,0000,2p0 ] [ "-0x1.0000,0000,0000,1,81p0" string>number ] unit-test
-[ -0x1.0000,0000,0000,2p0 ] [ "-0x1.0000,0000,0000,1,8000,0000,0000,0001p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,2p0 } [ "-0x1.0000,0000,0000,1,Cp0" string>number ] unit-test
+{ -0x1.0000,0000,0000,2p0 } [ "-0x1.0000,0000,0000,1,81p0" string>number ] unit-test
+{ -0x1.0000,0000,0000,2p0 } [ "-0x1.0000,0000,0000,1,8000,0000,0000,0001p0" string>number ] unit-test
! #453
! hex> dec> oct> bin> shouldn't admit radix prefixes
-[ 0x0b ] [ "0b" hex> ] unit-test
-[ 0x0b0 ] [ "0b0" hex> ] unit-test
-[ f ] [ "0o0" hex> ] unit-test
-[ f ] [ "0x0" hex> ] unit-test
-
-[ f ] [ "0b" dec> ] unit-test
-[ f ] [ "0b0" dec> ] unit-test
-[ f ] [ "0o0" dec> ] unit-test
-[ f ] [ "0x0" dec> ] unit-test
-
-[ f ] [ "0b" oct> ] unit-test
-[ f ] [ "0b0" oct> ] unit-test
-[ f ] [ "0o0" oct> ] unit-test
-[ f ] [ "0x0" oct> ] unit-test
-
-[ f ] [ "0b" bin> ] unit-test
-[ f ] [ "0b0" bin> ] unit-test
-[ f ] [ "0o0" bin> ] unit-test
-[ f ] [ "0x0" bin> ] unit-test
+{ 0x0b } [ "0b" hex> ] unit-test
+{ 0x0b0 } [ "0b0" hex> ] unit-test
+{ f } [ "0o0" hex> ] unit-test
+{ f } [ "0x0" hex> ] unit-test
+
+{ f } [ "0b" dec> ] unit-test
+{ f } [ "0b0" dec> ] unit-test
+{ f } [ "0o0" dec> ] unit-test
+{ f } [ "0x0" dec> ] unit-test
+
+{ f } [ "0b" oct> ] unit-test
+{ f } [ "0b0" oct> ] unit-test
+{ f } [ "0o0" oct> ] unit-test
+{ f } [ "0x0" oct> ] unit-test
+
+{ f } [ "0b" bin> ] unit-test
+{ f } [ "0b0" bin> ] unit-test
+{ f } [ "0o0" bin> ] unit-test
+{ f } [ "0x0" bin> ] unit-test
2 [ [ [ 3 throw ] instances ] must-fail ] times
! Tests for 'become'
-[ ] [ { } { } become ] unit-test
+{ } [ { } { } become ] unit-test
! Become something when it's on the data stack.
{ "replacer" } [
! Bug found on Windows build box, having too many words in the
! image breaks 'become'
-[ ] [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test
+{ } [ 100000 [ f <uninterned-word> ] replicate { } { } become drop ] unit-test
! Bug: code heap collection had to be done when data heap was
! full, not just when code heap was full. If the code heap
: leak-loop ( -- ) 100 [ leak-step ] times ;
-[ ] [ leak-loop ] unit-test
+{ } [ leak-loop ] unit-test
! Bug: allocation of large objects directly into tenured space
! can proceed past the high water mark.
! large objects are unreachable.
SYMBOL: foo
-[ ] [
+{ } [
gc
data-room tenured>> size>>
: test-namespace ( -- ? )
H{ } clone dup [ namespace = ] with-variables ;
-[ t ] [ test-namespace ] unit-test
+{ t } [ test-namespace ] unit-test
10 "some-global" set
-[ f ]
+{ f }
[ H{ } clone [ f "some-global" set "some-global" get ] with-variables ]
unit-test
test-initialize [ 1 ] initialize
test-initialize [ 2 ] initialize
-[ 1 ] [ test-initialize get-global ] unit-test
+{ 1 } [ test-initialize get-global ] unit-test
f test-initialize set-global
test-initialize [ 5 ] initialize
-[ 5 ] [ test-initialize get-global ] unit-test
+{ 5 } [ test-initialize get-global ] unit-test
SYMBOL: toggle-test
-[ f ] [ toggle-test get ] unit-test
-[ t ] [ toggle-test [ toggle ] [ get ] bi ] unit-test
-[ f ] [ toggle-test [ toggle ] [ get ] bi ] unit-test
+{ f } [ toggle-test get ] unit-test
+{ t } [ toggle-test [ toggle ] [ get ] bi ] unit-test
+{ f } [ toggle-test [ toggle ] [ get ] bi ] unit-test
-[ t ] [ toggle-test [ on ] [ get ] bi ] unit-test
-[ f ] [ toggle-test [ off ] [ get ] bi ] unit-test
+{ t } [ toggle-test [ on ] [ get ] bi ] unit-test
+{ f } [ toggle-test [ off ] [ get ] bi ] unit-test
-[ t ] [ [ test-initialize get-global ] { at* set-at } inlined? ] unit-test
-[ t ] [ [ test-initialize set-global ] { at* set-at } inlined? ] unit-test
+{ t } [ [ test-initialize get-global ] { at* set-at } inlined? ] unit-test
+{ t } [ [ test-initialize set-global ] { at* set-at } inlined? ] unit-test
USING: lexer namespaces parser.notes source-files tools.test ;
IN: parser.notes.tests
-[ ] [ f lexer set f file set "Hello world" note. ] unit-test
+{ } [ f lexer set f file set "Hello world" note. ] unit-test
tools.crossref grouping sets ;
IN: parser.tests
-[ 1 [ 2 [ 3 ] 4 ] 5 ]
+{ 1 [ 2 [ 3 ] 4 ] 5 }
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
unit-test
-[ t t f f ]
+{ t t f f }
[ "t t f f" eval( -- ? ? ? ? ) ]
unit-test
-[ "hello world" ]
+{ "hello world" }
[ "\"hello world\"" eval( -- string ) ]
unit-test
-[ "\n\r\t\\" ]
+{ "\n\r\t\\" }
[ "\"\\n\\r\\t\\\\\"" eval( -- string ) ]
unit-test
-[ "hello world" ]
+{ "hello world" }
[
"""#!/usr/bin/env factor
"hello world" """ eval( -- string )
] unit-test
-[ "hello world" ]
+{ "hello world" }
[
"IN: parser.tests : hello ( -- str ) \"hello world\" ;"
eval( -- ) "USE: parser.tests hello" eval( -- string )
[ "IN: parser.tests : 123 ( -- n ) 123 ;" eval( -- ) ]
[ error>> invalid-word-name? ] must-fail-with
-[ ]
+{ }
[ "! This is a comment, people." eval( -- ) ]
unit-test
! Test escapes
-[ " " ]
+{ " " }
[ "\"\\u000020\"" eval( -- string ) ]
unit-test
-[ "'" ]
+{ "'" }
[ "\"\\u000027\"" eval( -- string ) ]
unit-test
! Test EOL comments in multiline strings.
-[ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
+{ "Hello" } [ "#! This calls until-eol.\n\"Hello\"" eval( -- string ) ] unit-test
-[ word ] [ \ f class-of ] unit-test
+{ word } [ \ f class-of ] unit-test
! Test stack effect parsing
: effect-parsing-test ( a b -- c ) + ;
-[ t ] [
+{ t } [
"effect-parsing-test" "parser.tests" lookup-word
\ effect-parsing-test eq?
] unit-test
-[ T{ effect f { "a" "b" } { "c" } f } ]
+{ T{ effect f { "a" "b" } { "c" } f } }
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
: baz ( a b -- * ) 2array throw ;
-[ t ]
+{ t }
[ \ baz "declared-effect" word-prop terminated?>> ]
unit-test
-[ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval( -- ) ] unit-test
-[ t ] [
+{ t } [
"effect-parsing-test" "parser.tests" lookup-word
\ effect-parsing-test eq?
] unit-test
-[ T{ effect f { "a" "b" } { "d" } f } ]
+{ T{ effect f { "a" "b" } { "d" } f } }
[ \ effect-parsing-test "declared-effect" word-prop ] unit-test
[ "IN: parser.tests : missing-- ( a b ) ;" eval( -- ) ] must-fail
! Funny bug
-[ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
+{ 2 } [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval( -- n ) ] unit-test
DEFER: foo
"IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval( -- )
-[ ] [ "USE: parser.tests foo" eval( -- ) ] unit-test
+{ } [ "USE: parser.tests foo" eval( -- ) ] unit-test
"IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval( -- )
-[ t ] [
+{ t } [
"USE: parser.tests \\ foo" eval( -- word )
"foo" "parser.tests" lookup-word eq?
] unit-test
! Test smudging
-[ 1 ] [
+{ 1 } [
"IN: parser.tests : smudge-me ( -- ) ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ t ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
-[ ] [
+{ } [
"IN: parser.tests : smudge-me-more ( -- ) ;" <string-reader> "foo"
parse-stream drop
] unit-test
-[ t ] [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
-[ f ] [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "smudge-me-more" "parser.tests" lookup-word >boolean ] unit-test
+{ f } [ "smudge-me" "parser.tests" lookup-word >boolean ] unit-test
-[ 3 ] [
+{ 3 } [
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ 1 ] [
+{ 1 } [
"IN: parser.tests USING: arrays ; M: array smudge-me ;" <string-reader> "bar"
parse-stream drop
"bar" source-file definitions>> first cardinality
] unit-test
-[ 2 ] [
+{ 2 } [
"IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" <string-reader> "foo"
parse-stream drop
"foo" source-file definitions>> first cardinality
] unit-test
-[ t ] [
+{ t } [
array "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ t ] [
+{ t } [
integer "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ f ] [
+{ f } [
string "smudge-me" "parser.tests" lookup-word order member-eq?
] unit-test
-[ ] [
+{ } [
"IN: parser.tests USE: math 2 2 +" <string-reader> "a"
parse-stream drop
] unit-test
-[ t ] [
+{ t } [
"a" <pathname> \ + usage member?
] unit-test
-[ ] [
+{ } [
"IN: parser.tests USE: math 2 2 -" <string-reader> "a"
parse-stream drop
] unit-test
-[ f ] [
+{ f } [
"a" <pathname> \ + usage member?
] unit-test
-[ ] [
+{ } [
"a" source-files get delete-at
2 [
"IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;"
<string-reader> "a" parse-stream
] [ source-file-error? ] must-fail-with
-[ t ] [
+{ t } [
"y" "parser.tests" lookup-word >boolean
] unit-test
-[ f ] [
+{ f } [
"IN: parser.tests : x ( -- ) ;"
<string-reader> "a" parse-stream drop
"y" "parser.tests" lookup-word
] unit-test
! Test new forward definition logic
-[ ] [
+{ } [
"IN: axx : axx ( -- ) ;"
<string-reader> "axx" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop
] unit-test
! So we move the bxx word to axx...
-[ ] [
+{ } [
"IN: axx : axx ( -- ) ; : bxx ( -- ) ;"
<string-reader> "axx" parse-stream drop
] unit-test
-[ t ] [ "bxx" "axx" lookup-word >boolean ] unit-test
+{ t } [ "bxx" "axx" lookup-word >boolean ] unit-test
! And reload the file that uses it...
-[ ] [
+{ } [
"USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;"
<string-reader> "bxx" parse-stream drop
] unit-test
! Turning a generic into a non-generic could cause all
! kinds of funnyness
-[ ] [
+{ } [
"IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;"
<string-reader> "ayy" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: ayy USE: kernel : ayy ( -- ) ;"
<string-reader> "ayy" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )"
<string-reader> "azz" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: azz M: my-class a-generic ;"
<string-reader> "azz-2" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: azz GENERIC: a-generic ( a -- b )"
<string-reader> "azz" parse-stream drop
] unit-test
-[ ] [
+{ } [
"USE: azz USE: math M: integer a-generic ;"
<string-reader> "azz-2" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
<string-reader> "bogus-error" parse-stream drop
] unit-test
! Problems with class predicates -vs- ordinary words
-[ ] [
+{ } [
"IN: parser.tests TUPLE: killer ;"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: parser.tests GENERIC: killer? ( a -- b )"
<string-reader> "removing-the-predicate" parse-stream drop
] unit-test
-[ t ] [
+{ t } [
"killer?" "parser.tests" lookup-word >boolean
] unit-test
<string-reader> "redefining-a-class-1" parse-stream
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test"
<string-reader> "redefining-a-class-2" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-fwd-test ;"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-3" parse-stream drop
] [ error>> error>> error>> no-word-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests TUPLE: class-fwd-test ; SYMBOL: class-fwd-test"
<string-reader> "redefining-a-class-3" parse-stream drop
] unit-test
<string-reader> "redefining-a-class-4" parse-stream drop
] [ error>> error>> error>> redefine-error? ] must-fail-with
-[ ] [
+{ } [
"IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] unit-test
"IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval( -- )
] must-fail
-[ ] [
+{ } [
"IN: parser.tests USE: kernel PREDICATE: foo < object ;" eval( -- )
] unit-test
-[ t ] [
+{ t } [
"foo" "parser.tests" lookup-word last-word eq?
] unit-test
-[ ] [
+{ } [
[
"redefining-a-class-5" forget-source
"redefining-a-class-6" forget-source
] unit-test
] times
-[ ] [
+{ } [
[ "this-better-not-exist" forget-vocab ] with-compilation-unit
] unit-test
[ ": foo ;" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
-[ 92 ] [ "CHAR: \\" eval( -- n ) ] unit-test
-[ 92 ] [ "CHAR: \\\\" eval( -- n ) ] unit-test
+{ 92 } [ "CHAR: \\" eval( -- n ) ] unit-test
+{ 92 } [ "CHAR: \\\\" eval( -- n ) ] unit-test
-[ ] [
+{ } [
{
"IN: parser.tests"
"USING: math arrays kernel ;"
} "\n" join <string-reader> "change-combination-test" parse-stream drop
] unit-test
-[ ] [
+{ } [
{
"IN: parser.tests"
"USING: math arrays kernel ;"
} "\n" join <string-reader> "change-combination-test" parse-stream drop
] unit-test
-[ 2 ] [
+{ 2 } [
"change-combination" "parser.tests" lookup-word
"methods" word-prop assoc-size
] unit-test
-[ ] [
+{ } [
2 [
"IN: parser.tests DEFER: twice-fails FORGET: twice-fails MIXIN: twice-fails"
<string-reader> "twice-fails-test" parse-stream drop
] times
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream
] unit-test
-[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
<string-reader> "staging-problem-test" parse-stream
] unit-test
-[ t ] [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-1" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "staging-problem-test-2" "parser.tests" lookup-word >boolean ] unit-test
[ "DEFER: blahy" eval( -- ) ] [ error>> error>> no-current-vocab-error? ] must-fail-with
SYMBOLS: a b c ;
-[ a ] [ a ] unit-test
-[ b ] [ b ] unit-test
-[ c ] [ c ] unit-test
+{ a } [ a ] unit-test
+{ b } [ b ] unit-test
+{ c } [ c ] unit-test
DEFER: blah
-[ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval( -- ) ] unit-test
-[ ] [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests GENERIC: blah ( -- )" eval( -- ) ] unit-test
+{ } [ "IN: parser.tests SYMBOLS: blah ;" eval( -- ) ] unit-test
-[ f ] [ \ blah generic? ] unit-test
-[ t ] [ \ blah symbol? ] unit-test
+{ f } [ \ blah generic? ] unit-test
+{ t } [ \ blah symbol? ] unit-test
DEFER: blah1
QUALIFIED: qualified.tests.foo
QUALIFIED: qualified.tests.bar
-[ 1 2 3 ] [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
+{ 1 2 3 } [ qualified.tests.foo:x qualified.tests.bar:x x ] unit-test
QUALIFIED-WITH: qualified.tests.bar p
-[ 2 ] [ p:x ] unit-test
+{ 2 } [ p:x ] unit-test
RENAME: x qualified.tests.baz => y
-[ 3 ] [ y ] unit-test
+{ 3 } [ y ] unit-test
FROM: qualified.tests.baz => x ;
-[ 3 ] [ x ] unit-test
-[ 3 ] [ y ] unit-test
+{ 3 } [ x ] unit-test
+{ 3 } [ y ] unit-test
EXCLUDE: qualified.tests.bar => x ;
-[ 3 ] [ x ] unit-test
-[ 4 ] [ y ] unit-test
+{ 3 } [ x ] unit-test
+{ 4 } [ y ] unit-test
! Two similar bugs
! Replace : def with something in << >>
-/* [ [ ] ] [
+/* { [ ] } [
"IN: parser.tests : was-once-a-word-bug ( -- ) ;"
<string-reader> "was-once-a-word-test" parse-stream
] unit-test
-[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests USE: words << \"was-once-a-word-bug\" \"parser.tests\" create-word [ ] ( -- ) define-declared >>"
<string-reader> "was-once-a-word-test" parse-stream
] unit-test
-[ t ] [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
+{ t } [ "was-once-a-word-bug" "parser.tests" lookup-word >boolean ] unit-test */
! Replace : def with DEFER:
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests : is-not-deferred ( -- ) ;"
<string-reader> "is-not-deferred" parse-stream
] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
-[ f ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
+{ f } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests DEFER: is-not-deferred"
<string-reader> "is-not-deferred" parse-stream
] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
-[ t ] [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word >boolean ] unit-test
+{ t } [ "is-not-deferred" "parser.tests" lookup-word deferred? ] unit-test
! Forward-reference resolution case iterated using list in the wrong direction
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-1 DEFER: x DEFER: y"
<string-reader> "forward-ref-1" parse-stream
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-2 DEFER: x DEFER: y"
<string-reader> "forward-ref-2" parse-stream
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ t ] [
+{ t } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ ] ] [
+{ [ ] } [
"FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; IN: parser.tests.forward-ref-3 : x ( -- ) ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ f ] [
+{ f } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ ] ] [
+{ [ ] } [
"IN: parser.tests.forward-ref-3 FROM: parser.tests.forward-ref-1 => x y ; FROM: parser.tests.forward-ref-2 => x y ; : z ( -- ) x y ;"
<string-reader> "forward-ref-3" parse-stream
] unit-test
-[ t ] [
+{ t } [
"z" "parser.tests.forward-ref-3" lookup-word def>> [ vocabulary>> ] map all-equal?
] unit-test
-[ [ dup ] ] [
+{ [ dup ] } [
"USE: kernel dup" <string-reader> "unuse-test" parse-stream
] unit-test
"USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
] [ error>> error>> error>> no-word-error? ] must-fail-with
-[ ] [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
+{ } [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test
[
[ "vocabs.loader.test.l" use-vocab ] must-fail
USING: math kernel quotations tools.test sequences ;
IN: quotations.tests
-[ [ 3 ] ] [ 3 [ ] curry ] unit-test
-[ [ \ + ] ] [ \ + [ ] curry ] unit-test
-[ [ \ + = ] ] [ \ + [ = ] curry ] unit-test
+{ [ 3 ] } [ 3 [ ] curry ] unit-test
+{ [ \ + ] } [ \ + [ ] curry ] unit-test
+{ [ \ + = ] } [ \ + [ = ] curry ] unit-test
-[ [ 1 + 2 + 3 + ] ] [
+{ [ 1 + 2 + 3 + ] } [
{ 1 2 3 } [ [ + ] curry ] map concat
] unit-test
-[ [ 1 2 3 4 ] ] [ [ 1 2 ] [ 3 4 ] append ] unit-test
-[ [ 1 2 3 ] ] [ [ 1 2 ] 3 suffix ] unit-test
-[ [ 3 1 2 ] ] [ [ 1 2 ] 3 prefix ] unit-test
+{ [ 1 2 3 4 ] } [ [ 1 2 ] [ 3 4 ] append ] unit-test
+{ [ 1 2 3 ] } [ [ 1 2 ] 3 suffix ] unit-test
+{ [ 3 1 2 ] } [ [ 1 2 ] 3 prefix ] unit-test
-[ [ "hi" ] ] [ "hi" 1quotation ] unit-test
+{ [ "hi" ] } [ "hi" 1quotation ] unit-test
[ 1 \ + curry ] must-fail
sequences.private strings tools.test ;
IN: sbufs.tests
-[ 5 ] [ "Hello" >sbuf length ] unit-test
+{ 5 } [ "Hello" >sbuf length ] unit-test
-[ "Hello" ] [
+{ "Hello" } [
100 <sbuf> "buf" set
"Hello" "buf" get push-all
"buf" get clone "buf-clone" set
"buf" get >string
] unit-test
-[ CHAR: h ] [ 0 SBUF" hello world" nth ] unit-test
-[ CHAR: H ] [
+{ CHAR: h } [ 0 SBUF" hello world" nth ] unit-test
+{ CHAR: H } [
CHAR: H 0 SBUF" hello world" [ set-nth ] keep first
] unit-test
-[ SBUF" x" ] [ 1 <sbuf> CHAR: x >bignum over push ] unit-test
+{ SBUF" x" } [ 1 <sbuf> CHAR: x >bignum over push ] unit-test
-[ fixnum ] [ 1 >bignum SBUF" " new-sequence length class-of ] unit-test
+{ fixnum } [ 1 >bignum SBUF" " new-sequence length class-of ] unit-test
-[ fixnum ] [ 1 >bignum iota [ ] SBUF" " map-as length class-of ] unit-test
+{ fixnum } [ 1 >bignum iota [ ] SBUF" " map-as length class-of ] unit-test
[ 1.5 SBUF" " new-sequence ] must-fail
generic.single math.vectors math.functions ;
IN: sequences.tests
-[ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
-[ { 1 } "not empty" ] [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test
-
-[ V{ 1 2 3 4 } ] [ 1 5 dup iota <slice> >vector ] unit-test
-[ 3 ] [ 1 4 dup iota <slice> length ] unit-test
-[ 2 ] [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
-[ V{ 2 3 } ] [ 1 3 { 1 2 3 4 } <slice> >vector ] unit-test
-[ V{ 4 5 } ] [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
-[ V{ 3 4 } ] [ 2 4 1 10 dup iota <slice> subseq >vector ] unit-test
-[ V{ 3 4 } ] [ 0 2 2 4 1 10 dup iota <slice> <slice> subseq >vector ] unit-test
+{ "empty" } [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
+{ { 1 } "not empty" } [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test
+
+{ V{ 1 2 3 4 } } [ 1 5 dup iota <slice> >vector ] unit-test
+{ 3 } [ 1 4 dup iota <slice> length ] unit-test
+{ 2 } [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
+{ V{ 2 3 } } [ 1 3 { 1 2 3 4 } <slice> >vector ] unit-test
+{ V{ 4 5 } } [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
+{ V{ 3 4 } } [ 2 4 1 10 dup iota <slice> subseq >vector ] unit-test
+{ V{ 3 4 } } [ 0 2 2 4 1 10 dup iota <slice> <slice> subseq >vector ] unit-test
[ 0 10 "hello" <slice> ] must-fail
[ -10 3 "hello" <slice> ] must-fail
[ 2 1 "hello" <slice> ] must-fail
-[ "cba" ] [ "abcdef" 3 head-slice reverse ] unit-test
+{ "cba" } [ "abcdef" 3 head-slice reverse ] unit-test
-[ 5040 ] [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test
+{ 5040 } [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test
-[ 5040 { 1 1 2 6 24 120 720 } ]
+{ 5040 { 1 1 2 6 24 120 720 } }
[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate ] unit-test
-[ 64 B{ 1 2 4 16 } ]
+{ 64 B{ 1 2 4 16 } }
[ B{ 2 2 4 4 } 1 [ * ] accumulate ] unit-test
-[ 5040 { 1 1 2 6 24 120 720 } ]
+{ 5040 { 1 1 2 6 24 120 720 } }
[ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate! ] unit-test
-[ t ]
+{ t }
[ { 1 2 3 4 5 6 7 } dup 1 [ * ] accumulate! nip eq? ] unit-test
-[ f f ] [ [ ] [ ] find ] unit-test
-[ 0 1 ] [ [ 1 ] [ ] find ] unit-test
-[ 1 "world" ] [ [ "hello" "world" ] [ "world" = ] find ] unit-test
-[ 2 3 ] [ [ 1 2 3 ] [ 2 > ] find ] unit-test
-[ f f ] [ [ 1 2 3 ] [ 10 > ] find ] unit-test
+{ f f } [ [ ] [ ] find ] unit-test
+{ 0 1 } [ [ 1 ] [ ] find ] unit-test
+{ 1 "world" } [ [ "hello" "world" ] [ "world" = ] find ] unit-test
+{ 2 3 } [ [ 1 2 3 ] [ 2 > ] find ] unit-test
+{ f f } [ [ 1 2 3 ] [ 10 > ] find ] unit-test
-[ 1 CHAR: e ]
+{ 1 CHAR: e }
[ "hello world" "aeiou" [ member? ] curry find ] unit-test
-[ 4 CHAR: o ]
+{ 4 CHAR: o }
[ 3 "hello world" "aeiou" [ member? ] curry find-from ] unit-test
-[ f f ] [ "abcd" [ 10 > nip ] find-index ] unit-test
-[ f f ] [ "abcd" [ drop CHAR: e = ] find-index ] unit-test
-[ 3 CHAR: d ] [ "abcdefg" [ 3 = nip ] find-index ] unit-test
-[ 3 CHAR: d ] [ "abcdefg" [ drop CHAR: d = ] find-index ] unit-test
+{ f f } [ "abcd" [ 10 > nip ] find-index ] unit-test
+{ f f } [ "abcd" [ drop CHAR: e = ] find-index ] unit-test
+{ 3 CHAR: d } [ "abcdefg" [ 3 = nip ] find-index ] unit-test
+{ 3 CHAR: d } [ "abcdefg" [ drop CHAR: d = ] find-index ] unit-test
-[ 0 CHAR: a ] [ 0 "abcdef" [ drop CHAR: a >= ] find-index-from ] unit-test
-[ 1 CHAR: b ] [ 0 "abcdef" [ drop CHAR: a > ] find-index-from ] unit-test
-[ 2 CHAR: c ] [ 1 "abcdef" [ drop CHAR: b > ] find-index-from ] unit-test
+{ 0 CHAR: a } [ 0 "abcdef" [ drop CHAR: a >= ] find-index-from ] unit-test
+{ 1 CHAR: b } [ 0 "abcdef" [ drop CHAR: a > ] find-index-from ] unit-test
+{ 2 CHAR: c } [ 1 "abcdef" [ drop CHAR: b > ] find-index-from ] unit-test
-[ f ] [ 3 [ ] member? ] unit-test
-[ f ] [ 3 [ 1 2 ] member? ] unit-test
-[ t ] [ 1 [ 1 2 ] member? ] unit-test
-[ t ] [ 2 [ 1 2 ] member? ] unit-test
+{ f } [ 3 [ ] member? ] unit-test
+{ f } [ 3 [ 1 2 ] member? ] unit-test
+{ t } [ 1 [ 1 2 ] member? ] unit-test
+{ t } [ 2 [ 1 2 ] member? ] unit-test
-[ t ]
+{ t }
[ [ "hello" "world" ] [ second ] keep member-eq? ] unit-test
-[ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test
+{ 4 } [ CHAR: x "tuvwxyz" >vector index ] unit-test
-[ f ] [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test
+{ f } [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test
-[ f ] [ CHAR: a 0 "tuvwxyz" >vector index-from ] unit-test
+{ f } [ CHAR: a 0 "tuvwxyz" >vector index-from ] unit-test
-[ f ] [ [ "Hello" { } 0.75 ] [ string? ] all? ] unit-test
-[ t ] [ [ ] [ ] all? ] unit-test
-[ t ] [ [ "hi" t 0.5 ] [ ] all? ] unit-test
+{ f } [ [ "Hello" { } 0.75 ] [ string? ] all? ] unit-test
+{ t } [ [ ] [ ] all? ] unit-test
+{ t } [ [ "hi" t 0.5 ] [ ] all? ] unit-test
-[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] filter ] unit-test
-[ { 4 2 6 } ] [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] filter ] unit-test
+{ [ 1 2 3 ] } [ [ 1 4 2 5 3 6 ] [ 4 < ] filter ] unit-test
+{ { 4 2 6 } } [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] filter ] unit-test
-[ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test
+{ [ 3 ] } [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test
-[ V{ 1 2 3 } ] [ V{ 1 4 2 5 3 6 } clone [ 4 < ] filter! ] unit-test
-[ V{ 4 2 6 } ] [ V{ 1 4 2 5 3 6 } clone [ 2 mod 0 = ] filter! ] unit-test
+{ V{ 1 2 3 } } [ V{ 1 4 2 5 3 6 } clone [ 4 < ] filter! ] unit-test
+{ V{ 4 2 6 } } [ V{ 1 4 2 5 3 6 } clone [ 2 mod 0 = ] filter! ] unit-test
-[ V{ 3 } ] [ V{ 1 2 3 } clone 2 [ swap < ] curry filter! ] unit-test
+{ V{ 3 } } [ V{ 1 2 3 } clone 2 [ swap < ] curry filter! ] unit-test
-[ "hello world how are you" ]
+{ "hello world how are you" }
[ { "hello" "world" "how" "are" "you" } " " join ] unit-test
-[ "hello world how are you" ]
+{ "hello world how are you" }
[ { "hello" "world" "how" "are" "you" } " " "" join-as ] unit-test
-[ "" ] [ { } "" join ] unit-test
+{ "" } [ { } "" join ] unit-test
-[ "" ] [ { } "" "" join-as ] unit-test
+{ "" } [ { } "" "" join-as ] unit-test
-[ { } ] [ { } flip ] unit-test
+{ { } } [ { } flip ] unit-test
-[ { "b" "e" } ] [ 1 { { "a" "b" "c" } { "d" "e" "f" } } flip nth ] unit-test
+{ { "b" "e" } } [ 1 { { "a" "b" "c" } { "d" "e" "f" } } flip nth ] unit-test
-[ { { 1 4 } { 2 5 } { 3 6 } } ]
+{ { { 1 4 } { 2 5 } { 3 6 } } }
[ { { 1 2 3 } { 4 5 6 } } flip ] unit-test
-[ [ 2 3 4 ] ] [ [ 1 2 3 ] 1 [ + ] curry map ] unit-test
+{ [ 2 3 4 ] } [ [ 1 2 3 ] 1 [ + ] curry map ] unit-test
-[ 1 ] [ 0 [ 1 2 ] nth ] unit-test
-[ 2 ] [ 1 [ 1 2 ] nth ] unit-test
+{ 1 } [ 0 [ 1 2 ] nth ] unit-test
+{ 2 } [ 1 [ 1 2 ] nth ] unit-test
-[ [ ] ] [ [ ] [ ] append ] unit-test
-[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
-[ [ 2 ] ] [ [ ] [ 2 ] 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
+{ [ ] } [ [ ] [ ] append ] unit-test
+{ [ 1 ] } [ [ 1 ] [ ] append ] unit-test
+{ [ 2 ] } [ [ ] [ 2 ] 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 ] must-fail
[ -1 "a" append ] must-fail
{ "0123456789" } [ 58 iota [ 48 < ] "" reject-as ] unit-test
-[ [ ] ] [ 1 [ ] remove ] unit-test
-[ [ ] ] [ 1 [ 1 ] remove ] unit-test
-[ [ 3 1 1 ] ] [ 2 [ 3 2 1 2 1 ] remove ] unit-test
+{ [ ] } [ 1 [ ] remove ] unit-test
+{ [ ] } [ 1 [ 1 ] remove ] unit-test
+{ [ 3 1 1 ] } [ 2 [ 3 2 1 2 1 ] remove ] unit-test
-[ [ ] ] [ [ ] reverse ] unit-test
-[ [ 1 ] ] [ [ 1 ] reverse ] unit-test
-[ [ 3 2 1 ] ] [ [ 1 2 3 ] reverse ] unit-test
+{ [ ] } [ [ ] reverse ] unit-test
+{ [ 1 ] } [ [ 1 ] reverse ] unit-test
+{ [ 3 2 1 ] } [ [ 1 2 3 ] reverse ] unit-test
-[ f ] [ f 0 head ] unit-test
-[ [ ] ] [ [ 1 ] 0 head ] unit-test
-[ [ 1 2 3 ] ] [ [ 1 2 3 4 ] 3 head ] unit-test
-[ [ ] ] [ [ 1 2 3 ] 3 tail ] unit-test
-[ [ 3 ] ] [ [ 1 2 3 ] 2 tail ] unit-test
+{ f } [ f 0 head ] unit-test
+{ [ ] } [ [ 1 ] 0 head ] unit-test
+{ [ 1 2 3 ] } [ [ 1 2 3 4 ] 3 head ] unit-test
+{ [ ] } [ [ 1 2 3 ] 3 tail ] unit-test
+{ [ 3 ] } [ [ 1 2 3 ] 2 tail ] unit-test
-[ "blah" ] [ "blahxx" 2 head* ] unit-test
+{ "blah" } [ "blahxx" 2 head* ] unit-test
-[ "xx" ] [ "blahxx" 2 tail* ] unit-test
+{ "xx" } [ "blahxx" 2 tail* ] unit-test
-[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test
-[ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] same? ] unit-test
+{ t } [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test
+{ t } [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] same? ] unit-test
-[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test
-[ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] same? ] unit-test
+{ t } [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test
+{ t } [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] same? ] unit-test
-[ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
-[ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
-[ t ] [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
-[ f ] [ [ ] [ 1 2 3 ] sequence= ] unit-test
+{ t } [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
+{ t } [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
+{ t } [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
+{ f } [ [ ] [ 1 2 3 ] sequence= ] unit-test
-[ { 1 3 2 4 } ] [ { 1 2 3 4 } clone 1 2 pick exchange ] unit-test
+{ { 1 3 2 4 } } [ { 1 2 3 4 } clone 1 2 pick exchange ] unit-test
-[ { "" "a" "aa" "aaa" } ]
+{ { "" "a" "aa" "aaa" } }
[ 4 [ CHAR: a <string> ] { } map-integers ]
unit-test
{ V{ 1 3 5 7 9 } } [ 10 iota >vector [ even? ] reject! ] unit-test
-[ V{ } ] [ "f" V{ } clone remove! ] unit-test
-[ V{ } ] [ "f" V{ "f" } clone remove! ] unit-test
-[ V{ } ] [ "f" V{ "f" "f" } clone remove! ] unit-test
-[ V{ "x" } ] [ "f" V{ "f" "x" "f" } clone remove! ] unit-test
-[ V{ "y" "x" } ] [ "f" V{ "y" "f" "x" "f" } clone remove! ] unit-test
+{ V{ } } [ "f" V{ } clone remove! ] unit-test
+{ V{ } } [ "f" V{ "f" } clone remove! ] unit-test
+{ V{ } } [ "f" V{ "f" "f" } clone remove! ] unit-test
+{ V{ "x" } } [ "f" V{ "f" "x" "f" } clone remove! ] unit-test
+{ V{ "y" "x" } } [ "f" V{ "y" "f" "x" "f" } clone remove! ] unit-test
-[ V{ 0 1 4 5 } ] [ 6 iota >vector 2 4 pick delete-slice ] unit-test
+{ V{ 0 1 4 5 } } [ 6 iota >vector 2 4 pick delete-slice ] unit-test
[ 6 >vector 2 8 pick delete-slice ] must-fail
-[ V{ } ] [ 6 iota >vector 0 6 pick delete-slice ] unit-test
+{ V{ } } [ 6 iota >vector 0 6 pick delete-slice ] unit-test
-[ { 1 2 "a" "b" 5 6 7 } ] [
+{ { 1 2 "a" "b" 5 6 7 } } [
{ "a" "b" } 2 4 { 1 2 3 4 5 6 7 }
replace-slice
] unit-test
-[ { 1 2 "a" "b" 6 7 } ] [
+{ { 1 2 "a" "b" 6 7 } } [
{ "a" "b" } 2 5 { 1 2 3 4 5 6 7 }
replace-slice
] unit-test
-[ { 1 2 "a" "b" 4 5 6 7 } ] [
+{ { 1 2 "a" "b" 4 5 6 7 } } [
{ "a" "b" } 2 3 { 1 2 3 4 5 6 7 }
replace-slice
] unit-test
-[ { 1 2 3 4 5 6 7 "a" "b" } ] [
+{ { 1 2 3 4 5 6 7 "a" "b" } } [
{ "a" "b" } 7 7 { 1 2 3 4 5 6 7 }
replace-slice
] unit-test
-[ { "a" 3 } ] [
+{ { "a" 3 } } [
{ "a" } 0 2 { 1 2 3 } replace-slice
] unit-test
-[ { 1 4 9 } ] [ { 1 2 3 } clone [ sq ] map! ] unit-test
+{ { 1 4 9 } } [ { 1 2 3 } clone [ sq ] map! ] unit-test
-[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
-[ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
-[ 5 ] [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
+{ 5 } [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
+{ 5 } [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
+{ 5 } [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
-[ SBUF" before&after" ] [
+{ SBUF" before&after" } [
"&" 6 11 SBUF" before and after" replace-slice
] unit-test
-[ 3 "a" ] [ { "a" "b" "c" "a" "d" } [ "a" = ] find-last ] unit-test
+{ 3 "a" } [ { "a" "b" "c" "a" "d" } [ "a" = ] find-last ] unit-test
-[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-from ] unit-test
-[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last-from ] unit-test
-[ f f ] [ -1 { 1 2 3 } [ 1 = ] find-from ] unit-test
+{ f f } [ 100 { 1 2 3 } [ 1 = ] find-from ] unit-test
+{ f f } [ 100 { 1 2 3 } [ 1 = ] find-last-from ] unit-test
+{ f f } [ -1 { 1 2 3 } [ 1 = ] find-from ] unit-test
-[ 0 ] [ { "a" "b" "c" } { "A" "B" "C" } mismatch ] unit-test
+{ 0 } [ { "a" "b" "c" } { "A" "B" "C" } mismatch ] unit-test
-[ 1 ] [ { "a" "b" "c" } { "a" "B" "C" } mismatch ] unit-test
+{ 1 } [ { "a" "b" "c" } { "a" "B" "C" } mismatch ] unit-test
-[ f ] [ { "a" "b" "c" } { "a" "b" "c" } mismatch ] unit-test
+{ f } [ { "a" "b" "c" } { "a" "b" "c" } mismatch ] unit-test
-[ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] bi@ ] unit-test
+{ V{ } V{ } } [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] bi@ ] unit-test
-[ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] bi@ ] unit-test
+{ V{ "C" } V{ "c" } } [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] bi@ ] unit-test
[ -1 1 "abc" <slice> ] must-fail
-[ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test
+{ V{ "a" "b" } V{ } } [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test
[ 0.5 { 1 2 3 } nth ] [ no-method? ] must-fail-with
[ 0.5 "asdfasdf" nth ] [ no-method? ] must-fail-with
! Pathological case
-[ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
+{ "ihbye" } [ "hi" <reversed> "bye" append ] unit-test
-[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
+{ t } [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
-[ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
+{ t } [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
-[ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] same? ] unit-test
+{ t } [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] same? ] unit-test
[ -10 "hi" "bye" copy ] must-fail
[ 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 remove-nth!
] unit-test
! erg's random tester found this one
-[ SBUF" 12341234" ] [
+{ SBUF" 12341234" } [
9 <sbuf> dup "1234" swap push-all dup dup swap push-all
] unit-test
-[ f ] [ f V{ } like f V{ } like eq? ] unit-test
+{ f } [ f V{ } like f V{ } like eq? ] unit-test
-[ V{ f f f } ] [ 3 V{ } new-sequence ] unit-test
-[ SBUF" \0\0\0" ] [ 3 SBUF" " new-sequence ] unit-test
+{ V{ f f f } } [ 3 V{ } new-sequence ] unit-test
+{ SBUF" \0\0\0" } [ 3 SBUF" " new-sequence ] unit-test
-[ 0 ] [ f length ] unit-test
+{ 0 } [ f length ] unit-test
[ f first ] must-fail
-[ 3 ] [ 3 10 iota nth ] unit-test
-[ 3 ] [ 3 10 iota nth-unsafe ] unit-test
+{ 3 } [ 3 10 iota nth ] unit-test
+{ 3 } [ 3 10 iota nth-unsafe ] unit-test
[ -3 10 iota nth ] must-fail
[ 11 10 iota nth ] must-fail
-[ f ] [ f ?first ] unit-test
-[ f ] [ { } ?first ] unit-test
-[ 0 ] [ 10 iota ?first ] unit-test
+{ f } [ f ?first ] unit-test
+{ f } [ { } ?first ] unit-test
+{ 0 } [ 10 iota ?first ] unit-test
-[ f ] [ f ?last ] unit-test
-[ f ] [ { } ?last ] unit-test
-[ 9 ] [ 10 iota ?last ] unit-test
+{ f } [ f ?last ] unit-test
+{ f } [ { } ?last ] unit-test
+{ 9 } [ 10 iota ?last ] unit-test
[ -1/0. 0 remove-nth! ] must-fail
-[ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
-[ "" ] [ "" [ CHAR: \s = ] trim-head ] unit-test
-[ "" ] [ "" [ CHAR: \s = ] trim-tail ] unit-test
-[ "" ] [ " " [ CHAR: \s = ] trim-head ] unit-test
-[ "" ] [ " " [ CHAR: \s = ] trim-tail ] unit-test
-[ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
-[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
-[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
+{ "" } [ "" [ CHAR: \s = ] trim ] unit-test
+{ "" } [ "" [ CHAR: \s = ] trim-head ] unit-test
+{ "" } [ "" [ CHAR: \s = ] trim-tail ] unit-test
+{ "" } [ " " [ CHAR: \s = ] trim-head ] unit-test
+{ "" } [ " " [ CHAR: \s = ] trim-tail ] unit-test
+{ "asdf" } [ " asdf " [ CHAR: \s = ] trim ] unit-test
+{ "asdf " } [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
+{ " asdf" } [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
-[ 328350 ] [ 100 iota [ sq ] map-sum ] unit-test
+{ 328350 } [ 100 iota [ sq ] map-sum ] unit-test
-[ 50 ] [ 100 iota [ even? ] count ] unit-test
-[ 50 ] [ 100 iota [ odd? ] count ] unit-test
+{ 50 } [ 100 iota [ even? ] count ] unit-test
+{ 50 } [ 100 iota [ odd? ] count ] unit-test
-[ { "b" "d" } ] [ { 1 3 } { "a" "b" "c" "d" } nths ] unit-test
-[ { "a" "b" "c" "d" } ] [ { 0 1 2 3 } { "a" "b" "c" "d" } nths ] unit-test
-[ { "d" "c" "b" "a" } ] [ { 3 2 1 0 } { "a" "b" "c" "d" } nths ] unit-test
-[ { "d" "a" "b" "c" } ] [ { 3 0 1 2 } { "a" "b" "c" "d" } nths ] unit-test
+{ { "b" "d" } } [ { 1 3 } { "a" "b" "c" "d" } nths ] unit-test
+{ { "a" "b" "c" "d" } } [ { 0 1 2 3 } { "a" "b" "c" "d" } nths ] unit-test
+{ { "d" "c" "b" "a" } } [ { 3 2 1 0 } { "a" "b" "c" "d" } nths ] unit-test
+{ { "d" "a" "b" "c" } } [ { 3 0 1 2 } { "a" "b" "c" "d" } nths ] unit-test
-[ "dac" ] [ { 3 0 2 } "abcd" nths ] unit-test
+{ "dac" } [ { 3 0 2 } "abcd" nths ] unit-test
TUPLE: bogus-hashcode ;
M: bogus-hashcode hashcode* 2drop 0 >bignum ;
-[ 0 ] [ { T{ bogus-hashcode } } hashcode ] unit-test
+{ 0 } [ { T{ bogus-hashcode } } hashcode ] unit-test
-[ { 2 4 6 } { 1 3 5 7 } ] [ { 1 2 3 4 5 6 7 } [ even? ] partition ] unit-test
+{ { 2 4 6 } { 1 3 5 7 } } [ { 1 2 3 4 5 6 7 } [ even? ] partition ] unit-test
-[ { 1 3 7 } ] [ 2 { 1 3 5 7 } remove-nth ] unit-test
+{ { 1 3 7 } } [ 2 { 1 3 5 7 } remove-nth ] unit-test
-[ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
+{ { 1 3 "X" 5 7 } } [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
-[ V{ 0 2 } ] [ "a" { "a" "b" "a" } indices ] unit-test
+{ V{ 0 2 } } [ "a" { "a" "b" "a" } indices ] unit-test
-[ "a,b" ] [ "a" "b" "," glue ] unit-test
-[ "(abc)" ] [ "abc" "(" ")" surround ] unit-test
+{ "a,b" } [ "a" "b" "," glue ] unit-test
+{ "(abc)" } [ "abc" "(" ")" surround ] unit-test
-[ "HELLO" ] [
+{ "HELLO" } [
"HELLO" { -1 -1 -1 -1 -1 } { 2 2 2 2 2 2 }
[ * 2 + + ] 3map
] unit-test
{ 3 0 } [ [ 3drop ] 3each ] must-infer-as
-[ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
+{ V{ 0 3 } } [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
[ "asdf" iota ] must-fail
[ -1 iota ] must-fail
-[ T{ iota-tuple { n 10 } } ] [ 10 iota ] unit-test
-[ 0 ] [ 10 iota first ] unit-test
+{ T{ iota-tuple { n 10 } } } [ 10 iota ] unit-test
+{ 0 } [ 10 iota first ] unit-test
{ 0 } [ 0 iota sum ] unit-test
{ 0 } [ 1 iota sum ] unit-test
{ 10 } [ 5 iota sum ] unit-test
{ 15 } [ 6 iota sum ] unit-test
-[ "hi" 3 ] [
+{ "hi" 3 } [
{ 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
] unit-test
-[ f f ] [
+{ f f } [
{ 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
] unit-test
USE: make
-[ { "a" 1 "b" 1 "c" } ]
+{ { "a" 1 "b" 1 "c" } }
[ 1 { "a" "b" "c" } [ [ dup , ] [ , ] interleave drop ] { } make ] unit-test
-[ t ] [ 0 array-capacity? ] unit-test
-[ f ] [ -1 array-capacity? ] unit-test
+{ t } [ 0 array-capacity? ] unit-test
+{ f } [ -1 array-capacity? ] unit-test
-[ +lt+ ] [ { 0 0 0 } { 1 1 1 } <=> ] unit-test
-[ +lt+ ] [ { 0 0 0 } { 0 1 1 } <=> ] unit-test
-[ +lt+ ] [ { 0 0 0 } { 0 0 0 0 } <=> ] unit-test
-[ +gt+ ] [ { 1 1 1 } { 0 0 0 } <=> ] unit-test
-[ +gt+ ] [ { 0 1 1 } { 0 0 0 } <=> ] unit-test
-[ +gt+ ] [ { 0 0 0 0 } { 0 0 0 } <=> ] unit-test
-[ +eq+ ] [ { } { } <=> ] unit-test
-[ +eq+ ] [ { 1 2 3 } { 1 2 3 } <=> ] unit-test
+{ +lt+ } [ { 0 0 0 } { 1 1 1 } <=> ] unit-test
+{ +lt+ } [ { 0 0 0 } { 0 1 1 } <=> ] unit-test
+{ +lt+ } [ { 0 0 0 } { 0 0 0 0 } <=> ] unit-test
+{ +gt+ } [ { 1 1 1 } { 0 0 0 } <=> ] unit-test
+{ +gt+ } [ { 0 1 1 } { 0 0 0 } <=> ] unit-test
+{ +gt+ } [ { 0 0 0 0 } { 0 0 0 } <=> ] unit-test
+{ +eq+ } [ { } { } <=> ] unit-test
+{ +eq+ } [ { 1 2 3 } { 1 2 3 } <=> ] unit-test
-[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
+{ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } }
[ { 1 2 } { "a" "b" } cartesian-product ] unit-test
[ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
[ { } [ ] [ + ] map-reduce ] must-fail
-[ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
+{ 4 } [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
[ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
[ { } { } [ + ] [ + ] 2map-reduce ] must-fail
-[ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
+{ 24 } [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test
-[ 4 ] [ 5 iota [ ] supremum-by ] unit-test
-[ 0 ] [ 5 iota [ ] infimum-by ] unit-test
+{ 4 } [ 5 iota [ ] supremum-by ] unit-test
+{ 0 } [ 5 iota [ ] infimum-by ] unit-test
{ "bar" } [ { "bar" "baz" "qux" } [ length ] supremum-by ] unit-test
{ "bar" } [ { "bar" "baz" "qux" } [ length ] infimum-by ] unit-test
-[ { "foo" } ] [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
-[ { "bar" } ] [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
+{ { "foo" } } [ { { "foo" } { "bar" } } [ first ] supremum-by ] unit-test
+{ { "bar" } } [ { { "foo" } { "bar" } } [ first ] infimum-by ] unit-test
{ -2 1 } [ -2 { 1 2 3 } [ over ^ ] supremum-by ] unit-test
{ -2 3 } [ -2 { 1 2 3 } [ over ^ ] infimum-by ] unit-test
-[ { 0 0 255 } ] [
+{ { 0 0 255 } } [
{
{ 0 0 0 }
{ 95 255 95 }
math sequences bit-sets bit-arrays ;
IN: sets.tests
-[ V{ 1 2 3 } ] [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
-[ V{ 1 2 } ] [ 2 V{ 1 2 } clone [ adjoin ] keep ] unit-test
-
-[ t ] [ 4 { 2 4 5 } in? ] unit-test
-[ f ] [ 1 { 2 4 5 } in? ] unit-test
-[ f ] [ f 5 <bit-set> in? ] unit-test
-
-[ V{ 1 2 } ] [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test
-[ V{ 2 } ] [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test
-[ 0 ] [ 5 <bit-set> 0 over delete cardinality ] unit-test
-[ 0 ] [ 5 <bit-set> f over delete cardinality ] unit-test
-[ 0 ] [ 5 <bit-set> 3 over adjoin 3 over delete cardinality ] unit-test
-[ 0 ] [ 5 <bit-set> 10 over delete cardinality ] unit-test
-[ HS{ 1 } ] [ HS{ 1 2 } 2 over delete ] unit-test
-
-[ { 1 2 3 } ] [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test
-[ { 1 2 3 } ] [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
-[ { 1 2 3 } ] [ { 1 2 2 3 3 } { } set-like ] unit-test
-[ { 3 2 1 } ] [ { 3 3 2 2 1 } { } set-like ] unit-test
-[ t ] [ 4 <bit-set> 1 <bit-set> set-like 4 <bit-set> = ] unit-test
-[ t ] [ { 1 2 3 } HS{ } set-like HS{ 1 2 3 } = ] unit-test
-
-[ HS{ 1 2 3 } ] [ { 1 2 3 } fast-set ] unit-test
-[ T{ bit-set { table ?{ f } } } ]
+{ V{ 1 2 3 } } [ 3 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+{ V{ 1 2 } } [ 2 V{ 1 2 } clone [ adjoin ] keep ] unit-test
+
+{ t } [ 4 { 2 4 5 } in? ] unit-test
+{ f } [ 1 { 2 4 5 } in? ] unit-test
+{ f } [ f 5 <bit-set> in? ] unit-test
+
+{ V{ 1 2 } } [ 3 V{ 1 2 } clone [ delete ] keep ] unit-test
+{ V{ 2 } } [ 1 V{ 1 2 } clone [ delete ] keep ] unit-test
+{ 0 } [ 5 <bit-set> 0 over delete cardinality ] unit-test
+{ 0 } [ 5 <bit-set> f over delete cardinality ] unit-test
+{ 0 } [ 5 <bit-set> 3 over adjoin 3 over delete cardinality ] unit-test
+{ 0 } [ 5 <bit-set> 10 over delete cardinality ] unit-test
+{ HS{ 1 } } [ HS{ 1 2 } 2 over delete ] unit-test
+
+{ { 1 2 3 } } [ { 1 1 1 2 2 3 3 3 3 3 } dup set-like natural-sort ] unit-test
+{ { 1 2 3 } } [ HS{ 1 2 3 } { } set-like natural-sort ] unit-test
+{ { 1 2 3 } } [ { 1 2 2 3 3 } { } set-like ] unit-test
+{ { 3 2 1 } } [ { 3 3 2 2 1 } { } set-like ] unit-test
+{ t } [ 4 <bit-set> 1 <bit-set> set-like 4 <bit-set> = ] unit-test
+{ t } [ { 1 2 3 } HS{ } set-like HS{ 1 2 3 } = ] unit-test
+
+{ HS{ 1 2 3 } } [ { 1 2 3 } fast-set ] unit-test
+{ T{ bit-set { table ?{ f } } } }
[ 1 <bit-set> fast-set ] unit-test
-[ { 1 } ] [ { 1 } members ] unit-test
+{ { 1 } } [ { 1 } members ] unit-test
-[ { } ] [ { } { } union ] unit-test
-[ { 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test
+{ { } } [ { } { } union ] unit-test
+{ { 1 2 3 4 } } [ { 1 2 3 } { 2 3 4 } union ] unit-test
-[ { } ] [ { } { } intersect ] unit-test
-[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
-[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 5 } intersect ] unit-test
-[ { 2 3 4 } ] [ { 1 2 3 4 } { 2 3 4 } intersect ] unit-test
-[ { 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test
+{ { } } [ { } { } intersect ] unit-test
+{ { 2 3 } } [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
+{ { 2 3 } } [ { 1 2 3 } { 2 3 4 5 } intersect ] unit-test
+{ { 2 3 4 } } [ { 1 2 3 4 } { 2 3 4 } intersect ] unit-test
+{ { 2 3 } } [ { 1 2 2 3 } { 2 3 3 4 } intersect ] unit-test
-[ t ] [ { 1 2 } { 1 3 } intersects? ] unit-test
-[ f ] [ { 4 2 } { 1 3 } intersects? ] unit-test
-[ f ] [ { } { 1 } intersects? ] unit-test
-[ f ] [ { 1 } { } intersects? ] unit-test
-[ f ] [ { } { } intersects? ] unit-test
+{ t } [ { 1 2 } { 1 3 } intersects? ] unit-test
+{ f } [ { 4 2 } { 1 3 } intersects? ] unit-test
+{ f } [ { } { 1 } intersects? ] unit-test
+{ f } [ { 1 } { } intersects? ] unit-test
+{ f } [ { } { } intersects? ] unit-test
-[ { } ] [ { } { } diff ] unit-test
-[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
-[ { 1 } ] [ { 1 2 3 } { 2 3 4 5 } diff ] unit-test
-[ { 1 } ] [ { 1 2 3 4 } { 2 3 4 } diff ] unit-test
-[ { 1 } ] [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test
+{ { } } [ { } { } diff ] unit-test
+{ { 1 } } [ { 1 2 3 } { 2 3 4 } diff ] unit-test
+{ { 1 } } [ { 1 2 3 } { 2 3 4 5 } diff ] unit-test
+{ { 1 } } [ { 1 2 3 4 } { 2 3 4 } diff ] unit-test
+{ { 1 } } [ { 1 1 2 3 } { 2 3 4 4 } diff ] unit-test
-[ T{ bit-set { table ?{ f f f } } } ]
+{ T{ bit-set { table ?{ f f f } } } }
[ 3 <bit-set> 0 over adjoin dup diff ] unit-test
-[ f ] [ { 1 2 3 4 } { 1 2 } subset? ] unit-test
-[ t ] [ { 1 2 3 4 } { 1 2 } swap subset? ] unit-test
-[ t ] [ { 1 2 } { 1 2 } subset? ] unit-test
-[ t ] [ { } { 1 2 } subset? ] unit-test
-[ t ] [ { } { } subset? ] unit-test
-[ f ] [ { 1 } { } subset? ] unit-test
-
-[ t ] [ { 1 2 3 } { 2 1 3 } set= ] unit-test
-[ f ] [ { 2 3 } { 1 2 3 } set= ] unit-test
-[ f ] [ { 1 2 3 } { 2 3 } set= ] unit-test
-
-[ { 2 1 2 1 } ] [ { 1 2 3 2 1 2 1 } duplicates ] unit-test
-[ f ] [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test
-
-[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test
-[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test
-[ t ] [ HS{ 0 1 2 3 4 5 } all-unique? ] unit-test
-
-[ t ] [ f null? ] unit-test
-[ f ] [ { 4 } null? ] unit-test
-[ t ] [ HS{ } null? ] unit-test
-[ f ] [ HS{ 3 } null? ] unit-test
-[ t ] [ 2 <bit-set> null? ] unit-test
-[ f ] [ 3 <bit-set> 0 over adjoin null? ] unit-test
-
-[ 0 ] [ f cardinality ] unit-test
-[ 0 ] [ { } cardinality ] unit-test
-[ 1 ] [ { 1 } cardinality ] unit-test
-[ 1 ] [ { 1 1 } cardinality ] unit-test
-[ 1 ] [ HS{ 1 } cardinality ] unit-test
-[ 3 ] [ HS{ 1 2 3 } cardinality ] unit-test
-[ 0 ] [ 0 <bit-set> cardinality ] unit-test
-[ 0 ] [ 5 <bit-set> cardinality ] unit-test
-[ 2 ] [ 5 <bit-set> 0 over adjoin 1 over adjoin cardinality ] unit-test
-[ 1 ] [ 5 <bit-set> 1 over adjoin cardinality ] unit-test
-
-[ { } ] [ { } { } within ] unit-test
-[ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } within ] unit-test
-[ { 2 2 3 } ] [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test
-
-[ { } ] [ { } { } without ] unit-test
-[ { 1 } ] [ { 1 2 3 } { 2 3 4 } without ] unit-test
-[ { 1 1 } ] [ { 1 1 2 3 3 } { 2 3 4 4 } without ] unit-test
-
-[ { 1 2 3 } ] [ { { 1 } { 2 } { 1 3 } } combine ] unit-test
-[ f ] [ { } combine ] unit-test
-
-[ { 1 4 9 16 25 36 } ]
+{ f } [ { 1 2 3 4 } { 1 2 } subset? ] unit-test
+{ t } [ { 1 2 3 4 } { 1 2 } swap subset? ] unit-test
+{ t } [ { 1 2 } { 1 2 } subset? ] unit-test
+{ t } [ { } { 1 2 } subset? ] unit-test
+{ t } [ { } { } subset? ] unit-test
+{ f } [ { 1 } { } subset? ] unit-test
+
+{ t } [ { 1 2 3 } { 2 1 3 } set= ] unit-test
+{ f } [ { 2 3 } { 1 2 3 } set= ] unit-test
+{ f } [ { 1 2 3 } { 2 3 } set= ] unit-test
+
+{ { 2 1 2 1 } } [ { 1 2 3 2 1 2 1 } duplicates ] unit-test
+{ f } [ HS{ 1 2 3 1 2 1 } duplicates ] unit-test
+
+{ f } [ { 0 1 1 2 3 5 } all-unique? ] unit-test
+{ t } [ { 0 1 2 3 4 5 } all-unique? ] unit-test
+{ t } [ HS{ 0 1 2 3 4 5 } all-unique? ] unit-test
+
+{ t } [ f null? ] unit-test
+{ f } [ { 4 } null? ] unit-test
+{ t } [ HS{ } null? ] unit-test
+{ f } [ HS{ 3 } null? ] unit-test
+{ t } [ 2 <bit-set> null? ] unit-test
+{ f } [ 3 <bit-set> 0 over adjoin null? ] unit-test
+
+{ 0 } [ f cardinality ] unit-test
+{ 0 } [ { } cardinality ] unit-test
+{ 1 } [ { 1 } cardinality ] unit-test
+{ 1 } [ { 1 1 } cardinality ] unit-test
+{ 1 } [ HS{ 1 } cardinality ] unit-test
+{ 3 } [ HS{ 1 2 3 } cardinality ] unit-test
+{ 0 } [ 0 <bit-set> cardinality ] unit-test
+{ 0 } [ 5 <bit-set> cardinality ] unit-test
+{ 2 } [ 5 <bit-set> 0 over adjoin 1 over adjoin cardinality ] unit-test
+{ 1 } [ 5 <bit-set> 1 over adjoin cardinality ] unit-test
+
+{ { } } [ { } { } within ] unit-test
+{ { 2 3 } } [ { 1 2 3 } { 2 3 4 } within ] unit-test
+{ { 2 2 3 } } [ { 1 2 2 3 } { 2 3 3 4 } within ] unit-test
+
+{ { } } [ { } { } without ] unit-test
+{ { 1 } } [ { 1 2 3 } { 2 3 4 } without ] unit-test
+{ { 1 1 } } [ { 1 1 2 3 3 } { 2 3 4 4 } without ] unit-test
+
+{ { 1 2 3 } } [ { { 1 } { 2 } { 1 3 } } combine ] unit-test
+{ f } [ { } combine ] unit-test
+
+{ { 1 4 9 16 25 36 } }
[ { { 1 2 3 } { 4 5 6 } } [ [ sq ] map ] gather ] unit-test
-[ H{ { 3 HS{ 1 2 } } } ] [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test
+{ H{ { 3 HS{ 1 2 } } } } [ H{ } clone 1 3 pick adjoin-at 2 3 pick adjoin-at ] unit-test
-[ H{ { 3 H{ { 1 1 } { 2 2 } } } } ] [ H{ } clone 1 3 pick conjoin-at 2 3 pick conjoin-at ] unit-test
+{ H{ { 3 H{ { 1 1 } { 2 2 } } } } } [ H{ } clone 1 3 pick conjoin-at 2 3 pick conjoin-at ] unit-test
TUPLE: null-set ;
INSTANCE: null-set set
M: null-set members drop f ;
-[ 0 ] [ T{ null-set } cardinality ] unit-test
-[ f ] [ T{ null-set } members ] unit-test
-[ t ] [ T{ null-set } T{ null-set } set-like T{ null-set } = ] unit-test
-
-[ t ] [ T{ null-set } set? ] unit-test
-[ t ] [ HS{ } set? ] unit-test
-[ t ] [ { } set? ] unit-test
-[ t ] [ 5 <bit-set> set? ] unit-test
-[ f ] [ H{ } set? ] unit-test
-
-[ HS{ } ] [ HS{ } [ clear-set ] keep ] unit-test
-[ HS{ } ] [ HS{ 1 2 3 } [ clear-set ] keep ] unit-test
-
-[ HS{ } ] [ HS{ } HS{ } union! ] unit-test
-[ HS{ 1 } ] [ HS{ 1 } HS{ } union! ] unit-test
-[ HS{ 1 } ] [ HS{ } HS{ 1 } union! ] unit-test
-[ HS{ 1 2 3 } ] [ HS{ 1 } HS{ 1 2 3 } union! ] unit-test
-
-[ f ] [ { } intersection ] unit-test
-[ HS{ } ] [ { HS{ } } intersection ] unit-test
-[ HS{ 1 } ] [ { HS{ 1 2 3 } HS{ 1 } } intersection ] unit-test
-
-[ HS{ } ] [ HS{ } HS{ } diff! ] unit-test
-[ HS{ 1 } ] [ HS{ 1 2 3 } HS{ 2 3 } diff! ] unit-test
-[ HS{ 1 } ] [ HS{ 1 } HS{ 2 3 4 } diff! ] unit-test
-[ HS{ 1 2 3 } ] [ HS{ 1 2 3 } HS{ 4 } diff! ] unit-test
-
-[ HS{ } ] [ HS{ } HS{ } intersect! ] unit-test
-[ HS{ 2 3 } ] [ HS{ 1 2 3 } HS{ 2 3 } intersect! ] unit-test
-[ HS{ } ] [ HS{ 1 } HS{ 2 3 4 } intersect! ] unit-test
-[ HS{ } ] [ HS{ 1 2 3 } HS{ 4 } intersect! ] unit-test
+{ 0 } [ T{ null-set } cardinality ] unit-test
+{ f } [ T{ null-set } members ] unit-test
+{ t } [ T{ null-set } T{ null-set } set-like T{ null-set } = ] unit-test
+
+{ t } [ T{ null-set } set? ] unit-test
+{ t } [ HS{ } set? ] unit-test
+{ t } [ { } set? ] unit-test
+{ t } [ 5 <bit-set> set? ] unit-test
+{ f } [ H{ } set? ] unit-test
+
+{ HS{ } } [ HS{ } [ clear-set ] keep ] unit-test
+{ HS{ } } [ HS{ 1 2 3 } [ clear-set ] keep ] unit-test
+
+{ HS{ } } [ HS{ } HS{ } union! ] unit-test
+{ HS{ 1 } } [ HS{ 1 } HS{ } union! ] unit-test
+{ HS{ 1 } } [ HS{ } HS{ 1 } union! ] unit-test
+{ HS{ 1 2 3 } } [ HS{ 1 } HS{ 1 2 3 } union! ] unit-test
+
+{ f } [ { } intersection ] unit-test
+{ HS{ } } [ { HS{ } } intersection ] unit-test
+{ HS{ 1 } } [ { HS{ 1 2 3 } HS{ 1 } } intersection ] unit-test
+
+{ HS{ } } [ HS{ } HS{ } diff! ] unit-test
+{ HS{ 1 } } [ HS{ 1 2 3 } HS{ 2 3 } diff! ] unit-test
+{ HS{ 1 } } [ HS{ 1 } HS{ 2 3 4 } diff! ] unit-test
+{ HS{ 1 2 3 } } [ HS{ 1 2 3 } HS{ 4 } diff! ] unit-test
+
+{ HS{ } } [ HS{ } HS{ } intersect! ] unit-test
+{ HS{ 2 3 } } [ HS{ 1 2 3 } HS{ 2 3 } intersect! ] unit-test
+{ HS{ } } [ HS{ 1 } HS{ 2 3 4 } intersect! ] unit-test
+{ HS{ } } [ HS{ 1 2 3 } HS{ 4 } intersect! ] unit-test
TUPLE: hello length ;
-[ 3 ] [ "xyz" length>> ] unit-test
+{ 3 } [ "xyz" length>> ] unit-test
[ "xyz" 4 >>length ] [ no-method? ] must-fail-with
M: protocol-slot-test-tuple my-protocol-slot-test>> x>> sq ;
M: protocol-slot-test-tuple my-protocol-slot-test<< [ sqrt ] dip x<< ;
-[ 9 ] [ T{ protocol-slot-test-tuple { x 3 } } my-protocol-slot-test>> ] unit-test
+{ 9 } [ T{ protocol-slot-test-tuple { x 3 } } my-protocol-slot-test>> ] unit-test
-[ 4.0 ] [
+{ 4.0 } [
T{ protocol-slot-test-tuple { x 3 } } clone
[ 7 + ] change-my-protocol-slot-test x>>
] unit-test
UNION: comme-ca integer float ;
comme-ca 25.5 "initial-value" set-word-prop
-[ 0 t ] [ comme-ci initial-value ] unit-test
-[ 25.5 t ] [ comme-ca initial-value ] unit-test
+{ 0 t } [ comme-ci initial-value ] unit-test
+{ 25.5 t } [ comme-ca initial-value ] unit-test
tools.test vectors sets vocabs grouping ;
IN: sorting.tests
-[ { } ] [ { } natural-sort ] unit-test
+{ { } } [ { } natural-sort ] unit-test
-[ { 270000000 270000001 } ]
+{ { 270000000 270000001 } }
[ T{ slice f 270000000 270000002 T{ iota-tuple f 270000002 } } natural-sort ]
unit-test
-[ t ] [
+{ t } [
100 [
drop
100 [ 20 random [ 1000 random ] replicate ] replicate
] all-integers?
] unit-test
-[ ] [ { 1 2 } [ 2drop 1 ] sort drop ] unit-test
+{ } [ { 1 2 } [ 2drop 1 ] sort drop ] unit-test
! Is it a stable sort?
-[ t ] [ { { 1 "a" } { 1 "b" } { 1 "c" } } dup sort-keys = ] unit-test
+{ t } [ { { 1 "a" } { 1 "b" } { 1 "c" } } dup sort-keys = ] unit-test
-[ { { 1 "a" } { 1 "b" } { 1 "c" } { 1 "e" } { 2 "d" } } ]
+{ { { 1 "a" } { 1 "b" } { 1 "c" } { 1 "e" } { 2 "d" } } }
[ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test
-[ ] [ all-words natural-sort drop ] unit-test
+{ } [ all-words natural-sort drop ] unit-test
DEFER: forget-test
-[ ] [ [ \ forget-test [ 1 ] ( -- ) define-declared ] with-compilation-unit ] unit-test
-[ t ] [ \ forget-test compiler-errors get key? ] unit-test
-[ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test
-[ f ] [ \ forget-test compiler-errors get key? ] unit-test
+{ } [ [ \ forget-test [ 1 ] ( -- ) define-declared ] with-compilation-unit ] unit-test
+{ t } [ \ forget-test compiler-errors get key? ] unit-test
+{ } [ [ \ forget-test forget ] with-compilation-unit ] unit-test
+{ f } [ \ forget-test compiler-errors get key? ] unit-test
USING: source-files tools.test assocs sequences strings
namespaces kernel ;
-[ { } ] [ source-files get keys [ string? ] reject ] unit-test
+{ { } } [ source-files get keys [ string? ] reject ] unit-test
USING: splitting tools.test kernel sequences arrays strings ascii math ;
IN: splitting.tests
-[ "hello" "world ." ] [ "hello world ." " " split1 ] unit-test
-[ "hello" "world-+." ] [ "hello-+world-+." "-+" split1 ] unit-test
-[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
-[ "" "" ] [ "great" "great" split1 ] unit-test
-
-[ "hello world" "." ] [ "hello world ." " " split1-last ] unit-test
-[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last ] unit-test
-[ "goodbye" f ] [ "goodbye" " " split1-last ] unit-test
-[ "" "" ] [ "great" "great" split1-last ] unit-test
-
-[ "hello world" "." ] [ "hello world ." " " split1-last-slice [ >string ] bi@ ] unit-test
-[ "hello-+world" "." ] [ "hello-+world-+." "-+" split1-last-slice [ >string ] bi@ ] unit-test
-[ "goodbye" f ] [ "goodbye" " " split1-last-slice [ >string ] dip ] unit-test
-[ "" f ] [ "great" "great" split1-last-slice [ >string ] dip ] unit-test
-
-[ "and end" t ] [ "Beginning and end" "Beginning " ?head ] unit-test
-[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?head ] unit-test
-[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?head ] unit-test
-
-[ "Beginning" t ] [ "Beginning and end" " and end" ?tail ] unit-test
-[ "Beginning and end" f ] [ "Beginning and end" "Beginning x" ?tail ] unit-test
-[ "Beginning and end" f ] [ "Beginning and end" "eginning " ?tail ] unit-test
-
-[ { "This" "is" "a" "split" "sentence" } ]
+{ "hello" "world ." } [ "hello world ." " " split1 ] unit-test
+{ "hello" "world-+." } [ "hello-+world-+." "-+" split1 ] unit-test
+{ "goodbye" f } [ "goodbye" " " split1 ] unit-test
+{ "" "" } [ "great" "great" split1 ] unit-test
+
+{ "hello world" "." } [ "hello world ." " " split1-last ] unit-test
+{ "hello-+world" "." } [ "hello-+world-+." "-+" split1-last ] unit-test
+{ "goodbye" f } [ "goodbye" " " split1-last ] unit-test
+{ "" "" } [ "great" "great" split1-last ] unit-test
+
+{ "hello world" "." } [ "hello world ." " " split1-last-slice [ >string ] bi@ ] unit-test
+{ "hello-+world" "." } [ "hello-+world-+." "-+" split1-last-slice [ >string ] bi@ ] unit-test
+{ "goodbye" f } [ "goodbye" " " split1-last-slice [ >string ] dip ] unit-test
+{ "" f } [ "great" "great" split1-last-slice [ >string ] dip ] unit-test
+
+{ "and end" t } [ "Beginning and end" "Beginning " ?head ] unit-test
+{ "Beginning and end" f } [ "Beginning and end" "Beginning x" ?head ] unit-test
+{ "Beginning and end" f } [ "Beginning and end" "eginning " ?head ] unit-test
+
+{ "Beginning" t } [ "Beginning and end" " and end" ?tail ] unit-test
+{ "Beginning and end" f } [ "Beginning and end" "Beginning x" ?tail ] unit-test
+{ "Beginning and end" f } [ "Beginning and end" "eginning " ?tail ] unit-test
+
+{ { "This" "is" "a" "split" "sentence" } }
[ "This is a split sentence" " " split ]
unit-test
-[ { "OneWord" } ]
+{ { "OneWord" } }
[ "OneWord" " " split ]
unit-test
-[ { "a" "b" "c" "d" "e" "f" } ]
+{ { "a" "b" "c" "d" "e" "f" } }
[ "aXbYcXdYeXf" "XY" split ] unit-test
-[ { "" "" } ]
+{ { "" "" } }
[ " " " " split ] unit-test
-[ { "hey" } ]
+{ { "hey" } }
[ "hey" " " split ] unit-test
-[ "Hello world" t ] [ "Hello world\n" "\n" ?tail ] unit-test
-[ "Hello world" f ] [ "Hello world" "\n" ?tail ] unit-test
-[ "" t ] [ "\n" "\n" ?tail ] unit-test
-[ "" f ] [ "" "\n" ?tail ] unit-test
-
-[ { "" } ] [ "" string-lines ] unit-test
-[ { "" "" } ] [ "\n" string-lines ] unit-test
-[ { "" "" } ] [ "\r" string-lines ] unit-test
-[ { "" "" } ] [ "\r\n" string-lines ] unit-test
-[ { "hello" } ] [ "hello" string-lines ] unit-test
-[ { "hello" "" } ] [ "hello\n" string-lines ] unit-test
-[ { "hello" "" } ] [ "hello\r" string-lines ] unit-test
-[ { "hello" "" } ] [ "hello\r\n" string-lines ] unit-test
-[ { "hello" "hi" } ] [ "hello\nhi" string-lines ] unit-test
-[ { "hello" "hi" } ] [ "hello\rhi" string-lines ] unit-test
-[ { "hello" "hi" } ] [ "hello\r\nhi" string-lines ] unit-test
-
-[ { "" } ] [ SBUF" " string-lines ] unit-test
-[ { "" "" } ] [ SBUF" \n" string-lines ] unit-test
-[ { "" "" } ] [ SBUF" \r" string-lines ] unit-test
-[ { "" "" } ] [ SBUF" \r\n" string-lines ] unit-test
-[ { "hello" } ] [ SBUF" hello" string-lines ] unit-test
-[ { "hello" "" } ] [ SBUF" hello\n" string-lines ] unit-test
-[ { "hello" "" } ] [ SBUF" hello\r" string-lines ] unit-test
-[ { "hello" "" } ] [ SBUF" hello\r\n" string-lines ] unit-test
-[ { "hello" "hi" } ] [ SBUF" hello\nhi" string-lines ] unit-test
-[ { "hello" "hi" } ] [ SBUF" hello\rhi" string-lines ] unit-test
-[ { "hello" "hi" } ] [ SBUF" hello\r\nhi" string-lines ] unit-test
-
-[ { "hey" "world" "what's" "happening" } ]
+{ "Hello world" t } [ "Hello world\n" "\n" ?tail ] unit-test
+{ "Hello world" f } [ "Hello world" "\n" ?tail ] unit-test
+{ "" t } [ "\n" "\n" ?tail ] unit-test
+{ "" f } [ "" "\n" ?tail ] unit-test
+
+{ { "" } } [ "" string-lines ] unit-test
+{ { "" "" } } [ "\n" string-lines ] unit-test
+{ { "" "" } } [ "\r" string-lines ] unit-test
+{ { "" "" } } [ "\r\n" string-lines ] unit-test
+{ { "hello" } } [ "hello" string-lines ] unit-test
+{ { "hello" "" } } [ "hello\n" string-lines ] unit-test
+{ { "hello" "" } } [ "hello\r" string-lines ] unit-test
+{ { "hello" "" } } [ "hello\r\n" string-lines ] unit-test
+{ { "hello" "hi" } } [ "hello\nhi" string-lines ] unit-test
+{ { "hello" "hi" } } [ "hello\rhi" string-lines ] unit-test
+{ { "hello" "hi" } } [ "hello\r\nhi" string-lines ] unit-test
+
+{ { "" } } [ SBUF" " string-lines ] unit-test
+{ { "" "" } } [ SBUF" \n" string-lines ] unit-test
+{ { "" "" } } [ SBUF" \r" string-lines ] unit-test
+{ { "" "" } } [ SBUF" \r\n" string-lines ] unit-test
+{ { "hello" } } [ SBUF" hello" string-lines ] unit-test
+{ { "hello" "" } } [ SBUF" hello\n" string-lines ] unit-test
+{ { "hello" "" } } [ SBUF" hello\r" string-lines ] unit-test
+{ { "hello" "" } } [ SBUF" hello\r\n" string-lines ] unit-test
+{ { "hello" "hi" } } [ SBUF" hello\nhi" string-lines ] unit-test
+{ { "hello" "hi" } } [ SBUF" hello\rhi" string-lines ] unit-test
+{ { "hello" "hi" } } [ SBUF" hello\r\nhi" string-lines ] unit-test
+
+{ { "hey" "world" "what's" "happening" } }
[ "heyAworldBwhat'sChappening" [ LETTER? ] split-when ] unit-test
{ { { 2 } { 3 } { 5 1 } { 7 } } } [
1 { 2 1 3 2 5 1 3 7 }
[ dupd = dup [ [ 1 + ] dip ] when ] split-when nip
] unit-test
-[ { "hey" "world" "what's" "happening" } ]
+{ { "hey" "world" "what's" "happening" } }
[
"heyAworldBwhat'sChappening" [ LETTER? ] split-when-slice
[ >string ] map
] unit-test
-[ "" f ] [ "" [ blank? ] split1-when ] unit-test
-[ "" "ABC" ] [ " ABC" [ blank? ] split1-when ] unit-test
-[ "a" " bc" ] [ "a bc" [ blank? ] split1-when ] unit-test
+{ "" f } [ "" [ blank? ] split1-when ] unit-test
+{ "" "ABC" } [ " ABC" [ blank? ] split1-when ] unit-test
+{ "a" " bc" } [ "a bc" [ blank? ] split1-when ] unit-test
-[ "" f ] [ "" [ blank? ] split1-when-slice ] unit-test
-[ "" "ABC" ] [ " ABC" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test
-[ "a" " bc" ] [ "a bc" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test
+{ "" f } [ "" [ blank? ] split1-when-slice ] unit-test
+{ "" "ABC" } [ " ABC" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test
+{ "a" " bc" } [ "a bc" [ blank? ] split1-when-slice [ >string ] bi@ ] unit-test
{ "abarbbarc" }
[ "afoobfooc" "foo" "bar" replace ] unit-test
tools.test ;
IN: strings.parser.tests
-[ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test
+{ "Hello\n\rworld" } [ "Hello\\n\\rworld" unescape-string ] unit-test
-[ "Hello\n\rworld" ] [ "Hello\n\rworld" ] unit-test
-[ "Hello\n\rworld" ] [ """Hello\n\rworld""" ] unit-test
-[ "Hello\n\rworld\n" ] [ "Hello\n\rworld
+{ "Hello\n\rworld" } [ "Hello\n\rworld" ] unit-test
+{ "Hello\n\rworld" } [ """Hello\n\rworld""" ] unit-test
+{ "Hello\n\rworld\n" } [ "Hello\n\rworld
" ] unit-test
-[ "Hello\n\rworld" "hi" ] [ "Hello\n\rworld" "hi" ] unit-test
-[ "Hello\n\rworld" "hi" ] [ """Hello\n\rworld""" """hi""" ] unit-test
-[ "Hello\n\rworld\n" "hi" ] [ """Hello\n\rworld
+{ "Hello\n\rworld" "hi" } [ "Hello\n\rworld" "hi" ] unit-test
+{ "Hello\n\rworld" "hi" } [ """Hello\n\rworld""" """hi""" ] unit-test
+{ "Hello\n\rworld\n" "hi" } [ """Hello\n\rworld
""" """hi""" ] unit-test
-[ "Hello\n\rworld\"" "hi" ] [ """Hello\n\rworld\"""" """hi""" ] unit-test
+{ "Hello\n\rworld\"" "hi" } [ """Hello\n\rworld\"""" """hi""" ] unit-test
[
"\"\"\"Hello\n\rworld\\\n\"\"\"" eval( -- obj )
error>> escaped-char-expected?
] must-fail-with
-[
+{
" \" abc \" "
-] [
+} [
"\"\"\" \" abc \" \"\"\"" eval( -- string )
] unit-test
-[
+{
"\"abc\""
-] [
+} [
"\"\"\"\"abc\"\"\"\"" eval( -- string )
] unit-test
-[ "\"\\" ] [ "\"\\" ] unit-test
+{ "\"\\" } [ "\"\\" ] unit-test
-[ "\e" ] [ "\u00001b" ] unit-test
-[ "\e" ] [ "\x1b" ] unit-test
+{ "\e" } [ "\u00001b" ] unit-test
+{ "\e" } [ "\x1b" ] unit-test
arrays memory prettyprint io.streams.null kernel.private ;
IN: strings.tests
-[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
+{ CHAR: b } [ 1 >bignum "abc" nth ] unit-test
-[ ] [ 10 [ [ -1000000 <sbuf> ] ignore-errors ] 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
-[ "abc" ] [ "ab" "c" append ] unit-test
-[ "abc" ] [ "a" "b" "c" 3append ] unit-test
+{ "abc" } [ "ab" "c" append ] unit-test
+{ "abc" } [ "a" "b" "c" 3append ] unit-test
-[ 3 ] [ "a" "hola" start ] unit-test
-[ f ] [ "x" "hola" start ] unit-test
-[ 0 ] [ "" "a" start ] unit-test
-[ 0 ] [ "" "" start ] unit-test
-[ 0 ] [ "hola" "hola" start ] unit-test
-[ 1 ] [ "ol" "hola" start ] unit-test
-[ f ] [ "amigo" "hola" start ] unit-test
-[ f ] [ "holaa" "hola" start ] unit-test
+{ 3 } [ "a" "hola" start ] unit-test
+{ f } [ "x" "hola" start ] unit-test
+{ 0 } [ "" "a" start ] unit-test
+{ 0 } [ "" "" start ] unit-test
+{ 0 } [ "hola" "hola" start ] unit-test
+{ 1 } [ "ol" "hola" start ] unit-test
+{ f } [ "amigo" "hola" start ] unit-test
+{ f } [ "holaa" "hola" start ] unit-test
-[ "Beginning" ] [ "Beginning and end" 9 head ] unit-test
+{ "Beginning" } [ "Beginning and end" 9 head ] unit-test
-[ f ] [ CHAR: I "team" member? ] unit-test
-[ t ] [ "ea" "team" subseq? ] unit-test
-[ f ] [ "actore" "Factor" subseq? ] unit-test
+{ f } [ CHAR: I "team" member? ] unit-test
+{ t } [ "ea" "team" subseq? ] unit-test
+{ f } [ "actore" "Factor" subseq? ] unit-test
-[ "end" ] [ "Beginning and end" 14 tail ] unit-test
+{ "end" } [ "Beginning and end" 14 tail ] unit-test
-[ t ] [ "abc" "abd" before? ] unit-test
-[ t ] [ "z" "abd" after? ] unit-test
-[ "abc" ] [ "abc" "abd" min ] unit-test
-[ "z" ] [ "z" "abd" max ] unit-test
+{ t } [ "abc" "abd" before? ] unit-test
+{ t } [ "z" "abd" after? ] unit-test
+{ "abc" } [ "abc" "abd" min ] unit-test
+{ "z" } [ "z" "abd" max ] unit-test
[ 0 10 "hello" subseq ] must-fail
-[ "Replacing+spaces+with+plus" ]
+{ "Replacing+spaces+with+plus" }
[
"Replacing spaces with plus"
[ dup CHAR: \s = [ drop CHAR: + ] when ] map
]
unit-test
-[ "05" ] [ "5" 2 CHAR: 0 pad-head ] unit-test
-[ "666" ] [ "666" 2 CHAR: 0 pad-head ] unit-test
+{ "05" } [ "5" 2 CHAR: 0 pad-head ] unit-test
+{ "666" } [ "666" 2 CHAR: 0 pad-head ] unit-test
[ 1 "" nth ] must-fail
[ -6 "hello" nth ] must-fail
-[ t ] [ "hello world" dup >vector >string = ] unit-test
+{ t } [ "hello world" dup >vector >string = ] unit-test
-[ "ab" ] [ 2 "abc" resize-string ] unit-test
-[ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
+{ "ab" } [ 2 "abc" resize-string ] unit-test
+{ "abc\0\0\0" } [ 6 "abc" resize-string ] unit-test
-[ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test
-[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
+{ "\u001234b" } [ 2 "\u001234bc" resize-string ] unit-test
+{ "\u001234bc\0\0\0" } [ 6 "\u001234bc" resize-string ] unit-test
! Random tester found this
[ 2 -7 resize-string ]
! Make sure 24-bit strings work
"hello world" "s" set
-[ ] [ 0x1234 1 "s" get set-nth ] unit-test
-[ 0x1234 ] [ 1 "s" get nth ] unit-test
+{ } [ 0x1234 1 "s" get set-nth ] unit-test
+{ 0x1234 } [ 1 "s" get nth ] unit-test
-[ ] [ 0x4321 3 "s" get set-nth ] unit-test
-[ 0x4321 ] [ 3 "s" get nth ] unit-test
+{ } [ 0x4321 3 "s" get set-nth ] unit-test
+{ 0x4321 } [ 3 "s" get nth ] unit-test
-[ ] [ 0x654321 5 "s" get set-nth ] unit-test
-[ 0x654321 ] [ 5 "s" get nth ] unit-test
+{ } [ 0x654321 5 "s" get set-nth ] unit-test
+{ 0x654321 } [ 5 "s" get nth ] unit-test
-[
+{
{
CHAR: h
0x1234
CHAR: l
CHAR: d
}
-] [
+} [
"s" get >array
] unit-test
! Make sure string initialization works
-[ 0x123456 ] [ 100 0x123456 <string> first ] unit-test
+{ 0x123456 } [ 100 0x123456 <string> first ] unit-test
! Make sure we clear aux vector when storing octets
-[ "\u123456hi" ] [ "ih\u123456" clone reverse! ] unit-test
+{ "\u123456hi" } [ "ih\u123456" clone reverse! ] unit-test
! Make sure aux vector is not shared
-[ "\udeadbe" ] [
+{ "\udeadbe" } [
"\udeadbe" clone
CHAR: \u123456 over clone set-first
] unit-test
! Regressions
-[ ] [
+{ } [
[
4 [
100 [ "obdurak" clone ] replicate
] with-null-writer
] unit-test
-[ t ] [
+{ t } [
10000 [
drop
300 100 CHAR: \u123456
] unit-test
"X" "s" set
-[ ] [ 0x100,0000 0 "s" get set-nth ] unit-test
-[ 0 ] [ 0 "s" get nth ] unit-test
+{ } [ 0x100,0000 0 "s" get set-nth ] unit-test
+{ 0 } [ 0 "s" get nth ] unit-test
-[ ] [ -1 0 "s" get set-nth ] unit-test
-[ 0x7fffff ] [ 0 "s" get nth ] unit-test
+{ } [ -1 0 "s" get set-nth ] unit-test
+{ 0x7fffff } [ 0 "s" get nth ] unit-test
continuations random growable classes ;
IN: vectors.tests
-[ ] [ 10 [ [ -1000000 <vector> ] ignore-errors ] times ] unit-test
+{ } [ 10 [ [ -1000000 <vector> ] ignore-errors ] times ] unit-test
-[ 3 ] [ [ t f t ] length ] unit-test
-[ 3 ] [ V{ t f t } length ] unit-test
+{ 3 } [ [ t f t ] length ] unit-test
+{ 3 } [ V{ t f t } length ] unit-test
[ -3 V{ } nth ] must-fail
[ 3 V{ } nth ] must-fail
[ "hey" [ 1 2 ] set-length ] must-fail
[ "hey" V{ 1 2 } set-length ] must-fail
-[ 3 ] [ 3 0 <vector> [ set-length ] keep length ] unit-test
-[ "yo" ] [
+{ 3 } [ 3 0 <vector> [ set-length ] keep length ] unit-test
+{ "yo" } [
"yo" 4 1 <vector> [ set-nth ] keep 4 swap nth
] unit-test
[ 1 V{ } nth ] must-fail
[ -1 V{ } set-length ] must-fail
-[ V{ } ] [ [ ] >vector ] unit-test
-[ V{ 1 2 } ] [ [ 1 2 ] >vector ] unit-test
+{ V{ } } [ [ ] >vector ] unit-test
+{ V{ 1 2 } } [ [ 1 2 ] >vector ] unit-test
-[ t ] [
+{ t } [
100 [ 100 random ] V{ } replicate-as
dup >array >vector =
] unit-test
-[ f ] [ V{ } V{ 1 2 3 } = ] unit-test
-[ f ] [ V{ 1 2 } V{ 1 2 3 } = ] unit-test
-[ f ] [ [ 1 2 ] V{ 1 2 3 } = ] unit-test
-[ f ] [ V{ 1 2 } [ 1 2 3 ] = ] unit-test
+{ f } [ V{ } V{ 1 2 3 } = ] unit-test
+{ f } [ V{ 1 2 } V{ 1 2 3 } = ] unit-test
+{ f } [ [ 1 2 ] V{ 1 2 3 } = ] unit-test
+{ f } [ V{ 1 2 } [ 1 2 3 ] = ] unit-test
-[ { 1 4 9 16 } ]
+{ { 1 4 9 16 } }
[
[ 1 2 3 4 ]
>vector [ dup * ] map >array
] unit-test
-[ t ] [ V{ } hashcode V{ } hashcode = ] unit-test
-[ t ] [ V{ 1 2 3 } hashcode V{ 1 2 3 } hashcode = ] unit-test
-[ t ] [ V{ 1 V{ 2 } 3 } hashcode V{ 1 V{ 2 } 3 } hashcode = ] unit-test
-[ t ] [ V{ } hashcode V{ } hashcode = ] unit-test
+{ t } [ V{ } hashcode V{ } hashcode = ] unit-test
+{ t } [ V{ 1 2 3 } hashcode V{ 1 2 3 } hashcode = ] unit-test
+{ t } [ V{ 1 V{ 2 } 3 } hashcode V{ 1 V{ 2 } 3 } hashcode = ] unit-test
+{ t } [ V{ } hashcode V{ } hashcode = ] unit-test
-[ V{ 1 2 3 } V{ 1 2 3 4 5 6 } ]
+{ V{ 1 2 3 } V{ 1 2 3 4 5 6 } }
[ V{ 1 2 3 } dup V{ 4 5 6 } append ] unit-test
-[ V{ 1 2 3 4 } ] [ [ V{ 1 } [ 2 ] V{ 3 4 } ] concat ] unit-test
+{ V{ 1 2 3 4 } } [ [ V{ 1 } [ 2 ] V{ 3 4 } ] concat ] unit-test
-[ V{ } ] [ V{ } 0 tail ] unit-test
-[ V{ } ] [ V{ 1 2 } 2 tail ] unit-test
-[ V{ 3 4 } ] [ V{ 1 2 3 4 } 2 tail ] unit-test
+{ V{ } } [ V{ } 0 tail ] unit-test
+{ V{ } } [ V{ 1 2 } 2 tail ] unit-test
+{ V{ 3 4 } } [ V{ 1 2 3 4 } 2 tail ] unit-test
-[ V{ 3 } ] [ V{ 1 2 3 } 1 tail* ] unit-test
+{ V{ 3 } } [ V{ 1 2 3 } 1 tail* ] unit-test
0 <vector> "funny-stack" set
-[ ] [ V{ 1 5 } "funny-stack" get push ] unit-test
-[ ] [ V{ 2 3 } "funny-stack" get push ] unit-test
-[ V{ 2 3 } ] [ "funny-stack" get pop ] unit-test
-[ V{ 1 5 } ] [ "funny-stack" get last ] unit-test
-[ V{ 1 5 } ] [ "funny-stack" get pop ] unit-test
+{ } [ V{ 1 5 } "funny-stack" get push ] unit-test
+{ } [ V{ 2 3 } "funny-stack" get push ] unit-test
+{ V{ 2 3 } } [ "funny-stack" get pop ] unit-test
+{ V{ 1 5 } } [ "funny-stack" get last ] unit-test
+{ V{ 1 5 } } [ "funny-stack" get pop ] unit-test
[ "funny-stack" get pop ] must-fail
[ "funny-stack" get pop ] must-fail
-[ ] [ "funky" "funny-stack" get push ] unit-test
-[ "funky" ] [ "funny-stack" get pop ] unit-test
+{ } [ "funky" "funny-stack" get push ] unit-test
+{ "funky" } [ "funny-stack" get pop ] unit-test
-[ t ] [
+{ t } [
V{ 1 2 3 4 } dup underlying>> length
[ clone underlying>> length ] dip
=
] unit-test
-[ f ] [
+{ f } [
V{ 1 2 3 4 } dup clone
[ underlying>> ] bi@ eq?
] unit-test
-[ 0 ] [
+{ 0 } [
[
10 <vector> "x" set
"x" get clone length
] with-scope
] unit-test
-[ f ] [ 5 V{ } index ] unit-test
-[ 4 ] [ 5 V{ 1 2 3 4 5 } index ] unit-test
+{ f } [ 5 V{ } index ] unit-test
+{ 4 } [ 5 V{ 1 2 3 4 5 } index ] unit-test
-[ t ] [
+{ t } [
100 iota >array dup >vector <reversed> >array [ reverse ] dip =
] unit-test
-[ fixnum ] [ 1 >bignum V{ } new-sequence length class-of ] unit-test
+{ fixnum } [ 1 >bignum V{ } new-sequence length class-of ] unit-test
-[ fixnum ] [ 1 >bignum iota [ ] V{ } map-as length class-of ] unit-test
+{ fixnum } [ 1 >bignum iota [ ] V{ } map-as length class-of ] unit-test
-[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test
+{ V{ "lulz" } } [ "lulz" 1vector ] unit-test
IN: vocabs.loader.tests
! This vocab should not exist, but just in case...
-[ ] [
+{ } [
[
"vocabs.loader.test" forget-vocab
] with-compilation-unit
] unit-test
-[ T{ vocab-link f "vocabs.loader.test" } ]
+{ T{ vocab-link f "vocabs.loader.test" } }
[ "vocabs.loader.test" >vocab-link ] unit-test
-[ t ]
+{ t }
[ "kernel" >vocab-link "kernel" lookup-vocab = ] unit-test
IN: vocabs.loader.test.2
IN: vocabs.loader.tests
-[ ] [
+{ } [
"vocabs.loader.test.2" run
"vocabs.loader.test.2" lookup-vocab run
"vocabs.loader.test.2" <vocab-link> run
] unit-test
] times
-[ 2 ] [ "count-me" get-global ] unit-test
+{ 2 } [ "count-me" get-global ] unit-test
[
"IN: vocabs.loader.test.a v-l-t-a-hello"
0 "count-me" set-global
-[ ] [
+{ } [
[
"vocabs.loader.test.b" forget-vocab
] with-compilation-unit
] unit-test
-[ f ] [ "vocabs.loader.test.b" vocab-files empty? ] unit-test
+{ f } [ "vocabs.loader.test.b" vocab-files empty? ] unit-test
-[ ] [
+{ } [
[
"vocabs.loader.test.b" vocab-files
[ forget-source ] each
[ "vocabs.loader.test.b" require ] must-fail
-[ 1 ] [ "count-me" get-global ] unit-test
+{ 1 } [ "count-me" get-global ] unit-test
-[ ] [
+{ } [
[
"bob" "vocabs.loader.test.b" create-word [ ] define
] with-compilation-unit
] unit-test
-[ ] [ "vocabs.loader.test.b" refresh ] unit-test
+{ } [ "vocabs.loader.test.b" refresh ] unit-test
-[ 2 ] [ "count-me" get-global ] unit-test
+{ 2 } [ "count-me" get-global ] unit-test
-[ f ] [ "fred" "vocabs.loader.test.b" lookup-word undefined-word? ] unit-test
+{ f } [ "fred" "vocabs.loader.test.b" lookup-word undefined-word? ] unit-test
-[ ] [
+{ } [
[
"vocabs.loader.test.b" vocab-files
[ forget-source ] each
] with-compilation-unit
] unit-test
-[ ] [ "vocabs.loader.test.b" changed-vocab ] unit-test
+{ } [ "vocabs.loader.test.b" changed-vocab ] unit-test
-[ ] [ "vocabs.loader.test.b" refresh ] unit-test
+{ } [ "vocabs.loader.test.b" refresh ] unit-test
-[ 3 ] [ "count-me" get-global ] unit-test
+{ 3 } [ "count-me" get-global ] unit-test
-[ { "resource:core/kernel/kernel.factor" 1 } ]
+{ { "resource:core/kernel/kernel.factor" 1 } }
[ "kernel" <vocab-link> where ] unit-test
-[ { "resource:core/kernel/kernel.factor" 1 } ]
+{ { "resource:core/kernel/kernel.factor" 1 } }
[ "kernel" lookup-vocab where ] unit-test
-[ ] [
+{ } [
[
"vocabs.loader.test.c" forget-vocab
"vocabs.loader.test.d" forget-vocab
] with-compilation-unit
] unit-test
-[ +done+ ] [
+{ +done+ } [
[ "vocabs.loader.test.d" require ] [ :1 ] recover
"vocabs.loader.test.d" lookup-vocab source-loaded?>>
] unit-test
forget-junk
-[ { } ] [
+{ { } } [
"IN: xabbabbja" eval( -- ) "xabbabbja" vocab-files
] unit-test
forget-junk
-[ ] [ [ "vocabs.loader.test.e" forget-vocab ] with-compilation-unit ] unit-test
+{ } [ [ "vocabs.loader.test.e" forget-vocab ] with-compilation-unit ] unit-test
0 "vocabs.loader.test.g" set-global
"vocabs.loader.test.g" forget-vocab
] with-compilation-unit
-[ ] [ "vocabs.loader.test.g" require ] unit-test
+{ } [ "vocabs.loader.test.g" require ] unit-test
-[ 1 ] [ "vocabs.loader.test.g" get-global ] unit-test
+{ 1 } [ "vocabs.loader.test.g" get-global ] unit-test
[
"vocabs.loader.test.h" forget-vocab
"vocabs.loader.test.i" forget-vocab
] with-compilation-unit
-[ ] [ "vocabs.loader.test.h" require ] unit-test
+{ } [ "vocabs.loader.test.h" require ] unit-test
[
"vocabs.loader.test.k" forget-vocab
] with-compilation-unit
-[ ] [ [ "vocabs.loader.test.j" require ] [ drop :1 ] recover ] unit-test
+{ } [ [ "vocabs.loader.test.j" require ] [ drop :1 ] recover ] unit-test
-[ ] [ "vocabs.loader.test.m" require ] unit-test
-[ f ] [ "vocabs.loader.test.n" lookup-vocab ] unit-test
-[ ] [ "vocabs.loader.test.o" require ] unit-test
-[ t ] [ "vocabs.loader.test.n" lookup-vocab >boolean ] unit-test
+{ } [ "vocabs.loader.test.m" require ] unit-test
+{ f } [ "vocabs.loader.test.n" lookup-vocab ] unit-test
+{ } [ "vocabs.loader.test.o" require ] unit-test
+{ t } [ "vocabs.loader.test.n" lookup-vocab >boolean ] unit-test
[
"mno" [ "vocabs.loader.test." swap suffix forget-vocab ] each
] with-compilation-unit
-[ ] [ "vocabs.loader.test.o" require ] unit-test
-[ f ] [ "vocabs.loader.test.n" lookup-vocab ] unit-test
-[ ] [ "vocabs.loader.test.m" require ] unit-test
-[ t ] [ "vocabs.loader.test.n" lookup-vocab >boolean ] unit-test
+{ } [ "vocabs.loader.test.o" require ] unit-test
+{ f } [ "vocabs.loader.test.n" lookup-vocab ] unit-test
+{ } [ "vocabs.loader.test.m" require ] unit-test
+{ t } [ "vocabs.loader.test.n" lookup-vocab >boolean ] unit-test
-[ f ] [ "vocabs.loader.test.p" lookup-vocab ] unit-test
-[ ] [ "vocabs.loader.test.p.private" require ] unit-test
-[ { "foo" } ] [ "vocabs.loader.test.p" vocab-words [ name>> ] map ] unit-test
+{ f } [ "vocabs.loader.test.p" lookup-vocab ] unit-test
+{ } [ "vocabs.loader.test.p.private" require ] unit-test
+{ { "foo" } } [ "vocabs.loader.test.p" vocab-words [ name>> ] map ] unit-test
[
"mnop" [ "vocabs.loader.test." swap suffix forget-vocab ] each
USING: vocabs tools.test ;
IN: vocabs.tests
-[ f ] [ "kernel" vocab-main ] unit-test
+{ f } [ "kernel" vocab-main ] unit-test
-[ t ] [ "" "" child-vocab? ] unit-test
-[ t ] [ "" "io.files" child-vocab? ] unit-test
-[ t ] [ "io" "io.files" child-vocab? ] unit-test
-[ f ] [ "io.files" "io" child-vocab? ] unit-test
+{ t } [ "" "" child-vocab? ] unit-test
+{ t } [ "" "io.files" child-vocab? ] unit-test
+{ t } [ "io" "io.files" child-vocab? ] unit-test
+{ f } [ "io.files" "io" child-vocab? ] unit-test
[ "foo/bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
[ "foo\\bar" create-vocab ] [ bad-vocab-name? ] must-fail-with
IN: words.alias.tests
ALIAS: foo +
-[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
-[ ( -- value ) ] [ \ foo stack-effect ] unit-test
+{ } [ "IN: words.alias.tests CONSTANT: foo 5" eval( -- ) ] unit-test
+{ ( -- value ) } [ \ foo stack-effect ] unit-test
ALIAS: MY-H{ H{
{ H{ { 1 2 } } } [
CONSTANT: a +
-[ + ] [ a ] unit-test
+{ + } [ a ] unit-test
-[ t ] [ \ a constant? ] unit-test
+{ t } [ \ a constant? ] unit-test
CONSTANT: b \ +
-[ \ + ] [ b ] unit-test
+{ \ + } [ b ] unit-test
CONSTANT: c { 1 2 3 }
-[ { 1 2 3 } ] [ c ] unit-test
+{ { 1 2 3 } } [ c ] unit-test
SYMBOL: foo
-[ f ] [ \ foo constant? ] unit-test
+{ f } [ \ foo constant? ] unit-test
io.streams.string accessors eval words.symbol grouping ;
IN: words.tests
-[ 4 ] [
+{ 4 } [
[
"poo" "words.tests" create-word [ 2 2 + ] ( -- n ) define-declared
] with-compilation-unit
"poo" "words.tests" lookup-word execute
] unit-test
-[ t ] [ t loaded-vocab-names [ vocab-words [ word? and ] each ] each ] unit-test
+{ t } [ t loaded-vocab-names [ vocab-words [ word? and ] each ] each ] unit-test
DEFER: plist-test
-[ t ] [
+{ t } [
\ plist-test t "sample-property" set-word-prop
\ plist-test "sample-property" word-prop
] unit-test
-[ f ] [
+{ f } [
\ plist-test f "sample-property" set-word-prop
\ plist-test "sample-property" word-prop
] unit-test
-[ ] [ [ "create-test" "scratchpad" create-word { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
+{ } [ [ "create-test" "scratchpad" create-word { 1 2 } "testing" set-word-prop ] with-compilation-unit ] unit-test
-[ { 1 2 } ] [
+{ { 1 2 } } [
"create-test" "scratchpad" lookup-word "testing" word-prop
] unit-test
[ ] [ [ "test-scope" "scratchpad" create-word drop ] with-compilation-unit ] unit-test
] with-scope
-[ "test-scope" ] [
+{ "test-scope" } [
"test-scope" "scratchpad" lookup-word name>>
] unit-test
-[ t ] [ loaded-vocab-names array? ] unit-test
-[ t ] [ loaded-vocab-names [ vocab-words [ word? ] all? ] all? ] unit-test
+{ t } [ loaded-vocab-names array? ] unit-test
+{ t } [ loaded-vocab-names [ vocab-words [ word? ] all? ] all? ] unit-test
-[ f ] [ gensym gensym = ] unit-test
+{ f } [ gensym gensym = ] unit-test
SYMBOL: a-symbol
-[ t ] [ \ a-symbol symbol? ] unit-test
+{ t } [ \ a-symbol symbol? ] unit-test
! See if redefining a generic as a colon def clears some
! word props.
GENERIC: testing ( a -- b )
"IN: words.tests : testing ( -- ) ;" eval( -- )
-[ f ] [ \ testing generic? ] unit-test
+{ f } [ \ testing generic? ] unit-test
: forgotten ( -- ) ;
: another-forgotten ( -- ) ;
[ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ]
[ error>> [ undefined-word? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with
-[ ] [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
+{ } [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test
-[ ] [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
-[ f ] [ "no-loc" "words.tests" lookup-word where ] unit-test
+{ } [ [ "no-loc" "words.tests" create-word drop ] with-compilation-unit ] unit-test
+{ f } [ "no-loc" "words.tests" lookup-word where ] unit-test
-[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
-[ f ] [ "no-loc-2" "words.tests" lookup-word where ] unit-test
+{ } [ "IN: words.tests : no-loc-2 ( -- ) ;" eval( -- ) ] unit-test
+{ f } [ "no-loc-2" "words.tests" lookup-word where ] unit-test
-[ ] [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
-[ "test-last" ] [ last-word name>> ] unit-test
+{ } [ "IN: words.tests : test-last ( -- ) ;" eval( -- ) ] unit-test
+{ "test-last" } [ last-word name>> ] unit-test
"undef-test" "words.tests" lookup-word [
[ forget ] with-compilation-unit
[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval( -- ) ]
[ error>> undefined-word? ] must-fail-with
-[ ] [
+{ } [
"IN: words.tests GENERIC: symbol-generic ( -- )" eval( -- )
] unit-test
-[ ] [
+{ } [
"IN: words.tests SYMBOL: symbol-generic" eval( -- )
] unit-test
-[ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
-[ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
+{ t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
+{ f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
-[ ] [
+{ } [
"IN: words.tests GENERIC: symbol-generic ( a -- b )" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
-[ ] [
+{ } [
"IN: words.tests TUPLE: symbol-generic ;" <string-reader>
"symbol-generic-test" parse-stream drop
] unit-test
-[ t ] [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
-[ f ] [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
+{ t } [ "symbol-generic" "words.tests" lookup-word symbol? ] unit-test
+{ f } [ "symbol-generic" "words.tests" lookup-word generic? ] unit-test
! Regressions
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
-[ t ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
-[ f ] [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
+{ } [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval( -- ) ] unit-test
+{ t } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
+{ } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
+{ f } [ "decl-forget-test" "words.tests" lookup-word "foldable" word-prop ] unit-test
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
-[ t ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
-[ f ] [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
+{ } [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval( -- ) ] unit-test
+{ t } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
+{ } [ "IN: words.tests : decl-forget-test ( -- ) ;" eval( -- ) ] unit-test
+{ f } [ "decl-forget-test" "words.tests" lookup-word "flushable" word-prop ] unit-test
-[ { } ]
+{ { } }
[
all-words [
[ "effect-dependencies" word-prop ]
C-TYPE: _GDBM_FILE
TYPEDEF: _GDBM_FILE* GDBM_FILE
-CALLBACK: void fatal_func_cb ;
+CALLBACK: void fatal_func_cb ( ) ;
FUNCTION: GDBM_FILE gdbm_open ( c-string name, int block_size, int read_write, int mode, fatal_func_cb fatal_func ) ;
FUNCTION-ALIAS: gdbm-close void gdbm_close ( GDBM_FILE dbf ) ;
FUNCTION: int gdbm_store ( GDBM_FILE dbf, datum key, datum content, int flag ) ;
projects / factor.git / commitdiff