factor: second stab at [ ] [ ] unit-test -> { } [ ] unit-test

db4
Doug Coleman 2015-07-03 09:39:59 -07:00
parent 9e8ceb87d6
commit 892c62e1dc
579 changed files with 7200 additions and 7200 deletions

View File

@ -38,32 +38,32 @@ CONSTANT: eleven 11
FUNCTION: void* alien-parser-function-effect-test ( int *arg1, float arg2 ) ;
[ ( arg1 arg2 -- void* ) ] [
{ ( arg1 arg2 -- void* ) } [
\ alien-parser-function-effect-test "declared-effect" word-prop
] unit-test
[ t ] [ \ alien-parser-function-effect-test inline? ] unit-test
{ t } [ \ alien-parser-function-effect-test inline? ] unit-test
FUNCTION-ALIAS: (alien-parser-function-effect-test) void* alien-parser-function-effect-test ( int *arg1, float arg2 ) ;
[ ( arg1 arg2 -- void* ) ] [
{ ( arg1 arg2 -- void* ) } [
\ (alien-parser-function-effect-test) "declared-effect" word-prop
] unit-test
[ t ] [ \ (alien-parser-function-effect-test) inline? ] unit-test
{ t } [ \ (alien-parser-function-effect-test) inline? ] unit-test
CALLBACK: void* alien-parser-callback-effect-test ( int *arg1 float arg2 ) ;
[ ( arg1 arg2 -- void* ) ] [
{ ( arg1 arg2 -- void* ) } [
\ alien-parser-callback-effect-test "callback-effect" word-prop
] unit-test
[ t ] [ \ alien-parser-callback-effect-test inline? ] unit-test
{ t } [ \ alien-parser-callback-effect-test inline? ] unit-test
! Reported by mnestic
TYPEDEF: int alien-parser-test-int ! reasonably unique name...
[ "OK!" ] [
{ "OK!" } [
[
"USE: specialized-arrays SPECIALIZED-ARRAY: alien-parser-test-int" eval( -- )
! after restart, we end up here

View File

@ -7,67 +7,67 @@ CONSTANT: FOO 10
FUNCTION: int function_test ( float x, int[4][FOO] y, char* z, ushort *w ) ;
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
FUNCTION: int function_test
( float x, int[4][FOO] y, char* z, ushort* w ) ; inline
" ] [
" } [
[ \ function_test see ] with-string-writer
] unit-test
FUNCTION-ALIAS: function-test int function_test
( float x, int[4][FOO] y, char* z, ushort *w ) ;
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
FUNCTION-ALIAS: function-test int function_test
( float x, int[4][FOO] y, char* z, ushort* w ) ; inline
" ] [
" } [
[ \ function-test see ] with-string-writer
] unit-test
TYPEDEF: c-string[ascii] string-typedef
TYPEDEF: char[1][2][3] array-typedef
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
TYPEDEF: c-string[ascii] string-typedef
" ] [
" } [
[ \ string-typedef see ] with-string-writer
] unit-test
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
TYPEDEF: char[1][2][3] array-typedef
" ] [
" } [
[ \ array-typedef see ] with-string-writer
] unit-test
C-TYPE: opaque-c-type
[ "USING: alien.syntax ;
{ "USING: alien.syntax ;
IN: alien.prettyprint.tests
C-TYPE: opaque-c-type
" ] [
" } [
[ \ opaque-c-type see ] with-string-writer
] unit-test
TYPEDEF: pointer: int pint
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
TYPEDEF: int* pint
" ] [
" } [
[ \ pint see ] with-string-writer
] unit-test
[ "pointer: int" ] [ pointer: int unparse ] unit-test
{ "pointer: int" } [ pointer: int unparse ] unit-test
CALLBACK: void callback-test ( int x, float[4] y ) ;
[ "USING: alien.c-types alien.syntax ;
{ "USING: alien.c-types alien.syntax ;
IN: alien.prettyprint.tests
CALLBACK: void callback-test ( int x, float[4] y ) ;
" ] [
" } [
[ \ callback-test see ] with-string-writer
] unit-test

View File

@ -2,18 +2,18 @@ USING: bootstrap.image bootstrap.image.private tools.test
kernel math ;
IN: bootstrap.image.tests
[ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
{ f } [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
[ t ] [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test
{ t } [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test
[ f ] [ [ 2drop 0 ] [ 2drop 0.0 ] eql? ] unit-test
{ f } [ [ 2drop 0 ] [ 2drop 0.0 ] eql? ] unit-test
[ t ] [ [ 2drop 0 ] [ 2drop 0 ] eql? ] unit-test
{ t } [ [ 2drop 0 ] [ 2drop 0 ] eql? ] unit-test
[ f ] [ \ + [ 2drop 0 ] eql? ] unit-test
{ f } [ \ + [ 2drop 0 ] eql? ] unit-test
[ f ] [ 3 [ 0 1 2 ] eql? ] unit-test
{ f } [ 3 [ 0 1 2 ] eql? ] unit-test
[ f ] [ 3 3.0 eql? ] unit-test
{ f } [ 3 3.0 eql? ] unit-test
[ t ] [ 4.0 4.0 eql? ] unit-test
{ t } [ 4.0 4.0 eql? ] unit-test

View File

@ -3,8 +3,8 @@
USING: tools.test byte-arrays.hex eval ;
IN: byte-arrays.hex.tests
[ B{ 16 0 8 0 } ] [ HEX{ 10 00 08 00 } ] unit-test
[ B{ 255 255 15 255 255 255 } ] [ HEX{ ffff 0fff ffff } ] unit-test
{ B{ 16 0 8 0 } } [ HEX{ 10 00 08 00 } ] unit-test
{ B{ 255 255 15 255 255 255 } } [ HEX{ ffff 0fff ffff } ] unit-test
[ "HEX{ ffff fff ffff }" parse-string ] must-fail
[ "HEX{ 10 00 08 0 }" parse-string ] must-fail

View File

@ -2,61 +2,61 @@ USING: calendar.format calendar kernel math tools.test
io.streams.string accessors io math.order sequences ;
IN: calendar.format.tests
[ 0 ] [
{ 0 } [
"Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ 1 ] [
{ 1 } [
"+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ -1 ] [
{ -1 } [
"-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ -1-1/2 ] [
{ -1-1/2 } [
"-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ 1+1/2 ] [
{ 1+1/2 } [
"+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
] unit-test
[ ] [ now timestamp>rfc3339 drop ] unit-test
[ ] [ now timestamp>rfc822 drop ] unit-test
{ } [ now timestamp>rfc3339 drop ] unit-test
{ } [ now timestamp>rfc822 drop ] unit-test
[ 8/1000 -4 ] [
{ 8/1000 -4 } [
"2008-04-19T04:56:00.008-04:00" rfc3339>timestamp
[ second>> ] [ gmt-offset>> hour>> ] bi
] unit-test
[ T{ duration f 0 0 0 0 0 0 } ] [
{ T{ duration f 0 0 0 0 0 0 } } [
"GMT" parse-rfc822-gmt-offset
] unit-test
[ T{ duration f 0 0 0 -5 0 0 } ] [
{ T{ duration f 0 0 0 -5 0 0 } } [
"-0500" parse-rfc822-gmt-offset
] unit-test
[ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } ] [
{ T{ timestamp f 2008 4 22 14 36 12 T{ duration f 0 0 0 0 0 0 } } } [
"Tue, 22 Apr 2008 14:36:12 GMT" rfc822>timestamp
] unit-test
[ t ] [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
{ t } [ now dup timestamp>rfc822 rfc822>timestamp time- 1 seconds before? ] unit-test
[ t ] [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
{ t } [ now dup timestamp>cookie-string cookie-string>timestamp time- 1 seconds before? ] unit-test
[ "Sun, 4 May 2008 07:00:00" ] [
{ "Sun, 4 May 2008 07:00:00" } [
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
timestamp>string
] unit-test
[ "20080504070000" ] [
{ "20080504070000" } [
"Sun May 04 07:00:00 2008 GMT" cookie-string>timestamp
timestamp>mdtm
] unit-test
[
{
T{ timestamp f
2008
5
@ -66,9 +66,9 @@ IN: calendar.format.tests
42+2469/20000
T{ duration f 0 0 0 -5 0 0 }
}
] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
} [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
[
{
T{ timestamp
{ year 2008 }
{ month 10 }
@ -78,13 +78,13 @@ IN: calendar.format.tests
{ second 59 }
{ gmt-offset T{ duration f 0 0 0 0 0 0 } }
}
] [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
} [ "Thursday, 02-Oct-2008 23:59:59 GMT" cookie-string>timestamp ] unit-test
[ ]
{ }
[ { 2008 2009 } [ year. ] each ] unit-test
[
{
T{ timestamp
{ year 2013 }
{ month 4 }
@ -93,11 +93,11 @@ IN: calendar.format.tests
{ minute 50 }
{ second 24 }
}
] [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
} [ "2013-04-23T13:50:24" rfc3339>timestamp ] unit-test
{ "2001-12-14T21:59:43.100000-05:00" } [ "2001-12-14T21:59:43.1-05:00" rfc3339>timestamp timestamp>rfc3339 ] unit-test
[
{
T{ timestamp
{ year 2001 }
{ month 12 }
@ -106,9 +106,9 @@ IN: calendar.format.tests
{ minute 59 }
{ second 43+1/10 }
}
] [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test
} [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test
[
{
T{ timestamp
{ year 2001 }
{ month 12 }
@ -117,4 +117,4 @@ IN: calendar.format.tests
{ minute 59 }
{ second 43+1/10 }
}
] [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test
} [ "2001-12-15 02:59:43.1Z" rfc3339>timestamp ] unit-test

View File

@ -1,9 +1,9 @@
USING: tools.test kernel accessors ;
IN: calendar.format.macros
[ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test
{ 2 } [ { [ 2 ] } attempt-all-quots ] unit-test
[ 2 ] [ { [ 1 throw ] [ 2 ] } attempt-all-quots ] unit-test
{ 2 } [ { [ 1 throw ] [ 2 ] } attempt-all-quots ] unit-test
[ { [ 1 throw ] } attempt-all-quots ] [ 1 = ] must-fail-with
@ -12,4 +12,4 @@ IN: calendar.format.macros
\ compiled-test-1 def>> must-infer
[ 2 ] [ compiled-test-1 ] unit-test
{ 2 } [ compiled-test-1 ] unit-test

View File

@ -1,5 +1,5 @@
USING: checksums.adler-32 checksums strings tools.test ;
IN: checksums.adler-32.tests
[ 300286872 ] [ "Wikipedia" adler-32 checksum-bytes ] unit-test
[ 2679885283 ] [ 10000 CHAR: a <string> adler-32 checksum-bytes ] unit-test
{ 300286872 } [ "Wikipedia" adler-32 checksum-bytes ] unit-test
{ 2679885283 } [ 10000 CHAR: a <string> adler-32 checksum-bytes ] unit-test

View File

@ -3,39 +3,39 @@ IN: checksums.fnv1.tests
! A few test vectors taken from http://www.isthe.com/chongo/src/fnv/test_fnv.c
[ 0x811c9dc5 ] [ "" fnv1-32 checksum-bytes ] unit-test
[ 0x811c9dc5 ] [ "" fnv1a-32 checksum-bytes ] unit-test
[ 0xcbf29ce484222325 ] [ "" fnv1-64 checksum-bytes ] unit-test
[ 0xcbf29ce484222325 ] [ "" fnv1a-64 checksum-bytes ] unit-test
{ 0x811c9dc5 } [ "" fnv1-32 checksum-bytes ] unit-test
{ 0x811c9dc5 } [ "" fnv1a-32 checksum-bytes ] unit-test
{ 0xcbf29ce484222325 } [ "" fnv1-64 checksum-bytes ] unit-test
{ 0xcbf29ce484222325 } [ "" fnv1a-64 checksum-bytes ] unit-test
[ 0x050c5d7e ] [ "a" fnv1-32 checksum-bytes ] unit-test
[ 0xe40c292c ] [ "a" fnv1a-32 checksum-bytes ] unit-test
[ 0xaf63bd4c8601b7be ] [ "a" fnv1-64 checksum-bytes ] unit-test
[ 0xaf63dc4c8601ec8c ] [ "a" fnv1a-64 checksum-bytes ] unit-test
{ 0x050c5d7e } [ "a" fnv1-32 checksum-bytes ] unit-test
{ 0xe40c292c } [ "a" fnv1a-32 checksum-bytes ] unit-test
{ 0xaf63bd4c8601b7be } [ "a" fnv1-64 checksum-bytes ] unit-test
{ 0xaf63dc4c8601ec8c } [ "a" fnv1a-64 checksum-bytes ] unit-test
[ 0x050c5d7d ] [ "b" fnv1-32 checksum-bytes ] unit-test
[ 0xe70c2de5 ] [ "b" fnv1a-32 checksum-bytes ] unit-test
[ 0xaf63bd4c8601b7bd ] [ "b" fnv1-64 checksum-bytes ] unit-test
[ 0xaf63df4c8601f1a5 ] [ "b" fnv1a-64 checksum-bytes ] unit-test
{ 0x050c5d7d } [ "b" fnv1-32 checksum-bytes ] unit-test
{ 0xe70c2de5 } [ "b" fnv1a-32 checksum-bytes ] unit-test
{ 0xaf63bd4c8601b7bd } [ "b" fnv1-64 checksum-bytes ] unit-test
{ 0xaf63df4c8601f1a5 } [ "b" fnv1a-64 checksum-bytes ] unit-test
[ 0x31f0b262 ] [ "foobar" fnv1-32 checksum-bytes ] unit-test
[ 0xbf9cf968 ] [ "foobar" fnv1a-32 checksum-bytes ] unit-test
[ 0x340d8765a4dda9c2 ] [ "foobar" fnv1-64 checksum-bytes ] unit-test
[ 0x85944171f73967e8 ] [ "foobar" fnv1a-64 checksum-bytes ] unit-test
{ 0x31f0b262 } [ "foobar" fnv1-32 checksum-bytes ] unit-test
{ 0xbf9cf968 } [ "foobar" fnv1a-32 checksum-bytes ] unit-test
{ 0x340d8765a4dda9c2 } [ "foobar" fnv1-64 checksum-bytes ] unit-test
{ 0x85944171f73967e8 } [ "foobar" fnv1a-64 checksum-bytes ] unit-test
! I couldn't find any test vectors for 128, 256, 512, or 1024 versions of FNV1 hashes.
! So, just to check that your maths works the same as my maths, here's a few samples computed on my laptop.
! So they may be right or wrong, but either way, them failing is cause for concern somewhere...
[ 3897470310 ] [ "Hello, world!" fnv1-32 checksum-bytes ] unit-test
[ 3985698964 ] [ "Hello, world!" fnv1a-32 checksum-bytes ] unit-test
[ 7285062107457560934 ] [ "Hello, world!" fnv1-64 checksum-bytes ] unit-test
[ 4094109891673226228 ] [ "Hello, world!" fnv1a-64 checksum-bytes ] unit-test
[ 281580511747867177735318995358496831158 ] [ "Hello, world!" fnv1-128 checksum-bytes ] unit-test
[ 303126633380056630368940439484674414572 ] [ "Hello, world!" fnv1a-128 checksum-bytes ] unit-test
[ 104295939182568077644846978685759236849634734810631820736486253421270219742822 ] [ "Hello, world!" fnv1-256 checksum-bytes ] unit-test
[ 9495445728692795332446740615588417456874414534608540692485745371050033741380 ] [ "Hello, world!" fnv1a-256 checksum-bytes ] unit-test
[ 3577308325596719252093726711895047340166329831006673109476042102918876665433235513101496175651226507162015890004121912850661561110326527625579463564626958 ] [ "Hello, world!" fnv1-512 checksum-bytes ] unit-test
[ 3577308325596719162840652138474318309664256091923081930027929425092517582111473988451078821416039944023089883981242376700859598441397004715365740906054208 ] [ "Hello, world!" fnv1a-512 checksum-bytes ] unit-test
[ 52692754922840008511959888105094366091401994235075816792707658326855733053286986999719949898492311786648795846192078757217437117165934438286601534984230194601365788544275827382423366672856972872132009691615382991251544423521887009322211754219117294019951276080952271766377222613325328591830596794468813260226 ] [ "Hello, world!" fnv1-1024 checksum-bytes ] unit-test
[ 52692754922840008511959888105094366091401994235075816792707658326855804920671100511873485674717442819607149127986090276849364757610838433887624184145636764448608707614141109841761957788887305179569455221243999538336208648824673027111352338809582124430199044921035232455717748500524777795242051756321605065326 ] [ "Hello, world!" fnv1a-1024 checksum-bytes ] unit-test
{ 3897470310 } [ "Hello, world!" fnv1-32 checksum-bytes ] unit-test
{ 3985698964 } [ "Hello, world!" fnv1a-32 checksum-bytes ] unit-test
{ 7285062107457560934 } [ "Hello, world!" fnv1-64 checksum-bytes ] unit-test
{ 4094109891673226228 } [ "Hello, world!" fnv1a-64 checksum-bytes ] unit-test
{ 281580511747867177735318995358496831158 } [ "Hello, world!" fnv1-128 checksum-bytes ] unit-test
{ 303126633380056630368940439484674414572 } [ "Hello, world!" fnv1a-128 checksum-bytes ] unit-test
{ 104295939182568077644846978685759236849634734810631820736486253421270219742822 } [ "Hello, world!" fnv1-256 checksum-bytes ] unit-test
{ 9495445728692795332446740615588417456874414534608540692485745371050033741380 } [ "Hello, world!" fnv1a-256 checksum-bytes ] unit-test
{ 3577308325596719252093726711895047340166329831006673109476042102918876665433235513101496175651226507162015890004121912850661561110326527625579463564626958 } [ "Hello, world!" fnv1-512 checksum-bytes ] unit-test
{ 3577308325596719162840652138474318309664256091923081930027929425092517582111473988451078821416039944023089883981242376700859598441397004715365740906054208 } [ "Hello, world!" fnv1a-512 checksum-bytes ] unit-test
{ 52692754922840008511959888105094366091401994235075816792707658326855733053286986999719949898492311786648795846192078757217437117165934438286601534984230194601365788544275827382423366672856972872132009691615382991251544423521887009322211754219117294019951276080952271766377222613325328591830596794468813260226 } [ "Hello, world!" fnv1-1024 checksum-bytes ] unit-test
{ 52692754922840008511959888105094366091401994235075816792707658326855804920671100511873485674717442819607149127986090276849364757610838433887624184145636764448608707614141109841761957788887305179569455221243999538336208648824673027111352338809582124430199044921035232455717748500524777795242051756321605065326 } [ "Hello, world!" fnv1a-1024 checksum-bytes ] unit-test

View File

@ -3,45 +3,45 @@ parser checksums.hmac tools.test checksums.md5 checksums.sha
checksums ;
IN: checksums.hmac.tests
[
{
"\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
] [
} [
"Hi There" 16 11 <string> md5 hmac-bytes >string ] unit-test
[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
{ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" }
[ "what do ya want for nothing?" "Jefe" md5 hmac-bytes >string ] unit-test
[
{
"V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
]
}
[
50 0xdd <repetition>
16 0xaa <string> md5 hmac-bytes >string
] unit-test
[
{
"g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
] [
} [
"Hi There" 16 11 <string> sha1 hmac-bytes >string
] unit-test
[
{
"\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
] [
} [
"what do ya want for nothing?" "Jefe" sha1 hmac-bytes >string
] unit-test
[
{
"\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
] [
} [
50 0xdd <repetition>
16 0xaa <string> sha1 hmac-bytes >string
] unit-test
[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
{ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" }
[ "Hi There" 20 0xb <string> sha-256 hmac-bytes hex-string ] unit-test
[ "167f928588c5cc2eef8e3093caa0e87c9ff566a14794aa61648d81621a2a40c6" ]
{ "167f928588c5cc2eef8e3093caa0e87c9ff566a14794aa61648d81621a2a40c6" }
[
"what do ya want for nothing?"
"JefeJefeJefeJefeJefeJefeJefeJefe" sha-256 hmac-bytes hex-string

View File

@ -3,13 +3,13 @@
USING: tools.test checksums.interleave checksums.sha ;
IN: checksums.interleave.tests
[
{
B{
59 155 253 205 75 163 94 115 208 42 227 92 181 19 60 232
119 65 178 131 210 48 241 230 204 216 30 156 4 215 80 84 93
206 44 1 18 128 150 153
}
] [
} [
B{
102 83 241 12 26 250 181 76 97 200 37 117 168 74 254 48 216
170 26 58 150 150 179 24 153 146 191 225 203 127 166 167

View File

@ -5,10 +5,10 @@ USING: checksums checksums.internet tools.test ;
IN: checksums
[ B{ 255 255 } ] [ { } internet checksum-bytes ] unit-test
[ B{ 254 255 } ] [ { 1 } internet checksum-bytes ] unit-test
[ B{ 254 253 } ] [ { 1 2 } internet checksum-bytes ] unit-test
[ B{ 251 253 } ] [ { 1 2 3 } internet checksum-bytes ] unit-test
{ B{ 255 255 } } [ { } internet checksum-bytes ] unit-test
{ B{ 254 255 } } [ { 1 } internet checksum-bytes ] unit-test
{ B{ 254 253 } } [ { 1 2 } internet checksum-bytes ] unit-test
{ B{ 251 253 } } [ { 1 2 3 } internet checksum-bytes ] unit-test
: test-data ( -- bytes )
B{
@ -18,4 +18,4 @@ IN: checksums
0xf6 0xf7
} ;
[ B{ 34 13 } ] [ test-data internet checksum-bytes ] unit-test
{ B{ 34 13 } } [ test-data internet checksum-bytes ] unit-test

View File

@ -5,38 +5,38 @@ io.streams.byte-array kernel math namespaces tools.test
sequences ;
IN: checksums.md5.tests
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "900150983cd24fb0d6963f7d28e17f72" ] [ "abc" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "f96b697d7cb7938d525a2f31aaf161d0" ] [ "message digest" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "c3fcd3d76192e4007dfb496cca67e13b" ] [ "abcdefghijklmnopqrstuvwxyz" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
[ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "d41d8cd98f00b204e9800998ecf8427e" } [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "0cc175b9c0f1b6a831c399e269772661" } [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "900150983cd24fb0d6963f7d28e17f72" } [ "abc" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "f96b697d7cb7938d525a2f31aaf161d0" } [ "message digest" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "c3fcd3d76192e4007dfb496cca67e13b" } [ "abcdefghijklmnopqrstuvwxyz" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "d174ab98d277d9f5a5611c2c9f419d9f" } [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
{ "57edf4a22be3c955ac49da2e2107b67a" } [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test
[
{
t
] [
} [
<md5-state> "asdf" add-checksum-bytes
[ get-checksum ] [ get-checksum ] bi =
] unit-test
[
{
t
] [
} [
<md5-state> "" add-checksum-bytes
[ get-checksum ] [ get-checksum ] bi =
] unit-test
[
{
t
] [
} [
<md5-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
[
{
t
] [
} [
{ "abcd" "efg" } md5 checksum-lines length 16 =
] unit-test

View File

@ -2,17 +2,17 @@ USING: accessors byte-arrays checksums checksums.openssl
combinators.short-circuit kernel system tools.test ;
IN: checksums.openssl.tests
[
{
B{ 201 238 222 100 92 200 182 188 138 255 129 163 115 88 240 136 }
]
}
[
"Hello world from the openssl binding" >byte-array
"md5" <openssl-checksum> checksum-bytes
] unit-test
[
{
B{ 63 113 237 255 181 5 152 241 136 181 43 95 160 105 44 87 49 82 115 0 }
]
}
[
"Hello world from the openssl binding" >byte-array
"sha1" <openssl-checksum> checksum-bytes
@ -25,4 +25,4 @@ IN: checksums.openssl.tests
] [ { [ unknown-digest? ] [ name>> "no such checksum" = ] } 1&& ]
must-fail-with
[ ] [ image openssl-sha1 checksum-file drop ] unit-test
{ } [ image openssl-sha1 checksum-file drop ] unit-test

View File

@ -6,38 +6,38 @@ IN: checksums.sha.tests
: test-checksum ( text identifier -- checksum )
checksum-bytes hex-string ;
[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test
[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
{ "a9993e364706816aba3e25717850c26c9cd0d89d" } [ "abc" sha1 checksum-bytes hex-string ] unit-test
{ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" } [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test
! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time...
[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567"
{ "dea356a2cddd90c7a7ecedc5ebb563934f460452" } [ "0123456701234567012345670123456701234567012345670123456701234567"
10 swap <array> concat sha1 checksum-bytes hex-string ] unit-test
[ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
{ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" }
[
"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
sha-224 test-checksum
] unit-test
[ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" ]
{ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" }
[ "" sha-256 test-checksum ] unit-test
[ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" ]
{ "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad" }
[ "abc" sha-256 test-checksum ] unit-test
[ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" ]
{ "f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650" }
[ "message digest" sha-256 test-checksum ] unit-test
[ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" ]
{ "71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73" }
[ "abcdefghijklmnopqrstuvwxyz" sha-256 test-checksum ] unit-test
[ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" ]
{ "db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0" }
[
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
sha-256 test-checksum
] unit-test
[ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" ]
{ "f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e" }
[
"12345678901234567890123456789012345678901234567890123456789012345678901234567890"
sha-256 test-checksum
@ -47,23 +47,23 @@ IN: checksums.sha.tests
! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
[
{
t
] [
} [
<sha1-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
[
{
t
] [
} [
<sha-256-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
[
{
t
] [
} [
<sha-224-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test

View File

@ -4,5 +4,5 @@ USING: classes.struct.bit-accessors tools.test effects kernel
sequences random stack-checker ;
IN: classes.struct.bit-accessors.test
[ t ] [ 20 random 20 random bit-reader infer ( alien -- n ) effect= ] unit-test
[ t ] [ 20 random 20 random bit-writer infer ( n alien -- ) effect= ] unit-test
{ t } [ 20 random 20 random bit-reader infer ( alien -- n ) effect= ] unit-test
{ t } [ 20 random 20 random bit-writer infer ( n alien -- ) effect= ] unit-test

View File

@ -31,13 +31,13 @@ STRUCT: struct-test-bar
{ w ushort initial: 0xffff }
{ foo struct-test-foo } ;
[ 12 ] [ struct-test-foo heap-size ] unit-test
[ 12 ] [ struct-test-foo <struct> byte-length ] unit-test
[ 16 ] [ struct-test-bar heap-size ] unit-test
[ 123 ] [ struct-test-foo <struct> y>> ] unit-test
[ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test
{ 12 } [ struct-test-foo heap-size ] unit-test
{ 12 } [ struct-test-foo <struct> byte-length ] unit-test
{ 16 } [ struct-test-bar heap-size ] unit-test
{ 123 } [ struct-test-foo <struct> y>> ] unit-test
{ 123 } [ struct-test-bar <struct> foo>> y>> ] unit-test
[ 1 2 3 t ] [
{ 1 2 3 t } [
1 2 3 t struct-test-foo <struct-boa> struct-test-bar <struct-boa>
{
[ w>> ]
@ -47,111 +47,111 @@ STRUCT: struct-test-bar
} cleave
] unit-test
[ 7654 ] [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
[ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
{ 7654 } [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
{ 7654 } [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
[ {
{ {
{ "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
{ { "x" char } 98 }
{ { "y" int } 0x7F00007F }
{ { "z" bool } f }
} ] [
} } [
B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
make-mirror >alist
] unit-test
[ { { "underlying" f } } ] [
{ { { "underlying" f } } } [
f struct-test-foo memory>struct
make-mirror >alist
] unit-test
[ 55 t ] [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } ?of ] unit-test
[ 55 t ] [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int" } ?of ] unit-test
[ t t ] [ S{ struct-test-foo { z t } } make-mirror { "z" "bool" } ?of ] unit-test
[ f t ] [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } ?of ] unit-test
[ { "nonexist" "bool" } f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test
[ "nonexist" f ] [ S{ struct-test-foo } make-mirror "nonexist" ?of ] unit-test
[ f t ] [ f struct-test-foo memory>struct make-mirror "underlying" ?of ] unit-test
{ 55 t } [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } ?of ] unit-test
{ 55 t } [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int" } ?of ] unit-test
{ t t } [ S{ struct-test-foo { z t } } make-mirror { "z" "bool" } ?of ] unit-test
{ f t } [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } ?of ] unit-test
{ { "nonexist" "bool" } f } [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } ?of ] unit-test
{ "nonexist" f } [ S{ struct-test-foo } make-mirror "nonexist" ?of ] unit-test
{ f t } [ f struct-test-foo memory>struct make-mirror "underlying" ?of ] unit-test
[ S{ struct-test-foo { x 3 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 3 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ 3 { "x" "char" } ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 5 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 5 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ 5 { "y" "int" } ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z t } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z t } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ t { "z" "bool" } ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ "nonsense" "underlying" ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ "nonsense" "nonexist" ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror [ "nonsense" { "nonexist" "int" } ] dip set-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 123 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 123 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror { "y" "int" } swap delete-at ] keep
] unit-test
[ S{ struct-test-foo { x 0 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 0 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror { "x" "char" } swap delete-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror { "nonexist" "char" } swap delete-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror "underlying" swap delete-at ] keep
] unit-test
[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
{ S{ struct-test-foo { x 1 } { y 2 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z f } }
[ make-mirror "nonsense" swap delete-at ] keep
] unit-test
[ S{ struct-test-foo { x 0 } { y 123 } { z f } } ] [
{ S{ struct-test-foo { x 0 } { y 123 } { z f } } } [
S{ struct-test-foo { x 1 } { y 2 } { z t } }
[ make-mirror clear-assoc ] keep
] unit-test
[ POSTPONE: STRUCT: ]
{ POSTPONE: STRUCT: }
[ struct-test-foo struct-definer-word ] unit-test
UNION-STRUCT: struct-test-float-and-bits
{ f c:float }
{ bits uint } ;
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
[ 4 ] [ struct-test-float-and-bits heap-size ] unit-test
{ 1.0 } [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
{ 4 } [ struct-test-float-and-bits heap-size ] unit-test
[ 123 ] [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
{ 123 } [ [ struct-test-foo malloc-struct &free y>> ] with-destructors ] unit-test
[ POSTPONE: UNION-STRUCT: ]
{ POSTPONE: UNION-STRUCT: }
[ struct-test-float-and-bits struct-definer-word ] unit-test
STRUCT: struct-test-string-ptr
{ x c-string } ;
[ "hello world" ] [
{ "hello world" } [
[
struct-test-string-ptr <struct>
"hello world" utf8 malloc-string &free >>x
@ -159,49 +159,49 @@ STRUCT: struct-test-string-ptr
] with-destructors
] unit-test
[ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" ]
{ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" }
[
H{ { boa-tuples? f } { c-object-pointers? f } } [
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
] with-variables
] unit-test
[ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" ]
{ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" }
[
H{ { c-object-pointers? t } } [
12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
] with-variables
] unit-test
[ "S{ struct-test-foo f 0 7654 f }" ]
{ "S{ struct-test-foo f 0 7654 f }" }
[
H{ { boa-tuples? t } { c-object-pointers? f } } [
struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
] with-variables
] unit-test
[ "S@ struct-test-foo f" ]
{ "S@ struct-test-foo f" }
[
H{ { c-object-pointers? f } } [
f struct-test-foo memory>struct [ pprint ] with-string-writer
] with-variables
] unit-test
[ "USING: alien.c-types classes.struct ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
STRUCT: struct-test-foo
{ x char initial: 0 } { y int initial: 123 } { z bool } ;
" ]
" }
[ [ struct-test-foo see ] with-string-writer ] unit-test
[ "USING: alien.c-types classes.struct ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
UNION-STRUCT: struct-test-float-and-bits
{ f float initial: 0.0 } { bits uint initial: 0 } ;
" ]
" }
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
[ {
{ {
T{ struct-slot-spec
{ name "x" }
{ offset 0 }
@ -223,9 +223,9 @@ UNION-STRUCT: struct-test-float-and-bits
{ type bool }
{ class object }
}
} ] [ struct-test-foo lookup-c-type fields>> ] unit-test
} } [ struct-test-foo lookup-c-type fields>> ] unit-test
[ {
{ {
T{ struct-slot-spec
{ name "f" }
{ offset 0 }
@ -240,30 +240,30 @@ UNION-STRUCT: struct-test-float-and-bits
{ class $[ cell 4 = integer fixnum ? ] }
{ initial 0 }
}
} ] [ struct-test-float-and-bits lookup-c-type fields>> ] unit-test
} } [ struct-test-float-and-bits lookup-c-type fields>> ] unit-test
STRUCT: struct-test-equality-1
{ x int } ;
STRUCT: struct-test-equality-2
{ y int } ;
[ 0 ] [ struct-test-equality-1 new hashcode ] unit-test
{ 0 } [ struct-test-equality-1 new hashcode ] unit-test
[ t ] [
{ t } [
[
struct-test-equality-1 <struct> 5 >>x
struct-test-equality-1 malloc-struct &free 5 >>x =
] with-destructors
] unit-test
[ f ] [
{ f } [
[
struct-test-equality-1 <struct> 5 >>x
struct-test-equality-2 malloc-struct &free 5 >>y =
] with-destructors
] unit-test
[ t ] [
{ t } [
[
struct-test-equality-1 <struct> 5 >>x
struct-test-equality-1 malloc-struct &free 5 >>x
@ -276,9 +276,9 @@ STRUCT: struct-test-array-slots
{ y ushort[6] initial: ushort-array{ 2 3 5 7 11 13 } }
{ z int } ;
[ 11 ] [ struct-test-array-slots <struct> y>> 4 swap nth ] unit-test
{ 11 } [ struct-test-array-slots <struct> y>> 4 swap nth ] unit-test
[ t ] [
{ t } [
struct-test-array-slots <struct>
[ y>> [ 8 3 ] dip set-nth ]
[ y>> ushort-array{ 2 3 5 8 11 13 } sequence= ] bi
@ -289,27 +289,27 @@ STRUCT: struct-test-optimization
SPECIALIZED-ARRAY: struct-test-optimization
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
{ t } [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
{ t } [
[ 3 struct-test-optimization <c-direct-array> third y>> ]
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
] unit-test
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
{ t } [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
{ t } [
[ struct-test-optimization memory>struct x>> second ]
{ memory>struct x>> int <c-direct-array> <tuple> <tuple-boa> } inlined?
] unit-test
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
{ f } [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
{ t } [
[ struct-test-optimization <struct> struct-test-optimization <struct> [ x>> ] bi@ ]
{ x>> } inlined?
] unit-test
[ ] [
{ } [
[
struct-test-optimization specialized-array-vocab forget-vocab
] with-compilation-unit
@ -318,14 +318,14 @@ SPECIALIZED-ARRAY: struct-test-optimization
! Test cloning structs
STRUCT: clone-test-struct { x int } { y char[3] } ;
[ 1 char-array{ 9 1 1 } ] [
{ 1 char-array{ 9 1 1 } } [
clone-test-struct <struct>
1 >>x char-array{ 9 1 1 } >>y
clone
[ x>> ] [ y>> char >c-array ] bi
] unit-test
[ t 1 char-array{ 9 1 1 } ] [
{ t 1 char-array{ 9 1 1 } } [
[
clone-test-struct malloc-struct &free
1 >>x char-array{ 9 1 1 } >>y
@ -338,7 +338,7 @@ STRUCT: struct-that's-a-word { x int } ;
: struct-that's-a-word ( -- ) "OOPS" throw ;
[ -77 ] [ S{ struct-that's-a-word { x -77 } } clone x>> ] unit-test
{ -77 } [ S{ struct-that's-a-word { x -77 } } clone x>> ] unit-test
! Interactive parsing of struct slot definitions
[
@ -371,35 +371,35 @@ TUPLE: will-become-struct ;
TUPLE: a-subclass < will-become-struct ;
[ f ] [ will-become-struct struct-class? ] unit-test
{ f } [ will-become-struct struct-class? ] unit-test
[ will-become-struct ] [ a-subclass superclass ] unit-test
{ will-become-struct } [ a-subclass superclass ] unit-test
[ ] [ "IN: classes.struct.tests USING: classes.struct alien.c-types ; STRUCT: will-become-struct { x int } ;" eval( -- ) ] unit-test
{ } [ "IN: classes.struct.tests USING: classes.struct alien.c-types ; STRUCT: will-become-struct { x int } ;" eval( -- ) ] unit-test
[ t ] [ will-become-struct struct-class? ] unit-test
{ t } [ will-become-struct struct-class? ] unit-test
[ tuple ] [ a-subclass superclass ] unit-test
{ tuple } [ a-subclass superclass ] unit-test
STRUCT: bit-field-test
{ a uint bits: 12 }
{ b int bits: 2 }
{ c char } ;
[ S{ bit-field-test f 0 0 0 } ] [ bit-field-test <struct> ] unit-test
[ S{ bit-field-test f 1 -2 3 } ] [ bit-field-test <struct> 1 >>a 2 >>b 3 >>c ] unit-test
[ 4095 ] [ bit-field-test <struct> 8191 >>a a>> ] unit-test
[ 1 ] [ bit-field-test <struct> 1 >>b b>> ] unit-test
[ -2 ] [ bit-field-test <struct> 2 >>b b>> ] unit-test
[ 1 ] [ bit-field-test <struct> 257 >>c c>> ] unit-test
[ 3 ] [ bit-field-test heap-size ] unit-test
{ S{ bit-field-test f 0 0 0 } } [ bit-field-test <struct> ] unit-test
{ S{ bit-field-test f 1 -2 3 } } [ bit-field-test <struct> 1 >>a 2 >>b 3 >>c ] unit-test
{ 4095 } [ bit-field-test <struct> 8191 >>a a>> ] unit-test
{ 1 } [ bit-field-test <struct> 1 >>b b>> ] unit-test
{ -2 } [ bit-field-test <struct> 2 >>b b>> ] unit-test
{ 1 } [ bit-field-test <struct> 257 >>c c>> ] unit-test
{ 3 } [ bit-field-test heap-size ] unit-test
STRUCT: referent
{ y int } ;
STRUCT: referrer
{ x referent* } ;
[ 57 ] [
{ 57 } [
[
referrer <struct>
referent malloc-struct &free
@ -413,7 +413,7 @@ STRUCT: self-referent
{ x self-referent* }
{ y int } ;
[ 75 ] [
{ 75 } [
[
self-referent <struct>
self-referent malloc-struct &free
@ -431,7 +431,7 @@ STRUCT: forward-referent
{ x backward-referent* }
{ y int } ;
[ 41 ] [
{ 41 } [
[
forward-referent <struct>
backward-referent malloc-struct &free
@ -441,7 +441,7 @@ STRUCT: forward-referent
] with-destructors
] unit-test
[ 14 ] [
{ 14 } [
[
backward-referent <struct>
forward-referent malloc-struct &free
@ -473,7 +473,7 @@ STRUCT: struct-test-delegator
{ b int } ;
CONSULT: struct-test-delegate struct-test-delegator del>> ;
[ S{ struct-test-delegator f S{ struct-test-delegate f 7 } 8 } ] [
{ S{ struct-test-delegator f S{ struct-test-delegate f 7 } 8 } } [
struct-test-delegator <struct>
7 >>a
8 >>b
@ -483,7 +483,7 @@ SPECIALIZED-ARRAY: void*
STRUCT: silly-array-field-test { x int*[3] } ;
[ t ] [ silly-array-field-test <struct> x>> void*-array? ] unit-test
{ t } [ silly-array-field-test <struct> x>> void*-array? ] unit-test
! Packed structs
PACKED-STRUCT: packed-struct-test
@ -493,53 +493,53 @@ PACKED-STRUCT: packed-struct-test
{ g c:char }
{ h c:int } ;
[ 15 ] [ packed-struct-test heap-size ] unit-test
{ 15 } [ packed-struct-test heap-size ] unit-test
[ 0 ] [ "d" packed-struct-test offset-of ] unit-test
[ 4 ] [ "e" packed-struct-test offset-of ] unit-test
[ 6 ] [ "f" packed-struct-test offset-of ] unit-test
[ 10 ] [ "g" packed-struct-test offset-of ] unit-test
[ 11 ] [ "h" packed-struct-test offset-of ] unit-test
{ 0 } [ "d" packed-struct-test offset-of ] unit-test
{ 4 } [ "e" packed-struct-test offset-of ] unit-test
{ 6 } [ "f" packed-struct-test offset-of ] unit-test
{ 10 } [ "g" packed-struct-test offset-of ] unit-test
{ 11 } [ "h" packed-struct-test offset-of ] unit-test
[ POSTPONE: PACKED-STRUCT: ]
{ POSTPONE: PACKED-STRUCT: }
[ packed-struct-test struct-definer-word ] unit-test
STRUCT: struct-1 { a c:int } ;
PACKED-STRUCT: struct-1-packed { a c:int } ;
UNION-STRUCT: struct-1-union { a c:int } ;
[ "USING: alien.c-types classes.struct ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
STRUCT: struct-1 { a int initial: 0 } ;
" ]
" }
[ \ struct-1 [ see ] with-string-writer ] unit-test
[ "USING: alien.c-types classes.struct ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
PACKED-STRUCT: struct-1-packed { a int initial: 0 } ;
" ]
" }
[ \ struct-1-packed [ see ] with-string-writer ] unit-test
[ "USING: alien.c-types classes.struct ;
{ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
STRUCT: struct-1-union { a int initial: 0 } ;
" ]
" }
[ \ struct-1-union [ see ] with-string-writer ] unit-test
! Bug #206
STRUCT: going-to-redefine { a uint } ;
[ ] [
{ } [
"IN: classes.struct.tests TUPLE: going-to-redefine b ;" eval( -- )
] unit-test
[ f ] [ \ going-to-redefine \ clone ?lookup-method ] unit-test
[ f ] [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test
{ f } [ \ going-to-redefine \ clone ?lookup-method ] unit-test
{ f } [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test
! Test reset-class on structs, which should forget all the accessors, clone, and struct-slot-values
STRUCT: some-accessors { aaa uint } { bbb int } ;
[ ] [ [ \ some-accessors reset-class ] with-compilation-unit ] unit-test
[ f ] [ \ some-accessors \ a>> ?lookup-method ] unit-test
[ f ] [ \ some-accessors \ a<< ?lookup-method ] unit-test
[ f ] [ \ some-accessors \ b>> ?lookup-method ] unit-test
[ f ] [ \ some-accessors \ b<< ?lookup-method ] unit-test
[ f ] [ \ some-accessors \ clone ?lookup-method ] unit-test
[ f ] [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
{ } [ [ \ some-accessors reset-class ] with-compilation-unit ] unit-test
{ f } [ \ some-accessors \ a>> ?lookup-method ] unit-test
{ f } [ \ some-accessors \ a<< ?lookup-method ] unit-test
{ f } [ \ some-accessors \ b>> ?lookup-method ] unit-test
{ f } [ \ some-accessors \ b<< ?lookup-method ] unit-test
{ f } [ \ some-accessors \ clone ?lookup-method ] unit-test
{ f } [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
<< \ some-accessors forget >>

View File

@ -3,4 +3,4 @@
USING: tools.test colors.constants colors ;
IN: colors.constants.tests
[ t ] [ COLOR: light-green rgba? ] unit-test
{ t } [ COLOR: light-green rgba? ] unit-test

View File

@ -5,8 +5,8 @@ USING: colors colors.hex tools.test ;
IN: colors.hex.test
[ HEXCOLOR: 000000 ] [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
[ HEXCOLOR: FFFFFF ] [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
[ HEXCOLOR: abcdef ] [ "abcdef" hex>rgba ] unit-test
[ HEXCOLOR: abcdef ] [ "ABCDEF" hex>rgba ] unit-test
[ "ABCDEF" ] [ HEXCOLOR: abcdef rgba>hex ] unit-test
{ HEXCOLOR: 000000 } [ 0.0 0.0 0.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: FFFFFF } [ 1.0 1.0 1.0 1.0 <rgba> ] unit-test
{ HEXCOLOR: abcdef } [ "abcdef" hex>rgba ] unit-test
{ HEXCOLOR: abcdef } [ "ABCDEF" hex>rgba ] unit-test
{ "ABCDEF" } [ HEXCOLOR: abcdef rgba>hex ] unit-test

View File

@ -5,24 +5,24 @@ IN: colors.hsv.tests
[ 360 * ] 2dip
1 <hsva> >rgba [ red>> ] [ green>> ] [ blue>> ] tri ;
[ 1/2 1/2 1/2 ] [ 0 0 1/2 hsv>rgb ] unit-test
{ 1/2 1/2 1/2 } [ 0 0 1/2 hsv>rgb ] unit-test
[ 1/2 1/4 1/4 ] [ 0 1/2 1/2 hsv>rgb ] unit-test
[ 1/3 2/9 2/9 ] [ 0 1/3 1/3 hsv>rgb ] unit-test
{ 1/2 1/4 1/4 } [ 0 1/2 1/2 hsv>rgb ] unit-test
{ 1/3 2/9 2/9 } [ 0 1/3 1/3 hsv>rgb ] unit-test
[ 24/125 1/5 4/25 ] [ 1/5 1/5 1/5 hsv>rgb ] unit-test
[ 29/180 1/6 5/36 ] [ 1/5 1/6 1/6 hsv>rgb ] unit-test
{ 24/125 1/5 4/25 } [ 1/5 1/5 1/5 hsv>rgb ] unit-test
{ 29/180 1/6 5/36 } [ 1/5 1/6 1/6 hsv>rgb ] unit-test
[ 6/25 2/5 38/125 ] [ 2/5 2/5 2/5 hsv>rgb ] unit-test
[ 8/25 4/5 64/125 ] [ 2/5 3/5 4/5 hsv>rgb ] unit-test
{ 6/25 2/5 38/125 } [ 2/5 2/5 2/5 hsv>rgb ] unit-test
{ 8/25 4/5 64/125 } [ 2/5 3/5 4/5 hsv>rgb ] unit-test
[ 6/25 48/125 3/5 ] [ 3/5 3/5 3/5 hsv>rgb ] unit-test
[ 0 0 0 ] [ 3/5 1/5 0 hsv>rgb ] unit-test
{ 6/25 48/125 3/5 } [ 3/5 3/5 3/5 hsv>rgb ] unit-test
{ 0 0 0 } [ 3/5 1/5 0 hsv>rgb ] unit-test
[ 84/125 4/25 4/5 ] [ 4/5 4/5 4/5 hsv>rgb ] unit-test
[ 7/15 1/3 1/2 ] [ 4/5 1/3 1/2 hsv>rgb ] unit-test
{ 84/125 4/25 4/5 } [ 4/5 4/5 4/5 hsv>rgb ] unit-test
{ 7/15 1/3 1/2 } [ 4/5 1/3 1/2 hsv>rgb ] unit-test
[ 5/6 5/36 5/6 ] [ 5/6 5/6 5/6 hsv>rgb ] unit-test
[ 1/6 0 1/6 ] [ 5/6 1 1/6 hsv>rgb ] unit-test
{ 5/6 5/36 5/6 } [ 5/6 5/6 5/6 hsv>rgb ] unit-test
{ 1/6 0 1/6 } [ 5/6 1 1/6 hsv>rgb ] unit-test
[ 0.5 ] [ 180 0.1 0.2 0.5 <hsva> alpha>> ] unit-test
{ 0.5 } [ 180 0.1 0.2 0.5 <hsva> alpha>> ] unit-test

View File

@ -3,70 +3,70 @@
USING: tools.test combinators.random combinators.random.private ;
IN: combinators.random.tests
[ 1 ] [ 1 [ 1 ] [ 2 ] ifp ] unit-test
[ 2 ] [ 0 [ 1 ] [ 2 ] ifp ] unit-test
{ 1 } [ 1 [ 1 ] [ 2 ] ifp ] unit-test
{ 2 } [ 0 [ 1 ] [ 2 ] ifp ] unit-test
[ 3 ]
{ 3 }
[ { { 0 [ 1 ] }
{ 0 [ 2 ] }
{ 1 [ 3 ] }
[ 4 ]
} casep ] unit-test
[ 4 ]
{ 4 }
[ { { 0 [ 1 ] }
{ 0 [ 2 ] }
{ 0 [ 3 ] }
[ 4 ]
} casep ] unit-test
[ 1 1 ] [ 1 {
{ 1 1 } [ 1 {
{ 1 [ 1 ] }
{ 0 [ 2 ] }
{ 0 [ 3 ] }
[ 4 ]
} casep ] unit-test
[ 1 4 ] [ 1 {
{ 1 4 } [ 1 {
{ 0 [ 1 ] }
{ 0 [ 2 ] }
{ 0 [ 3 ] }
[ 4 ]
} casep ] unit-test
[ 2 ] [ 0.7 {
{ 2 } [ 0.7 {
{ 0.3 [ 1 ] }
{ 0.5 [ 2 ] }
[ 2 ] } (casep) ] unit-test
[ { { 1/3 [ 1 ] }
{ { { 1/3 [ 1 ] }
{ 1/3 [ 2 ] }
{ 1/3 [ 3 ] } } ]
{ 1/3 [ 3 ] } } }
[ { [ 1 ] [ 2 ] [ 3 ] } call-random>casep ] unit-test
[ { { 1/2 [ 1 ] }
{ { { 1/2 [ 1 ] }
{ 1/4 [ 2 ] }
{ 1/4 [ 3 ] } } ]
{ 1/4 [ 3 ] } } }
[ { { 1/2 [ 1 ] }
{ 1/2 [ 2 ] }
{ 1 [ 3 ] } } direct>conditional ] unit-test
[ { { 1/2 [ 1 ] }
{ { { 1/2 [ 1 ] }
{ 1/4 [ 2 ] }
{ [ 3 ] } } ]
{ [ 3 ] } } }
[ { { 1/2 [ 1 ] }
{ 1/2 [ 2 ] }
{ [ 3 ] } } direct>conditional ] unit-test
[ f ] [ { { 0.6 [ 1 ] }
{ f } [ { { 0.6 [ 1 ] }
{ 0.6 [ 2 ] } } good-probabilities? ] unit-test
[ f ] [ { { 0.3 [ 1 ] }
{ f } [ { { 0.3 [ 1 ] }
{ 0.6 [ 2 ] } } good-probabilities? ] unit-test
[ f ] [ { { -0.6 [ 1 ] }
{ f } [ { { -0.6 [ 1 ] }
{ 1.4 [ 2 ] } } good-probabilities? ] unit-test
[ f ] [ { { -0.6 [ 1 ] }
{ f } [ { { -0.6 [ 1 ] }
[ 2 ] } good-probabilities? ] unit-test
[ t ] [ { { 0.6 [ 1 ] }
{ t } [ { { 0.6 [ 1 ] }
[ 2 ] } good-probabilities? ] unit-test
[ t ] [ { { 0.6 [ 1 ] }
{ t } [ { { 0.6 [ 1 ] }
{ 0.4 [ 2 ] } } good-probabilities? ] unit-test

View File

@ -1,39 +1,39 @@
USING: kernel math tools.test combinators.short-circuit accessors ;
IN: combinators.short-circuit.tests
[ 3 ] [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test
[ 5 ] [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& ] unit-test
[ 30 ] [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& ] unit-test
{ 3 } [ { [ 1 ] [ 2 ] [ 3 ] } 0&& ] unit-test
{ 5 } [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } 1&& ] unit-test
{ 30 } [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } 2&& ] unit-test
[ f ] [ { [ 1 ] [ f ] [ 3 ] } 0&& ] unit-test
[ f ] [ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] unit-test
[ f ] [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& ] unit-test
{ f } [ { [ 1 ] [ f ] [ 3 ] } 0&& ] unit-test
{ f } [ 3 { [ 0 > ] [ even? ] [ 2 + ] } 1&& ] unit-test
{ f } [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } 2&& ] unit-test
[ "factor" ] [ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| ] unit-test
[ 11 ] [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| ] unit-test
[ 30 ] [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| ] unit-test
[ f ] [ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] unit-test
{ "factor" } [ { [ 10 0 < ] [ f ] [ "factor" ] } 0|| ] unit-test
{ 11 } [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } 1|| ] unit-test
{ 30 } [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } 2|| ] unit-test
{ f } [ { [ 10 0 < ] [ f ] [ 0 1 = ] } 0|| ] unit-test
: compiled-&& ( a -- ? ) { [ 0 > ] [ even? ] [ 2 + ] } 1&& ;
[ f ] [ 3 compiled-&& ] unit-test
[ 4 ] [ 2 compiled-&& ] unit-test
{ f } [ 3 compiled-&& ] unit-test
{ 4 } [ 2 compiled-&& ] unit-test
: compiled-|| ( a b -- ? ) { [ + odd? ] [ + 100 > ] [ + ] } 2|| ;
[ 30 ] [ 10 20 compiled-|| ] unit-test
[ 2 ] [ 1 1 compiled-|| ] unit-test
{ 30 } [ 10 20 compiled-|| ] unit-test
{ 2 } [ 1 1 compiled-|| ] unit-test
! && and || should be row-polymorphic both when compiled and when interpreted
: row-&& ( -- ? )
f t { [ drop dup ] } 1&& nip ;
[ f ] [ row-&& ] unit-test
[ f ] [ \ row-&& def>> call ] unit-test
{ f } [ row-&& ] unit-test
{ f } [ \ row-&& def>> call ] unit-test
: row-|| ( -- ? )
f t { [ drop dup ] } 1|| nip ;
[ f ] [ row-|| ] unit-test
[ f ] [ \ row-|| def>> call ] unit-test
{ f } [ row-|| ] unit-test
{ f } [ \ row-|| def>> call ] unit-test

View File

@ -1,18 +1,18 @@
USING: kernel math tools.test combinators.short-circuit.smart ;
IN: combinators.short-circuit.smart.tests
[ t ] [ { [ 1 ] [ 2 ] [ 3 ] } && 3 = ] unit-test
[ t ] [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } && 5 = ] unit-test
[ t ] [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } && 30 = ] unit-test
{ t } [ { [ 1 ] [ 2 ] [ 3 ] } && 3 = ] unit-test
{ t } [ 3 { [ 0 > ] [ odd? ] [ 2 + ] } && 5 = ] unit-test
{ t } [ 10 20 { [ + 0 > ] [ - even? ] [ + ] } && 30 = ] unit-test
[ f ] [ { [ 1 ] [ f ] [ 3 ] } && 3 = ] unit-test
[ f ] [ 3 { [ 0 > ] [ even? ] [ 2 + ] } && ] unit-test
[ f ] [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } && 30 = ] unit-test
{ f } [ { [ 1 ] [ f ] [ 3 ] } && 3 = ] unit-test
{ f } [ 3 { [ 0 > ] [ even? ] [ 2 + ] } && ] unit-test
{ f } [ 10 20 { [ + 0 > ] [ - odd? ] [ + ] } && 30 = ] unit-test
[ t ] [ { [ 10 0 < ] [ f ] [ "factor" ] } || "factor" = ] unit-test
{ t } [ { [ 10 0 < ] [ f ] [ "factor" ] } || "factor" = ] unit-test
[ t ] [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } || 11 = ] unit-test
{ t } [ 10 { [ odd? ] [ 100 > ] [ 1 + ] } || 11 = ] unit-test
[ t ] [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } || 30 = ] unit-test
{ t } [ 10 20 { [ + odd? ] [ + 100 > ] [ + ] } || 30 = ] unit-test
[ f ] [ { [ 10 0 < ] [ f ] [ 0 1 = ] } || ] unit-test
{ f } [ { [ 10 0 < ] [ f ] [ 0 1 = ] } || ] unit-test

View File

@ -8,33 +8,33 @@ IN: combinators.smart.tests
10 [ 1 - ] [ 1 + ] bi ;
[ [ test-bi ] output>array ] must-infer
[ { 9 11 } ] [ [ test-bi ] output>array ] unit-test
{ { 9 11 } } [ [ test-bi ] output>array ] unit-test
[ { 9 11 } [ + ] input<sequence ] must-infer
[ 20 ] [ { 9 11 } [ + ] input<sequence ] unit-test
{ 20 } [ { 9 11 } [ + ] input<sequence ] unit-test
[ 6 ] [ [ 1 2 3 ] [ + ] reduce-outputs ] unit-test
{ 6 } [ [ 1 2 3 ] [ + ] reduce-outputs ] unit-test
[ [ 1 2 3 ] [ + ] reduce-outputs ] must-infer
[ 6 ] [ [ 1 2 3 ] sum-outputs ] unit-test
{ 6 } [ [ 1 2 3 ] sum-outputs ] unit-test
[ "ab" ]
{ "ab" }
[
[ "a" "b" ] "" append-outputs-as
] unit-test
[ "" ]
{ "" }
[
[ ] "" append-outputs-as
] unit-test
[ { } ]
{ { } }
[
[ ] append-outputs
] unit-test
[ B{ 1 2 3 } ]
{ B{ 1 2 3 } }
[
[ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
] unit-test
@ -45,9 +45,9 @@ IN: combinators.smart.tests
\ nested-smart-combo-test def>> must-infer
[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
{ { { 1 2 } { 3 4 } } } [ nested-smart-combo-test ] unit-test
[ 14 ] [ [ 1 2 3 ] [ sq ] [ + ] map-reduce-outputs ] unit-test
{ 14 } [ [ 1 2 3 ] [ sq ] [ + ] map-reduce-outputs ] unit-test
{ 2 3 } [ [ + ] preserving ] must-infer-as
@ -58,34 +58,34 @@ IN: combinators.smart.tests
: smart-if-test ( a b -- b )
[ < ] [ swap - ] [ - ] smart-if ;
[ 7 ] [ 10 3 smart-if-test ] unit-test
[ 16 ] [ 25 41 smart-if-test ] unit-test
{ 7 } [ 10 3 smart-if-test ] unit-test
{ 16 } [ 25 41 smart-if-test ] unit-test
[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 3 smart-apply ] unit-test
[ { 1 2 3 } { 4 5 6 } ] [ 1 2 3 4 5 6 [ 3array ] 2 smart-apply ] unit-test
{ { 1 2 } { 3 4 } { 5 6 } } [ 1 2 3 4 5 6 [ 2array ] 3 smart-apply ] unit-test
{ { 1 2 3 } { 4 5 6 } } [ 1 2 3 4 5 6 [ 3array ] 2 smart-apply ] unit-test
[ 4 ] [ 2 [ even? ] [ 2 + ] smart-when ] unit-test
[ 3 ] [ 3 [ even? ] [ 2 + ] smart-when ] unit-test
[ 4 ] [ 2 [ odd? ] [ 2 + ] smart-unless ] unit-test
[ 3 ] [ 3 [ odd? ] [ 2 + ] smart-unless ] unit-test
{ 4 } [ 2 [ even? ] [ 2 + ] smart-when ] unit-test
{ 3 } [ 3 [ even? ] [ 2 + ] smart-when ] unit-test
{ 4 } [ 2 [ odd? ] [ 2 + ] smart-unless ] unit-test
{ 3 } [ 3 [ odd? ] [ 2 + ] smart-unless ] unit-test
[ 4 ] [ 2 [ even? ] [ 2 + ] smart-when* ] unit-test
[ ] [ 3 [ even? ] [ 2 + ] smart-when* ] unit-test
[ 3 ] [ 2 [ odd? ] [ 3 ] smart-unless* ] unit-test
[ 3 ] [ 3 [ odd? ] [ 5 ] smart-unless* ] unit-test
{ 4 } [ 2 [ even? ] [ 2 + ] smart-when* ] unit-test
{ } [ 3 [ even? ] [ 2 + ] smart-when* ] unit-test
{ 3 } [ 2 [ odd? ] [ 3 ] smart-unless* ] unit-test
{ 3 } [ 3 [ odd? ] [ 5 ] smart-unless* ] unit-test
[ -1 ] [ 1 2 [ + odd? ] [ - ] smart-when* ] unit-test
[ ] [ 2 2 [ + odd? ] [ ] smart-unless* ] unit-test
{ -1 } [ 1 2 [ + odd? ] [ - ] smart-when* ] unit-test
{ } [ 2 2 [ + odd? ] [ ] smart-unless* ] unit-test
[ ( -- x ) ] [ [ [ ] [ call ] curry output>array ] infer ] unit-test
{ ( -- x ) } [ [ [ ] [ call ] curry output>array ] infer ] unit-test
:: map-reduce-test ( a b c -- d ) [ a b c ] [ a - ] [ b * + ] map-reduce-outputs ;
[ 10 ] [ 1 2 3 map-reduce-test ] unit-test
{ 10 } [ 1 2 3 map-reduce-test ] unit-test
[ ( x x -- x ) ] [ [ curry inputs ] infer ] unit-test
{ ( x x -- x ) } [ [ curry inputs ] infer ] unit-test
[ ( x -- x ) ] [ [ [ curry ] curry inputs ] infer ] unit-test
{ ( x -- x ) } [ [ [ curry ] curry inputs ] infer ] unit-test
{ 1 1 1 } [ 1 3 [ ] smart-with times ] unit-test
{ "BCD" } [ 1 "ABC" [ + ] smart-with map ] unit-test

View File

@ -10,13 +10,13 @@ IN: compiler.cfg.alias-analysis.tests
[ f >>insn# ] map ;
! Redundant load elimination
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##copy f 2 1 any-rep }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -25,14 +25,14 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Store-load forwarding
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##set-slot-imm f 1 0 1 0 }
T{ ##copy f 2 1 any-rep }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -42,14 +42,14 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Dead store elimination
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##peek f 2 D 2 }
T{ ##set-slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -59,7 +59,7 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -67,7 +67,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##peek f 3 D 3 }
T{ ##set-slot-imm f 3 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -80,12 +80,12 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Redundant store elimination
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -93,13 +93,13 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##copy f 2 1 any-rep }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -109,7 +109,7 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Not a redundant load
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -117,7 +117,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##set-slot-imm f 0 1 1 0 }
T{ ##slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -128,7 +128,7 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Not a redundant store
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -138,7 +138,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##slot-imm f 4 0 1 0 }
T{ ##set-slot-imm f 3 1 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -151,7 +151,7 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! There's a redundant load, but not a redundant store
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -163,7 +163,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##set-slot-imm f 3 0 1 0 }
T{ ##copy f 6 3 any-rep }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -180,7 +180,7 @@ IN: compiler.cfg.alias-analysis.tests
! Fresh allocations don't alias existing values
! Redundant load elimination
[
{
V{
T{ ##peek f 1 D 1 }
T{ ##peek f 2 D 2 }
@ -190,7 +190,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##set-slot-imm f 2 1 1 0 }
T{ ##copy f 5 3 any-rep }
}
] [
} [
V{
T{ ##peek f 1 D 1 }
T{ ##peek f 2 D 2 }
@ -203,7 +203,7 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Redundant store elimination
[
{
V{
T{ ##peek f 1 D 1 }
T{ ##peek f 2 D 2 }
@ -212,7 +212,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##slot-imm f 5 1 1 0 }
T{ ##set-slot-imm f 3 4 1 0 }
}
] [
} [
V{
T{ ##peek f 1 D 1 }
T{ ##peek f 2 D 2 }
@ -226,7 +226,7 @@ IN: compiler.cfg.alias-analysis.tests
! Storing a new alias class into another object means that heap-ac
! can now alias the new ac
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -239,7 +239,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##set-slot-imm f 1 5 1 0 }
T{ ##slot-imm f 6 4 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -255,13 +255,13 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Compares between objects which cannot alias are eliminated
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##allot f 1 16 array }
T{ ##load-reference f 2 f }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##allot f 1 16 array }
@ -270,7 +270,7 @@ IN: compiler.cfg.alias-analysis.tests
] unit-test
! Make sure that input to ##box-displaced-alien becomes heap-ac
[
{
V{
T{ ##allot f 1 16 byte-array }
T{ ##load-reference f 2 10 }
@ -278,7 +278,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
T{ ##compare f 6 5 1 cc= }
}
] [
} [
V{
T{ ##allot f 1 16 byte-array }
T{ ##load-reference f 2 10 }
@ -290,14 +290,14 @@ IN: compiler.cfg.alias-analysis.tests
! We can't make any assumptions about heap-ac between
! instructions which can call back into Factor code
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -306,7 +306,7 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -314,7 +314,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -324,7 +324,7 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -333,7 +333,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##set-slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -344,14 +344,14 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##set-slot-imm f 1 0 1 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -362,14 +362,14 @@ IN: compiler.cfg.alias-analysis.tests
! We can't eliminate stores on any alias class across a GC-ing
! instruction
[
{
V{
T{ ##allot f 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##copy f 2 1 any-rep }
}
] [
} [
V{
T{ ##allot f 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -378,7 +378,7 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##allot f 0 }
T{ ##peek f 1 D 1 }
@ -386,7 +386,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##copy f 2 1 any-rep }
}
] [
} [
V{
T{ ##allot f 0 }
T{ ##peek f 1 D 1 }
@ -396,7 +396,7 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##allot f 0 }
T{ ##peek f 1 D 1 }
@ -405,7 +405,7 @@ IN: compiler.cfg.alias-analysis.tests
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
T{ ##set-slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##allot f 0 }
T{ ##peek f 1 D 1 }
@ -416,13 +416,13 @@ IN: compiler.cfg.alias-analysis.tests
} test-alias-analysis
] unit-test
[
{
V{
T{ ##allot f 0 }
T{ ##slot-imm f 1 0 1 0 }
T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
}
] [
} [
V{
T{ ##allot f 0 }
T{ ##slot-imm f 1 0 1 0 }
@ -433,13 +433,13 @@ IN: compiler.cfg.alias-analysis.tests
! Make sure that gc-map-insns which are also vreg-insns are
! handled properly
[
{
V{
T{ ##allot f 0 }
T{ ##alien-indirect f { } { } { { 2 double-rep 0 } } { } 0 0 "free" }
T{ ##set-slot-imm f 2 0 1 0 }
}
] [
} [
V{
T{ ##allot f 0 }
T{ ##alien-indirect f { } { } { { 2 double-rep 0 } } { } 0 0 "free" }

View File

@ -30,7 +30,7 @@ V{ T{ ##branch } } 4 test-bb
test-diamond
[ ] [ test-branch-splitting ] unit-test
{ } [ test-branch-splitting ] unit-test
V{ T{ ##branch } } 0 test-bb
@ -50,7 +50,7 @@ V{ T{ ##branch } } 5 test-bb
2 { 3 4 } edges
[ ] [ test-branch-splitting ] unit-test
{ } [ test-branch-splitting ] unit-test
V{ T{ ##branch } } 0 test-bb
@ -68,7 +68,7 @@ V{ T{ ##branch } } 4 test-bb
2 4 edge
[ ] [ test-branch-splitting ] unit-test
{ } [ test-branch-splitting ] unit-test
V{ T{ ##branch } } 0 test-bb
@ -80,4 +80,4 @@ V{ T{ ##branch } } 2 test-bb
1 2 edge
[ ] [ test-branch-splitting ] unit-test
{ } [ test-branch-splitting ] unit-test

View File

@ -167,42 +167,42 @@ IN: compiler.cfg.builder.tests
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-builder
] each
[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
{ t } [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
[ f ] [ [ swap swap ] [ ##replace? ] contains-insn? ] unit-test
{ f } [ [ swap swap ] [ ##replace? ] contains-insn? ] unit-test
[ t ] [
{ t } [
[ { fixnum byte-array fixnum } declare set-alien-unsigned-1 ]
[ [ ##store-memory? ] [ ##store-memory-imm? ] bi or ] contains-insn?
] unit-test
[ t ] [
{ t } [
[ { fixnum byte-array fixnum } declare [ dup * dup * ] 2dip set-alien-unsigned-1 ]
[ [ ##store-memory? ] [ ##store-memory-imm? ] bi or ] contains-insn?
] unit-test
[ f ] [
{ f } [
[ { byte-array fixnum } declare set-alien-unsigned-1 ]
[ [ ##store-memory? ] [ ##store-memory-imm? ] bi or ] contains-insn?
] unit-test
[ t t ] [
{ t t } [
[ { byte-array fixnum } declare alien-cell ]
[ [ [ ##load-memory? ] [ ##load-memory-imm? ] bi or ] contains-insn? ]
[ [ ##box-alien? ] contains-insn? ]
bi
] unit-test
[ f ] [
{ f } [
[ { byte-array integer } declare alien-cell ]
[ [ ##load-memory? ] [ ##load-memory-imm? ] bi or ] contains-insn?
] unit-test
[ f ] [
{ f } [
[ 1000 [ ] times ] [ ##peek? ] contains-insn?
] unit-test
[ f t ] [
{ f t } [
[ { fixnum alien } declare <displaced-alien> 0 alien-cell ]
[ [ ##unbox-any-c-ptr? ] contains-insn? ]
[ [ ##unbox-alien? ] contains-insn? ] bi
@ -225,13 +225,13 @@ IN: compiler.cfg.builder.tests
] when
! Regression. Make sure everything is inlined correctly
[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
{ f } [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
! Regression. Make sure branch splitting works.
[ 2 ] [ [ 1 2 ? ] [ ##return? ] count-insns ] unit-test
{ 2 } [ [ 1 2 ? ] [ ##return? ] count-insns ] unit-test
! Make sure fast union predicates don't have conditionals.
[ f ] [
{ f } [
[ tag 1 swap fixnum-shift-fast ]
[ ##compare-integer-imm-branch? ] contains-insn?
] unit-test

View File

@ -53,16 +53,16 @@ V{
3 4 edge
4 5 edge
[ ] [ test-copy-propagation ] unit-test
{ } [ test-copy-propagation ] unit-test
[
{
V{
T{ ##replace f 0 D 0 }
T{ ##replace f 4 D 1 }
T{ ##replace f 4 D 2 }
T{ ##branch }
}
] [ 5 get instructions>> ] unit-test
} [ 5 get instructions>> ] unit-test
! Test optimistic assumption
V{
@ -96,11 +96,11 @@ V{
2 { 2 3 } edges
3 4 edge
[ ] [ test-copy-propagation ] unit-test
{ } [ test-copy-propagation ] unit-test
[
{
V{
T{ ##replace f 0 D 1 }
T{ ##branch }
}
] [ 3 get instructions>> ] unit-test
} [ 3 get instructions>> ] unit-test

View File

@ -7,61 +7,61 @@ IN: compiler.cfg.dce.tests
: test-dce ( insns -- insns' )
insns>cfg dup eliminate-dead-code entry>> instructions>> ;
[ V{
{ V{
T{ ##load-integer { dst 1 } { val 8 } }
T{ ##load-integer { dst 2 } { val 16 } }
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
T{ ##replace { src 3 } { loc D 0 } }
} ] [ V{
} } [ V{
T{ ##load-integer { dst 1 } { val 8 } }
T{ ##load-integer { dst 2 } { val 16 } }
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
T{ ##replace { src 3 } { loc D 0 } }
} test-dce ] unit-test
[ V{ } ] [ V{
{ V{ } } [ V{
T{ ##load-integer { dst 1 } { val 8 } }
T{ ##load-integer { dst 2 } { val 16 } }
T{ ##add { dst 3 } { src1 1 } { src2 2 } }
} test-dce ] unit-test
[ V{ } ] [ V{
{ V{ } } [ V{
T{ ##load-integer { dst 3 } { val 8 } }
T{ ##allot { dst 1 } { temp 2 } }
} test-dce ] unit-test
[ V{ } ] [ V{
{ V{ } } [ V{
T{ ##load-integer { dst 3 } { val 8 } }
T{ ##allot { dst 1 } { temp 2 } }
T{ ##set-slot-imm { obj 1 } { src 3 } }
} test-dce ] unit-test
[ V{
{ V{
T{ ##load-integer { dst 3 } { val 8 } }
T{ ##allot { dst 1 } { temp 2 } }
T{ ##set-slot-imm { obj 1 } { src 3 } }
T{ ##replace { src 1 } { loc D 0 } }
} ] [ V{
} } [ V{
T{ ##load-integer { dst 3 } { val 8 } }
T{ ##allot { dst 1 } { temp 2 } }
T{ ##set-slot-imm { obj 1 } { src 3 } }
T{ ##replace { src 1 } { loc D 0 } }
} test-dce ] unit-test
[ V{
{ V{
T{ ##allot { dst 1 } { temp 2 } }
T{ ##replace { src 1 } { loc D 0 } }
} ] [ V{
} } [ V{
T{ ##allot { dst 1 } { temp 2 } }
T{ ##replace { src 1 } { loc D 0 } }
} test-dce ] unit-test
[ V{
{ V{
T{ ##allot { dst 1 } { temp 2 } }
T{ ##replace { src 1 } { loc D 0 } }
T{ ##load-integer { dst 3 } { val 8 } }
T{ ##set-slot-imm { obj 1 } { src 3 } }
} ] [ V{
} } [ V{
T{ ##allot { dst 1 } { temp 2 } }
T{ ##replace { src 1 } { loc D 0 } }
T{ ##load-integer { dst 3 } { val 8 } }

View File

@ -37,4 +37,4 @@ V{
5 6 edge
1 get block>cfg 0 set
[ ] [ 0 get compute-defs ] unit-test
{ } [ 0 get compute-defs ] unit-test

View File

@ -21,22 +21,22 @@ V{ } 5 test-bb
3 4 edge
4 5 edge
[ ] [ test-dominance ] unit-test
{ } [ test-dominance ] unit-test
[ t ] [ 0 get dom-parent 0 get eq? ] unit-test
[ t ] [ 1 get dom-parent 0 get eq? ] unit-test
[ t ] [ 2 get dom-parent 0 get eq? ] unit-test
[ t ] [ 4 get dom-parent 0 get eq? ] unit-test
[ t ] [ 3 get dom-parent 1 get eq? ] unit-test
[ t ] [ 5 get dom-parent 4 get eq? ] unit-test
{ t } [ 0 get dom-parent 0 get eq? ] unit-test
{ t } [ 1 get dom-parent 0 get eq? ] unit-test
{ t } [ 2 get dom-parent 0 get eq? ] unit-test
{ t } [ 4 get dom-parent 0 get eq? ] unit-test
{ t } [ 3 get dom-parent 1 get eq? ] unit-test
{ t } [ 5 get dom-parent 4 get eq? ] unit-test
[ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
{ t } [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
[ t ] [ 0 get 3 get dominates? ] unit-test
[ f ] [ 3 get 4 get dominates? ] unit-test
[ f ] [ 1 get 4 get dominates? ] unit-test
[ t ] [ 4 get 5 get dominates? ] unit-test
[ f ] [ 1 get 5 get dominates? ] unit-test
{ t } [ 0 get 3 get dominates? ] unit-test
{ f } [ 3 get 4 get dominates? ] unit-test
{ f } [ 1 get 4 get dominates? ] unit-test
{ t } [ 4 get 5 get dominates? ] unit-test
{ f } [ 1 get 5 get dominates? ] unit-test
! Example from the paper
V{ } 0 test-bb
@ -51,9 +51,9 @@ V{ } 4 test-bb
3 4 edge
4 3 edge
[ ] [ test-dominance ] unit-test
{ } [ test-dominance ] unit-test
[ t ] [ 0 4 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
{ t } [ 0 4 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
! The other example from the paper
V{ } 0 test-bb
@ -70,9 +70,9 @@ V{ } 5 test-bb
4 { 5 3 } edges
3 4 edge
[ ] [ test-dominance ] unit-test
{ } [ test-dominance ] unit-test
[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
{ t } [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
: non-det-test ( -- cfg )
9 iota [ V{ } clone over insns>block ] { } map>assoc dup

View File

@ -59,7 +59,7 @@ IN: compiler.cfg.gc-checks.tests
] cfg-unit-test
! gc-check-offsets
[ { } ] [
{ { } } [
V{
T{ ##inc }
T{ ##peek }
@ -68,7 +68,7 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { } ] [
{ { } } [
V{
T{ ##inc }
T{ ##peek }
@ -78,7 +78,7 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { 0 } ] [
{ { 0 } } [
V{
T{ ##inc }
T{ ##peek }
@ -89,7 +89,7 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { 0 } ] [
{ { 0 } } [
V{
T{ ##inc }
T{ ##peek }
@ -100,7 +100,7 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { 0 4 } ] [
{ { 0 4 } } [
V{
T{ ##inc }
T{ ##peek }
@ -113,7 +113,7 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { 3 } ] [
{ { 3 } } [
V{
T{ ##inc }
T{ ##peek }
@ -124,15 +124,15 @@ IN: compiler.cfg.gc-checks.tests
} gc-check-offsets
] unit-test
[ { { "a" } } ] [ { "a" } { } split-instructions ] unit-test
{ { { "a" } } } [ { "a" } { } split-instructions ] unit-test
[ { { } { "a" } } ] [ { "a" } { 0 } split-instructions ] unit-test
{ { { } { "a" } } } [ { "a" } { 0 } split-instructions ] unit-test
[ { { "a" } { } } ] [ { "a" } { 1 } split-instructions ] unit-test
{ { { "a" } { } } } [ { "a" } { 1 } split-instructions ] unit-test
[ { { "a" } { "b" } } ] [ { "a" "b" } { 1 } split-instructions ] unit-test
{ { { "a" } { "b" } } } [ { "a" "b" } { 1 } split-instructions ] unit-test
[ { { } { "a" } { "b" "c" } } ] [ { "a" "b" "c" } { 0 1 } split-instructions ] unit-test
{ { { } { "a" } { "b" "c" } } } [ { "a" "b" "c" } { 0 1 } split-instructions ] unit-test
: test-gc-checks ( -- )
H{ } clone representations set
@ -149,9 +149,9 @@ V{
0 1 edge
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
[ t ] [ cfg get blocks-with-gc 1 get 1array sequence= ] unit-test
{ t } [ cfg get blocks-with-gc 1 get 1array sequence= ] unit-test
: gc-check? ( bb -- ? )
instructions>>
@ -167,7 +167,7 @@ V{
T{ ##branch }
} = ;
[ t ] [ <gc-call> gc-call? ] unit-test
{ t } [ <gc-call> gc-call? ] unit-test
reset-vreg-counter
@ -207,33 +207,33 @@ V{
3 4 edge
4 5 edge
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
H{
{ 2 tagged-rep }
} representations set
[ ] [ cfg get insert-gc-checks ] unit-test
{ } [ cfg get insert-gc-checks ] unit-test
[ ] [ 1 get successors>> first successors>> first 2 set ] unit-test
{ } [ 1 get successors>> first successors>> first 2 set ] unit-test
[ 2 ] [ 2 get predecessors>> length ] unit-test
{ 2 } [ 2 get predecessors>> length ] unit-test
[ t ] [ 1 get successors>> first gc-check? ] unit-test
{ t } [ 1 get successors>> first gc-check? ] unit-test
[ 64 ] [ 1 get successors>> first instructions>> first size>> ] unit-test
{ 64 } [ 1 get successors>> first instructions>> first size>> ] unit-test
[ t ] [ 2 get predecessors>> first gc-check? ] unit-test
{ t } [ 2 get predecessors>> first gc-check? ] unit-test
[
{
V{
T{ ##call-gc f T{ gc-map } }
T{ ##branch }
}
] [ 2 get predecessors>> second instructions>> ] unit-test
} [ 2 get predecessors>> second instructions>> ] unit-test
! Don't forget to invalidate RPO after inserting basic blocks!
[ 8 ] [ cfg get reverse-post-order length ] unit-test
{ 8 } [ cfg get reverse-post-order length ] unit-test
! Do the right thing with ##phi instructions
V{
@ -260,7 +260,7 @@ V{
1 3 edge
2 3 edge
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
H{
{ 1 tagged-rep }
@ -268,10 +268,10 @@ H{
{ 3 tagged-rep }
} representations set
[ ] [ cfg get insert-gc-checks ] unit-test
[ ] [ 1 get successors>> first successors>> first 3 set ] unit-test
[ t ] [ 2 get successors>> first instructions>> first ##phi? ] unit-test
[ 2 ] [ 3 get instructions>> length ] unit-test
{ } [ cfg get insert-gc-checks ] unit-test
{ } [ 1 get successors>> first successors>> first 3 set ] unit-test
{ t } [ 2 get successors>> first instructions>> first ##phi? ] unit-test
{ 2 } [ 3 get instructions>> length ] unit-test
! GC check in a block that is its own successor
V{
@ -292,23 +292,23 @@ V{
0 1 edge
1 { 1 2 } edges
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
[ ] [ cfg get insert-gc-checks ] unit-test
{ } [ cfg get insert-gc-checks ] unit-test
[ ] [
{ } [
0 get successors>> first predecessors>>
[ first 0 get assert= ]
[ second 1 get [ instructions>> ] bi@ assert= ] bi
] unit-test
[ ] [
{ } [
0 get successors>> first successors>>
[ first 1 get [ instructions>> ] bi@ assert= ]
[ second gc-call? t assert= ] bi
] unit-test
[ ] [
{ } [
2 get predecessors>> first predecessors>>
[ first gc-check? t assert= ]
[ second gc-call? t assert= ] bi
@ -338,17 +338,17 @@ V{
2 vreg-counter set-global
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
[ ] [ cfg get insert-gc-checks ] unit-test
{ } [ cfg get insert-gc-checks ] unit-test
! The GC check should come after the alien-invoke
[
{
V{
T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
T{ ##check-nursery-branch f 64 cc<= 3 4 }
}
] [ 0 get successors>> first instructions>> ] unit-test
} [ 0 get successors>> first instructions>> ] unit-test
! call then allot then call then allot
V{
@ -374,40 +374,40 @@ V{
2 vreg-counter set-global
[ ] [ test-gc-checks ] unit-test
{ } [ test-gc-checks ] unit-test
[ ] [ cfg get insert-gc-checks ] unit-test
{ } [ cfg get insert-gc-checks ] unit-test
[
{
V{
T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
T{ ##check-nursery-branch f 64 cc<= 3 4 }
}
] [
} [
0 get
successors>> first
instructions>>
] unit-test
[
{
V{
T{ ##allot f 1 64 byte-array }
T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
T{ ##check-nursery-branch f 64 cc<= 5 6 }
}
] [
} [
0 get
successors>> first
successors>> first
instructions>>
] unit-test
[
{
V{
T{ ##allot f 2 64 byte-array }
T{ ##branch }
}
] [
} [
0 get
successors>> first
successors>> first

View File

@ -118,31 +118,31 @@ M: simple-ops-cpu %gather-vector-4-reps { int-4-rep uint-4-rep float-4-rep } ;
M: simple-ops-cpu %alien-vector-reps all-reps ;
! v+
[ { ##add-vector } ]
{ { ##add-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-v+ ] test-emit ]
unit-test
! v-
[ { ##sub-vector } ]
{ { ##sub-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-v- ] test-emit ]
unit-test
! vneg
[ { ##load-reference ##sub-vector } ]
{ { ##load-reference ##sub-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vneg ] test-emit ]
unit-test
[ { ##zero-vector ##sub-vector } ]
{ { ##zero-vector ##sub-vector } }
[ simple-ops-cpu int-4-rep [ emit-simd-vneg ] test-emit ]
unit-test
! v*
[ { ##mul-vector } ]
{ { ##mul-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-v* ] test-emit ]
unit-test
! v/
[ { ##div-vector } ]
{ { ##div-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-v/ ] test-emit ]
unit-test
@ -150,15 +150,15 @@ TUPLE: addsub-cpu < simple-ops-cpu ;
M: addsub-cpu %add-sub-vector-reps { int-4-rep float-4-rep } ;
! v+-
[ { ##add-sub-vector } ]
{ { ##add-sub-vector } }
[ addsub-cpu float-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
[ { ##load-reference ##xor-vector ##add-vector } ]
{ { ##load-reference ##xor-vector ##add-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
[ { ##load-reference ##xor-vector ##sub-vector ##add-vector } ]
{ { ##load-reference ##xor-vector ##sub-vector ##add-vector } }
[ simple-ops-cpu int-4-rep [ emit-simd-v+- ] test-emit ]
unit-test
@ -168,41 +168,41 @@ M: saturating-cpu %saturated-sub-vector-reps { int-4-rep } ;
M: saturating-cpu %saturated-mul-vector-reps { int-4-rep } ;
! vs+
[ { ##add-vector } ]
{ { ##add-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vs+ ] test-emit ]
unit-test
[ { ##add-vector } ]
{ { ##add-vector } }
[ saturating-cpu float-4-rep [ emit-simd-vs+ ] test-emit ]
unit-test
[ { ##saturated-add-vector } ]
{ { ##saturated-add-vector } }
[ saturating-cpu int-4-rep [ emit-simd-vs+ ] test-emit ]
unit-test
! vs-
[ { ##sub-vector } ]
{ { ##sub-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vs- ] test-emit ]
unit-test
[ { ##sub-vector } ]
{ { ##sub-vector } }
[ saturating-cpu float-4-rep [ emit-simd-vs- ] test-emit ]
unit-test
[ { ##saturated-sub-vector } ]
{ { ##saturated-sub-vector } }
[ saturating-cpu int-4-rep [ emit-simd-vs- ] test-emit ]
unit-test
! vs*
[ { ##mul-vector } ]
{ { ##mul-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vs* ] test-emit ]
unit-test
[ { ##mul-vector } ]
{ { ##mul-vector } }
[ saturating-cpu float-4-rep [ emit-simd-vs* ] test-emit ]
unit-test
[ { ##saturated-mul-vector } ]
{ { ##saturated-mul-vector } }
[ saturating-cpu int-4-rep [ emit-simd-vs* ] test-emit ]
unit-test
@ -217,20 +217,20 @@ M: compare-cpu %compare-vector-reps drop signed-reps ;
M: compare-cpu %compare-vector-ccs nip f 2array 1array f ;
! vmin
[ { ##min-vector } ]
{ { ##min-vector } }
[ minmax-cpu float-4-rep [ emit-simd-vmin ] test-emit ]
unit-test
[ { ##compare-vector ##and-vector ##andn-vector ##or-vector } ]
{ { ##compare-vector ##and-vector ##andn-vector ##or-vector } }
[ compare-cpu float-4-rep [ emit-simd-vmin ] test-emit ]
unit-test
! vmax
[ { ##max-vector } ]
{ { ##max-vector } }
[ minmax-cpu float-4-rep [ emit-simd-vmax ] test-emit ]
unit-test
[ { ##compare-vector ##and-vector ##andn-vector ##or-vector } ]
{ { ##compare-vector ##and-vector ##andn-vector ##or-vector } }
[ compare-cpu float-4-rep [ emit-simd-vmax ] test-emit ]
unit-test
@ -243,50 +243,50 @@ M: horizontal-cpu %unpack-vector-head-reps signed-reps ;
M: horizontal-cpu %unpack-vector-tail-reps signed-reps ;
! v.
[ { ##dot-vector } ]
{ { ##dot-vector } }
[ dot-cpu float-4-rep [ emit-simd-v. ] test-emit ]
unit-test
[ { ##mul-vector ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } ]
{ { ##mul-vector ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } }
[ horizontal-cpu float-4-rep [ emit-simd-v. ] test-emit ]
unit-test
[ {
{ {
##mul-vector
##merge-vector-head ##merge-vector-tail ##add-vector
##merge-vector-head ##merge-vector-tail ##add-vector
##vector>scalar
} ]
} }
[ simple-ops-cpu float-4-rep [ emit-simd-v. ] test-emit ]
unit-test
! vsqrt
[ { ##sqrt-vector } ]
{ { ##sqrt-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vsqrt ] test-emit ]
unit-test
! sum
[ { ##horizontal-add-vector ##vector>scalar } ]
{ { ##horizontal-add-vector ##vector>scalar } }
[ horizontal-cpu double-2-rep [ emit-simd-sum ] test-emit ]
unit-test
[ { ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } ]
{ { ##horizontal-add-vector ##horizontal-add-vector ##vector>scalar } }
[ horizontal-cpu float-4-rep [ emit-simd-sum ] test-emit ]
unit-test
[ {
{ {
##unpack-vector-head ##unpack-vector-tail ##add-vector
##horizontal-add-vector ##horizontal-add-vector
##vector>scalar
} ]
} }
[ horizontal-cpu short-8-rep [ emit-simd-sum ] test-emit ]
unit-test
[ {
{ {
##unpack-vector-head ##unpack-vector-tail ##add-vector
##horizontal-add-vector ##horizontal-add-vector ##horizontal-add-vector
##vector>scalar
} ]
} }
[ horizontal-cpu char-16-rep [ emit-simd-sum ] test-emit ]
unit-test
@ -294,39 +294,39 @@ TUPLE: abs-cpu < simple-ops-cpu ;
M: abs-cpu %abs-vector-reps signed-reps ;
! vabs
[ { } ]
{ { } }
[ simple-ops-cpu uint-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
[ { ##abs-vector } ]
{ { ##abs-vector } }
[ abs-cpu float-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
[ { ##load-reference ##andn-vector } ]
{ { ##load-reference ##andn-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
[ { ##zero-vector ##sub-vector ##compare-vector ##and-vector ##andn-vector ##or-vector } ]
{ { ##zero-vector ##sub-vector ##compare-vector ##and-vector ##andn-vector ##or-vector } }
[ compare-cpu int-4-rep [ emit-simd-vabs ] test-emit ]
unit-test
! vand
[ { ##and-vector } ]
{ { ##and-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vand ] test-emit ]
unit-test
! vandn
[ { ##andn-vector } ]
{ { ##andn-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vandn ] test-emit ]
unit-test
! vor
[ { ##or-vector } ]
{ { ##or-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vor ] test-emit ]
unit-test
! vxor
[ { ##xor-vector } ]
{ { ##xor-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vxor ] test-emit ]
unit-test
@ -334,11 +334,11 @@ TUPLE: not-cpu < simple-ops-cpu ;
M: not-cpu %not-vector-reps signed-reps ;
! vnot
[ { ##not-vector } ]
{ { ##not-vector } }
[ not-cpu float-4-rep [ emit-simd-vnot ] test-emit ]
unit-test
[ { ##fill-vector ##xor-vector } ]
{ { ##fill-vector ##xor-vector } }
[ simple-ops-cpu float-4-rep [ emit-simd-vnot ] test-emit ]
unit-test
@ -355,30 +355,30 @@ M: horizontal-shift-cpu %horizontal-shl-vector-imm-reps signed-reps ;
M: horizontal-shift-cpu %horizontal-shr-vector-imm-reps signed-reps ;
! vlshift
[ { ##shl-vector-imm } ]
{ { ##shl-vector-imm } }
[ shift-imm-cpu 2 int-4-rep [ emit-simd-vlshift ] test-emit-literal ]
unit-test
[ { ##shl-vector } ]
{ { ##shl-vector } }
[ shift-cpu int-4-rep [ emit-simd-vlshift ] test-emit ]
unit-test
! vrshift
[ { ##shr-vector-imm } ]
{ { ##shr-vector-imm } }
[ shift-imm-cpu 2 int-4-rep [ emit-simd-vrshift ] test-emit-literal ]
unit-test
[ { ##shr-vector } ]
{ { ##shr-vector } }
[ shift-cpu int-4-rep [ emit-simd-vrshift ] test-emit ]
unit-test
! hlshift
[ { ##horizontal-shl-vector-imm } ]
{ { ##horizontal-shl-vector-imm } }
[ horizontal-shift-cpu 2 int-4-rep [ emit-simd-hlshift ] test-emit-literal ]
unit-test
! hrshift
[ { ##horizontal-shr-vector-imm } ]
{ { ##horizontal-shr-vector-imm } }
[ horizontal-shift-cpu 2 int-4-rep [ emit-simd-hrshift ] test-emit-literal ]
unit-test
@ -389,44 +389,44 @@ TUPLE: shuffle-cpu < simple-ops-cpu ;
M: shuffle-cpu %shuffle-vector-reps signed-reps ;
! vshuffle-elements
[ { ##load-reference ##shuffle-vector } ]
{ { ##load-reference ##shuffle-vector } }
[ shuffle-cpu { 0 1 2 3 } int-4-rep [ emit-simd-vshuffle-elements ] test-emit-literal ]
unit-test
[ { ##shuffle-vector-imm } ]
{ { ##shuffle-vector-imm } }
[ shuffle-imm-cpu { 0 1 2 3 } int-4-rep [ emit-simd-vshuffle-elements ] test-emit-literal ]
unit-test
! vshuffle-bytes
[ { ##shuffle-vector } ]
{ { ##shuffle-vector } }
[ shuffle-cpu int-4-rep [ emit-simd-vshuffle-bytes ] test-emit ]
unit-test
! vmerge-head
[ { ##merge-vector-head } ]
{ { ##merge-vector-head } }
[ simple-ops-cpu float-4-rep [ emit-simd-vmerge-head ] test-emit ]
unit-test
! vmerge-tail
[ { ##merge-vector-tail } ]
{ { ##merge-vector-tail } }
[ simple-ops-cpu float-4-rep [ emit-simd-vmerge-tail ] test-emit ]
unit-test
! v<= etc.
[ { ##compare-vector } ]
{ { ##compare-vector } }
[ compare-cpu int-4-rep [ emit-simd-v<= ] test-emit ]
unit-test
[ { ##min-vector ##compare-vector } ]
{ { ##min-vector ##compare-vector } }
[ minmax-cpu int-4-rep [ emit-simd-v<= ] test-emit ]
unit-test
[ { ##load-reference ##xor-vector ##xor-vector ##compare-vector } ]
{ { ##load-reference ##xor-vector ##xor-vector ##compare-vector } }
[ compare-cpu uint-4-rep [ emit-simd-v<= ] test-emit ]
unit-test
! vany? etc.
[ { ##test-vector } ]
{ { ##test-vector } }
[ simple-ops-cpu int-4-rep [ emit-simd-vany? ] test-emit ]
unit-test
@ -435,30 +435,30 @@ M: convert-cpu %integer>float-vector-reps { int-4-rep } ;
M: convert-cpu %float>integer-vector-reps { float-4-rep } ;
! v>float
[ { } ]
{ { } }
[ convert-cpu float-4-rep [ emit-simd-v>float ] test-emit ]
unit-test
[ { ##integer>float-vector } ]
{ { ##integer>float-vector } }
[ convert-cpu int-4-rep [ emit-simd-v>float ] test-emit ]
unit-test
! v>integer
[ { } ]
{ { } }
[ convert-cpu int-4-rep [ emit-simd-v>integer ] test-emit ]
unit-test
[ { ##float>integer-vector } ]
{ { ##float>integer-vector } }
[ convert-cpu float-4-rep [ emit-simd-v>integer ] test-emit ]
unit-test
! vpack-signed
[ { ##signed-pack-vector } ]
{ { ##signed-pack-vector } }
[ simple-ops-cpu int-4-rep [ emit-simd-vpack-signed ] test-emit ]
unit-test
! vpack-unsigned
[ { ##unsigned-pack-vector } ]
{ { ##unsigned-pack-vector } }
[ simple-ops-cpu int-4-rep [ emit-simd-vpack-unsigned ] test-emit ]
unit-test
@ -468,60 +468,60 @@ TUPLE: unpack-cpu < unpack-head-cpu ;
M: unpack-cpu %unpack-vector-tail-reps all-reps ;
! vunpack-head
[ { ##unpack-vector-head } ]
{ { ##unpack-vector-head } }
[ unpack-head-cpu int-4-rep [ emit-simd-vunpack-head ] test-emit ]
unit-test
[ { ##zero-vector ##merge-vector-head } ]
{ { ##zero-vector ##merge-vector-head } }
[ simple-ops-cpu uint-4-rep [ emit-simd-vunpack-head ] test-emit ]
unit-test
[ { ##merge-vector-head ##shr-vector-imm } ]
{ { ##merge-vector-head ##shr-vector-imm } }
[ shift-imm-cpu int-4-rep [ emit-simd-vunpack-head ] test-emit ]
unit-test
[ { ##zero-vector ##compare-vector ##merge-vector-head } ]
{ { ##zero-vector ##compare-vector ##merge-vector-head } }
[ compare-cpu int-4-rep [ emit-simd-vunpack-head ] test-emit ]
unit-test
! vunpack-tail
[ { ##unpack-vector-tail } ]
{ { ##unpack-vector-tail } }
[ unpack-cpu int-4-rep [ emit-simd-vunpack-tail ] test-emit ]
unit-test
[ { ##tail>head-vector ##unpack-vector-head } ]
{ { ##tail>head-vector ##unpack-vector-head } }
[ unpack-head-cpu int-4-rep [ emit-simd-vunpack-tail ] test-emit ]
unit-test
[ { ##zero-vector ##merge-vector-tail } ]
{ { ##zero-vector ##merge-vector-tail } }
[ simple-ops-cpu uint-4-rep [ emit-simd-vunpack-tail ] test-emit ]
unit-test
[ { ##merge-vector-tail ##shr-vector-imm } ]
{ { ##merge-vector-tail ##shr-vector-imm } }
[ shift-imm-cpu int-4-rep [ emit-simd-vunpack-tail ] test-emit ]
unit-test
[ { ##zero-vector ##compare-vector ##merge-vector-tail } ]
{ { ##zero-vector ##compare-vector ##merge-vector-tail } }
[ compare-cpu int-4-rep [ emit-simd-vunpack-tail ] test-emit ]
unit-test
! with
[ { ##scalar>vector ##shuffle-vector-imm } ]
{ { ##scalar>vector ##shuffle-vector-imm } }
[ shuffle-imm-cpu float-4-rep [ emit-simd-with ] test-emit ]
unit-test
! gather-2
[ { ##gather-vector-2 } ]
{ { ##gather-vector-2 } }
[ simple-ops-cpu double-2-rep [ emit-simd-gather-2 ] test-emit ]
unit-test
! gather-4
[ { ##gather-vector-4 } ]
{ { ##gather-vector-4 } }
[ simple-ops-cpu float-4-rep [ emit-simd-gather-4 ] test-emit ]
unit-test
! select
[ { ##shuffle-vector-imm ##vector>scalar } ]
{ { ##shuffle-vector-imm ##vector>scalar } }
[ shuffle-imm-cpu 1 float-4-rep [ emit-simd-select ] test-emit-literal ]
unit-test

View File

@ -42,7 +42,7 @@ V{
[ cfg set ] [ number-instructions ] [ compute-live-intervals ] tri
drop ;
[ ] [
{ } [
H{
{ 1 int-rep }
} representations set
@ -52,45 +52,45 @@ V{
test-live-intervals
] unit-test
[ 0 0 ] [
{ 0 0 } [
1 live-intervals get at [ start>> ] [ end>> ] bi
] unit-test
! Live range and interval splitting
[
{
{ T{ live-range f 1 10 } T{ live-range f 15 15 } }
{ T{ live-range f 16 20 } }
] [
} [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 15 split-ranges
] unit-test
[
{
{ T{ live-range f 1 10 } T{ live-range f 15 16 } }
{ T{ live-range f 17 20 } }
] [
} [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 16 split-ranges
] unit-test
[
{
{ T{ live-range f 1 10 } }
{ T{ live-range f 15 20 } }
] [
} [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
} 12 split-ranges
] unit-test
[
{
{ T{ live-range f 1 10 } T{ live-range f 15 17 } }
{ T{ live-range f 18 20 } }
] [
} [
{
T{ live-range f 1 10 }
T{ live-range f 15 20 }
@ -101,10 +101,10 @@ V{
{ T{ live-range f 1 10 } } 0 split-ranges
] must-fail
[
{
{ T{ live-range f 0 0 } }
{ T{ live-range f 1 5 } }
] [
} [
{ T{ live-range f 0 5 } } 0 split-ranges
] unit-test
@ -120,7 +120,7 @@ H{
: clean-up-split ( a b -- a b )
[ dup [ [ >vector ] change-uses [ >vector ] change-ranges ] when ] bi@ ;
[
{
T{ live-interval-state
{ vreg 1 }
{ reg-class float-regs }
@ -141,7 +141,7 @@ H{
{ reload-from T{ spill-slot f 0 } }
{ reload-rep float-rep }
}
] [
} [
T{ live-interval-state
{ vreg 1 }
{ reg-class float-regs }
@ -153,7 +153,7 @@ H{
clean-up-split
] unit-test
[
{
f
T{ live-interval-state
{ vreg 2 }
@ -165,7 +165,7 @@ H{
{ reload-from T{ spill-slot f 4 } }
{ reload-rep float-rep }
}
] [
} [
T{ live-interval-state
{ vreg 2 }
{ reg-class float-regs }
@ -177,7 +177,7 @@ H{
clean-up-split
] unit-test
[
{
T{ live-interval-state
{ vreg 3 }
{ reg-class float-regs }
@ -189,7 +189,7 @@ H{
{ spill-rep float-rep }
}
f
] [
} [
T{ live-interval-state
{ vreg 3 }
{ reg-class float-regs }
@ -201,7 +201,7 @@ H{
clean-up-split
] unit-test
[
{
T{ live-interval-state
{ vreg 4 }
{ reg-class float-regs }
@ -222,7 +222,7 @@ H{
{ reload-from T{ spill-slot f 12 } }
{ reload-rep float-rep }
}
] [
} [
T{ live-interval-state
{ vreg 4 }
{ reg-class float-regs }
@ -235,7 +235,7 @@ H{
] unit-test
! Don't insert reload if first usage is a def
[
{
T{ live-interval-state
{ vreg 5 }
{ reg-class float-regs }
@ -254,7 +254,7 @@ H{
{ uses V{ T{ vreg-use f 20 float-rep f } T{ vreg-use f 30 f float-rep } } }
{ ranges V{ T{ live-range f 20 30 } } }
}
] [
} [
T{ live-interval-state
{ vreg 5 }
{ reg-class float-regs }
@ -267,7 +267,7 @@ H{
] unit-test
! Multiple representations
[
{
T{ live-interval-state
{ vreg 6 }
{ reg-class float-regs }
@ -288,7 +288,7 @@ H{
{ reload-from T{ spill-slot f 24 } }
{ reload-rep double-rep }
}
] [
} [
T{ live-interval-state
{ vreg 6 }
{ reg-class float-regs }
@ -300,7 +300,7 @@ H{
clean-up-split
] unit-test
[
{
f
T{ live-interval-state
{ vreg 7 }
@ -310,7 +310,7 @@ H{
{ uses V{ T{ vreg-use f 8 int-rep } } }
{ reg-class int-regs }
}
] [
} [
T{ live-interval-state
{ vreg 7 }
{ start 4 }
@ -323,7 +323,7 @@ H{
] unit-test
! trim-before-ranges, trim-after-ranges
[
{
T{ live-interval-state
{ vreg 8 }
{ start 0 }
@ -344,7 +344,7 @@ H{
{ reload-from T{ spill-slot f 32 } }
{ reload-rep int-rep }
}
] [
} [
T{ live-interval-state
{ vreg 8 }
{ start 0 }
@ -362,12 +362,12 @@ H{
{ 3 int-rep }
} representations set
[
{
{
3
10
}
] [
} [
H{
{ int-regs
V{
@ -409,12 +409,12 @@ H{
spill-status
] unit-test
[
{
{
1
1/0.
}
] [
} [
H{
{ int-regs
V{
@ -450,7 +450,7 @@ H{
H{ { 1 int-rep } { 2 int-rep } } representations set
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -465,7 +465,7 @@ H{ { 1 int-rep } { 2 int-rep } } representations set
check-linear-scan
] unit-test
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -488,7 +488,7 @@ H{ { 1 int-rep } { 2 int-rep } } representations set
check-linear-scan
] unit-test
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -511,7 +511,7 @@ H{ { 1 int-rep } { 2 int-rep } } representations set
check-linear-scan
] unit-test
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -566,7 +566,7 @@ H{
{ 5 int-rep }
} representations set
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -617,7 +617,7 @@ H{
! Test spill-new code path
[ ] [
{ } [
{
T{ live-interval-state
{ vreg 1 }
@ -642,37 +642,37 @@ H{
check-linear-scan
] unit-test
[ f ] [
{ f } [
T{ live-range f 0 10 }
T{ live-range f 20 30 }
intersect-live-range
] unit-test
[ 10 ] [
{ 10 } [
T{ live-range f 0 10 }
T{ live-range f 10 30 }
intersect-live-range
] unit-test
[ 5 ] [
{ 5 } [
T{ live-range f 0 10 }
T{ live-range f 5 30 }
intersect-live-range
] unit-test
[ 5 ] [
{ 5 } [
T{ live-range f 5 30 }
T{ live-range f 0 10 }
intersect-live-range
] unit-test
[ 5 ] [
{ 5 } [
T{ live-range f 5 10 }
T{ live-range f 0 15 }
intersect-live-range
] unit-test
[ 50 ] [
{ 50 } [
{
T{ live-range f 0 10 }
T{ live-range f 20 30 }
@ -686,7 +686,7 @@ H{
intersect-live-ranges
] unit-test
[ f ] [
{ f } [
{
T{ live-range f 0 10 }
T{ live-range f 20 30 }
@ -700,7 +700,7 @@ H{
intersect-live-ranges
] unit-test
[ 5 ] [
{ 5 } [
T{ live-interval-state
{ start 0 }
{ reg-class int-regs }
@ -727,7 +727,7 @@ H{
{ 4 int-rep }
} representations set
[ { 0 10 } ] [
{ { 0 10 } } [
H{
{ int-regs
{

View File

@ -5,24 +5,24 @@ compiler.cfg.instructions cpu.architecture make sequences
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.resolve.tests
[
{
{
{
T{ location f T{ spill-slot f 0 } int-rep int-regs }
T{ location f 1 int-rep int-regs }
}
}
] [
} [
[
0 <spill-slot> 1 int-rep add-mapping
] { } make
] unit-test
[
{
{
T{ ##reload { dst 1 } { rep int-rep } { src T{ spill-slot f 0 } } }
}
] [
} [
[
T{ location f T{ spill-slot f 0 } int-rep int-regs }
T{ location f 1 int-rep int-regs }
@ -30,11 +30,11 @@ IN: compiler.cfg.linear-scan.resolve.tests
] { } make
] unit-test
[
{
{
T{ ##spill { src 1 } { rep int-rep } { dst T{ spill-slot f 0 } } }
}
] [
} [
[
T{ location f 1 int-rep int-regs }
T{ location f T{ spill-slot f 0 } int-rep int-regs }
@ -42,11 +42,11 @@ IN: compiler.cfg.linear-scan.resolve.tests
] { } make
] unit-test
[
{
{
T{ ##copy { src 1 } { dst 2 } { rep int-rep } }
}
] [
} [
[
T{ location f 1 int-rep int-regs }
T{ location f 2 int-rep int-regs }
@ -54,23 +54,23 @@ IN: compiler.cfg.linear-scan.resolve.tests
] { } make
] unit-test
[
{
{
T{ ##copy { src 1 } { dst 2 } { rep int-rep } }
T{ ##branch }
}
] [
} [
{ { T{ location f 1 int-rep int-regs } T{ location f 2 int-rep int-regs } } }
mapping-instructions
] unit-test
[
{
{
T{ ##spill { src 0 } { rep int-rep } { dst T{ spill-slot f 0 } } }
T{ ##reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 1 } } }
T{ ##branch }
}
] [
} [
{
{ T{ location f T{ spill-slot f 1 } tagged-rep int-regs } T{ location f 0 tagged-rep int-regs } }
{ T{ location f 0 int-rep int-regs } T{ location f T{ spill-slot f 0 } int-rep int-regs } }
@ -78,13 +78,13 @@ IN: compiler.cfg.linear-scan.resolve.tests
mapping-instructions
] unit-test
[
{
{
T{ ##spill { src 0 } { rep int-rep } { dst T{ spill-slot f 1 } } }
T{ ##reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 0 } } }
T{ ##branch }
}
] [
} [
{
{ T{ location f T{ spill-slot f 0 } tagged-rep int-regs } T{ location f 0 tagged-rep int-regs } }
{ T{ location f 0 int-rep int-regs } T{ location f T{ spill-slot f 1 } int-rep int-regs } }
@ -92,13 +92,13 @@ IN: compiler.cfg.linear-scan.resolve.tests
mapping-instructions
] unit-test
[
{
{
T{ ##spill { src 0 } { rep int-rep } { dst T{ spill-slot f 1 } } }
T{ ##reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 0 } } }
T{ ##branch }
}
] [
} [
{
{ T{ location f 0 int-rep int-regs } T{ location f T{ spill-slot f 1 } int-rep int-regs } }
{ T{ location f T{ spill-slot f 0 } tagged-rep int-regs } T{ location f 0 tagged-rep int-regs } }
@ -109,7 +109,7 @@ IN: compiler.cfg.linear-scan.resolve.tests
cfg new 8 >>spill-area-size cfg set
init-resolve
[ t ] [
{ t } [
{
{ T{ location f 0 int-rep int-regs } T{ location f 1 int-rep int-regs } }
{ T{ location f 1 int-rep int-regs } T{ location f 0 int-rep int-regs } }

View File

@ -174,15 +174,15 @@ V{
1 { 2 3 } edges
[ ] [ test-liveness ] unit-test
{ } [ test-liveness ] unit-test
[
{
H{
{ 1 1 }
{ 2 2 }
{ 3 3 }
}
]
}
[ 1 get live-in ]
unit-test
@ -200,9 +200,9 @@ V{
1 2 edge
[ ] [ test-liveness ] unit-test
{ } [ test-liveness ] unit-test
[ H{ { 0 0 } } ] [ 2 get live-in ] unit-test
{ H{ { 0 0 } } } [ 2 get live-in ] unit-test
! Regression
V{
@ -286,12 +286,12 @@ V{
7 8 edge
8 9 edge
[ ] [ test-liveness ] unit-test
{ } [ test-liveness ] unit-test
[ H{ { 28 28 } { 29 29 } { 30 30 } { 31 31 } } ] [ 5 get live-out ] unit-test
[ H{ { 28 28 } { 29 29 } { 30 30 } } ] [ 6 get live-in ] unit-test
[ H{ { 28 28 } { 29 29 } { 31 31 } } ] [ 7 get live-in ] unit-test
[ H{ { 30 30 } } ] [ 6 get 8 get edge-live-in ] unit-test
{ H{ { 28 28 } { 29 29 } { 30 30 } { 31 31 } } } [ 5 get live-out ] unit-test
{ H{ { 28 28 } { 29 29 } { 30 30 } } } [ 6 get live-in ] unit-test
{ H{ { 28 28 } { 29 29 } { 31 31 } } } [ 7 get live-in ] unit-test
{ H{ { 30 30 } } } [ 6 get 8 get edge-live-in ] unit-test
V{
T{ ##prologue }
@ -339,15 +339,15 @@ V{
5 6 edge
6 7 edge
[ ] [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
{ } [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
[ t ] [ 0 get live-in assoc-empty? ] unit-test
{ t } [ 0 get live-in assoc-empty? ] unit-test
[ H{ { 2 2 } } ] [ 4 get live-out ] unit-test
{ H{ { 2 2 } } } [ 4 get live-out ] unit-test
[ H{ { 0 0 } } ] [ 2 get 4 get edge-live-in ] unit-test
{ H{ { 0 0 } } } [ 2 get 4 get edge-live-in ] unit-test
[ H{ { 1 1 } } ] [ 3 get 4 get edge-live-in ] unit-test
{ H{ { 1 1 } } } [ 3 get 4 get edge-live-in ] unit-test
V{
@ -378,12 +378,12 @@ H{
{ 1 int-rep }
} representations set
[ ] [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
{ } [ 0 get block>cfg dup cfg set compute-live-sets ] unit-test
[ V{ { 1 0 } } ] [ 1 get instructions>> 2 swap nth gc-map>> derived-roots>> ] unit-test
{ V{ { 1 0 } } } [ 1 get instructions>> 2 swap nth gc-map>> derived-roots>> ] unit-test
[ { 0 } ] [ 1 get instructions>> 2 swap nth gc-map>> gc-roots>> ] unit-test
{ { 0 } } [ 1 get instructions>> 2 swap nth gc-map>> gc-roots>> ] unit-test
[ V{ { 1 0 } } ] [ 1 get instructions>> 4 swap nth gc-map>> derived-roots>> ] unit-test
{ V{ { 1 0 } } } [ 1 get instructions>> 4 swap nth gc-map>> derived-roots>> ] unit-test
[ { 0 } ] [ 1 get instructions>> 4 swap nth gc-map>> gc-roots>> ] unit-test
{ { 0 } } [ 1 get instructions>> 4 swap nth gc-map>> gc-roots>> ] unit-test

View File

@ -28,8 +28,8 @@ V{ } 2 test-bb
: test-loop-detection ( -- )
0 get block>cfg needs-loops ;
[ ] [ test-loop-detection ] unit-test
{ } [ test-loop-detection ] unit-test
[ 1 ] [ 0 get loop-nesting-at ] unit-test
[ 0 ] [ 1 get loop-nesting-at ] unit-test
[ 1 ] [ 2 get loop-nesting-at ] unit-test
{ 1 } [ 0 get loop-nesting-at ] unit-test
{ 0 } [ 1 get loop-nesting-at ] unit-test
{ 1 } [ 2 get loop-nesting-at ] unit-test

View File

@ -14,51 +14,51 @@ SYMBOL: temp
H{ } test-parallel-copy
] unit-test
[
{
{
T{ ##copy f 4 2 any-rep }
T{ ##copy f 2 1 any-rep }
T{ ##copy f 1 4 any-rep }
}
] [
} [
H{
{ 1 2 }
{ 2 1 }
} test-parallel-copy
] unit-test
[
{
{
T{ ##copy f 1 2 any-rep }
T{ ##copy f 3 4 any-rep }
}
] [
} [
H{
{ 1 2 }
{ 3 4 }
} test-parallel-copy
] unit-test
[
{
{
T{ ##copy f 1 3 any-rep }
T{ ##copy f 2 1 any-rep }
}
] [
} [
H{
{ 1 3 }
{ 2 3 }
} test-parallel-copy
] unit-test
[
{
{
T{ ##copy f 4 3 any-rep }
T{ ##copy f 3 2 any-rep }
T{ ##copy f 2 1 any-rep }
T{ ##copy f 1 4 any-rep }
}
] [
} [
{
{ 2 1 }
{ 3 2 }

View File

@ -34,8 +34,8 @@ V{
1 3 edge
2 3 edge
[ ] [ test-scc ] unit-test
{ } [ test-scc ] unit-test
[ t ] [ 0 vreg>scc 1 vreg>scc = ] unit-test
[ t ] [ 0 vreg>scc 3 vreg>scc = ] unit-test
[ f ] [ 2 vreg>scc 3 vreg>scc = ] unit-test
{ t } [ 0 vreg>scc 1 vreg>scc = ] unit-test
{ t } [ 0 vreg>scc 3 vreg>scc = ] unit-test
{ f } [ 2 vreg>scc 3 vreg>scc = ] unit-test

View File

@ -9,7 +9,7 @@ make ;
FROM: alien.c-types => char ;
IN: compiler.cfg.representations
[ { double-rep double-rep } ] [
{ { double-rep double-rep } } [
T{ ##add-float
{ dst 5 }
{ src1 3 }
@ -17,7 +17,7 @@ IN: compiler.cfg.representations
} uses-vreg-reps
] unit-test
[ { double-rep } ] [
{ { double-rep } } [
T{ ##load-memory-imm
{ dst 5 }
{ base 3 }
@ -30,22 +30,22 @@ H{ } clone representations set
3 vreg-counter set-global
[
{
{
T{ ##allot f 2 16 float 4 }
T{ ##store-memory-imm f 1 2 $[ float-offset ] double-rep f }
}
] [
} [
[
2 1 tagged-rep double-rep emit-conversion
] { } make
] unit-test
[
{
{
T{ ##load-memory-imm f 2 1 $[ float-offset ] double-rep f }
}
] [
} [
[
2 1 double-rep tagged-rep emit-conversion
] { } make
@ -78,9 +78,9 @@ V{
0 1 edge
1 2 edge
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[ 1 ] [ 1 get instructions>> [ ##allot? ] count ] unit-test
{ 1 } [ 1 get instructions>> [ ##allot? ] count ] unit-test
! Don't dereference the result of a peek
V{
@ -110,14 +110,14 @@ V{
0 1 edge
1 { 2 3 } edges
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##branch }
}
] [ 1 get instructions>> ] unit-test
} [ 1 get instructions>> ] unit-test
! We cannot untag-fixnum the result of a peek if there are usages
! of it as a tagged-rep
@ -153,14 +153,14 @@ V{
3 { 3 4 } edges
2 4 edge
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##branch }
}
] [ 1 get instructions>> ] unit-test
} [ 1 get instructions>> ] unit-test
! But its ok to untag-fixnum the result of a peek if all usages use
! it as int-rep
@ -199,15 +199,15 @@ V{
3 vreg-counter set-global
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[
{
V{
T{ ##peek f 4 D 0 }
T{ ##sar-imm f 1 4 $[ tag-bits get ] }
T{ ##branch }
}
] [ 1 get instructions>> ] unit-test
} [ 1 get instructions>> ] unit-test
! scalar-rep => int-rep conversion
V{
@ -231,9 +231,9 @@ V{
0 1 edge
1 2 edge
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[ t ] [ 1 get instructions>> 4 swap nth ##scalar>integer? ] unit-test
{ t } [ 1 get instructions>> 4 swap nth ##scalar>integer? ] unit-test
! Test phi node behavior
V{
@ -267,13 +267,13 @@ V{
2 3 edge
3 4 edge
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
[ T{ ##load-tagged f 1 $[ 1 tag-fixnum ] } ]
{ T{ ##load-tagged f 1 $[ 1 tag-fixnum ] } }
[ 1 get instructions>> first ]
unit-test
[ T{ ##load-tagged f 2 $[ 2 tag-fixnum ] } ]
{ T{ ##load-tagged f 2 $[ 2 tag-fixnum ] } }
[ 2 get instructions>> first ]
unit-test
@ -311,10 +311,10 @@ V{
2 3 edge
3 4 edge
[ ] [ test-representations ] unit-test
{ } [ test-representations ] unit-test
! Don't untag the f!
[ 2 ] [ 2 get instructions>> length ] unit-test
{ 2 } [ 2 get instructions>> length ] unit-test
cpu x86.32? [
@ -398,7 +398,7 @@ cpu x86.32? [
! we might lose precision
5 vreg-counter set-global
[ f ] [
{ f } [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -413,12 +413,12 @@ cpu x86.32? [
] unit-test
! Converting a ##load-integer into a ##load-tagged
[
{
V{
T{ ##load-tagged f 1 $[ 100 tag-fixnum ] }
T{ ##replace f 1 D 0 }
}
] [
} [
V{
T{ ##load-integer f 1 100 }
T{ ##replace f 1 D 0 }
@ -428,7 +428,7 @@ cpu x86.32? [
! Peephole optimization if input to ##shl-imm is tagged
3 vreg-counter set-global
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##sar-imm f 2 1 1 }
@ -436,7 +436,7 @@ cpu x86.32? [
T{ ##shl-imm f 3 4 $[ tag-bits get ] }
T{ ##replace f 3 D 0 }
}
] [
} [
V{
T{ ##peek f 1 D 0 }
T{ ##shl-imm f 2 1 3 }
@ -447,7 +447,7 @@ cpu x86.32? [
3 vreg-counter set-global
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##shl-imm f 2 1 $[ 10 tag-bits get - ] }
@ -455,7 +455,7 @@ cpu x86.32? [
T{ ##shl-imm f 3 4 $[ tag-bits get ] }
T{ ##replace f 3 D 0 }
}
] [
} [
V{
T{ ##peek f 1 D 0 }
T{ ##shl-imm f 2 1 10 }
@ -464,7 +464,7 @@ cpu x86.32? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##copy f 2 1 int-rep }
@ -472,7 +472,7 @@ cpu x86.32? [
T{ ##shl-imm f 3 5 $[ tag-bits get ] }
T{ ##replace f 3 D 0 }
}
] [
} [
V{
T{ ##peek f 1 D 0 }
T{ ##shl-imm f 2 1 $[ tag-bits get ] }
@ -482,13 +482,13 @@ cpu x86.32? [
] unit-test
! Peephole optimization if output of ##shl-imm needs to be tagged
[
{
V{
T{ ##load-integer f 1 100 }
T{ ##shl-imm f 2 1 $[ 3 tag-bits get + ] }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##load-integer f 1 100 }
T{ ##shl-imm f 2 1 3 }
@ -498,13 +498,13 @@ cpu x86.32? [
! Peephole optimization if both input and output of ##shl-imm
! need to be tagged
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##shl-imm f 1 0 3 }
T{ ##replace f 1 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##shl-imm f 1 0 3 }
@ -513,7 +513,7 @@ cpu x86.32? [
] unit-test
! Peephole optimization if neither input nor output of ##shl-imm need to be tagged
[
{
V{
T{ ##load-integer f 1 100 }
T{ ##shl-imm f 2 1 3 }
@ -521,7 +521,7 @@ cpu x86.32? [
T{ ##load-integer f 4 100 }
T{ ##store-memory f 2 3 4 0 0 int-rep char }
}
] [
} [
V{
T{ ##load-integer f 1 100 }
T{ ##shl-imm f 2 1 3 }
@ -534,14 +534,14 @@ cpu x86.32? [
6 vreg-counter set-global
! Peephole optimization if input to ##sar-imm is tagged
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##sar-imm f 7 1 $[ 3 tag-bits get + ] }
T{ ##shl-imm f 2 7 $[ tag-bits get ] }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##peek f 1 D 0 }
T{ ##sar-imm f 2 1 3 }
@ -552,14 +552,14 @@ cpu x86.32? [
6 vreg-counter set-global
! (Lack of) peephole optimization if output of ##sar-imm needs to be tagged
[
{
V{
T{ ##load-integer f 1 100 }
T{ ##sar-imm f 7 1 3 }
T{ ##shl-imm f 2 7 $[ tag-bits get ] }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##load-integer f 1 100 }
T{ ##sar-imm f 2 1 3 }
@ -569,7 +569,7 @@ cpu x86.32? [
! Peephole optimization if input of ##sar-imm is tagged but output is untagged
! need to be tagged
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##sar-imm f 1 0 $[ 3 tag-bits get + ] }
@ -577,7 +577,7 @@ cpu x86.32? [
T{ ##load-integer f 4 100 }
T{ ##store-memory f 1 3 4 0 0 int-rep char }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##sar-imm f 1 0 3 }
@ -588,7 +588,7 @@ cpu x86.32? [
] unit-test
! Peephole optimization if neither input nor output of ##sar-imm need to be tagged
[
{
V{
T{ ##load-integer f 1 100 }
T{ ##sar-imm f 2 1 3 }
@ -596,7 +596,7 @@ cpu x86.32? [
T{ ##load-integer f 4 100 }
T{ ##store-memory f 2 3 4 0 0 int-rep char }
}
] [
} [
V{
T{ ##load-integer f 1 100 }
T{ ##sar-imm f 2 1 3 }
@ -606,7 +606,7 @@ cpu x86.32? [
} test-peephole
] unit-test
[
{
V{
T{ ##load-vector f 0 B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } short-8-rep }
T{ ##select-vector f 1 0 0 short-8-rep }
@ -617,7 +617,7 @@ cpu x86.32? [
T{ ##load-integer f 6 100 }
T{ ##store-memory f 4 5 6 0 0 int-rep char }
}
] [
} [
V{
T{ ##load-vector f 0 B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } short-8-rep }
T{ ##select-vector f 1 0 0 short-8-rep }
@ -632,7 +632,7 @@ cpu x86.32? [
6 vreg-counter set-global
[
{
V{
T{ ##load-vector f 0 B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } int-4-rep }
T{ ##select-vector f 1 0 0 int-4-rep }
@ -642,7 +642,7 @@ cpu x86.32? [
T{ ##shl-imm f 4 7 $[ tag-bits get ] }
T{ ##replace f 4 D 0 }
}
] [
} [
V{
T{ ##load-vector f 0 B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } int-4-rep }
T{ ##select-vector f 1 0 0 int-4-rep }
@ -654,13 +654,13 @@ cpu x86.32? [
] unit-test
! Tag/untag elimination
[
{
V{
T{ ##peek f 1 D 0 }
T{ ##add-imm f 2 1 $[ 100 tag-fixnum ] }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##peek f 1 D 0 }
T{ ##add-imm f 2 1 100 }
@ -668,14 +668,14 @@ cpu x86.32? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##add f 2 0 1 }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -721,13 +721,13 @@ cpu x86.64? [
] when
! Tag/untag elimination for ##mul-imm
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##mul-imm f 1 0 100 }
T{ ##replace f 1 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##mul-imm f 1 0 100 }
@ -737,7 +737,7 @@ cpu x86.64? [
4 vreg-counter set-global
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -746,7 +746,7 @@ cpu x86.64? [
T{ ##mul-imm f 3 2 $[ 100 tag-fixnum ] }
T{ ##replace f 3 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -757,14 +757,14 @@ cpu x86.64? [
] unit-test
! Tag/untag elimination for ##compare-integer and ##test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##test f 2 0 1 cc= }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -773,14 +773,14 @@ cpu x86.64? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##compare-integer f 2 0 1 cc= }
T{ ##replace f 2 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -789,13 +789,13 @@ cpu x86.64? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##compare-integer-branch f 0 1 cc= }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -803,13 +803,13 @@ cpu x86.64? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##test-branch f 0 1 cc= }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -817,13 +817,13 @@ cpu x86.64? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##compare-integer-imm-branch f 0 $[ 10 tag-fixnum ] cc= }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -831,13 +831,13 @@ cpu x86.64? [
} test-peephole
] unit-test
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
T{ ##test-imm-branch f 0 $[ 10 tag-fixnum ] cc= }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -846,13 +846,13 @@ cpu x86.64? [
] unit-test
! Tag/untag elimination for ##neg
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##neg f 1 0 }
T{ ##replace f 1 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##neg f 1 0 }
@ -862,7 +862,7 @@ cpu x86.64? [
4 vreg-counter set-global
[
{
V{
T{ ##peek { dst 0 } { loc D 0 } }
T{ ##peek { dst 1 } { loc D 1 } }
@ -872,7 +872,7 @@ cpu x86.64? [
T{ ##mul-imm { dst 3 } { src1 2 } { src2 -16 } }
T{ ##replace { src 3 } { loc D 0 } }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##peek f 1 D 1 }
@ -885,14 +885,14 @@ cpu x86.64? [
! Tag/untag elimination for ##not
2 vreg-counter set-global
[
{
V{
T{ ##peek f 0 D 0 }
T{ ##not f 3 0 }
T{ ##xor-imm f 1 3 $[ tag-mask get ] }
T{ ##replace f 1 D 0 }
}
] [
} [
V{
T{ ##peek f 0 D 0 }
T{ ##not f 1 0 }

View File

@ -13,12 +13,12 @@ V{
0 get [ insert-save-context ] change-instructions drop
[
{
V{
T{ ##add f 1 2 3 }
T{ ##branch }
}
] [
} [
0 get instructions>>
] unit-test
@ -33,7 +33,7 @@ V{
0 get [ insert-save-context ] change-instructions drop
[
{
V{
T{ ##inc f D 3 }
T{ ##save-context f 5 6 }
@ -41,7 +41,7 @@ V{
T{ gc-map { scrub-d B{ 0 0 0 } } { scrub-r B{ } } { gc-roots { } } }
}
}
] [
} [
0 get instructions>>
] unit-test
@ -52,13 +52,13 @@ V{
0 get [ insert-save-context ] change-instructions drop
[
{
V{
T{ ##phi }
T{ ##save-context f 7 8 }
T{ ##box }
}
] [
} [
0 get instructions>>
] unit-test

View File

@ -72,38 +72,38 @@ V{
1 3 edge
2 3 edge
[ ] [ test-ssa ] unit-test
{ } [ test-ssa ] unit-test
[
{
V{
T{ ##load-integer f 1 100 }
T{ ##add-imm f 2 1 50 }
T{ ##add-imm f 3 2 10 }
T{ ##branch }
}
] [ 0 get instructions>> ] unit-test
} [ 0 get instructions>> ] unit-test
[
{
V{
T{ ##load-integer f 4 3 }
T{ ##branch }
}
] [ 1 get instructions>> ] unit-test
} [ 1 get instructions>> ] unit-test
[
{
V{
T{ ##load-integer f 5 4 }
T{ ##branch }
}
] [ 2 get instructions>> ] unit-test
} [ 2 get instructions>> ] unit-test
[
{
V{
T{ ##phi f 6 H{ { 1 4 } { 2 5 } } }
T{ ##replace f 6 D 0 }
T{ ##return }
}
] [
} [
3 get instructions>>
clean-up-phis
] unit-test
@ -126,14 +126,14 @@ V{ } 6 test-bb
4 6 edge
5 6 edge
[ ] [ test-ssa ] unit-test
{ } [ test-ssa ] unit-test
[
{
V{
T{ ##phi f 3 H{ { 2 1 } { 3 2 } } }
T{ ##replace f 3 D 0 }
}
] [
} [
4 get instructions>>
clean-up-phis
] unit-test
@ -168,9 +168,9 @@ V{
2 4 edge
3 4 edge
[ ] [ test-ssa ] unit-test
{ } [ test-ssa ] unit-test
[ V{ } ] [ 4 get instructions>> [ ##phi? ] filter ] unit-test
{ V{ } } [ 4 get instructions>> [ ##phi? ] filter ] unit-test
! Test 4
reset-counters
@ -217,8 +217,8 @@ V{
5 7 edge
6 7 edge
[ ] [ test-ssa ] unit-test
{ } [ test-ssa ] unit-test
[ V{ } ] [ 5 get instructions>> [ ##phi? ] filter ] unit-test
{ V{ } } [ 5 get instructions>> [ ##phi? ] filter ] unit-test
[ V{ } ] [ 7 get instructions>> [ ##phi? ] filter ] unit-test
{ V{ } } [ 7 get instructions>> [ ##phi? ] filter ] unit-test

View File

@ -22,12 +22,12 @@ V{ } 5 test-bb
3 4 edge
4 5 edge
[ ] [ test-tdmsc ] unit-test
{ } [ test-tdmsc ] unit-test
[ { 4 } ] [ 1 get 1array merge-set [ number>> ] map ] unit-test
[ { 4 } ] [ 2 get 1array merge-set [ number>> ] map ] unit-test
[ { } ] [ 0 get 1array merge-set ] unit-test
[ { } ] [ 4 get 1array merge-set ] unit-test
{ { 4 } } [ 1 get 1array merge-set [ number>> ] map ] unit-test
{ { 4 } } [ 2 get 1array merge-set [ number>> ] map ] unit-test
{ { } } [ 0 get 1array merge-set ] unit-test
{ { } } [ 4 get 1array merge-set ] unit-test
V{ } 0 test-bb
V{ } 1 test-bb
@ -44,9 +44,9 @@ V{ } 6 test-bb
4 6 edge
5 6 edge
[ ] [ test-tdmsc ] unit-test
{ } [ test-tdmsc ] unit-test
[ t ] [
{ t } [
2 get 3 get 2array merge-set
4 get 6 get 2array set=
] unit-test
@ -68,7 +68,7 @@ V{ } 7 test-bb
4 5 edge
5 2 edge
[ ] [ test-tdmsc ] unit-test
{ } [ test-tdmsc ] unit-test
[ { 2 } ] [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test
[ { } ] [ { 0 1 6 7 } [ get ] map merge-set ] unit-test
{ { 2 } } [ { 2 3 4 5 } [ get ] map merge-set [ number>> ] map ] unit-test
{ { } } [ { 0 1 6 7 } [ get ] map merge-set ] unit-test

View File

@ -51,22 +51,22 @@ V{
0 1 edge
[ ] [ test-interference ] unit-test
{ } [ test-interference ] unit-test
[ f ] [ 0 1 test-vregs-intersect? ] unit-test
[ f ] [ 1 0 test-vregs-intersect? ] unit-test
[ f ] [ 2 3 test-vregs-intersect? ] unit-test
[ f ] [ 3 2 test-vregs-intersect? ] unit-test
[ t ] [ 0 2 test-vregs-intersect? ] unit-test
[ t ] [ 2 0 test-vregs-intersect? ] unit-test
[ f ] [ 1 3 test-vregs-intersect? ] unit-test
[ f ] [ 3 1 test-vregs-intersect? ] unit-test
[ t ] [ 3 4 test-vregs-intersect? ] unit-test
[ t ] [ 4 3 test-vregs-intersect? ] unit-test
[ t ] [ 3 5 test-vregs-intersect? ] unit-test
[ t ] [ 5 3 test-vregs-intersect? ] unit-test
[ f ] [ 3 6 test-vregs-intersect? ] unit-test
[ f ] [ 6 3 test-vregs-intersect? ] unit-test
{ f } [ 0 1 test-vregs-intersect? ] unit-test
{ f } [ 1 0 test-vregs-intersect? ] unit-test
{ f } [ 2 3 test-vregs-intersect? ] unit-test
{ f } [ 3 2 test-vregs-intersect? ] unit-test
{ t } [ 0 2 test-vregs-intersect? ] unit-test
{ t } [ 2 0 test-vregs-intersect? ] unit-test
{ f } [ 1 3 test-vregs-intersect? ] unit-test
{ f } [ 3 1 test-vregs-intersect? ] unit-test
{ t } [ 3 4 test-vregs-intersect? ] unit-test
{ t } [ 4 3 test-vregs-intersect? ] unit-test
{ t } [ 3 5 test-vregs-intersect? ] unit-test
{ t } [ 5 3 test-vregs-intersect? ] unit-test
{ f } [ 3 6 test-vregs-intersect? ] unit-test
{ f } [ 6 3 test-vregs-intersect? ] unit-test
V{
T{ ##prologue }
@ -96,9 +96,9 @@ V{
0 1 edge
1 2 edge
[ ] [ test-interference ] unit-test
{ } [ test-interference ] unit-test
[ t ] [ { 15 } { 23 13 } test-sets-interfere? nip ] unit-test
{ t } [ { 15 } { 23 13 } test-sets-interfere? nip ] unit-test
V{
T{ ##prologue f }
@ -164,9 +164,9 @@ V{
5 6 edge
7 8 edge
[ ] [ test-interference ] unit-test
{ } [ test-interference ] unit-test
[ f ] [ { 48 } { 32 35 } test-sets-interfere? nip ] unit-test
{ f } [ { 48 } { 32 35 } test-sets-interfere? nip ] unit-test
TUPLE: bab ;
TUPLE: gfg { x bab } ;
@ -289,20 +289,20 @@ V{
14 15 edge
15 16 edge
[ ] [ test-interference ] unit-test
{ } [ test-interference ] unit-test
[ t ] [ 43 45 test-vregs-intersect? ] unit-test
[ f ] [ 43 45 test-vregs-interfere? ] unit-test
{ t } [ 43 45 test-vregs-intersect? ] unit-test
{ f } [ 43 45 test-vregs-interfere? ] unit-test
[ t ] [ 43 46 test-vregs-intersect? ] unit-test
[ t ] [ 43 46 test-vregs-interfere? ] unit-test
{ t } [ 43 46 test-vregs-intersect? ] unit-test
{ t } [ 43 46 test-vregs-interfere? ] unit-test
[ f ] [ 45 46 test-vregs-intersect? ] unit-test
[ f ] [ 45 46 test-vregs-interfere? ] unit-test
{ f } [ 45 46 test-vregs-intersect? ] unit-test
{ f } [ 45 46 test-vregs-interfere? ] unit-test
[ f ] [ { 43 } { 45 } test-sets-interfere? nip ] unit-test
{ f } [ { 43 } { 45 } test-sets-interfere? nip ] unit-test
[ t f ] [
{ t f } [
{ 46 } { 43 } { 45 }
[ [ <test-vreg-info> ] map ] tri@
sets-interfere? [ sets-interfere? nip ] dip
@ -350,14 +350,14 @@ V{
3 2 edge
4 5 edge
[ ] [ test-interference ] unit-test
{ } [ test-interference ] unit-test
[ f f ] [
{ f f } [
{ 33 } { 21 } { 32 }
[ [ <test-vreg-info> ] map ] tri@
sets-interfere? [ sets-interfere? nip ] dip
] unit-test
[ f ] [ 33 21 test-vregs-intersect? ] unit-test
[ f ] [ 32 21 test-vregs-intersect? ] unit-test
[ f ] [ 32 33 test-vregs-intersect? ] unit-test
{ f } [ 33 21 test-vregs-intersect? ] unit-test
{ f } [ 32 21 test-vregs-intersect? ] unit-test
{ f } [ 32 33 test-vregs-intersect? ] unit-test

View File

@ -3,13 +3,13 @@ tools.test ;
IN: compiler.cfg.write-barrier.tests
! Do need a write barrier on a random store.
[
{
V{
T{ ##peek f 1 }
T{ ##set-slot f 2 1 3 }
T{ ##write-barrier f 1 3 }
}
] [
} [
V{
T{ ##peek f 1 }
T{ ##set-slot f 2 1 3 }
@ -17,13 +17,13 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##peek f 1 }
T{ ##set-slot-imm f 2 1 }
T{ ##write-barrier-imm f 1 }
}
] [
} [
V{
T{ ##peek f 1 }
T{ ##set-slot-imm f 2 1 }
@ -32,12 +32,12 @@ IN: compiler.cfg.write-barrier.tests
] unit-test
! Don't need a write barrier on freshly allocated objects.
[
{
V{
T{ ##allot f 1 }
T{ ##set-slot f 2 1 3 }
}
] [
} [
V{
T{ ##allot f 1 }
T{ ##set-slot f 2 1 3 }
@ -45,12 +45,12 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##allot f 1 }
T{ ##set-slot-imm f 2 1 }
}
] [
} [
V{
T{ ##allot f 1 }
T{ ##set-slot-imm f 2 1 }
@ -60,14 +60,14 @@ IN: compiler.cfg.write-barrier.tests
! Do need a write barrier if there's a subroutine call between
! the allocation and the store.
[
{
V{
T{ ##allot f 1 }
T{ ##box }
T{ ##set-slot f 2 1 3 }
T{ ##write-barrier f 1 3 }
}
] [
} [
V{
T{ ##allot f 1 }
T{ ##box }
@ -76,14 +76,14 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##allot f 1 }
T{ ##box }
T{ ##set-slot-imm f 2 1 }
T{ ##write-barrier-imm f 1 }
}
] [
} [
V{
T{ ##allot f 1 }
T{ ##box }
@ -93,13 +93,13 @@ IN: compiler.cfg.write-barrier.tests
] unit-test
! ##copy instructions
[
{
V{
T{ ##copy f 2 1 }
T{ ##set-slot-imm f 3 1 }
T{ ##write-barrier-imm f 2 }
}
] [
} [
V{
T{ ##copy f 2 1 }
T{ ##set-slot-imm f 3 1 }
@ -107,13 +107,13 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##copy f 2 1 }
T{ ##set-slot-imm f 3 2 }
T{ ##write-barrier-imm f 1 }
}
] [
} [
V{
T{ ##copy f 2 1 }
T{ ##set-slot-imm f 3 2 }
@ -121,14 +121,14 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##copy f 2 1 }
T{ ##copy f 3 2 }
T{ ##set-slot-imm f 3 1 }
T{ ##write-barrier-imm f 2 }
}
] [
} [
V{
T{ ##copy f 2 1 }
T{ ##copy f 3 2 }
@ -137,14 +137,14 @@ IN: compiler.cfg.write-barrier.tests
} write-barriers-step
] unit-test
[
{
V{
T{ ##copy f 2 1 }
T{ ##copy f 3 2 }
T{ ##set-slot-imm f 4 1 }
T{ ##write-barrier-imm f 3 }
}
] [
} [
V{
T{ ##copy f 2 1 }
T{ ##copy f 3 2 }

View File

@ -3,11 +3,11 @@ compiler.codegen.relocation tools.test cpu.architecture math
kernel make compiler.constants words ;
IN: compiler.codegen.tests
[ ] [ [ ] with-fixup drop ] unit-test
[ ] [ [ \ + %call ] with-fixup drop ] unit-test
{ } [ [ ] with-fixup drop ] unit-test
{ } [ [ \ + %call ] with-fixup drop ] unit-test
[ ] [ [ <label> dup define-label dup resolve-label %jump-label ] with-fixup drop ] unit-test
[ ] [ [ <label> dup define-label dup resolve-label B{ 0 0 0 0 } % rc-absolute-cell label-fixup ] with-fixup drop ] unit-test
{ } [ [ <label> dup define-label dup resolve-label %jump-label ] with-fixup drop ] unit-test
{ } [ [ <label> dup define-label dup resolve-label B{ 0 0 0 0 } % rc-absolute-cell label-fixup ] with-fixup drop ] unit-test
! Error checking
[ [ <label> dup define-label %jump-label ] with-fixup ] must-fail

View File

@ -33,7 +33,7 @@ M: fake-cpu gc-root-offset ;
] B{ } make
"result" set
[ 0 ] [ "result" get length 16 mod ] unit-test
{ 0 } [ "result" get length 16 mod ] unit-test
[
100 <byte-array> %
@ -69,8 +69,8 @@ M: fake-cpu gc-root-offset ;
] B{ } make
"expect" set
[ t ] [ "result" get length "expect" get length = ] unit-test
[ t ] [ "result" get "expect" get = ] unit-test
{ t } [ "result" get length "expect" get length = ] unit-test
{ t } [ "result" get "expect" get = ] unit-test
! Fix the gc root offset calculations
SINGLETON: linux-x86.64

View File

@ -3,7 +3,7 @@ IN: compiler.crossref.tests
! Dependencies of all words should always be satisfied unless we're
! in the middle of recompiling something
[ { } ] [
{ { } } [
all-words dup [ subwords ] map concat append
H{ } clone '[ _ dependencies-satisfied? ] reject
] unit-test

View File

@ -4,7 +4,7 @@ IN: compiler.tree.builder.tests
: inline-recursive ( -- ) inline-recursive ; inline recursive
[ t ] [ \ inline-recursive build-tree [ #recursive? ] any? ] unit-test
{ t } [ \ inline-recursive build-tree [ #recursive? ] any? ] unit-test
: bad-recursion-1 ( a -- b )
dup [ drop bad-recursion-1 5 ] [ ] if ;

View File

@ -20,23 +20,23 @@ FROM: math => float ;
QUALIFIED-WITH: alien.c-types c
IN: compiler.tree.cleanup.tests
[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
{ t } [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
[ f ] [ [ f [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
{ f } [ [ f [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
[ f ] [ [ { array } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
{ f } [ [ { array } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
[ t ] [ [ { sequence } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
{ t } [ [ { sequence } declare [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
: recursive-test ( a -- b ) dup [ not recursive-test ] when ; inline recursive
[ t ] [ [ recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
{ t } [ [ recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
[ f ] [ [ f recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
{ f } [ [ f recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
[ t ] [ [ t recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
{ t } [ [ t recursive-test ] cleaned-up-tree [ #recursive? ] contains-node? ] unit-test
[ f ] [
{ f } [
[ { integer } declare >fixnum ]
\ >fixnum inlined?
] unit-test
@ -51,7 +51,7 @@ GENERIC: detect-f ( x -- y )
M: f detect-f ; inline
[ t ] [
{ t } [
[ dup [ mynot ] [ ] if detect-f ] \ detect-f inlined?
] unit-test
@ -61,11 +61,11 @@ M: integer xyz ; inline
M: object xyz ; inline
[ t ] [
{ t } [
[ { integer } declare xyz ] \ xyz inlined?
] unit-test
[ t ] [
{ t } [
[ dup fixnum? [ xyz ] [ drop "hi" ] if ]
\ xyz inlined?
] unit-test
@ -82,7 +82,7 @@ M: object xyz ; inline
! The + should be optimized into fixnum+, if it was not, then
! the type of the loop index was not inferred correctly
[ t ] [
{ t } [
[ [ dup 2 + drop ] fx-repeat ] \ + inlined?
] unit-test
@ -95,78 +95,78 @@ M: object xyz ; inline
: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
[ t ] [
{ t } [
[ [ dup xyz drop ] i-repeat ] \ xyz inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare dup 100 >= [ 1 + ] unless ] \ fixnum+ inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
\ + inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare dupd < [ 1 + 1 + ] when ]
\ + inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare [ ] times ] \ >= inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare [ ] times ] \ + inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare [ ] times ] \ fixnum+ inlined?
] unit-test
[ t ] [
{ t } [
[ { integer fixnum } declare dupd < [ 1 + ] when ]
\ + inlined?
] unit-test
[ f ] [
{ f } [
[ { integer fixnum } declare dupd < [ 1 + ] when ]
\ +-integer-fixnum inlined?
] unit-test
[ t ] [
{ t } [
[
[ no-cond ] 1
[ 1array dup quotation? [ >quotation ] unless ] times
] \ quotation? inlined?
] unit-test
[ t ] [
{ t } [
[
1000000000000000000000000000000000 [ ] times
] \ + inlined?
] unit-test
[ f ] [
{ f } [
[
1000000000000000000000000000000000 [ ] times
] \ +-integer-fixnum inlined?
] unit-test
[ f ] [
{ f } [
[ { bignum } declare [ ] times ]
\ +-integer-fixnum inlined?
] unit-test
[ t ] [
{ t } [
[ { array-capacity } declare 0 < ] \ < inlined?
] unit-test
[ t ] [
{ t } [
[ { array-capacity } declare 0 < ] \ fixnum< inlined?
] unit-test
[ t ] [
{ t } [
[ { array-capacity } declare 1 fixnum- ] \ fixnum- inlined?
] unit-test
@ -183,12 +183,12 @@ M: fixnum annotate-entry-test-1 drop ;
: annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline
[ f ] [
{ f } [
[ { bignum } declare annotate-entry-test-2 ]
\ annotate-entry-test-1 inlined?
] unit-test
[ t ] [
{ t } [
[ { float } declare 10 [ 2.3 * ] times >float ]
\ >float inlined?
] unit-test
@ -197,37 +197,37 @@ GENERIC: detect-float ( a -- b )
M: float detect-float ;
[ t ] [
{ t } [
[ { real float } declare + detect-float ]
\ detect-float inlined?
] unit-test
[ t ] [
{ t } [
[ { float real } declare + detect-float ]
\ detect-float inlined?
] unit-test
[ f ] [
{ f } [
[ { fixnum fixnum } declare 7 bitand neg shift ]
\ fixnum-shift-fast inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare 7 bitand neg shift ]
{ shift fixnum-shift } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare 1 swap 7 bitand shift ]
{ shift fixnum-shift } inlined?
] unit-test
[ f ] [
{ f } [
[ { fixnum fixnum } declare 1 swap 7 bitand shift ]
{ fixnum-shift-fast } inlined?
] unit-test
[ t ] [
{ t } [
[ 1 swap 7 bitand shift ]
{ shift fixnum-shift } inlined?
] unit-test
@ -244,41 +244,41 @@ cell-bits 32 = [
] unit-test
] when
[ t ] [
{ t } [
[ B{ 1 0 } c:short deref 0 number= ]
\ number= inlined?
] unit-test
[ t ] [
{ t } [
[ B{ 1 0 } c:short deref 0 { number number } declare number= ]
\ number= inlined?
] unit-test
[ t ] [
{ t } [
[ B{ 1 0 } c:short deref 0 = ]
\ number= inlined?
] unit-test
[ t ] [
{ t } [
[ B{ 1 0 } c:short deref dup number? [ 0 number= ] [ drop f ] if ]
\ number= inlined?
] unit-test
[ t ] [
{ t } [
[ 0xff bitand 0 0xff between? ]
\ >= inlined?
] unit-test
[ t ] [
{ t } [
[ 0xff swap 0xff bitand >= ]
\ >= inlined?
] unit-test
[ t ] [
{ t } [
[ { vector } declare nth-unsafe ] \ nth-unsafe inlined?
] unit-test
[ t ] [
{ t } [
[
dup integer? [
dup fixnum? [
@ -293,7 +293,7 @@ cell-bits 32 = [
: rec ( a -- b )
dup 0 > [ 1 - rec ] when ; inline recursive
[ t ] [
{ t } [
[ { fixnum } declare rec 1 + ]
{ > - + } inlined?
] unit-test
@ -301,116 +301,116 @@ cell-bits 32 = [
: fib ( m -- n )
dup 2 < [ drop 1 ] [ dup 1 - fib swap 2 - fib + ] if ; inline recursive
[ t ] [
{ t } [
[ 27.0 fib ] { < - + } inlined?
] unit-test
[ f ] [
{ f } [
[ 27.0 fib ] { +-integer-integer } inlined?
] unit-test
[ t ] [
{ t } [
[ 27 fib ] { < - + } inlined?
] unit-test
[ t ] [
{ t } [
[ 27 >bignum fib ] { < - + } inlined?
] unit-test
[ f ] [
{ f } [
[ 27/2 fib ] { < - } inlined?
] unit-test
[ t ] [
{ t } [
[ 10 [ -1 shift ] times ] \ shift inlined?
] unit-test
[ f ] [
{ f } [
[ { fixnum } declare 1048575 fixnum-bitand 524288 fixnum- ]
\ fixnum-bitand inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare [ drop ] each-integer ]
{ < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare iota [ drop ] each ]
{ < <-integer-fixnum +-integer-fixnum + } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare iota 0 [ + ] reduce ]
{ < <-integer-fixnum nth-unsafe } inlined?
] unit-test
[ f ] [
{ f } [
[ { fixnum } declare iota 0 [ + ] reduce ]
\ +-integer-fixnum inlined?
] unit-test
[ f ] [
{ f } [
[
{ integer } declare iota [ ] map
] \ integer>fixnum inlined?
] unit-test
[ f ] [
{ f } [
[
{ integer } declare { } set-nth-unsafe
] \ integer>fixnum inlined?
] unit-test
[ f ] [
{ f } [
[
{ integer } declare 1 + { } set-nth-unsafe
] \ >fixnum inlined?
] unit-test
[ t ] [
{ t } [
[
{ array } declare length
1 + dup 100 fixnum> [ 1 fixnum+ ] when
] \ fixnum+ inlined?
] unit-test
[ t ] [
{ t } [
[ [ resize-array ] keep length ] \ length inlined?
] unit-test
[ t ] [
{ t } [
[ dup 0 > [ sqrt ] when ] \ sqrt inlined?
] unit-test
[ t ] [
{ t } [
[ { utf8 } declare decode-char ] \ decode-char inlined?
] unit-test
[ t ] [
{ t } [
[ { ascii } declare decode-char ] \ decode-char inlined?
] unit-test
[ t ] [ [ { 1 2 } length ] { length length>> slot } inlined? ] unit-test
{ t } [ [ { 1 2 } length ] { length length>> slot } inlined? ] unit-test
[ t ] [
{ t } [
[
{ integer } declare iota [ 0 >= ] map
] { >= fixnum>= } inlined?
] unit-test
[ ] [
{ } [
[
4 pick array-capacity?
[ set-slot ] [ \ array-capacity 2nip bad-slot-value ] if
] cleaned-up-tree drop
] unit-test
[ ] [
{ } [
[ { merge-state } declare accum>> 0 >>length ] cleaned-up-tree drop
] unit-test
[ ] [
{ } [
[
[ "X" throw ]
[ dupd dup -1 < [ 0 >= [ ] [ "X" throw ] if ] [ drop ] if ]
@ -418,12 +418,12 @@ cell-bits 32 = [
] cleaned-up-tree drop
] unit-test
[ t ] [
{ t } [
[ [ 2array ] [ 0 3array ] if first ]
{ nth-unsafe < <= > >= } inlined?
] unit-test
[ ] [
{ } [
[ [ [ "A" throw ] dip ] [ "B" throw ] if ]
cleaned-up-tree drop
] unit-test
@ -444,7 +444,7 @@ cell-bits 32 = [
2drop
] if ; inline recursive
[ t ] [
{ t } [
[ 2 swap >fixnum buffalo-wings ]
{ <-integer-fixnum +-integer-fixnum } inlined?
] unit-test
@ -463,41 +463,41 @@ cell-bits 32 = [
2drop
] if ; inline recursive
[ t ] [
{ t } [
[ 2 swap >fixnum ribs ]
{ <-integer-fixnum +-integer-fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ hashtable new ] \ new inlined?
] unit-test
[ t ] [
{ t } [
[ { array-capacity } declare 1 fixnum+ ] cleaned-up-tree
[ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] any?
] unit-test
[ ] [
{ } [
[ { null } declare [ 1 ] [ 2 ] if ]
build-tree normalize propagate cleanup-tree check-nodes
] unit-test
[ t ] [
{ t } [
[ { array } declare 2 <groups> [ . . ] assoc-each ]
\ nth-unsafe inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare = ]
\ both-fixnums? inlined?
] unit-test
[ t ] [
{ t } [
[ { integer integer } declare + drop ]
{ + +-integer-integer } inlined?
] unit-test
[ [ ] ] [
{ [ ] } [
[
20 f <array>
[ 0 swap nth ] keep
@ -517,27 +517,27 @@ cell-bits 32 = [
] cleaned-up-tree nodes>quot
] unit-test
[ t ] [
{ t } [
[ int { } cdecl [ 2 2 + ] alien-callback ]
{ + } inlined?
] unit-test
[ t ] [
{ t } [
[ double { double double } cdecl [ + ] alien-callback ]
\ + inlined?
] unit-test
[ f ] [
{ f } [
[ double { double double } cdecl [ + ] alien-callback ]
\ float+ inlined?
] unit-test
[ f ] [
{ f } [
[ char { char char } cdecl [ + ] alien-callback ]
\ fixnum+fast inlined?
] unit-test
[ t ] [
{ t } [
[ void { } cdecl [ ] alien-callback void { } cdecl alien-indirect ]
\ >c-ptr inlined?
] unit-test

View File

@ -26,41 +26,41 @@ IN: compiler.tree.dead-code.tests
[ out-d>> length + ] [ drop ] if
] each-node ;
[ 3 ] [ [ 1 2 3 ] count-live-values ] unit-test
{ 3 } [ [ 1 2 3 ] count-live-values ] unit-test
[ 1 ] [ [ drop ] count-live-values ] unit-test
{ 1 } [ [ drop ] count-live-values ] unit-test
[ 0 ] [ [ 1 drop ] count-live-values ] unit-test
{ 0 } [ [ 1 drop ] count-live-values ] unit-test
[ 1 ] [ [ 1 2 drop ] count-live-values ] unit-test
{ 1 } [ [ 1 2 drop ] count-live-values ] unit-test
[ 3 ] [ [ [ 1 ] [ 2 ] if ] count-live-values ] unit-test
{ 3 } [ [ [ 1 ] [ 2 ] if ] count-live-values ] unit-test
[ 1 ] [ [ [ 1 ] [ 2 ] if drop ] count-live-values ] unit-test
{ 1 } [ [ [ 1 ] [ 2 ] if drop ] count-live-values ] unit-test
[ 2 ] [ [ [ 1 ] [ dup ] if drop ] count-live-values ] unit-test
{ 2 } [ [ [ 1 ] [ dup ] if drop ] count-live-values ] unit-test
[ 2 ] [ [ 1 + ] count-live-values ] unit-test
{ 2 } [ [ 1 + ] count-live-values ] unit-test
[ 0 ] [ [ 1 2 + drop ] count-live-values ] unit-test
{ 0 } [ [ 1 2 + drop ] count-live-values ] unit-test
[ 3 ] [ [ 1 + 3 + ] count-live-values ] unit-test
{ 3 } [ [ 1 + 3 + ] count-live-values ] unit-test
[ 0 ] [ [ 1 2 + 3 + drop ] count-live-values ] unit-test
{ 0 } [ [ 1 2 + 3 + drop ] count-live-values ] unit-test
[ 4 ] [ [ [ 1 ] [ 2 ] if 3 + ] count-live-values ] unit-test
{ 4 } [ [ [ 1 ] [ 2 ] if 3 + ] count-live-values ] unit-test
[ 1 ] [ [ [ 1 ] [ 2 ] if 3 + drop ] count-live-values ] unit-test
{ 1 } [ [ [ 1 ] [ 2 ] if 3 + drop ] count-live-values ] unit-test
[ 0 ] [ [ [ ] call ] count-live-values ] unit-test
{ 0 } [ [ [ ] call ] count-live-values ] unit-test
[ 1 ] [ [ [ 1 ] call ] count-live-values ] unit-test
{ 1 } [ [ [ 1 ] call ] count-live-values ] unit-test
[ 2 ] [ [ [ 1 ] [ 2 ] compose call ] count-live-values ] unit-test
{ 2 } [ [ [ 1 ] [ 2 ] compose call ] count-live-values ] unit-test
[ 0 ] [ [ [ 1 ] [ 2 ] compose call + drop ] count-live-values ] unit-test
{ 0 } [ [ [ 1 ] [ 2 ] compose call + drop ] count-live-values ] unit-test
[ 3 ] [ [ 10 [ ] times ] count-live-values ] unit-test
{ 3 } [ [ 10 [ ] times ] count-live-values ] unit-test
: optimize-quot ( quot -- quot' )
build-tree
@ -74,40 +74,40 @@ IN: compiler.tree.dead-code.tests
remove-dead-code
"no-check" get [ dup check-nodes ] unless nodes>quot ;
[ [ drop 1 ] ] [ [ [ 1 ] dip drop ] optimize-quot ] unit-test
{ [ drop 1 ] } [ [ [ 1 ] dip drop ] optimize-quot ] unit-test
[ [ stream-read1 drop 1 2 ] ] [ [ stream-read1 [ 1 2 ] dip drop ] optimize-quot ] unit-test
{ [ stream-read1 drop 1 2 ] } [ [ stream-read1 [ 1 2 ] dip drop ] optimize-quot ] unit-test
[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
{ [ over >R + R> ] } [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
[ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test
{ [ [ ] [ ] if ] } [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test
: flushable-1 ( a b -- c ) 2drop f ; flushable
: flushable-2 ( a b -- c ) 2drop f ; flushable
[ [ 2nip [ ] [ ] if ] ] [
{ [ 2nip [ ] [ ] if ] } [
[ [ flushable-1 ] [ flushable-2 ] if drop ] optimize-quot
] unit-test
: non-flushable-3 ( a b -- c ) 2drop f ;
[ [ [ 2drop ] [ non-flushable-3 drop ] if ] ] [
{ [ [ 2drop ] [ non-flushable-3 drop ] if ] } [
[ [ flushable-1 ] [ non-flushable-3 ] if drop ] optimize-quot
] unit-test
[ [ [ f ] [ f ] if ] ] [ [ [ f ] [ f ] if ] optimize-quot ] unit-test
{ [ [ f ] [ f ] if ] } [ [ [ f ] [ f ] if ] optimize-quot ] unit-test
[ ] [ [ dup [ 3 throw ] [ ] if ] optimize-quot drop ] unit-test
{ } [ [ dup [ 3 throw ] [ ] if ] optimize-quot drop ] unit-test
[ [ [ . ] [ drop ] if ] ] [ [ [ dup . ] [ ] if drop ] optimize-quot ] unit-test
{ [ [ . ] [ drop ] if ] } [ [ [ dup . ] [ ] if drop ] optimize-quot ] unit-test
[ [ f ] ] [ [ f dup [ ] [ ] if ] optimize-quot ] unit-test
{ [ f ] } [ [ f dup [ ] [ ] if ] optimize-quot ] unit-test
[ ] [ [ over [ ] [ dup [ "X" throw ] [ "X" throw ] if ] if ] optimize-quot drop ] unit-test
{ } [ [ over [ ] [ dup [ "X" throw ] [ "X" throw ] if ] if ] optimize-quot drop ] unit-test
: boo ( a b -- c ) 2drop f ;
[ [ dup 4 eq? [ nip ] [ boo ] if ] ] [ [ dup dup 4 eq? [ drop nip ] [ drop boo ] if ] optimize-quot ] unit-test
{ [ dup 4 eq? [ nip ] [ boo ] if ] } [ [ dup dup 4 eq? [ drop nip ] [ drop boo ] if ] optimize-quot ] unit-test
: squish ( quot -- quot' )
[
@ -121,7 +121,7 @@ IN: compiler.tree.dead-code.tests
: call-recursive-dce-1 ( a -- b )
[ call-recursive-dce-1 drop ] [ call-recursive-dce-1 ] bi ; inline recursive
[ [ drop "WRAP" [ "REC" drop "REC" ] label ] ] [
{ [ drop "WRAP" [ "REC" drop "REC" ] label ] } [
[ call-recursive-dce-1 ] optimize-quot squish
] unit-test
@ -131,76 +131,76 @@ IN: compiler.tree.dead-code.tests
drop
produce-a-value dup . call-recursive-dce-2 ; inline recursive
[ [ "WRAP" [ produce-a-value . "REC" ] label ] ] [
{ [ "WRAP" [ produce-a-value . "REC" ] label ] } [
[ f call-recursive-dce-2 drop ] optimize-quot squish
] unit-test
[ [ "WRAP" [ produce-a-value . "REC" ] label ] ] [
{ [ "WRAP" [ produce-a-value . "REC" ] label ] } [
[ f call-recursive-dce-2 ] optimize-quot squish
] unit-test
: call-recursive-dce-3 ( a -- )
call-recursive-dce-3 ; inline recursive
[ [ [ drop "WRAP" [ "REC" ] label ] [ . ] if ] ] [
{ [ [ drop "WRAP" [ "REC" ] label ] [ . ] if ] } [
[ [ call-recursive-dce-3 ] [ . ] if ] optimize-quot squish
] unit-test
[ [ drop "WRAP" [ "REC" ] label ] ] [
{ [ drop "WRAP" [ "REC" ] label ] } [
[ call-recursive-dce-3 ] optimize-quot squish
] unit-test
: call-recursive-dce-4 ( a -- b )
call-recursive-dce-4 ; inline recursive
[ [ drop "WRAP" [ "REC" ] label ] ] [
{ [ drop "WRAP" [ "REC" ] label ] } [
[ call-recursive-dce-4 ] optimize-quot squish
] unit-test
[ [ drop "WRAP" [ "REC" ] label ] ] [
{ [ drop "WRAP" [ "REC" ] label ] } [
[ call-recursive-dce-4 drop ] optimize-quot squish
] unit-test
[ ] [ [ f call-recursive-dce-3 swap ] optimize-quot drop ] unit-test
{ } [ [ f call-recursive-dce-3 swap ] optimize-quot drop ] unit-test
: call-recursive-dce-5 ( -- ) call-recursive-dce-5 ; inline recursive
[ ] [ [ call-recursive-dce-5 swap ] optimize-quot drop ] unit-test
{ } [ [ call-recursive-dce-5 swap ] optimize-quot drop ] unit-test
[ ] [ [ [ 0 -rot set-nth-unsafe ] curry (each-integer) ] optimize-quot drop ] unit-test
{ } [ [ [ 0 -rot set-nth-unsafe ] curry (each-integer) ] optimize-quot drop ] unit-test
: call-recursive-dce-6 ( i quot: ( ..a -- ..b ) -- i )
dup call [ drop ] [ call-recursive-dce-6 ] if ; inline recursive
[ ] [ [ [ ] curry [ ] swap compose call-recursive-dce-6 ] optimize-quot drop ] unit-test
{ } [ [ [ ] curry [ ] swap compose call-recursive-dce-6 ] optimize-quot drop ] unit-test
[ ] [ [ [ ] rot [ . ] curry pick [ roll 2drop call ] [ 2nip call ] if ] optimize-quot drop ] unit-test
{ } [ [ [ ] rot [ . ] curry pick [ roll 2drop call ] [ 2nip call ] if ] optimize-quot drop ] unit-test
[ [ drop ] ] [ [ array? drop ] optimize-quot ] unit-test
{ [ drop ] } [ [ array? drop ] optimize-quot ] unit-test
[ [ drop ] ] [ [ array instance? drop ] optimize-quot ] unit-test
{ [ drop ] } [ [ array instance? drop ] optimize-quot ] unit-test
[ [ drop ] ] [ [ { integer } declare f <array> drop ] optimize-quot ] unit-test
{ [ drop ] } [ [ { integer } declare f <array> drop ] optimize-quot ] unit-test
[ [ f <array> drop ] ] [ [ f <array> drop ] optimize-quot ] unit-test
{ [ f <array> drop ] } [ [ f <array> drop ] optimize-quot ] unit-test
: call-recursive-dce-7 ( obj -- elt ? )
dup 5 = [ t ] [ dup [ call-recursive-dce-7 ] [ drop f f ] if ] if ; inline recursive
[ ] [ [ call-recursive-dce-7 ] optimize-quot drop ] unit-test
{ } [ [ call-recursive-dce-7 ] optimize-quot drop ] unit-test
[ [ /i ] ] [ [ /mod drop ] optimize-quot ] unit-test
{ [ /i ] } [ [ /mod drop ] optimize-quot ] unit-test
[ [ mod ] ] [ [ /mod nip ] optimize-quot ] unit-test
{ [ mod ] } [ [ /mod nip ] optimize-quot ] unit-test
[ [ fixnum/i ] ] [ [ { fixnum fixnum } declare /mod drop ] optimize-quot ] unit-test
{ [ fixnum/i ] } [ [ { fixnum fixnum } declare /mod drop ] optimize-quot ] unit-test
[ [ fixnum-mod ] ] [ [ { fixnum fixnum } declare /mod nip ] optimize-quot ] unit-test
{ [ fixnum-mod ] } [ [ { fixnum fixnum } declare /mod nip ] optimize-quot ] unit-test
[ [ bignum/i ] ] [ [ { bignum bignum } declare /mod drop ] optimize-quot ] unit-test
{ [ bignum/i ] } [ [ { bignum bignum } declare /mod drop ] optimize-quot ] unit-test
[ [ bignum-mod ] ] [ [ { bignum bignum } declare /mod nip ] optimize-quot ] unit-test
{ [ bignum-mod ] } [ [ { bignum bignum } declare /mod nip ] optimize-quot ] unit-test
[ [ /i ] ] [ [ /mod drop ] optimize-quot ] unit-test
{ [ /i ] } [ [ /mod drop ] optimize-quot ] unit-test
[ [ mod ] ] [ [ /mod nip ] optimize-quot ] unit-test
{ [ mod ] } [ [ /mod nip ] optimize-quot ] unit-test

View File

@ -7,7 +7,7 @@ compiler.tree.def-use arrays kernel.private sorting math.order
binary-search compiler.tree.checker ;
IN: compiler.tree.def-use.tests
[ t ] [
{ t } [
[ 1 2 3 ] build-tree compute-def-use drop
def-use get {
[ assoc-size 3 = ]
@ -27,7 +27,7 @@ IN: compiler.tree.def-use.tests
: too-deep ( a b -- c )
dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive
[ ] [
{ } [
[ too-deep ]
build-tree
analyze-recursive

View File

@ -3,7 +3,7 @@ compiler.tree.recursive compiler.tree.def-use
compiler.tree.def-use.simplified accessors sequences sorting classes ;
IN: compiler.tree.def-use.simplified
[ { #call #return } ] [
{ { #call #return } } [
[ 1 dup reverse ] build-tree compute-def-use
first out-d>> first actually-used-by
[ node>> class-of ] map natural-sort
@ -11,13 +11,13 @@ IN: compiler.tree.def-use.simplified
: word-1 ( a -- b ) dup [ word-1 ] when ; inline recursive
[ { #introduce } ] [
{ { #introduce } } [
[ word-1 ] build-tree analyze-recursive compute-def-use
last in-d>> first actually-defined-by
[ node>> class-of ] map natural-sort
] unit-test
[ { #if #return } ] [
{ { #if #return } } [
[ word-1 ] build-tree analyze-recursive compute-def-use
first out-d>> first actually-used-by
[ node>> class-of ] map natural-sort

View File

@ -6,22 +6,22 @@ IN: compiler.tree.escape-analysis.check.tests
: test-checker ( quot -- ? )
build-tree normalize propagate cleanup-tree run-escape-analysis? ;
[ t ] [
{ t } [
[ { complex } declare [ real>> ] [ imaginary>> ] bi ]
test-checker
] unit-test
[ t ] [
{ t } [
[ complex boa [ real>> ] [ imaginary>> ] bi ]
test-checker
] unit-test
[ t ] [
{ t } [
[ [ complex boa [ real>> ] [ imaginary>> ] bi ] when ]
test-checker
] unit-test
[ f ] [
{ f } [
[ swap 1 2 ? ]
test-checker
] unit-test

View File

@ -41,45 +41,45 @@ M: node count-unboxed-allocations* drop ;
remove-dead-code
0 swap [ count-unboxed-allocations* ] each-node ;
[ 0 ] [ [ [ + ] curry ] count-unboxed-allocations ] unit-test
{ 0 } [ [ [ + ] curry ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry drop ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry drop ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry 3 slot ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry 3 slot ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry 3 slot drop ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry 3 slot drop ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry uncurry ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry uncurry ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
{ 1 } [ [ [ + ] curry call ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ [ [ + ] curry ] [ drop [ ] ] if ] count-unboxed-allocations ] unit-test
{ 0 } [ [ [ [ + ] curry ] [ drop [ ] ] if ] count-unboxed-allocations ] unit-test
[ 2 ] [
{ 2 } [
[ [ [ + ] curry ] [ [ * ] curry ] if uncurry ] count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ [ [ + ] curry ] [ [ * ] curry ] if ] count-unboxed-allocations
] unit-test
[ 3 ] [
{ 3 } [
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if uncurry ] count-unboxed-allocations
] unit-test
[ 2 ] [
{ 2 } [
[ [ [ + ] curry 4 ] [ dup [ [ * ] curry ] [ [ / ] curry ] if uncurry ] if ] count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ [ [ + ] curry ] [ dup [ [ * ] curry ] [ [ / ] curry ] if ] if ] count-unboxed-allocations
] unit-test
TUPLE: cons { car read-only } { cdr read-only } ;
[ 0 ] [
{ 0 } [
[
dup 0 = [
2 cons boa
@ -91,7 +91,7 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 3 ] [
{ 3 } [
[
dup 0 = [
2 cons boa
@ -105,7 +105,7 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[
dup 0 = [
dup 1 = [
@ -117,7 +117,7 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 2 ] [
{ 2 } [
[
dup 0 = [
2 cons boa
@ -131,7 +131,7 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[
dup 0 = [
2 cons boa
@ -145,13 +145,13 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 2 ] [
{ 2 } [
[
[ dup cons boa ] [ drop 1 2 cons boa ] if car>>
] count-unboxed-allocations
] unit-test
[ 2 ] [
{ 2 } [
[
3dup
[ cons boa ] [ cons boa 3 cons boa ] if
@ -159,23 +159,23 @@ TUPLE: cons { car read-only } { cdr read-only } ;
] count-unboxed-allocations
] unit-test
[ 2 ] [
{ 2 } [
[
3dup [ cons boa ] [ cons boa . 1 2 cons boa ] if
[ car>> ] [ cdr>> ] bi
] count-unboxed-allocations
] unit-test
[ 1 ] [
{ 1 } [
[ [ 3 cons boa ] [ "A" throw ] if car>> ]
count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ 10 [ drop ] each-integer ] count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[
1 2 cons boa 10 [ drop 2 cons boa ] each-integer car>>
] count-unboxed-allocations
@ -183,7 +183,7 @@ TUPLE: cons { car read-only } { cdr read-only } ;
: infinite-cons-loop ( a -- b ) 2 cons boa infinite-cons-loop ; inline recursive
[ 0 ] [
{ 0 } [
[
1 2 cons boa infinite-cons-loop
] count-unboxed-allocations
@ -193,12 +193,12 @@ TUPLE: rw-box i ;
C: <rw-box> rw-box
[ 0 ] [ [ <rw-box> i>> ] count-unboxed-allocations ] unit-test
{ 0 } [ [ <rw-box> i>> ] count-unboxed-allocations ] unit-test
: fake-fib ( m -- n )
dup i>> 1 <= [ drop 1 <rw-box> ] when ; inline recursive
[ 0 ] [ [ <rw-box> fake-fib i>> ] count-unboxed-allocations ] unit-test
{ 0 } [ [ <rw-box> fake-fib i>> ] count-unboxed-allocations ] unit-test
TUPLE: ro-box { i read-only } ;
@ -216,14 +216,14 @@ C: <ro-box> ro-box
swap i>> swap i>> + <ro-box>
] if ; inline recursive
[ 5 ] [ [ <ro-box> tuple-fib i>> ] count-unboxed-allocations ] unit-test
{ 5 } [ [ <ro-box> tuple-fib i>> ] count-unboxed-allocations ] unit-test
[ 3 ] [ [ <ro-box> tuple-fib ] count-unboxed-allocations ] unit-test
{ 3 } [ [ <ro-box> tuple-fib ] count-unboxed-allocations ] unit-test
: tuple-fib' ( m -- n )
dup 1 <= [ 1 - tuple-fib' i>> ] when <ro-box> ; inline recursive
[ 0 ] [ [ tuple-fib' ] count-unboxed-allocations ] unit-test
{ 0 } [ [ tuple-fib' ] count-unboxed-allocations ] unit-test
: bad-tuple-fib-1 ( m -- n )
dup i>> 1 <= [
@ -237,7 +237,7 @@ C: <ro-box> ro-box
swap i>> swap i>> + <ro-box>
] if ; inline recursive
[ 3 ] [ [ <ro-box> bad-tuple-fib-1 i>> ] count-unboxed-allocations ] unit-test
{ 3 } [ [ <ro-box> bad-tuple-fib-1 i>> ] count-unboxed-allocations ] unit-test
: bad-tuple-fib-2 ( m -- n )
dup .
@ -252,7 +252,7 @@ C: <ro-box> ro-box
swap i>> swap i>> + <ro-box>
] if ; inline recursive
[ 2 ] [ [ <ro-box> bad-tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test
{ 2 } [ [ <ro-box> bad-tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test
: tuple-fib-2 ( m -- n )
dup 1 <= [
@ -264,7 +264,7 @@ C: <ro-box> ro-box
swap i>> swap i>> + <ro-box>
] if ; inline recursive
[ 2 ] [ [ tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test
{ 2 } [ [ tuple-fib-2 i>> ] count-unboxed-allocations ] unit-test
: tuple-fib-3 ( m -- n )
dup 1 <= [
@ -276,7 +276,7 @@ C: <ro-box> ro-box
swap i>> swap i>> + <ro-box>
] if ; inline recursive
[ 0 ] [ [ tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
{ 0 } [ [ tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
: bad-tuple-fib-3 ( m -- n )
dup 1 <= [
@ -288,24 +288,24 @@ C: <ro-box> ro-box
2drop f
] if ; inline recursive
[ 0 ] [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
{ 0 } [ [ bad-tuple-fib-3 i>> ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ complex boa >rect ] count-unboxed-allocations ] unit-test
{ 1 } [ [ complex boa >rect ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa 2 cons boa ] count-unboxed-allocations ] unit-test
{ 0 } [ [ 1 cons boa 2 cons boa ] count-unboxed-allocations ] unit-test
[ 1 ] [ [ 1 cons boa 2 cons boa car>> ] count-unboxed-allocations ] unit-test
{ 1 } [ [ 1 cons boa 2 cons boa car>> ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa 2 cons boa dup . car>> ] count-unboxed-allocations ] unit-test
{ 0 } [ [ 1 cons boa 2 cons boa dup . car>> ] count-unboxed-allocations ] unit-test
[ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
{ 0 } [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
[ 0 ] [
{ 0 } [
[ dup -1 over >= [ 0 >= [ "A" throw ] unless ] [ drop ] if ]
count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ \ too-many->r boa f f \ inference-error boa ]
count-unboxed-allocations
] unit-test
@ -314,18 +314,18 @@ C: <ro-box> ro-box
TUPLE: empty-tuple ;
[ ] [ [ empty-tuple boa layout-of ] count-unboxed-allocations drop ] unit-test
{ } [ [ empty-tuple boa layout-of ] count-unboxed-allocations drop ] unit-test
! New feature!
[ 1 ] [ [ { complex } declare real>> ] count-unboxed-allocations ] unit-test
{ 1 } [ [ { complex } declare real>> ] count-unboxed-allocations ] unit-test
[ 1 ] [
{ 1 } [
[ { complex } declare [ real>> ] [ imaginary>> ] bi ]
count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ { vector } declare length>> ]
count-unboxed-allocations
] unit-test
@ -335,12 +335,12 @@ TUPLE: empty-tuple ;
TUPLE: point-2d { x read-only } { y read-only } ;
TUPLE: point-3d < point-2d { z read-only } ;
[ 0 ] [
{ 0 } [
[ { point-2d } declare dup point-3d? [ z>> ] [ x>> ] if ]
count-unboxed-allocations
] unit-test
[ 0 ] [
{ 0 } [
[ point-2d boa dup point-3d? [ z>> ] [ x>> ] if ]
count-unboxed-allocations
] unit-test

View File

@ -6,10 +6,10 @@ IN: compiler.tree.escape-analysis.recursive.tests
H{ } clone allocations set
<escaping-values> escaping-values set
[ ] [ 8 [ introduce-value ] each-integer ] unit-test
{ } [ 8 [ introduce-value ] each-integer ] unit-test
[ ] [ { 1 2 } 3 record-allocation ] unit-test
{ } [ { 1 2 } 3 record-allocation ] unit-test
[ t ] [ { 1 2 } { 6 7 } congruent? ] unit-test
[ f ] [ { 3 4 } { 6 7 } congruent? ] unit-test
[ f ] [ { 3 4 5 } { 6 7 } congruent? ] unit-test
{ t } [ { 1 2 } { 6 7 } congruent? ] unit-test
{ f } [ { 3 4 } { 6 7 } congruent? ] unit-test
{ f } [ { 3 4 5 } { 6 7 } congruent? ] unit-test

View File

@ -10,18 +10,18 @@ IN: compiler.tree.modular-arithmetic.tests
: test-modular-arithmetic ( quot -- quot' )
cleaned-up-tree nodes>quot ;
[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
{ [ >R >fixnum R> >fixnum fixnum+fast ] }
[ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test
[ [ +-integer-integer dup >fixnum ] ]
{ [ +-integer-integer dup >fixnum ] }
[ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test
[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ]
{ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] }
[ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test
TUPLE: declared-fixnum { x fixnum } ;
[ t ] [
{ t } [
[ { declared-fixnum } declare [ 1 + ] change-x ]
{ + } inlined?
! XXX: As of .97, we do a bounds check and throw an error on
@ -30,27 +30,27 @@ TUPLE: declared-fixnum { x fixnum } ;
! { + fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { declared-fixnum } declare x>> drop ]
{ slot } inlined?
] unit-test
[ f ] [
{ f } [
[ { integer } declare -63 shift 4095 bitand ]
\ shift inlined?
] unit-test
[ t ] [
{ t } [
[ { integer } declare 127 bitand 3 + ]
{ + +-integer-fixnum bitand } inlined?
] unit-test
[ f ] [
{ f } [
[ { integer } declare 127 bitand 3 + ]
{ integer>fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[
{ integer } declare
dup 0 >= [
@ -59,14 +59,14 @@ TUPLE: declared-fixnum { x fixnum } ;
] { * + shift mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
] unit-test
[ t ] [
{ t } [
[
{ fixnum } declare
615949 * 797807 + 20 2^ mod dup 19 2^ -
] { >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[
{ integer } declare 0 swap
[
@ -75,7 +75,7 @@ TUPLE: declared-fixnum { x fixnum } ;
] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- } inlined?
] unit-test
[ t ] [
{ t } [
[
{ fixnum } declare iota 0 swap
[
@ -84,78 +84,78 @@ TUPLE: declared-fixnum { x fixnum } ;
] { * + shift rem mod fixnum-mod fixnum* fixnum+ fixnum- >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { string sbuf } declare ] \ push-all def>> append \ + inlined?
] unit-test
[ t ] [
{ t } [
[ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined?
] unit-test
[ t ] [
{ t } [
[ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined?
] unit-test
[ t ] [
{ t } [
[
{ integer } declare iota [ 256 mod ] map
] { mod fixnum-mod } inlined?
] unit-test
[ f ] [
{ f } [
[
256 mod
] { mod fixnum-mod } inlined?
] unit-test
[ f ] [
{ f } [
[
>fixnum 256 mod
] { mod fixnum-mod } inlined?
] unit-test
[ f ] [
{ f } [
[
dup 0 >= [ 256 mod ] when
] { mod fixnum-mod } inlined?
] unit-test
[ t ] [
{ t } [
[
{ integer } declare dup 0 >= [ 256 mod ] when
] { mod fixnum-mod } inlined?
] unit-test
[ t ] [
{ t } [
[
{ integer } declare 256 rem
] { mod fixnum-mod } inlined?
] unit-test
[ t ] [
{ t } [
[
{ iota-tuple } declare [ 256 rem ] map
] { mod fixnum-mod rem } inlined?
] unit-test
[ [ drop 0 ] ]
{ [ drop 0 ] }
[ [ >integer 1 rem ] test-modular-arithmetic ] unit-test
[ [ drop 0 ] ]
{ [ drop 0 ] }
[ [ >integer 1 mod ] test-modular-arithmetic ] unit-test
[ [ >fixnum 255 >R R> fixnum-bitand ] ]
{ [ >fixnum 255 >R R> fixnum-bitand ] }
[ [ >integer 256 rem ] test-modular-arithmetic ] unit-test
[ t ] [
{ t } [
[ { fixnum fixnum } declare + [ 1 + >fixnum ] [ 2 + >fixnum ] bi ]
{ >fixnum } inlined?
] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-1 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-1 ] test-modular-arithmetic ] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-unsigned-2 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-2 ] test-modular-arithmetic ] unit-test
cell {
@ -164,13 +164,13 @@ cell {
} case
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-4 ] test-modular-arithmetic ] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-unsigned-8 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-unsigned-8 ] test-modular-arithmetic ] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-1 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-1 ] test-modular-arithmetic ] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+fast "COMPLEX SHUFFLE" set-alien-signed-2 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-2 ] test-modular-arithmetic ] unit-test
cell {
@ -179,118 +179,118 @@ cell {
} case
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-4 ] test-modular-arithmetic ] unit-test
[ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] ]
{ [ "COMPLEX SHUFFLE" fixnum+ "COMPLEX SHUFFLE" set-alien-signed-8 ] }
[ [ [ { fixnum fixnum } declare + ] 2dip set-alien-signed-8 ] test-modular-arithmetic ] unit-test
[ t ] [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
{ t } [ [ { fixnum byte-array } declare [ + ] with map ] { + fixnum+ >fixnum } inlined? ] unit-test
[ t ] [
{ t } [
[ 0 10 <byte-array> 10 [ 1 pick 0 + >fixnum pick set-nth-unsafe [ 1 + >fixnum ] dip ] times ]
{ >fixnum } inlined?
] unit-test
[ f ] [ [ + >fixnum ] { >fixnum } inlined? ] unit-test
{ f } [ [ + >fixnum ] { >fixnum } inlined? ] unit-test
[ t ] [
{ t } [
[ >integer [ >fixnum ] [ >fixnum ] bi ]
{ >integer } inlined?
] unit-test
[ f ] [
{ f } [
[ >integer [ >fixnum ] [ >fixnum ] bi ]
{ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
{ >integer } inlined?
] unit-test
[ f ] [
{ f } [
[ >integer [ 2 + >fixnum ] [ 3 + >fixnum ] bi ]
{ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ >integer [ >fixnum ] [ >fixnum ] bi ]
{ >integer } inlined?
] unit-test
[ f ] [
{ f } [
[ >bignum [ >fixnum ] [ >fixnum ] bi ]
{ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ >bignum [ >fixnum ] [ >fixnum ] bi ]
{ >bignum } inlined?
] unit-test
[ f ] [
{ f } [
[ [ { fixnum } declare 2 fixnum+ ] dip [ >fixnum 2 - ] [ ] if ]
{ fixnum+ } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum boolean } declare [ 1 + ] [ "HI" throw ] if >fixnum ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum boolean } declare [ 1 + ] [ drop 5 ] if >fixnum ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum boolean } declare [ 1 + ] [ 2 + ] if >fixnum ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ [ [ 1 ] [ 4 ] if ] ] [
{ [ [ 1 ] [ 4 ] if ] } [
[ [ 1.5 ] [ 4 ] if >fixnum ] test-modular-arithmetic
] unit-test
[ [ [ 1 ] [ 2 ] if ] ] [
{ [ [ 1 ] [ 2 ] if ] } [
[ [ 1.5 ] [ 2.3 ] if >fixnum ] test-modular-arithmetic
] unit-test
[ f ] [
{ f } [
[ { fixnum fixnum boolean } declare [ [ 3 * ] [ 1 + ] dip ] [ [ 4 - ] [ 2 + ] dip ] if >fixnum ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ 0 1000 [ 1 + dup >fixnum . ] times drop ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare 3 + [ 1000 ] dip [ >fixnum . ] curry times ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ 0 1000 [ 1 + ] times >fixnum ]
{ fixnum+ >fixnum } inlined?
] unit-test
[ f ] [
{ f } [
[ f >fixnum ]
{ >fixnum } inlined?
] unit-test
[ f ] [
{ f } [
[ [ >fixnum ] 2dip set-alien-unsigned-1 ]
{ >fixnum } inlined?
] unit-test
[ t ] [
{ t } [
[ { fixnum } declare 123 >bignum bitand >fixnum ]
{ >bignum fixnum>bignum bignum-bitand } inlined?
] unit-test
! Shifts
[ t ] [
{ t } [
[
[ 0 ] 2dip { array } declare [
hashcode* >fixnum swap [

View File

@ -6,20 +6,20 @@ compiler.tree compiler.tree.checker
sequences accessors tools.test kernel math ;
IN: compiler.tree.normalization.tests
[ 3 ] [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
{ 3 } [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
[ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test
{ 4 } [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test
[ 3 ] [ [ [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
{ 3 } [ [ [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
[ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
{ 2 } [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
: foo ( ..a quot: ( ..a -- ..b ) -- ..b ) call ; inline recursive
: recursive-inputs ( nodes -- n )
[ #recursive? ] find nip child>> first in-d>> length ;
[ 1 3 ] [
{ 1 3 } [
[ [ swap ] foo ] build-tree
[ recursive-inputs ]
[ analyze-recursive normalize recursive-inputs ] bi
@ -28,24 +28,24 @@ IN: compiler.tree.normalization.tests
: test-normalization ( quot -- )
build-tree analyze-recursive normalize check-nodes ;
[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
{ } [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
DEFER: bbb
: aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
: bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
[ ] [ [ bbb ] test-normalization ] unit-test
{ } [ [ bbb ] test-normalization ] unit-test
: ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
[ ] [ [ ccc ] test-normalization ] unit-test
{ } [ [ ccc ] test-normalization ] unit-test
DEFER: eee
: ddd ( a b -- a b ) eee ; inline recursive
: eee ( a b -- a b ) swap ddd ; inline recursive
[ ] [ [ eee ] test-normalization ] unit-test
{ } [ [ eee ] test-normalization ] unit-test
: call-recursive-5 ( -- ) call-recursive-5 ; inline recursive
[ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test
{ } [ [ call-recursive-5 swap ] test-normalization ] unit-test

View File

@ -71,10 +71,10 @@ IN: compiler.tree.propagation.call-effect.tests
] unit-test
! execute-effect-unsafe?
[ t ] [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test
[ t ] [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test
[ f ] [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test
[ f ] [ \ call ( x -- ) execute-effect-unsafe? ] unit-test
{ t } [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test
{ t } [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test
{ f } [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test
{ f } [ \ call ( x -- ) execute-effect-unsafe? ] unit-test
! update-inline-cache
{ t } [
@ -92,55 +92,55 @@ IN: compiler.tree.propagation.call-effect.tests
: compiled-execute2 ( a b word: ( a b -- c ) -- c )
execute( a b -- c ) ;
[ [ 3 ] ] [ [ 1 2 \ + execute( a b -- c ) ] optimized-quot ] unit-test
[ [ 3 ] ] [ [ 1 2 [ + ] call( a b -- c ) ] optimized-quot ] unit-test
[ [ 3 ] ] [ [ 1 2 '[ _ + ] call( a -- b ) ] optimized-quot ] unit-test
[ [ 3 ] ] [ [ 1 2 '[ _ ] [ + ] compose call( a -- b ) ] optimized-quot ] unit-test
{ [ 3 ] } [ [ 1 2 \ + execute( a b -- c ) ] optimized-quot ] unit-test
{ [ 3 ] } [ [ 1 2 [ + ] call( a b -- c ) ] optimized-quot ] unit-test
{ [ 3 ] } [ [ 1 2 '[ _ + ] call( a -- b ) ] optimized-quot ] unit-test
{ [ 3 ] } [ [ 1 2 '[ _ ] [ + ] compose call( a -- b ) ] optimized-quot ] unit-test
[ 1 2 { [ + ] } first compiled-call2 ] must-fail
[ 3 ] [ 1 2 { + } first compiled-execute2 ] unit-test
[ 3 ] [ 1 2 '[ _ + ] compiled-call2 ] unit-test
[ 3 ] [ 1 2 '[ _ ] [ + ] compose compiled-call2 ] unit-test
[ 3 ] [ 1 2 \ + compiled-execute2 ] unit-test
{ 3 } [ 1 2 { + } first compiled-execute2 ] unit-test
{ 3 } [ 1 2 '[ _ + ] compiled-call2 ] unit-test
{ 3 } [ 1 2 '[ _ ] [ + ] compose compiled-call2 ] unit-test
{ 3 } [ 1 2 \ + compiled-execute2 ] unit-test
[ 3 ] [ 1 2 { [ + ] } first call( a b -- c ) ] unit-test
[ 3 ] [ 1 2 { + } first execute( a b -- c ) ] unit-test
[ 3 ] [ 1 2 '[ _ + ] call( a -- b ) ] unit-test
[ 3 ] [ 1 2 '[ _ ] [ + ] compose call( a -- b ) ] unit-test
{ 3 } [ 1 2 { [ + ] } first call( a b -- c ) ] unit-test
{ 3 } [ 1 2 { + } first execute( a b -- c ) ] unit-test
{ 3 } [ 1 2 '[ _ + ] call( a -- b ) ] unit-test
{ 3 } [ 1 2 '[ _ ] [ + ] compose call( a -- b ) ] unit-test
[ t ] [ [ 2 '[ _ ] [ + ] compose ] final-info first infer-value ( object -- object ) effect= ] unit-test
[ t ] [ [ 2 '[ _ ] 1 '[ _ + ] compose ] final-info first infer-value ( -- object ) effect= ] unit-test
[ t ] [ [ 2 '[ _ + ] ] final-info first infer-value ( object -- object ) effect= ] unit-test
[ f ] [ [ [ [ ] [ 1 ] if ] ] final-info first infer-value ] unit-test
[ t ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value ( -- object ) effect= ] unit-test
[ f ] [ [ dup drop ] final-info first infer-value ] unit-test
{ t } [ [ 2 '[ _ ] [ + ] compose ] final-info first infer-value ( object -- object ) effect= ] unit-test
{ t } [ [ 2 '[ _ ] 1 '[ _ + ] compose ] final-info first infer-value ( -- object ) effect= ] unit-test
{ t } [ [ 2 '[ _ + ] ] final-info first infer-value ( object -- object ) effect= ] unit-test
{ f } [ [ [ [ ] [ 1 ] if ] ] final-info first infer-value ] unit-test
{ t } [ [ [ 1 ] '[ @ ] ] final-info first infer-value ( -- object ) effect= ] unit-test
{ f } [ [ dup drop ] final-info first infer-value ] unit-test
! This should not hang
[ ] [ [ [ dup call( quot -- ) ] dup call( quot -- ) ] final-info drop ] unit-test
[ ] [ [ [ dup curry call( quot -- ) ] dup curry call( quot -- ) ] final-info drop ] unit-test
{ } [ [ [ dup call( quot -- ) ] dup call( quot -- ) ] final-info drop ] unit-test
{ } [ [ [ dup curry call( quot -- ) ] dup curry call( quot -- ) ] final-info drop ] unit-test
! This should get inlined, because the parameter to the curry is literal even though
! [ boa ] by itself doesn't infer
TUPLE: a-tuple x ;
[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
{ V{ a-tuple } } [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
! See if redefinitions are handled correctly
: call(-redefine-test ( a -- b ) 1 + ;
: test-quotatation ( -- quot ) [ call(-redefine-test ] ;
[ t ] [ test-quotatation cached-effect ( a -- b ) effect<= ] unit-test
{ t } [ test-quotatation cached-effect ( a -- b ) effect<= ] unit-test
[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a b -- c ) + ;" eval( -- ) ] unit-test
[ t ] [ test-quotatation cached-effect ( a b -- c ) effect<= ] unit-test
{ t } [ test-quotatation cached-effect ( a b -- c ) effect<= ] unit-test
: inline-cache-invalidation-test ( a b c -- c ) call( a b -- c ) ;
[ 4 ] [ 1 3 test-quotatation inline-cache-invalidation-test ] unit-test
{ 4 } [ 1 3 test-quotatation inline-cache-invalidation-test ] unit-test
[ ] [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests USE: math : call(-redefine-test ( a -- c ) 1 + ;" eval( -- ) ] unit-test
[ 1 3 test-quotatation inline-cache-invalidation-test ] [ T{ wrong-values f [ call(-redefine-test ] ( a b -- c ) } = ] must-fail-with
@ -151,8 +151,8 @@ TUPLE: my-tuple a b c ;
: my-word ( a b c q -- result ) call( a b c -- result ) ;
[ T{ my-tuple f 1 2 3 } ] [ 1 2 3 my-quot my-word ] unit-test
{ T{ my-tuple f 1 2 3 } } [ 1 2 3 my-quot my-word ] unit-test
[ ] [ "IN: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
{ } [ "IN: compiler.tree.propagation.call-effect.tests TUPLE: my-tuple a b ;" eval( -- ) ] unit-test
[ 1 2 3 my-quot my-word ] [ wrong-values? ] must-fail-with

View File

@ -4,22 +4,22 @@ IN: compiler.tree.propagation.copy.tests
H{ } clone copies set
[ ] [ 0 introduce-value ] unit-test
[ ] [ 1 introduce-value ] unit-test
[ ] [ 1 2 is-copy-of ] unit-test
[ ] [ 2 3 is-copy-of ] unit-test
[ ] [ 2 4 is-copy-of ] unit-test
[ ] [ 4 5 is-copy-of ] unit-test
[ ] [ 0 6 is-copy-of ] unit-test
{ } [ 0 introduce-value ] unit-test
{ } [ 1 introduce-value ] unit-test
{ } [ 1 2 is-copy-of ] unit-test
{ } [ 2 3 is-copy-of ] unit-test
{ } [ 2 4 is-copy-of ] unit-test
{ } [ 4 5 is-copy-of ] unit-test
{ } [ 0 6 is-copy-of ] unit-test
[ 0 ] [ 0 resolve-copy ] unit-test
[ 1 ] [ 5 resolve-copy ] unit-test
{ 0 } [ 0 resolve-copy ] unit-test
{ 1 } [ 5 resolve-copy ] unit-test
! Make sure that we did path compression
[ 1 ] [ 5 copies get at ] unit-test
{ 1 } [ 5 copies get at ] unit-test
[ 1 ] [ 1 resolve-copy ] unit-test
[ 1 ] [ 2 resolve-copy ] unit-test
[ 1 ] [ 3 resolve-copy ] unit-test
[ 1 ] [ 4 resolve-copy ] unit-test
[ 0 ] [ 6 resolve-copy ] unit-test
{ 1 } [ 1 resolve-copy ] unit-test
{ 1 } [ 2 resolve-copy ] unit-test
{ 1 } [ 3 resolve-copy ] unit-test
{ 1 } [ 4 resolve-copy ] unit-test
{ 0 } [ 6 resolve-copy ] unit-test

View File

@ -2,9 +2,9 @@ USING: accessors math math.intervals sequences classes.algebra
kernel tools.test compiler.tree.propagation.info arrays ;
IN: compiler.tree.propagation.info.tests
[ f ] [ 0.0 -0.0 eql? ] unit-test
{ f } [ 0.0 -0.0 eql? ] unit-test
[ t t ] [
{ t t } [
0 10 [a,b] <interval-info>
5 20 [a,b] <interval-info>
value-info-intersect
@ -13,62 +13,62 @@ IN: compiler.tree.propagation.info.tests
bi
] unit-test
[ float 10.0 t ] [
{ float 10.0 t } [
10.0 <literal-info>
10.0 <literal-info>
value-info-intersect
[ class>> ] [ >literal< ] bi
] unit-test
[ null ] [
{ null } [
10 <literal-info>
10.0 <literal-info>
value-info-intersect
class>>
] unit-test
[ fixnum 10 t ] [
{ fixnum 10 t } [
10 <literal-info>
10 <literal-info>
value-info-union
[ class>> ] [ >literal< ] bi
] unit-test
[ 3.0 t ] [
{ 3.0 t } [
3 3 [a,b] <interval-info> float <class-info>
value-info-intersect >literal<
] unit-test
[ 3 t ] [
{ 3 t } [
2 3 (a,b] <interval-info> fixnum <class-info>
value-info-intersect >literal<
] unit-test
[ T{ value-info-state f null empty-interval f f } ] [
{ T{ value-info-state f null empty-interval f f } } [
fixnum -10 0 [a,b] <class/interval-info>
fixnum 19 29 [a,b] <class/interval-info>
value-info-intersect
] unit-test
[ 3 t ] [
{ 3 t } [
3 <literal-info>
null-info value-info-union >literal<
] unit-test
[ ] [ { } value-infos-union drop ] unit-test
{ } [ { } value-infos-union drop ] unit-test
TUPLE: test-tuple { x read-only } ;
[ t ] [
{ t } [
f f 3 <literal-info> 3array test-tuple <tuple-info> dup
object-info value-info-intersect =
] unit-test
[ t ] [
{ t } [
null-info 3 <literal-info> value-info<=
] unit-test
[ t t ] [
{ t t } [
f <literal-info>
fixnum 0 40 [a,b] <class/interval-info>
value-info-union

File diff suppressed because it is too large Load Diff

View File

@ -2,51 +2,51 @@ USING: tools.test compiler.tree.propagation.recursive
math.intervals kernel math literals layouts ;
IN: compiler.tree.propagation.recursive.tests
[ T{ interval f { 0 t } { 1/0. t } } ] [
{ T{ interval f { 0 t } { 1/0. t } } } [
T{ interval f { 1 t } { 1 t } }
T{ interval f { 0 t } { 0 t } }
integer generalize-counter-interval
] unit-test
[ T{ interval f { 0 t } { $[ max-array-capacity ] t } } ] [
{ T{ interval f { 0 t } { $[ max-array-capacity ] t } } } [
T{ interval f { 1 t } { 1 t } }
T{ interval f { 0 t } { 0 t } }
fixnum generalize-counter-interval
] unit-test
[ T{ interval f { -1/0. t } { 10 t } } ] [
{ T{ interval f { -1/0. t } { 10 t } } } [
T{ interval f { -1 t } { -1 t } }
T{ interval f { 10 t } { 10 t } }
integer generalize-counter-interval
] unit-test
[ T{ interval f { $[ most-negative-fixnum ] t } { 10 t } } ] [
{ T{ interval f { $[ most-negative-fixnum ] t } { 10 t } } } [
T{ interval f { -1 t } { -1 t } }
T{ interval f { 10 t } { 10 t } }
fixnum generalize-counter-interval
] unit-test
[ t ] [
{ t } [
T{ interval f { -268435456 t } { 268435455 t } }
T{ interval f { 1 t } { 268435455 t } }
over
integer generalize-counter-interval =
] unit-test
[ t ] [
{ t } [
T{ interval f { -268435456 t } { 268435455 t } }
T{ interval f { 1 t } { 268435455 t } }
over
fixnum generalize-counter-interval =
] unit-test
[ full-interval ] [
{ full-interval } [
T{ interval f { -5 t } { 3 t } }
T{ interval f { 2 t } { 11 t } }
integer generalize-counter-interval
] unit-test
[ $[ fixnum-interval ] ] [
{ $[ fixnum-interval ] } [
T{ interval f { -5 t } { 3 t } }
T{ interval f { 2 t } { 11 t } }
fixnum generalize-counter-interval

View File

@ -6,10 +6,10 @@ compiler.tree.recursive
compiler.tree.recursive.private ;
IN: compiler.tree.recursive.tests
[ { f f f f } ] [ f { f t f f } (tail-calls) ] unit-test
[ { f f f t } ] [ t { f t f f } (tail-calls) ] unit-test
[ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test
[ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test
{ { f f f f } } [ f { f t f f } (tail-calls) ] unit-test
{ { f f f t } } [ t { f t f f } (tail-calls) ] unit-test
{ { f t t t } } [ t { f f t t } (tail-calls) ] unit-test
{ { f f f t } } [ t { f f t f } (tail-calls) ] unit-test
: label-is-loop? ( nodes word -- ? )
swap [
@ -34,22 +34,22 @@ IN: compiler.tree.recursive.tests
: loop-test-1 ( a -- )
dup [ 1 + loop-test-1 ] [ drop ] if ; inline recursive
[ t ] [
{ t } [
[ loop-test-1 ] build-tree analyze-recursive
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
{ t } [
[ loop-test-1 1 2 3 ] build-tree analyze-recursive
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
{ t } [
[ [ loop-test-1 ] each ] build-tree analyze-recursive
\ loop-test-1 label-is-loop?
] unit-test
[ t ] [
{ t } [
[ [ loop-test-1 ] each ] build-tree analyze-recursive
\ (each-integer) label-is-loop?
] unit-test
@ -57,7 +57,7 @@ IN: compiler.tree.recursive.tests
: loop-test-2 ( a b -- a' )
dup [ 1 + loop-test-2 1 - ] [ drop ] if ; inline recursive
[ t ] [
{ t } [
[ loop-test-2 ] build-tree analyze-recursive
\ loop-test-2 label-is-not-loop?
] unit-test
@ -65,12 +65,12 @@ IN: compiler.tree.recursive.tests
: loop-test-3 ( a -- )
dup [ [ loop-test-3 ] each ] [ drop ] if ; inline recursive
[ t ] [
{ t } [
[ loop-test-3 ] build-tree analyze-recursive
\ loop-test-3 label-is-not-loop?
] unit-test
[ f ] [
{ f } [
[ [ [ ] map ] map ] build-tree analyze-recursive
[
dup #recursive? [ label>> loop?>> not ] [ drop f ] if
@ -87,22 +87,22 @@ DEFER: a
: a ( -- )
blah [ b ] [ a ] if ; inline recursive
[ t ] [
{ t } [
[ a ] build-tree analyze-recursive
\ a label-is-loop?
] unit-test
[ t ] [
{ t } [
[ a ] build-tree analyze-recursive
\ b label-is-loop?
] unit-test
[ t ] [
{ t } [
[ b ] build-tree analyze-recursive
\ a label-is-loop?
] unit-test
[ t ] [
{ t } [
[ a ] build-tree analyze-recursive
\ b label-is-loop?
] unit-test
@ -115,12 +115,12 @@ DEFER: a'
: a' ( -- )
blah [ b' ] [ a' ] if ; inline recursive
[ f ] [
{ f } [
[ a' ] build-tree analyze-recursive
\ a' label-is-loop?
] unit-test
[ f ] [
{ f } [
[ b' ] build-tree analyze-recursive
\ b' label-is-loop?
] unit-test
@ -129,12 +129,12 @@ DEFER: a'
! paper almost convinced me that a loop conversion here is
! sound.
[ t ] [
{ t } [
[ b' ] build-tree analyze-recursive
\ a' label-is-loop?
] unit-test
[ f ] [
{ f } [
[ a' ] build-tree analyze-recursive
\ b' label-is-loop?
] unit-test
@ -147,22 +147,22 @@ DEFER: a''
: a'' ( a -- b )
dup [ b'' a'' ] when ; inline recursive
[ t ] [
{ t } [
[ a'' ] build-tree analyze-recursive
\ a'' label-is-not-loop?
] unit-test
[ t ] [
{ t } [
[ a'' ] build-tree analyze-recursive
\ b'' label-is-loop?
] unit-test
[ t ] [
{ t } [
[ b'' ] build-tree analyze-recursive
\ a'' label-is-loop?
] unit-test
[ t ] [
{ t } [
[ b'' ] build-tree analyze-recursive
\ b'' label-is-not-loop?
] unit-test
@ -172,7 +172,7 @@ DEFER: a''
[ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi
] [ 2drop ] if ; inline recursive
[ t ] [
{ t } [
[ 10 [ [ drop ] each-integer ] loop-in-non-loop ]
build-tree analyze-recursive
\ (each-integer) label-is-loop?
@ -186,7 +186,7 @@ DEFER: a'''
: a''' ( -- )
blah [ b''' ] [ a''' ] if ; inline recursive
[ t ] [
{ t } [
[ b''' ] build-tree analyze-recursive
\ a''' label-is-loop?
] unit-test
@ -197,7 +197,7 @@ DEFER: b4
: b4 ( a -- b ) dup [ a4 reverse ] when ; inline recursive
[ t ] [ [ b4 ] build-tree analyze-recursive \ a4 label-is-loop? ] unit-test
[ t ] [ [ b4 ] build-tree analyze-recursive \ b4 label-is-not-loop? ] unit-test
[ t ] [ [ a4 ] build-tree analyze-recursive \ a4 label-is-not-loop? ] unit-test
[ t ] [ [ a4 ] build-tree analyze-recursive \ b4 label-is-loop? ] unit-test
{ t } [ [ b4 ] build-tree analyze-recursive \ a4 label-is-loop? ] unit-test
{ t } [ [ b4 ] build-tree analyze-recursive \ b4 label-is-not-loop? ] unit-test
{ t } [ [ a4 ] build-tree analyze-recursive \ a4 label-is-not-loop? ] unit-test
{ t } [ [ a4 ] build-tree analyze-recursive \ b4 label-is-loop? ] unit-test

View File

@ -45,11 +45,11 @@ TUPLE: empty-tuple ;
: bleach-node ( quot: ( ..a -- ..b ) -- )
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
[ ] [ [ [ ] bleach-node ] test-unboxing ] unit-test
{ } [ [ [ ] bleach-node ] test-unboxing ] unit-test
TUPLE: box { i read-only } ;
: box-test ( m -- n )
dup box-test i>> swap box-test drop box boa ; inline recursive
[ ] [ [ T{ box f 34 } box-test i>> ] test-unboxing ] unit-test
{ } [ [ T{ box f 34 } box-test i>> ] test-unboxing ] unit-test

View File

@ -3,7 +3,7 @@
USING: tools.test compression.inflate ;
IN: compression.inflate.tests
[
{
B{
1 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 122 121 94 119
@ -58,7 +58,7 @@ B{
255 255 255 0 255 255 255 0 255 255 255 0 255 255 255 0 255
255 255 0
}
] [
} [
B{
56 141 99 252 255 255 63 3 41 160 170 50 174 252 253 219
199 17 2 2 92 172 2 130 82 107 152 69 132 191 138 153 153

View File

@ -3,22 +3,22 @@
USING: arrays byte-arrays compression.snappy kernel tools.test ;
IN: compression.snappy.tests
[ t ] [
{ t } [
1000 2 <array> >byte-array [ snappy-compress snappy-uncompress ] keep =
] unit-test
[ t ] [
{ t } [
B{ } [ snappy-compress snappy-uncompress ] keep =
] unit-test
[ t ] [
{ t } [
B{ 1 } [ snappy-compress snappy-uncompress ] keep =
] unit-test
[ t ] [
{ t } [
B{ 1 2 } [ snappy-compress snappy-uncompress ] keep =
] unit-test
[ t ] [
{ t } [
B{ 1 2 3 } [ snappy-compress snappy-uncompress ] keep =
] unit-test

View File

@ -6,6 +6,6 @@ IN: compression.zlib.tests
: compress-me ( -- byte-array ) B{ 1 2 3 4 5 } ;
[ t ] [ compress-me [ compress uncompress ] keep = ] unit-test
{ t } [ compress-me [ compress uncompress ] keep = ] unit-test
[ ffi:Z_DATA_ERROR zlib-error-message ] [ string>> "data error" = ] must-fail-with

View File

@ -9,28 +9,28 @@ IN: concurrency.combinators.tests
{ 2 1 } [ [ 2array ] 2parallel-map ] must-infer-as
[ [ ] parallel-filter ] must-infer
[ { 1 4 9 } ] [ { 1 2 3 } [ sq ] parallel-map ] unit-test
{ { 1 4 9 } } [ { 1 2 3 } [ sq ] parallel-map ] unit-test
[ { 1 4 9 } ] [ { 1 2 3 } [ 1000000 random sleep sq ] parallel-map ] unit-test
{ { 1 4 9 } } [ { 1 2 3 } [ 1000000 random sleep sq ] parallel-map ] unit-test
[ { 1 2 3 } [ dup 2 mod 0 = [ "Even" throw ] when ] parallel-map ]
[ error>> "Even" = ] must-fail-with
[ V{ 0 3 6 9 } ]
{ V{ 0 3 6 9 } }
[ 10 iota [ 3 mod zero? ] parallel-filter ] unit-test
[ 10 ]
{ 10 }
[
V{ } clone
10 iota over [ push ] curry parallel-each
length
] unit-test
[ { 10 20 30 } ] [
{ { 10 20 30 } } [
{ 1 4 3 } { 10 5 10 } [ * ] 2parallel-map
] unit-test
[ { -9 -1 -7 } ] [
{ { -9 -1 -7 } } [
{ 1 4 3 } { 10 5 10 } [ - ] 2parallel-map
] unit-test
@ -38,7 +38,7 @@ IN: concurrency.combinators.tests
{ 1 4 3 } { 1 0 1 } [ / drop ] 2parallel-each
] must-fail
[ 20 ]
{ 20 }
[
V{ } clone
10 iota 10 iota pick [ [ push ] [ push ] bi ] curry 2parallel-each
@ -47,7 +47,7 @@ IN: concurrency.combinators.tests
[ { f } [ "OOPS" throw ] parallel-each ] must-fail
[ "1a" "4b" "3c" ] [
{ "1a" "4b" "3c" } [
2
{ [ 1 - ] [ sq ] [ 1 + ] } parallel-cleave
[ number>string ] 3 parallel-napply

View File

@ -1,11 +1,11 @@
USING: concurrency.count-downs threads kernel tools.test ;
IN: concurrency.count-downs.tests`
[ ] [ 0 <count-down> await ] unit-test
{ } [ 0 <count-down> await ] unit-test
[ 1 <count-down> dup count-down count-down ] must-fail
[ ] [
{ } [
1 <count-down>
3 <count-down>
2dup [ await count-down ] 2curry "Master" spawn drop

View File

@ -20,7 +20,7 @@ CONSTANT: test-ip "127.0.0.1"
} cond ;
[ ] [ [ "distributed-concurrency-test" temp-file delete-file ] ignore-errors ] unit-test
{ } [ [ "distributed-concurrency-test" temp-file delete-file ] ignore-errors ] unit-test
test-node-server [
[ ] [

View File

@ -26,4 +26,4 @@ IN: concurrency.exchangers.tests
pr ?promise ;
[ "Hello world, Goodbye world" ] [ exchanger-test ] unit-test
{ "Hello world, Goodbye world" } [ exchanger-test ] unit-test

View File

@ -8,7 +8,7 @@ IN: concurrency.flags.tests
f lower-flag
f value>> ;
[ f ] [ flag-test-1 ] unit-test
{ f } [ flag-test-1 ] unit-test
:: flag-test-2 ( -- ? )
<flag> :> f
@ -16,14 +16,14 @@ IN: concurrency.flags.tests
f lower-flag
f value>> ;
[ f ] [ flag-test-2 ] unit-test
{ f } [ flag-test-2 ] unit-test
:: flag-test-3 ( -- val )
<flag> :> f
f raise-flag
f value>> ;
[ t ] [ flag-test-3 ] unit-test
{ t } [ flag-test-3 ] unit-test
:: flag-test-4 ( -- val )
<flag> :> f
@ -31,7 +31,7 @@ IN: concurrency.flags.tests
f wait-for-flag
f value>> ;
[ t ] [ flag-test-4 ] unit-test
{ t } [ flag-test-4 ] unit-test
:: flag-test-5 ( -- val )
<flag> :> f
@ -39,9 +39,9 @@ IN: concurrency.flags.tests
f wait-for-flag
f value>> ;
[ t ] [ flag-test-5 ] unit-test
{ t } [ flag-test-5 ] unit-test
[ ] [
{ } [
{ 1 2 } <flag>
[ [ 1 seconds sleep raise-flag ] curry "Flag test" spawn drop ]
[ [ wait-for-flag drop ] curry parallel-each ] bi

View File

@ -1,7 +1,7 @@
USING: concurrency.futures kernel tools.test threads ;
IN: concurrency.futures.tests
[ 50 ] [
{ 50 } [
[ 50 ] future ?future
] unit-test
@ -9,17 +9,17 @@ IN: concurrency.futures.tests
[ "this should propogate" throw ] future ?future
] must-fail
[ ] [
{ } [
[ "this should not propogate" throw ] future drop
] unit-test
! Race condition with futures
[ 3 3 ] [
{ 3 3 } [
[ 3 ] future
dup ?future swap ?future
] unit-test
! Another race
[ 3 ] [
{ 3 } [
[ 3 yield ] future ?future
] unit-test

View File

@ -54,10 +54,10 @@ IN: concurrency.locks.tests
c await
v ;
[ V{ 1 3 2 4 } ] [ lock-test-0 ] unit-test
[ V{ 1 2 3 4 } ] [ lock-test-1 ] unit-test
{ V{ 1 3 2 4 } } [ lock-test-0 ] unit-test
{ V{ 1 2 3 4 } } [ lock-test-1 ] unit-test
[ 3 ] [
{ 3 } [
<reentrant-lock> dup [
[
3
@ -65,17 +65,17 @@ IN: concurrency.locks.tests
] with-lock
] unit-test
[ ] [ <rw-lock> drop ] unit-test
{ } [ <rw-lock> drop ] unit-test
[ ] [ <rw-lock> [ ] with-read-lock ] unit-test
{ } [ <rw-lock> [ ] with-read-lock ] unit-test
[ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-read-lock ] unit-test
{ } [ <rw-lock> dup [ [ ] with-read-lock ] with-read-lock ] unit-test
[ ] [ <rw-lock> [ ] with-write-lock ] unit-test
{ } [ <rw-lock> [ ] with-write-lock ] unit-test
[ ] [ <rw-lock> dup [ [ ] with-write-lock ] with-write-lock ] unit-test
{ } [ <rw-lock> dup [ [ ] with-write-lock ] with-write-lock ] unit-test
[ ] [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test
{ } [ <rw-lock> dup [ [ ] with-read-lock ] with-write-lock ] unit-test
:: rw-lock-test-1 ( -- v )
<rw-lock> :> l
@ -124,7 +124,7 @@ IN: concurrency.locks.tests
c'' await
v ;
[ V{ 1 2 3 4 5 6 } ] [ rw-lock-test-1 ] unit-test
{ V{ 1 2 3 4 5 6 } } [ rw-lock-test-1 ] unit-test
:: rw-lock-test-2 ( -- v )
<rw-lock> :> l
@ -153,7 +153,7 @@ IN: concurrency.locks.tests
c' await
v ;
[ V{ 1 2 3 } ] [ rw-lock-test-2 ] unit-test
{ V{ 1 2 3 } } [ rw-lock-test-2 ] unit-test
! Test lock timeouts
:: lock-timeout-test ( -- v )
@ -187,7 +187,7 @@ IN: concurrency.locks.tests
] with-write-lock
] must-fail
[ ] [
{ } [
<rw-lock> dup [
dup [
1 seconds [ ] with-read-lock-timeout

View File

@ -5,7 +5,7 @@ IN: concurrency.mailboxes.tests
{ 1 1 } [ [ integer? ] mailbox-get? ] must-infer-as
[ V{ 1 2 3 } ] [
{ V{ 1 2 3 } } [
0 <vector>
<mailbox>
[ mailbox-get swap push ] in-thread
@ -16,7 +16,7 @@ IN: concurrency.mailboxes.tests
3 swap mailbox-put
] unit-test
[ V{ 1 2 3 } ] [
{ V{ 1 2 3 } } [
0 <vector>
<mailbox>
[ [ integer? ] mailbox-get? swap push ] in-thread
@ -27,7 +27,7 @@ IN: concurrency.mailboxes.tests
3 swap mailbox-put
] unit-test
[ V{ 1 "junk" 3 "junk2" } [ 456 ] ] [
{ V{ 1 "junk" 3 "junk2" } [ 456 ] } [
0 <vector>
<mailbox>
[ [ integer? ] mailbox-get? swap push ] in-thread
@ -42,7 +42,7 @@ IN: concurrency.mailboxes.tests
mailbox-get
] unit-test
[ { "foo" "bar" } ] [
{ { "foo" "bar" } } [
<mailbox>
"foo" over mailbox-put
"bar" over mailbox-put

View File

@ -6,16 +6,16 @@ quotations concurrency.messaging concurrency.mailboxes
concurrency.count-downs accessors ;
IN: concurrency.messaging.tests
[ ] [ my-mailbox data>> clear-deque ] unit-test
{ } [ my-mailbox data>> clear-deque ] unit-test
[ "received" ] [
{ "received" } [
[
receive "received" swap reply-synchronous
] "Synchronous test" spawn
"sent" swap send-synchronous
] unit-test
[ 1 3 2 ] [
{ 1 3 2 } [
1 self send
2 self send
3 self send
@ -45,7 +45,7 @@ SYMBOL: exit
{ exit [ f ] }
} match-cond ;
[ -5 ] [
{ -5 } [
[ 0 [ counter ] loop ] "Counter" spawn "counter" set
{ increment 10 } "counter" get send
{ decrement 15 } "counter" get send

View File

@ -2,7 +2,7 @@ USING: vectors concurrency.promises kernel threads sequences
tools.test ;
IN: concurrency.promises.tests
[ V{ 50 50 50 } ] [
{ V{ 50 50 50 } } [
0 <vector>
<promise>
[ ?promise swap push ] in-thread

View File

@ -2,7 +2,7 @@ IN: core-foundation.arrays.tests
USING: core-foundation core-foundation.arrays
core-foundation.strings destructors sequences tools.test ;
[ { "1" "2" "3" } ] [
{ { "1" "2" "3" } } [
[
{ "1" "2" "3" }
[ <CFString> &CFRelease ] map

View File

@ -4,4 +4,4 @@ USING: tools.test core-foundation.attributed-strings
core-foundation ;
IN: core-foundation.attributed-strings.tests
[ ] [ "Hello world" H{ } <CFAttributedString> CFRelease ] unit-test
{ } [ "Hello world" H{ } <CFAttributedString> CFRelease ] unit-test

View File

@ -4,9 +4,9 @@ USING: tools.test core-foundation core-foundation.dictionaries
arrays destructors core-foundation.strings kernel namespaces ;
IN: core-foundation.dictionaries.tests
[ ] [ { } <CFDictionary> CFRelease ] unit-test
{ } [ { } <CFDictionary> CFRelease ] unit-test
[ "raps in the back of cars and doesn't afraid of anything" ] [
{ "raps in the back of cars and doesn't afraid of anything" } [
[
"cpst" <CFString> &CFRelease dup "key" set
"raps in the back of cars and doesn't afraid of anything" <CFString> &CFRelease

View File

@ -4,12 +4,12 @@ USING: core-foundation.strings core-foundation tools.test kernel
strings ;
IN: core-foundation
[ ] [ "Hello" <CFString> CFRelease ] unit-test
[ "Hello" ] [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
[ "Hello\u003456" ] [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
[ "Hello\u013456" ] [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
[ ] [ "\0" <CFString> CFRelease ] unit-test
[ "\0" ] [ "\0" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
{ } [ "Hello" <CFString> CFRelease ] unit-test
{ "Hello" } [ "Hello" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
{ "Hello\u003456" } [ "Hello\u003456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
{ "Hello\u013456" } [ "Hello\u013456" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
{ } [ "\0" <CFString> CFRelease ] unit-test
{ "\0" } [ "\0" <CFString> [ CF>string ] [ CFRelease ] bi ] unit-test
! This shouldn't fail
[ ] [ { 0x123456 } >string <CFString> CFRelease ] unit-test
{ } [ { 0x123456 } >string <CFString> CFRelease ] unit-test

View File

@ -3,13 +3,13 @@ kernel tools.test namespaces make layouts ;
IN: cpu.x86.assembler.tests
! small registers
[ { 128 192 12 } ] [ [ AL 12 <byte> ADD ] { } make ] unit-test
[ { 128 196 12 } ] [ [ AH 12 <byte> ADD ] { } make ] unit-test
[ { 176 12 } ] [ [ AL 12 <byte> MOV ] { } make ] unit-test
[ { 180 12 } ] [ [ AH 12 <byte> MOV ] { } make ] unit-test
[ { 198 0 12 } ] [ [ EAX [] 12 <byte> MOV ] { } make ] unit-test
[ { 0 235 } ] [ [ BL CH ADD ] { } make ] unit-test
[ { 136 235 } ] [ [ BL CH MOV ] { } make ] unit-test
{ { 128 192 12 } } [ [ AL 12 <byte> ADD ] { } make ] unit-test
{ { 128 196 12 } } [ [ AH 12 <byte> ADD ] { } make ] unit-test
{ { 176 12 } } [ [ AL 12 <byte> MOV ] { } make ] unit-test
{ { 180 12 } } [ [ AH 12 <byte> MOV ] { } make ] unit-test
{ { 198 0 12 } } [ [ EAX [] 12 <byte> MOV ] { } make ] unit-test
{ { 0 235 } } [ [ BL CH ADD ] { } make ] unit-test
{ { 136 235 } } [ [ BL CH MOV ] { } make ] unit-test
! immediate operands
cell 4 = [
@ -18,220 +18,220 @@ cell 4 = [
[ { 0xb9 0x01 0x00 0x00 0x00 0x00 0x00 0x00 0x00 } ] [ [ ECX 1 MOV ] { } make ] unit-test
] if
[ { 0x83 0xc1 0x01 } ] [ [ ECX 1 ADD ] { } make ] unit-test
[ { 0x81 0xc1 0x96 0x00 0x00 0x00 } ] [ [ ECX 150 ADD ] { } make ] unit-test
[ { 0xf7 0xc1 0xd2 0x04 0x00 0x00 } ] [ [ ECX 1234 TEST ] { } make ] unit-test
{ { 0x83 0xc1 0x01 } } [ [ ECX 1 ADD ] { } make ] unit-test
{ { 0x81 0xc1 0x96 0x00 0x00 0x00 } } [ [ ECX 150 ADD ] { } make ] unit-test
{ { 0xf7 0xc1 0xd2 0x04 0x00 0x00 } } [ [ ECX 1234 TEST ] { } make ] unit-test
! 64-bit registers
[ { 0x40 0x8a 0x2a } ] [ [ BPL RDX [] MOV ] { } make ] unit-test
{ { 0x40 0x8a 0x2a } } [ [ BPL RDX [] MOV ] { } make ] unit-test
[ { 0x49 0x89 0x04 0x24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test
[ { 0x49 0x8b 0x06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test
{ { 0x49 0x89 0x04 0x24 } } [ [ R12 [] RAX MOV ] { } make ] unit-test
{ { 0x49 0x8b 0x06 } } [ [ RAX R14 [] MOV ] { } make ] unit-test
[ { 0x89 0xca } ] [ [ EDX ECX MOV ] { } make ] unit-test
[ { 0x4c 0x89 0xe2 } ] [ [ RDX R12 MOV ] { } make ] unit-test
[ { 0x49 0x89 0xd4 } ] [ [ R12 RDX MOV ] { } make ] unit-test
{ { 0x89 0xca } } [ [ EDX ECX MOV ] { } make ] unit-test
{ { 0x4c 0x89 0xe2 } } [ [ RDX R12 MOV ] { } make ] unit-test
{ { 0x49 0x89 0xd4 } } [ [ R12 RDX MOV ] { } make ] unit-test
! memory address modes
[ { 0x8a 0x18 } ] [ [ BL RAX [] MOV ] { } make ] unit-test
[ { 0x66 0x8b 0x18 } ] [ [ BX RAX [] MOV ] { } make ] unit-test
[ { 0x8b 0x18 } ] [ [ EBX RAX [] MOV ] { } make ] unit-test
[ { 0x48 0x8b 0x18 } ] [ [ RBX RAX [] MOV ] { } make ] unit-test
[ { 0x88 0x18 } ] [ [ RAX [] BL MOV ] { } make ] unit-test
[ { 0x66 0x89 0x18 } ] [ [ RAX [] BX MOV ] { } make ] unit-test
[ { 0x89 0x18 } ] [ [ RAX [] EBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x18 } ] [ [ RAX [] RBX MOV ] { } make ] unit-test
{ { 0x8a 0x18 } } [ [ BL RAX [] MOV ] { } make ] unit-test
{ { 0x66 0x8b 0x18 } } [ [ BX RAX [] MOV ] { } make ] unit-test
{ { 0x8b 0x18 } } [ [ EBX RAX [] MOV ] { } make ] unit-test
{ { 0x48 0x8b 0x18 } } [ [ RBX RAX [] MOV ] { } make ] unit-test
{ { 0x88 0x18 } } [ [ RAX [] BL MOV ] { } make ] unit-test
{ { 0x66 0x89 0x18 } } [ [ RAX [] BX MOV ] { } make ] unit-test
{ { 0x89 0x18 } } [ [ RAX [] EBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x18 } } [ [ RAX [] RBX MOV ] { } make ] unit-test
[ { 0x0f 0xbe 0xc3 } ] [ [ EAX BL MOVSX ] { } make ] unit-test
[ { 0x0f 0xbf 0xc3 } ] [ [ EAX BX MOVSX ] { } make ] unit-test
{ { 0x0f 0xbe 0xc3 } } [ [ EAX BL MOVSX ] { } make ] unit-test
{ { 0x0f 0xbf 0xc3 } } [ [ EAX BX MOVSX ] { } make ] unit-test
[ { 0x80 0x08 0x05 } ] [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
[ { 0xc6 0x00 0x05 } ] [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
{ { 0x80 0x08 0x05 } } [ [ EAX [] 5 <byte> OR ] { } make ] unit-test
{ { 0xc6 0x00 0x05 } } [ [ EAX [] 5 <byte> MOV ] { } make ] unit-test
[ { 0x49 0x89 0x04 0x1a } ] [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x49 0x89 0x04 0x1b } ] [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x49 0x89 0x04 0x1a } } [ [ R10 RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x49 0x89 0x04 0x1b } } [ [ R11 RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x49 0x89 0x04 0x1c } ] [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x04 0x1c } ] [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x49 0x89 0x04 0x1c } } [ [ R12 RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x04 0x1c } } [ [ RSP RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x49 0x89 0x44 0x1d 0x00 } ] [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x44 0x1d 0x00 } ] [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x49 0x89 0x44 0x1d 0x00 } } [ [ R13 RBX [+] RAX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x44 0x1d 0x00 } } [ [ RBP RBX [+] RAX MOV ] { } make ] unit-test
[ { 0x4a 0x89 0x04 0x23 } ] [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test
[ { 0x4a 0x89 0x04 0x2b } ] [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test
{ { 0x4a 0x89 0x04 0x23 } } [ [ RBX R12 [+] RAX MOV ] { } make ] unit-test
{ { 0x4a 0x89 0x04 0x2b } } [ [ RBX R13 [+] RAX MOV ] { } make ] unit-test
[ { 0x4b 0x89 0x44 0x25 0x00 } ] [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test
[ { 0x4b 0x89 0x04 0x2c } ] [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test
{ { 0x4b 0x89 0x44 0x25 0x00 } } [ [ R13 R12 [+] RAX MOV ] { } make ] unit-test
{ { 0x4b 0x89 0x04 0x2c } } [ [ R12 R13 [+] RAX MOV ] { } make ] unit-test
[ { 0x49 0x89 0x04 0x2c } ] [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test
{ { 0x49 0x89 0x04 0x2c } } [ [ R12 RBP [+] RAX MOV ] { } make ] unit-test
[ [ R12 RSP [+] RAX MOV ] { } make ] must-fail
[ { 0x89 0x1c 0x11 } ] [ [ ECX EDX [+] EBX MOV ] { } make ] unit-test
[ { 0x89 0x1c 0x51 } ] [ [ ECX EDX 1 0 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x1c 0x91 } ] [ [ ECX EDX 2 0 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x1c 0xd1 } ] [ [ ECX EDX 3 0 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x5c 0x11 0x64 } ] [ [ ECX EDX 0 100 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x5c 0x51 0x64 } ] [ [ ECX EDX 1 100 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x5c 0x91 0x64 } ] [ [ ECX EDX 2 100 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x89 0x5c 0xd1 0x64 } ] [ [ ECX EDX 3 100 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x1c 0x11 } } [ [ ECX EDX [+] EBX MOV ] { } make ] unit-test
{ { 0x89 0x1c 0x51 } } [ [ ECX EDX 1 0 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x1c 0x91 } } [ [ ECX EDX 2 0 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x1c 0xd1 } } [ [ ECX EDX 3 0 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x5c 0x11 0x64 } } [ [ ECX EDX 0 100 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x5c 0x51 0x64 } } [ [ ECX EDX 1 100 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x5c 0x91 0x64 } } [ [ ECX EDX 2 100 <indirect> EBX MOV ] { } make ] unit-test
{ { 0x89 0x5c 0xd1 0x64 } } [ [ ECX EDX 3 100 <indirect> EBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x1c 0x11 } ] [ [ RCX RDX [+] RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x1c 0x51 } ] [ [ RCX RDX 1 0 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x1c 0x91 } ] [ [ RCX RDX 2 0 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x1c 0xd1 } ] [ [ RCX RDX 3 0 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x5c 0x11 0x64 } ] [ [ RCX RDX 0 100 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x5c 0x51 0x64 } ] [ [ RCX RDX 1 100 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x5c 0x91 0x64 } ] [ [ RCX RDX 2 100 <indirect> RBX MOV ] { } make ] unit-test
[ { 0x48 0x89 0x5c 0xd1 0x64 } ] [ [ RCX RDX 3 100 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x1c 0x11 } } [ [ RCX RDX [+] RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x1c 0x51 } } [ [ RCX RDX 1 0 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x1c 0x91 } } [ [ RCX RDX 2 0 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x1c 0xd1 } } [ [ RCX RDX 3 0 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x5c 0x11 0x64 } } [ [ RCX RDX 0 100 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x5c 0x51 0x64 } } [ [ RCX RDX 1 100 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x5c 0x91 0x64 } } [ [ RCX RDX 2 100 <indirect> RBX MOV ] { } make ] unit-test
{ { 0x48 0x89 0x5c 0xd1 0x64 } } [ [ RCX RDX 3 100 <indirect> RBX MOV ] { } make ] unit-test
! r-rm / m-r sse instruction
[ { 0x0f 0x10 0xc1 } ] [ [ XMM0 XMM1 MOVUPS ] { } make ] unit-test
[ { 0x0f 0x10 0x01 } ] [ [ XMM0 ECX [] MOVUPS ] { } make ] unit-test
[ { 0x0f 0x11 0x08 } ] [ [ EAX [] XMM1 MOVUPS ] { } make ] unit-test
{ { 0x0f 0x10 0xc1 } } [ [ XMM0 XMM1 MOVUPS ] { } make ] unit-test
{ { 0x0f 0x10 0x01 } } [ [ XMM0 ECX [] MOVUPS ] { } make ] unit-test
{ { 0x0f 0x11 0x08 } } [ [ EAX [] XMM1 MOVUPS ] { } make ] unit-test
[ { 0xf3 0x0f 0x10 0xc1 } ] [ [ XMM0 XMM1 MOVSS ] { } make ] unit-test
[ { 0xf3 0x0f 0x10 0x01 } ] [ [ XMM0 ECX [] MOVSS ] { } make ] unit-test
[ { 0xf3 0x0f 0x11 0x08 } ] [ [ EAX [] XMM1 MOVSS ] { } make ] unit-test
{ { 0xf3 0x0f 0x10 0xc1 } } [ [ XMM0 XMM1 MOVSS ] { } make ] unit-test
{ { 0xf3 0x0f 0x10 0x01 } } [ [ XMM0 ECX [] MOVSS ] { } make ] unit-test
{ { 0xf3 0x0f 0x11 0x08 } } [ [ EAX [] XMM1 MOVSS ] { } make ] unit-test
[ { 0x66 0x0f 0x6f 0xc1 } ] [ [ XMM0 XMM1 MOVDQA ] { } make ] unit-test
[ { 0x66 0x0f 0x6f 0x01 } ] [ [ XMM0 ECX [] MOVDQA ] { } make ] unit-test
[ { 0x66 0x0f 0x7f 0x08 } ] [ [ EAX [] XMM1 MOVDQA ] { } make ] unit-test
{ { 0x66 0x0f 0x6f 0xc1 } } [ [ XMM0 XMM1 MOVDQA ] { } make ] unit-test
{ { 0x66 0x0f 0x6f 0x01 } } [ [ XMM0 ECX [] MOVDQA ] { } make ] unit-test
{ { 0x66 0x0f 0x7f 0x08 } } [ [ EAX [] XMM1 MOVDQA ] { } make ] unit-test
! r-rm only sse instruction
[ { 0x66 0x0f 0x2e 0xc1 } ] [ [ XMM0 XMM1 UCOMISD ] { } make ] unit-test
[ { 0x66 0x0f 0x2e 0x01 } ] [ [ XMM0 ECX [] UCOMISD ] { } make ] unit-test
{ { 0x66 0x0f 0x2e 0xc1 } } [ [ XMM0 XMM1 UCOMISD ] { } make ] unit-test
{ { 0x66 0x0f 0x2e 0x01 } } [ [ XMM0 ECX [] UCOMISD ] { } make ] unit-test
[ [ EAX [] XMM1 UCOMISD ] { } make ] must-fail
[ { 0x66 0x0f 0x38 0x2a 0x01 } ] [ [ XMM0 ECX [] MOVNTDQA ] { } make ] unit-test
{ { 0x66 0x0f 0x38 0x2a 0x01 } } [ [ XMM0 ECX [] MOVNTDQA ] { } make ] unit-test
[ { 0x66 0x48 0x0f 0x6e 0xc8 } ] [ [ XMM1 RAX MOVD ] { } make ] unit-test
[ { 0x66 0x0f 0x6e 0xc8 } ] [ [ XMM1 EAX MOVD ] { } make ] unit-test
[ { 0x66 0x48 0x0f 0x7e 0xc8 } ] [ [ RAX XMM1 MOVD ] { } make ] unit-test
[ { 0x66 0x0f 0x7e 0xc8 } ] [ [ EAX XMM1 MOVD ] { } make ] unit-test
{ { 0x66 0x48 0x0f 0x6e 0xc8 } } [ [ XMM1 RAX MOVD ] { } make ] unit-test
{ { 0x66 0x0f 0x6e 0xc8 } } [ [ XMM1 EAX MOVD ] { } make ] unit-test
{ { 0x66 0x48 0x0f 0x7e 0xc8 } } [ [ RAX XMM1 MOVD ] { } make ] unit-test
{ { 0x66 0x0f 0x7e 0xc8 } } [ [ EAX XMM1 MOVD ] { } make ] unit-test
[ { 0xf3 0x0f 0x7e 0x08 } ] [ [ XMM1 EAX [] MOVQ ] { } make ] unit-test
[ { 0xf3 0x0f 0x7e 0x08 } ] [ [ XMM1 EAX [] MOVQ ] { } make ] unit-test
[ { 0xf3 0x0f 0x7e 0xca } ] [ [ XMM1 XMM2 MOVQ ] { } make ] unit-test
{ { 0xf3 0x0f 0x7e 0x08 } } [ [ XMM1 EAX [] MOVQ ] { } make ] unit-test
{ { 0xf3 0x0f 0x7e 0x08 } } [ [ XMM1 EAX [] MOVQ ] { } make ] unit-test
{ { 0xf3 0x0f 0x7e 0xca } } [ [ XMM1 XMM2 MOVQ ] { } make ] unit-test
! rm-r only sse instructions
[ { 0x0f 0x2b 0x08 } ] [ [ EAX [] XMM1 MOVNTPS ] { } make ] unit-test
[ { 0x66 0x0f 0xe7 0x08 } ] [ [ EAX [] XMM1 MOVNTDQ ] { } make ] unit-test
{ { 0x0f 0x2b 0x08 } } [ [ EAX [] XMM1 MOVNTPS ] { } make ] unit-test
{ { 0x66 0x0f 0xe7 0x08 } } [ [ EAX [] XMM1 MOVNTDQ ] { } make ] unit-test
! three-byte-opcode ssse3 instruction
[ { 0x66 0x0f 0x38 0x02 0xc1 } ] [ [ XMM0 XMM1 PHADDD ] { } make ] unit-test
{ { 0x66 0x0f 0x38 0x02 0xc1 } } [ [ XMM0 XMM1 PHADDD ] { } make ] unit-test
! int/sse conversion instruction
[ { 0xf2 0x0f 0x2c 0xc0 } ] [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
[ { 0xf2 0x48 0x0f 0x2c 0xc0 } ] [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
[ { 0xf2 0x4c 0x0f 0x2c 0xe0 } ] [ [ R12 XMM0 CVTTSD2SI ] { } make ] unit-test
[ { 0xf2 0x0f 0x2a 0xc0 } ] [ [ XMM0 EAX CVTSI2SD ] { } make ] unit-test
[ { 0xf2 0x48 0x0f 0x2a 0xc0 } ] [ [ XMM0 RAX CVTSI2SD ] { } make ] unit-test
[ { 0xf2 0x48 0x0f 0x2a 0xc1 } ] [ [ XMM0 RCX CVTSI2SD ] { } make ] unit-test
[ { 0xf2 0x48 0x0f 0x2a 0xd9 } ] [ [ XMM3 RCX CVTSI2SD ] { } make ] unit-test
[ { 0xf2 0x48 0x0f 0x2a 0xc0 } ] [ [ XMM0 RAX CVTSI2SD ] { } make ] unit-test
[ { 0xf2 0x49 0x0f 0x2a 0xc4 } ] [ [ XMM0 R12 CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x0f 0x2c 0xc0 } } [ [ EAX XMM0 CVTTSD2SI ] { } make ] unit-test
{ { 0xf2 0x48 0x0f 0x2c 0xc0 } } [ [ RAX XMM0 CVTTSD2SI ] { } make ] unit-test
{ { 0xf2 0x4c 0x0f 0x2c 0xe0 } } [ [ R12 XMM0 CVTTSD2SI ] { } make ] unit-test
{ { 0xf2 0x0f 0x2a 0xc0 } } [ [ XMM0 EAX CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x48 0x0f 0x2a 0xc0 } } [ [ XMM0 RAX CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x48 0x0f 0x2a 0xc1 } } [ [ XMM0 RCX CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x48 0x0f 0x2a 0xd9 } } [ [ XMM3 RCX CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x48 0x0f 0x2a 0xc0 } } [ [ XMM0 RAX CVTSI2SD ] { } make ] unit-test
{ { 0xf2 0x49 0x0f 0x2a 0xc4 } } [ [ XMM0 R12 CVTSI2SD ] { } make ] unit-test
! 3-operand r-rm-imm sse instructions
[ { 0x66 0x0f 0x70 0xc1 0x02 } ]
{ { 0x66 0x0f 0x70 0xc1 0x02 } }
[ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
[ { 0x0f 0xc6 0xc1 0x02 } ]
{ { 0x0f 0xc6 0xc1 0x02 } }
[ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
! shufflers with arrays of indexes
[ { 0x66 0x0f 0x70 0xc1 0x02 } ]
{ { 0x66 0x0f 0x70 0xc1 0x02 } }
[ [ XMM0 XMM1 { 2 0 0 0 } PSHUFD ] { } make ] unit-test
[ { 0x0f 0xc6 0xc1 0x63 } ]
{ { 0x0f 0xc6 0xc1 0x63 } }
[ [ XMM0 XMM1 { 3 0 2 1 } SHUFPS ] { } make ] unit-test
[ { 0x66 0x0f 0xc6 0xc1 0x2 } ]
{ { 0x66 0x0f 0xc6 0xc1 0x2 } }
[ [ XMM0 XMM1 { 0 1 } SHUFPD ] { } make ] unit-test
[ { 0x66 0x0f 0xc6 0xc1 0x1 } ]
{ { 0x66 0x0f 0xc6 0xc1 0x1 } }
[ [ XMM0 XMM1 { 1 0 } SHUFPD ] { } make ] unit-test
! scalar register insert/extract sse instructions
[ { 0x66 0x0f 0xc4 0xc1 0x02 } ] [ [ XMM0 ECX 2 PINSRW ] { } make ] unit-test
[ { 0x66 0x0f 0xc4 0x04 0x11 0x03 } ] [ [ XMM0 ECX EDX [+] 3 PINSRW ] { } make ] unit-test
{ { 0x66 0x0f 0xc4 0xc1 0x02 } } [ [ XMM0 ECX 2 PINSRW ] { } make ] unit-test
{ { 0x66 0x0f 0xc4 0x04 0x11 0x03 } } [ [ XMM0 ECX EDX [+] 3 PINSRW ] { } make ] unit-test
[ { 0x66 0x0f 0xc5 0xc1 0x02 } ] [ [ EAX XMM1 2 PEXTRW ] { } make ] unit-test
[ { 0x66 0x0f 0x3a 0x15 0x08 0x02 } ] [ [ EAX [] XMM1 2 PEXTRW ] { } make ] unit-test
[ { 0x66 0x0f 0x3a 0x15 0x14 0x08 0x03 } ] [ [ EAX ECX [+] XMM2 3 PEXTRW ] { } make ] unit-test
[ { 0x66 0x0f 0x3a 0x14 0xc8 0x02 } ] [ [ EAX XMM1 2 PEXTRB ] { } make ] unit-test
[ { 0x66 0x0f 0x3a 0x14 0x08 0x02 } ] [ [ EAX [] XMM1 2 PEXTRB ] { } make ] unit-test
{ { 0x66 0x0f 0xc5 0xc1 0x02 } } [ [ EAX XMM1 2 PEXTRW ] { } make ] unit-test
{ { 0x66 0x0f 0x3a 0x15 0x08 0x02 } } [ [ EAX [] XMM1 2 PEXTRW ] { } make ] unit-test
{ { 0x66 0x0f 0x3a 0x15 0x14 0x08 0x03 } } [ [ EAX ECX [+] XMM2 3 PEXTRW ] { } make ] unit-test
{ { 0x66 0x0f 0x3a 0x14 0xc8 0x02 } } [ [ EAX XMM1 2 PEXTRB ] { } make ] unit-test
{ { 0x66 0x0f 0x3a 0x14 0x08 0x02 } } [ [ EAX [] XMM1 2 PEXTRB ] { } make ] unit-test
! sse shift instructions
[ { 0x66 0x0f 0x71 0xd0 0x05 } ] [ [ XMM0 5 PSRLW ] { } make ] unit-test
[ { 0x66 0x0f 0xd1 0xc1 } ] [ [ XMM0 XMM1 PSRLW ] { } make ] unit-test
{ { 0x66 0x0f 0x71 0xd0 0x05 } } [ [ XMM0 5 PSRLW ] { } make ] unit-test
{ { 0x66 0x0f 0xd1 0xc1 } } [ [ XMM0 XMM1 PSRLW ] { } make ] unit-test
! sse comparison instructions
[ { 0x66 0x0f 0xc2 0xc1 0x02 } ] [ [ XMM0 XMM1 CMPLEPD ] { } make ] unit-test
{ { 0x66 0x0f 0xc2 0xc1 0x02 } } [ [ XMM0 XMM1 CMPLEPD ] { } make ] unit-test
! unique sse instructions
[ { 0x0f 0x18 0x00 } ] [ [ EAX [] PREFETCHNTA ] { } make ] unit-test
[ { 0x0f 0x18 0x08 } ] [ [ EAX [] PREFETCHT0 ] { } make ] unit-test
[ { 0x0f 0x18 0x10 } ] [ [ EAX [] PREFETCHT1 ] { } make ] unit-test
[ { 0x0f 0x18 0x18 } ] [ [ EAX [] PREFETCHT2 ] { } make ] unit-test
[ { 0x0f 0xae 0x10 } ] [ [ EAX [] LDMXCSR ] { } make ] unit-test
[ { 0x0f 0xae 0x18 } ] [ [ EAX [] STMXCSR ] { } make ] unit-test
{ { 0x0f 0x18 0x00 } } [ [ EAX [] PREFETCHNTA ] { } make ] unit-test
{ { 0x0f 0x18 0x08 } } [ [ EAX [] PREFETCHT0 ] { } make ] unit-test
{ { 0x0f 0x18 0x10 } } [ [ EAX [] PREFETCHT1 ] { } make ] unit-test
{ { 0x0f 0x18 0x18 } } [ [ EAX [] PREFETCHT2 ] { } make ] unit-test
{ { 0x0f 0xae 0x10 } } [ [ EAX [] LDMXCSR ] { } make ] unit-test
{ { 0x0f 0xae 0x18 } } [ [ EAX [] STMXCSR ] { } make ] unit-test
[ { 0x0f 0xc3 0x08 } ] [ [ EAX [] ECX MOVNTI ] { } make ] unit-test
{ { 0x0f 0xc3 0x08 } } [ [ EAX [] ECX MOVNTI ] { } make ] unit-test
[ { 0x0f 0x50 0xc1 } ] [ [ EAX XMM1 MOVMSKPS ] { } make ] unit-test
[ { 0x66 0x0f 0x50 0xc1 } ] [ [ EAX XMM1 MOVMSKPD ] { } make ] unit-test
{ { 0x0f 0x50 0xc1 } } [ [ EAX XMM1 MOVMSKPS ] { } make ] unit-test
{ { 0x66 0x0f 0x50 0xc1 } } [ [ EAX XMM1 MOVMSKPD ] { } make ] unit-test
[ { 0xf3 0x0f 0xb8 0xc1 } ] [ [ EAX ECX POPCNT ] { } make ] unit-test
[ { 0xf3 0x48 0x0f 0xb8 0xc1 } ] [ [ RAX RCX POPCNT ] { } make ] unit-test
[ { 0xf3 0x0f 0xb8 0x01 } ] [ [ EAX ECX [] POPCNT ] { } make ] unit-test
[ { 0xf3 0x0f 0xb8 0x04 0x11 } ] [ [ EAX ECX EDX [+] POPCNT ] { } make ] unit-test
{ { 0xf3 0x0f 0xb8 0xc1 } } [ [ EAX ECX POPCNT ] { } make ] unit-test
{ { 0xf3 0x48 0x0f 0xb8 0xc1 } } [ [ RAX RCX POPCNT ] { } make ] unit-test
{ { 0xf3 0x0f 0xb8 0x01 } } [ [ EAX ECX [] POPCNT ] { } make ] unit-test
{ { 0xf3 0x0f 0xb8 0x04 0x11 } } [ [ EAX ECX EDX [+] POPCNT ] { } make ] unit-test
[ { 0xf2 0x0f 0x38 0xf0 0xc1 } ] [ [ EAX CL CRC32B ] { } make ] unit-test
[ { 0xf2 0x0f 0x38 0xf0 0x01 } ] [ [ EAX ECX [] CRC32B ] { } make ] unit-test
[ { 0xf2 0x0f 0x38 0xf1 0xc1 } ] [ [ EAX ECX CRC32 ] { } make ] unit-test
[ { 0xf2 0x0f 0x38 0xf1 0x01 } ] [ [ EAX ECX [] CRC32 ] { } make ] unit-test
{ { 0xf2 0x0f 0x38 0xf0 0xc1 } } [ [ EAX CL CRC32B ] { } make ] unit-test
{ { 0xf2 0x0f 0x38 0xf0 0x01 } } [ [ EAX ECX [] CRC32B ] { } make ] unit-test
{ { 0xf2 0x0f 0x38 0xf1 0xc1 } } [ [ EAX ECX CRC32 ] { } make ] unit-test
{ { 0xf2 0x0f 0x38 0xf1 0x01 } } [ [ EAX ECX [] CRC32 ] { } make ] unit-test
! shifts
[ { 0x48 0xd3 0xe0 } ] [ [ RAX CL SHL ] { } make ] unit-test
[ { 0x48 0xd3 0xe1 } ] [ [ RCX CL SHL ] { } make ] unit-test
[ { 0x48 0xd3 0xe8 } ] [ [ RAX CL SHR ] { } make ] unit-test
[ { 0x48 0xd3 0xe9 } ] [ [ RCX CL SHR ] { } make ] unit-test
{ { 0x48 0xd3 0xe0 } } [ [ RAX CL SHL ] { } make ] unit-test
{ { 0x48 0xd3 0xe1 } } [ [ RCX CL SHL ] { } make ] unit-test
{ { 0x48 0xd3 0xe8 } } [ [ RAX CL SHR ] { } make ] unit-test
{ { 0x48 0xd3 0xe9 } } [ [ RCX CL SHR ] { } make ] unit-test
[ { 0xc1 0xe0 0x05 } ] [ [ EAX 5 SHL ] { } make ] unit-test
[ { 0xc1 0xe1 0x05 } ] [ [ ECX 5 SHL ] { } make ] unit-test
[ { 0xc1 0xe8 0x05 } ] [ [ EAX 5 SHR ] { } make ] unit-test
[ { 0xc1 0xe9 0x05 } ] [ [ ECX 5 SHR ] { } make ] unit-test
{ { 0xc1 0xe0 0x05 } } [ [ EAX 5 SHL ] { } make ] unit-test
{ { 0xc1 0xe1 0x05 } } [ [ ECX 5 SHL ] { } make ] unit-test
{ { 0xc1 0xe8 0x05 } } [ [ EAX 5 SHR ] { } make ] unit-test
{ { 0xc1 0xe9 0x05 } } [ [ ECX 5 SHR ] { } make ] unit-test
! multiplication
[ { 0x4d 0x6b 0xc0 0x03 } ] [ [ R8 R8 3 IMUL3 ] { } make ] unit-test
[ { 0x49 0x6b 0xc0 0x03 } ] [ [ RAX R8 3 IMUL3 ] { } make ] unit-test
[ { 0x4c 0x6b 0xc0 0x03 } ] [ [ R8 RAX 3 IMUL3 ] { } make ] unit-test
[ { 0x48 0x6b 0xc1 0x03 } ] [ [ RAX RCX 3 IMUL3 ] { } make ] unit-test
[ { 0x48 0x69 0xc1 0x44 0x03 0x00 0x00 } ] [ [ RAX RCX 0x344 IMUL3 ] { } make ] unit-test
{ { 0x4d 0x6b 0xc0 0x03 } } [ [ R8 R8 3 IMUL3 ] { } make ] unit-test
{ { 0x49 0x6b 0xc0 0x03 } } [ [ RAX R8 3 IMUL3 ] { } make ] unit-test
{ { 0x4c 0x6b 0xc0 0x03 } } [ [ R8 RAX 3 IMUL3 ] { } make ] unit-test
{ { 0x48 0x6b 0xc1 0x03 } } [ [ RAX RCX 3 IMUL3 ] { } make ] unit-test
{ { 0x48 0x69 0xc1 0x44 0x03 0x00 0x00 } } [ [ RAX RCX 0x344 IMUL3 ] { } make ] unit-test
! BT family instructions
[ { 0x0f 0xba 0xe0 0x01 } ] [ [ EAX 1 BT ] { } make ] unit-test
[ { 0x0f 0xba 0xf8 0x01 } ] [ [ EAX 1 BTC ] { } make ] unit-test
[ { 0x0f 0xba 0xe8 0x01 } ] [ [ EAX 1 BTS ] { } make ] unit-test
[ { 0x0f 0xba 0xf0 0x01 } ] [ [ EAX 1 BTR ] { } make ] unit-test
[ { 0x48 0x0f 0xba 0xe0 0x01 } ] [ [ RAX 1 BT ] { } make ] unit-test
[ { 0x0f 0xba 0x20 0x01 } ] [ [ EAX [] 1 BT ] { } make ] unit-test
{ { 0x0f 0xba 0xe0 0x01 } } [ [ EAX 1 BT ] { } make ] unit-test
{ { 0x0f 0xba 0xf8 0x01 } } [ [ EAX 1 BTC ] { } make ] unit-test
{ { 0x0f 0xba 0xe8 0x01 } } [ [ EAX 1 BTS ] { } make ] unit-test
{ { 0x0f 0xba 0xf0 0x01 } } [ [ EAX 1 BTR ] { } make ] unit-test
{ { 0x48 0x0f 0xba 0xe0 0x01 } } [ [ RAX 1 BT ] { } make ] unit-test
{ { 0x0f 0xba 0x20 0x01 } } [ [ EAX [] 1 BT ] { } make ] unit-test
[ { 0x0f 0xa3 0xd8 } ] [ [ EAX EBX BT ] { } make ] unit-test
[ { 0x0f 0xbb 0xd8 } ] [ [ EAX EBX BTC ] { } make ] unit-test
[ { 0x0f 0xab 0xd8 } ] [ [ EAX EBX BTS ] { } make ] unit-test
[ { 0x0f 0xb3 0xd8 } ] [ [ EAX EBX BTR ] { } make ] unit-test
[ { 0x0f 0xa3 0x18 } ] [ [ EAX [] EBX BT ] { } make ] unit-test
{ { 0x0f 0xa3 0xd8 } } [ [ EAX EBX BT ] { } make ] unit-test
{ { 0x0f 0xbb 0xd8 } } [ [ EAX EBX BTC ] { } make ] unit-test
{ { 0x0f 0xab 0xd8 } } [ [ EAX EBX BTS ] { } make ] unit-test
{ { 0x0f 0xb3 0xd8 } } [ [ EAX EBX BTR ] { } make ] unit-test
{ { 0x0f 0xa3 0x18 } } [ [ EAX [] EBX BT ] { } make ] unit-test
! x87 instructions
[ { 0xD8 0xC5 } ] [ [ ST0 ST5 FADD ] { } make ] unit-test
[ { 0xDC 0xC5 } ] [ [ ST5 ST0 FADD ] { } make ] unit-test
[ { 0xD8 0x00 } ] [ [ ST0 EAX [] FADD ] { } make ] unit-test
{ { 0xD8 0xC5 } } [ [ ST0 ST5 FADD ] { } make ] unit-test
{ { 0xDC 0xC5 } } [ [ ST5 ST0 FADD ] { } make ] unit-test
{ { 0xD8 0x00 } } [ [ ST0 EAX [] FADD ] { } make ] unit-test
[ { 0xD9 0xC2 } ] [ [ ST2 FLD ] { } make ] unit-test
[ { 0xDD 0xD2 } ] [ [ ST2 FST ] { } make ] unit-test
[ { 0xDD 0xDA } ] [ [ ST2 FSTP ] { } make ] unit-test
{ { 0xD9 0xC2 } } [ [ ST2 FLD ] { } make ] unit-test
{ { 0xDD 0xD2 } } [ [ ST2 FST ] { } make ] unit-test
{ { 0xDD 0xDA } } [ [ ST2 FSTP ] { } make ] unit-test
[ { 15 183 195 } ] [ [ EAX BX MOVZX ] { } make ] unit-test
{ { 15 183 195 } } [ [ EAX BX MOVZX ] { } make ] unit-test
bootstrap-cell 4 = [
[ { 100 199 5 0 0 0 0 123 0 0 0 } ] [ [ 0 [] FS 123 MOV ] { } make ] unit-test

View File

@ -11,10 +11,10 @@ USE: db.sqlite
[ "pool-test.db" temp-file delete-file ] ignore-errors
[ ] [ "pool-test.db" temp-file <sqlite-db> <db-pool> "pool" set ] unit-test
{ } [ "pool-test.db" temp-file <sqlite-db> <db-pool> "pool" set ] unit-test
[ ] [ "pool" get expired>> t >>expired drop ] unit-test
{ } [ "pool" get expired>> t >>expired drop ] unit-test
[ ] [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
{ } [ 1000 [ "pool" get [ ] with-pooled-db ] times ] unit-test
[ ] [ "pool" get dispose ] unit-test
{ } [ "pool" get dispose ] unit-test

View File

@ -11,7 +11,7 @@ IN: db.postgresql.tests
"dont-exist" >>database ;
! Don't leak connections
[ ] [
{ } [
2000 [ [ nonexistant-db [ ] with-db ] ignore-errors ] times
] unit-test
@ -30,7 +30,7 @@ postgresql-template1-db [
! ] with-db
! ] [ sql-unknown-error? ] must-fail-with
[ ] [
{ } [
postgresql-test-db [
[ "drop table person;" sql-command ] ignore-errors
"create table person (name varchar(30), country varchar(30));"
@ -41,39 +41,39 @@ postgresql-template1-db [
] with-db
] unit-test
[
{
{
{ "John" "America" }
{ "Jane" "New Zealand" }
}
] [
} [
postgresql-test-db [
"select * from person" sql-query
] with-db
] unit-test
[
{
{
{ "John" "America" }
{ "Jane" "New Zealand" }
}
] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test
} [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test
[
] [
{
} [
postgresql-test-db [
"insert into person(name, country) values('Jimmy', 'Canada')"
sql-command
] with-db
] unit-test
[
{
{
{ "John" "America" }
{ "Jane" "New Zealand" }
{ "Jimmy" "Canada" }
}
] [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test
} [ postgresql-test-db [ "select * from person" sql-query ] with-db ] unit-test
[
postgresql-test-db [
@ -85,14 +85,14 @@ postgresql-template1-db [
] with-db
] must-fail
[ 3 ] [
{ 3 } [
postgresql-test-db [
"select * from person" sql-query length
] with-db
] unit-test
[
] [
{
} [
postgresql-test-db [
[
"insert into person(name, country) values('Jose', 'Mexico')"
@ -103,7 +103,7 @@ postgresql-template1-db [
] with-db
] unit-test
[ 5 ] [
{ 5 } [
postgresql-test-db [
"select * from person" sql-query length
] with-db

View File

@ -7,9 +7,9 @@ IN: db.sqlite.tests
: db-path ( -- path ) "test-" cell number>string ".db" 3append temp-file ;
: test.db ( -- sqlite-db ) db-path <sqlite-db> ;
[ ] [ [ db-path delete-file ] ignore-errors ] unit-test
{ } [ [ db-path delete-file ] ignore-errors ] unit-test
[ ] [
{ } [
test.db [
"create table person (name varchar(30), country varchar(30))" sql-command
"insert into person values('John', 'America')" sql-command
@ -18,29 +18,29 @@ IN: db.sqlite.tests
] unit-test
[ { { "John" "America" } { "Jane" "New Zealand" } } ] [
{ { { "John" "America" } { "Jane" "New Zealand" } } } [
test.db [
"select * from person" sql-query
] with-db
] unit-test
[ { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } ]
{ { { "1" "John" "America" } { "2" "Jane" "New Zealand" } } }
[ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
[ ] [
{ } [
test.db [
"insert into person(name, country) values('Jimmy', 'Canada')"
sql-command
] with-db
] unit-test
[
{
{
{ "1" "John" "America" }
{ "2" "Jane" "New Zealand" }
{ "3" "Jimmy" "Canada" }
}
] [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
} [ test.db [ "select rowid, * from person" sql-query ] with-db ] unit-test
[
test.db [
@ -52,13 +52,13 @@ IN: db.sqlite.tests
] with-db
] must-fail
[ 3 ] [
{ 3 } [
test.db [
"select * from person" sql-query length
] with-db
] unit-test
[ ] [
{ } [
test.db [
[
"insert into person(name, country) values('Jose', 'Mexico')"
@ -69,7 +69,7 @@ IN: db.sqlite.tests
] with-db
] unit-test
[ 5 ] [
{ 5 } [
test.db [
"select * from person" sql-query length
] with-db
@ -85,7 +85,7 @@ things "THINGS" {
{ "two" "TWO" INTEGER +not-null+ }
} define-persistent
[ { { 0 0 } { 0 1 } { 1 0 } { 1 1 } } ] [
{ { { 0 0 } { 0 1 } { 1 0 } { 1 1 } } } [
test.db [
things create-table
0 0 things boa insert-tuple
@ -110,7 +110,7 @@ hi "HELLO" {
{ "try" "RETHROW" INTEGER { +foreign-id+ foo "SOMETHING" } }
} define-persistent
[ T{ foo { slot 1 } } T{ hi { bye 1 } { try 1 } } ] [
{ T{ foo { slot 1 } } T{ hi { bye 1 } { try 1 } } } [
test.db [
foo create-table
hi create-table
@ -146,7 +146,7 @@ watch "WATCH" {
{ +foreign-id+ show "ID" } }
} define-persistent
[ T{ user { username "littledan" } { data "foo" } } ] [
{ T{ user { username "littledan" } { data "foo" } } } [
test.db [
user create-table
show create-table

View File

@ -3,5 +3,5 @@
USING: tools.test db.tester ;
IN: db.tester.tests
[ ] [ sqlite-test-db db-tester ] unit-test
[ ] [ sqlite-test-db db-tester2 ] unit-test
{ } [ sqlite-test-db db-tester ] unit-test
{ } [ sqlite-test-db db-tester2 ] unit-test

View File

@ -8,51 +8,51 @@ SYMBOL: doc
"123\nabcé" doc get set-doc-string
! char-elt
[ { 0 0 } ] [ { 0 0 } doc get char-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 1 } doc get char-elt prev-elt ] unit-test
[ { 0 3 } ] [ { 1 0 } doc get char-elt prev-elt ] unit-test
[ { 1 3 } ] [ { 1 5 } doc get char-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 0 } doc get char-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 1 } doc get char-elt prev-elt ] unit-test
{ { 0 3 } } [ { 1 0 } doc get char-elt prev-elt ] unit-test
{ { 1 3 } } [ { 1 5 } doc get char-elt prev-elt ] unit-test
[ { 1 5 } ] [ { 1 5 } doc get char-elt next-elt ] unit-test
[ { 0 2 } ] [ { 0 1 } doc get char-elt next-elt ] unit-test
[ { 1 0 } ] [ { 0 3 } doc get char-elt next-elt ] unit-test
[ { 1 5 } ] [ { 1 3 } doc get char-elt next-elt ] unit-test
{ { 1 5 } } [ { 1 5 } doc get char-elt next-elt ] unit-test
{ { 0 2 } } [ { 0 1 } doc get char-elt next-elt ] unit-test
{ { 1 0 } } [ { 0 3 } doc get char-elt next-elt ] unit-test
{ { 1 5 } } [ { 1 3 } doc get char-elt next-elt ] unit-test
! word-elt
<document> doc set
"Hello world\nanother line" doc get set-doc-string
[ { 0 0 } ] [ { 0 0 } doc get word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 2 } doc get word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 5 } doc get word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 6 } doc get word-elt prev-elt ] unit-test
[ { 0 6 } ] [ { 0 8 } doc get word-elt prev-elt ] unit-test
[ { 0 11 } ] [ { 1 0 } doc get word-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 0 } doc get word-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 2 } doc get word-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 5 } doc get word-elt prev-elt ] unit-test
{ { 0 5 } } [ { 0 6 } doc get word-elt prev-elt ] unit-test
{ { 0 6 } } [ { 0 8 } doc get word-elt prev-elt ] unit-test
{ { 0 11 } } [ { 1 0 } doc get word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 0 } doc get word-elt next-elt ] unit-test
[ { 0 6 } ] [ { 0 5 } doc get word-elt next-elt ] unit-test
[ { 0 11 } ] [ { 0 6 } doc get word-elt next-elt ] unit-test
[ { 1 0 } ] [ { 0 11 } doc get word-elt next-elt ] unit-test
{ { 0 5 } } [ { 0 0 } doc get word-elt next-elt ] unit-test
{ { 0 6 } } [ { 0 5 } doc get word-elt next-elt ] unit-test
{ { 0 11 } } [ { 0 6 } doc get word-elt next-elt ] unit-test
{ { 1 0 } } [ { 0 11 } doc get word-elt next-elt ] unit-test
! one-word-elt
[ { 0 0 } ] [ { 0 0 } doc get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 2 } doc get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 5 } doc get one-word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 2 } doc get one-word-elt next-elt ] unit-test
[ { 0 5 } ] [ { 0 5 } doc get one-word-elt next-elt ] unit-test
{ { 0 0 } } [ { 0 0 } doc get one-word-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 2 } doc get one-word-elt prev-elt ] unit-test
{ { 0 0 } } [ { 0 5 } doc get one-word-elt prev-elt ] unit-test
{ { 0 5 } } [ { 0 2 } doc get one-word-elt next-elt ] unit-test
{ { 0 5 } } [ { 0 5 } doc get one-word-elt next-elt ] unit-test
! line-elt
<document> doc set
"Hello\nworld, how are\nyou?" doc get set-doc-string
[ { 0 0 } ] [ { 0 3 } doc get line-elt prev-elt ] unit-test
[ { 0 3 } ] [ { 1 3 } doc get line-elt prev-elt ] unit-test
[ { 2 4 } ] [ { 2 1 } doc get line-elt next-elt ] unit-test
{ { 0 0 } } [ { 0 3 } doc get line-elt prev-elt ] unit-test
{ { 0 3 } } [ { 1 3 } doc get line-elt prev-elt ] unit-test
{ { 2 4 } } [ { 2 1 } doc get line-elt next-elt ] unit-test
! one-line-elt
[ { 1 0 } ] [ { 1 3 } doc get one-line-elt prev-elt ] unit-test
[ { 1 14 } ] [ { 1 3 } doc get one-line-elt next-elt ] unit-test
{ { 1 0 } } [ { 1 3 } doc get one-line-elt prev-elt ] unit-test
{ { 1 14 } } [ { 1 3 } doc get one-line-elt next-elt ] unit-test
! page-elt
<document> doc set
@ -63,12 +63,12 @@ Fourth line
Fifth line
Sixth line" doc get set-doc-string
[ { 0 0 } ] [ { 3 3 } doc get 4 <page-elt> prev-elt ] unit-test
[ { 1 2 } ] [ { 5 2 } doc get 4 <page-elt> prev-elt ] unit-test
{ { 0 0 } } [ { 3 3 } doc get 4 <page-elt> prev-elt ] unit-test
{ { 1 2 } } [ { 5 2 } doc get 4 <page-elt> prev-elt ] unit-test
[ { 4 3 } ] [ { 0 3 } doc get 4 <page-elt> next-elt ] unit-test
[ { 5 10 } ] [ { 4 2 } doc get 4 <page-elt> next-elt ] unit-test
{ { 4 3 } } [ { 0 3 } doc get 4 <page-elt> next-elt ] unit-test
{ { 5 10 } } [ { 4 2 } doc get 4 <page-elt> next-elt ] unit-test
! doc-elt
[ { 0 0 } ] [ { 3 4 } doc get doc-elt prev-elt ] unit-test
[ { 5 10 } ] [ { 3 4 } doc get doc-elt next-elt ] unit-test
{ { 0 0 } } [ { 3 4 } doc get doc-elt prev-elt ] unit-test
{ { 5 10 } } [ { 3 4 } doc get doc-elt next-elt ] unit-test

View File

@ -24,7 +24,7 @@ CONSTANT: test-file-contents "Files are so boring anymore."
] with-threaded-server
] cleanup-unique-directory ; inline
[ t ]
{ t }
[
[
[

View File

@ -13,7 +13,7 @@ GET http://foo/bar?a=12&b=13 HTTP/1.1
blah
;
[ 25 ] [
{ 25 } [
action-request-test-1 lf>crlf
[ read-request ] with-string-reader
init-request
@ -31,7 +31,7 @@ GET http://foo/bar/123 HTTP/1.1
blah
;
[ 25 ] [
{ 25 } [
action-request-test-2 lf>crlf
[ read-request ] with-string-reader
init-request

View File

@ -7,7 +7,7 @@ IN: furnace.auth.providers.assoc.tests
<users-in-memory> >>users
realm set
[ t ] [
{ t } [
"slava" <user>
"foobar" >>encoded-password
"slava@factorcode.org" >>email
@ -16,20 +16,20 @@ realm set
username>> "slava" =
] unit-test
[ f ] [
{ f } [
"slava" <user>
H{ } clone >>profile
users new-user
] unit-test
[ f ] [ "fdasf" "slava" check-login >boolean ] unit-test
{ f } [ "fdasf" "slava" check-login >boolean ] unit-test
[ ] [ "foobar" "slava" check-login "user" set ] unit-test
{ } [ "foobar" "slava" check-login "user" set ] unit-test
[ t ] [ "user" get >boolean ] unit-test
{ t } [ "user" get >boolean ] unit-test
[ ] [ "user" get "fdasf" >>encoded-password drop ] unit-test
{ } [ "user" get "fdasf" >>encoded-password drop ] unit-test
[ t ] [ "fdasf" "slava" check-login >boolean ] unit-test
{ t } [ "fdasf" "slava" check-login >boolean ] unit-test
[ f ] [ "foobar" "slava" check-login >boolean ] unit-test
{ f } [ "foobar" "slava" check-login >boolean ] unit-test

View File

@ -1,17 +1,17 @@
USING: html.forms furnace.chloe-tags tools.test ;
IN: furnace.chloe-tags.tests
[ f ] [ f parse-query-attr ] unit-test
{ f } [ f parse-query-attr ] unit-test
[ f ] [ "" parse-query-attr ] unit-test
{ f } [ "" parse-query-attr ] unit-test
[ H{ { "a" "b" } } ] [
{ H{ { "a" "b" } } } [
begin-form
"b" "a" set-value
"a" parse-query-attr
] unit-test
[ H{ { "a" "b" } { "c" "d" } } ] [
{ H{ { "a" "b" } { "c" "d" } } } [
begin-form
"b" "a" set-value
"d" "c" set-value

View File

@ -8,13 +8,13 @@ os { [ windows? ] [ macosx? ] } 1|| [
[ ] [ close-game-input ] unit-test
] when
[ f ] [ t t button-delta ] unit-test
[ pressed ] [ f t button-delta ] unit-test
[ released ] [ t f button-delta ] unit-test
{ f } [ t t button-delta ] unit-test
{ pressed } [ f t button-delta ] unit-test
{ released } [ t f button-delta ] unit-test
[ f ] [ 0.5 1.0 button-delta ] unit-test
[ pressed ] [ f 0.7 button-delta ] unit-test
[ released ] [ 0.2 f button-delta ] unit-test
{ f } [ 0.5 1.0 button-delta ] unit-test
{ pressed } [ f 0.7 button-delta ] unit-test
{ released } [ 0.2 f button-delta ] unit-test
[ { pressed f f released } ] [ { f t f t } { t t f f } buttons-delta ] unit-test
[ V{ pressed f f released } ] [ { f t f t } { t t f f } V{ } buttons-delta-as ] unit-test
{ { pressed f f released } } [ { f t f t } { t t f f } buttons-delta ] unit-test
{ V{ pressed f f released } } [ { f t f t } { t t f f } V{ } buttons-delta-as ] unit-test

View File

@ -12,11 +12,11 @@ CONSTANT: will
: please-stand-up ( set obj -- ? )
swap in? ;
[ t ] [ will the-real-slim-shady please-stand-up ] unit-test
[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test
{ t } [ will the-real-slim-shady please-stand-up ] unit-test
{ t } [ will clone the-real-slim-shady please-stand-up ] unit-test
[ 2 ] [ will cardinality ] unit-test
[ { "marshall mathers" } ] [
{ 2 } [ will cardinality ] unit-test
{ { "marshall mathers" } } [
the-real-slim-shady will clone
[ delete ] [ members ] bi
] unit-test

View File

@ -6,15 +6,15 @@ tools.test ;
IN: hash-sets.sequences.tests
[ t ] [ 0 4 "asdf" <slice> SHS{ "asdf" } in? ] unit-test
{ t } [ 0 4 "asdf" <slice> SHS{ "asdf" } in? ] unit-test
[ SHS{ "asdf" } ] [
{ SHS{ "asdf" } } [
0 4 "asdf" <slice> SHS{ "asdf" } [ adjoin ] keep
] unit-test
[ t ] [
{ t } [
SHS{ } clone 0 4 "asdf" <slice> over adjoin
"asdf" swap in?
] unit-test
[ { "asdf" } ] [ SHS{ "asdf" } members ] unit-test
{ { "asdf" } } [ SHS{ "asdf" } members ] unit-test

View File

@ -13,19 +13,19 @@ CONSTANT: will
: please-stand-up ( assoc key -- value )
of ;
[ t ] [ will the-real-slim-shady please-stand-up ] unit-test
[ t ] [ will clone the-real-slim-shady please-stand-up ] unit-test
{ t } [ will the-real-slim-shady please-stand-up ] unit-test
{ t } [ will clone the-real-slim-shady please-stand-up ] unit-test
[ 2 ] [ will assoc-size ] unit-test
[ { { "marshall mathers" f } } ] [
{ 2 } [ will assoc-size ] unit-test
{ { { "marshall mathers" f } } } [
the-real-slim-shady will clone
[ delete-at ] [ >alist ] bi
] unit-test
[ t ] [
{ t } [
t the-real-slim-shady identity-associate
t the-real-slim-shady identity-associate =
] unit-test
[ f ] [
{ f } [
t the-real-slim-shady identity-associate
t "marshall mathers" identity-associate =
] unit-test

View File

@ -6,16 +6,16 @@ tools.test ;
IN: hashtables.sequences.tests
[ 1000 ] [ 0 4 "asdf" <slice> SH{ { "asdf" 1000 } } at ] unit-test
{ 1000 } [ 0 4 "asdf" <slice> SH{ { "asdf" 1000 } } at ] unit-test
[ 1001 ] [
{ 1001 } [
1001 0 4 "asdf" <slice> SH{ { "asdf" 1000 } }
[ set-at ] [ at ] 2bi
] unit-test
[ 1001 ] [
{ 1001 } [
SH{ } clone 1001 0 4 "asdf" <slice> pick set-at
"asdf" of
] unit-test
[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test
{ { { "asdf" 1000 } } } [ SH{ { "asdf" 1000 } } >alist ] unit-test

View File

@ -1,4 +1,4 @@
USING: help.apropos tools.test ;
IN: help.apropos.tests
[ ] [ "swp" apropos ] unit-test
{ } [ "swp" apropos ] unit-test

View File

@ -4,57 +4,57 @@ io.streams.string continuations debugger compiler.units eval
help.syntax ;
IN: help.crossref.tests
[ ] [
{ } [
"IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval( -- )
] unit-test
[ $subsection ] [
{ $subsection } [
"foo" article-content first first
] unit-test
[ t ] [
{ t } [
"foo" article-children
"foo" "help.crossref.tests" lookup-word >link 1array sequence=
] unit-test
[ "foo" ] [ "foo" "help.crossref.tests" lookup-word article-parent ] unit-test
{ "foo" } [ "foo" "help.crossref.tests" lookup-word article-parent ] unit-test
[ ] [
{ } [
[ "foo" "help.crossref.tests" lookup-word forget ] with-compilation-unit
] unit-test
[ ] [
{ } [
"IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval( -- )
] unit-test
[ ] [
{ } [
"IN: ayy USE: help.syntax ARTICLE: \"b\" \"B\" ;"
<string-reader> "ayy" parse-stream drop
] unit-test
[ ] [
{ } [
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"a\" \"A\" { $subsection \"b\" } ;"
<string-reader> "ayy" parse-stream drop
] unit-test
[ ] [
{ } [
"IN: ayy USE: help.syntax ARTICLE: \"c\" \"C\" ;"
<string-reader> "ayy" parse-stream drop
] unit-test
[ ] [
{ } [
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"a\" \"A\" { $subsection \"c\" } ;"
<string-reader> "ayy" parse-stream drop
] unit-test
[ ] [
{ } [
[
"IN: azz USE: help.syntax USE: help.markup ARTICLE: \"yyy\" \"YYY\" ; ARTICLE: \"xxx\" \"XXX\" { $subsection \"yyy\" } ; ARTICLE: \"yyy\" \"YYY\" ;"
<string-reader> "parent-test" parse-stream drop
] [ :1 ] recover
] unit-test
[ "xxx" ] [ "yyy" article-parent ] unit-test
{ "xxx" } [ "yyy" article-parent ] unit-test
ARTICLE: "crossref-test-1" "Crossref test 1"
"Hello world" ;
@ -62,4 +62,4 @@ ARTICLE: "crossref-test-1" "Crossref test 1"
ARTICLE: "crossref-test-2" "Crossref test 2"
{ $markup-example { $subsection "crossref-test-1" } } ;
[ { } ] [ "crossref-test-2" >link article-children ] unit-test
{ { } } [ "crossref-test-2" >link article-children ] unit-test

View File

@ -3,7 +3,7 @@ prettyprint parser io.streams.string kernel source-files
assocs namespaces words io sequences eval accessors see ;
IN: help.definitions.tests
[ ] [ \ + >link see ] unit-test
{ } [ \ + >link see ] unit-test
[
[ 4 ] [

Some files were not shown because too many files have changed in this diff Show More