LIBRARY: f-cdecl
FUNCTION: void ffi_test_0 ( )
-[ ] [ ffi_test_0 ] unit-test
+{ } [ ffi_test_0 ] unit-test
FUNCTION: int ffi_test_1 ( )
-[ 3 ] [ ffi_test_1 ] unit-test
+{ 3 } [ ffi_test_1 ] unit-test
-[ ] [ \ ffi_test_1 def>> [ drop ] append compile-call ] unit-test
+{ } [ \ ffi_test_1 def>> [ drop ] append compile-call ] unit-test
FUNCTION: int ffi_test_2 ( int x, int y )
-[ 5 ] [ 2 3 ffi_test_2 ] unit-test
+{ 5 } [ 2 3 ffi_test_2 ] unit-test
[ "hi" 3 ffi_test_2 ] must-fail
FUNCTION: int ffi_test_3 ( int x, int y, int z, int t )
-[ 25 ] [ 2 3 4 5 ffi_test_3 ] unit-test
+{ 25 } [ 2 3 4 5 ffi_test_3 ] unit-test
FUNCTION: float ffi_test_4 ( )
-[ 1.5 ] [ ffi_test_4 ] unit-test
+{ 1.5 } [ ffi_test_4 ] unit-test
FUNCTION: double ffi_test_5 ( )
-[ 1.5 ] [ ffi_test_5 ] unit-test
+{ 1.5 } [ ffi_test_5 ] unit-test
FUNCTION: int ffi_test_9 ( int a, int b, int c, int d, int e, int f, int g )
-[ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test
+{ 28 } [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test
[ "a" 2 3 4 5 6 7 ffi_test_9 ] must-fail
[ 1 2 3 4 5 6 "a" ffi_test_9 ] must-fail
FUNCTION: int ffi_test_11 ( int a, FOO b, int c )
-[ 14 ] [ 1 2 3 make-FOO 4 ffi_test_11 ] unit-test
+{ 14 } [ 1 2 3 make-FOO 4 ffi_test_11 ] unit-test
FUNCTION: int ffi_test_13 ( int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k )
-[ 66 ] [ 1 2 3 4 5 6 7 8 9 10 11 ffi_test_13 ] unit-test
+{ 66 } [ 1 2 3 4 5 6 7 8 9 10 11 ffi_test_13 ] unit-test
FUNCTION: FOO ffi_test_14 ( int x, int y )
-[ 11 6 ] [ 11 6 ffi_test_14 [ x>> ] [ y>> ] bi ] unit-test
+{ 11 6 } [ 11 6 ffi_test_14 [ x>> ] [ y>> ] bi ] unit-test
FUNCTION: c-string ffi_test_15 ( c-string x, c-string y )
-[ "foo" ] [ "xy" "zt" ffi_test_15 ] unit-test
-[ "bar" ] [ "xy" "xy" ffi_test_15 ] unit-test
+{ "foo" } [ "xy" "zt" ffi_test_15 ] unit-test
+{ "bar" } [ "xy" "xy" ffi_test_15 ] unit-test
[ 1 2 ffi_test_15 ] must-fail
STRUCT: BAR { x long } { y long } { z long } ;
FUNCTION: BAR ffi_test_16 ( long x, long y, long z )
-[ 11 6 -7 ] [
+{ 11 6 -7 } [
11 6 -7 ffi_test_16 [ x>> ] [ y>> ] [ z>> ] tri
] unit-test
FUNCTION: TINY ffi_test_17 ( int x )
-[ 11 ] [ 11 ffi_test_17 x>> ] unit-test
+{ 11 } [ 11 ffi_test_17 x>> ] unit-test
[ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
{ 1 1 } [ indirect-test-1 ] must-infer-as
-[ 3 ] [ &: ffi_test_1 indirect-test-1 ] unit-test
+{ 3 } [ &: ffi_test_1 indirect-test-1 ] unit-test
: indirect-test-1' ( ptr -- )
int { } cdecl alien-indirect drop ;
{ 1 0 } [ indirect-test-1' ] must-infer-as
-[ ] [ &: ffi_test_1 indirect-test-1' ] unit-test
+{ } [ &: ffi_test_1 indirect-test-1' ] unit-test
[ -1 indirect-test-1 ] must-fail
{ 3 1 } [ indirect-test-2 ] must-infer-as
-[ 5 ]
-[ 2 3 &: ffi_test_2 indirect-test-2 ]
-unit-test
+{ 5 } [ 2 3 &: ffi_test_2 indirect-test-2 ] unit-test
: indirect-test-3 ( a b c d ptr -- result )
int { int int int int } stdcall alien-indirect
gc ;
-[ f ] [ "f-stdcall" library-dll f = ] unit-test
-[ stdcall ] [ "f-stdcall" lookup-library abi>> ] unit-test
+{ f } [ "f-stdcall" library-dll f = ] unit-test
+{ stdcall } [ "f-stdcall" lookup-library abi>> ] unit-test
: ffi_test_18 ( w x y z -- int )
int "f-stdcall" "ffi_test_18" { int int int int } f
alien-invoke gc ;
-[ 25 ] [ 2 3 4 5 ffi_test_18 ] unit-test
+{ 25 } [ 2 3 4 5 ffi_test_18 ] unit-test
: ffi_test_19 ( x y z -- BAR )
BAR "f-stdcall" "ffi_test_19" { long long long } f
alien-invoke gc ;
-[ 11 6 -7 ] [
+{ 11 6 -7 } [
11 6 -7 ffi_test_19 [ x>> ] [ y>> ] [ z>> ] tri
] unit-test
int "f-stdcall" "ffi_test_18" { int int int int } f alien-invoke
gc ;
-[ 25 85 ] [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
+{ 25 85 } [ 2 3 4 5 6 7 8 9 multi_ffi_test_18 ] unit-test
FUNCTION: double ffi_test_6 ( float x, float y )
-[ 6.0 ] [ 3.0 2.0 ffi_test_6 ] unit-test
+{ 6.0 } [ 3.0 2.0 ffi_test_6 ] unit-test
[ "a" "b" ffi_test_6 ] must-fail
FUNCTION: double ffi_test_7 ( double x, double y )
-[ 6.0 ] [ 3.0 2.0 ffi_test_7 ] unit-test
+{ 6.0 } [ 3.0 2.0 ffi_test_7 ] unit-test
FUNCTION: double ffi_test_8 ( double x, float y, double z, float t, int w )
-[ 19.0 ] [ 3.0 2.0 1.0 6.0 7 ffi_test_8 ] unit-test
+{ 19.0 } [ 3.0 2.0 1.0 6.0 7 ffi_test_8 ] unit-test
FUNCTION: int ffi_test_10 ( int a, int b, double c, int d, float e, int f, int g, int h )
-[ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test
+{ -34 } [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test
FUNCTION: void ffi_test_20 ( double x1, double x2, double x3,
double y1, double y2, double y3,
double z1, double z2, double z3 )
-[ ] [ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ffi_test_20 ] unit-test
+{ } [ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ffi_test_20 ] unit-test
! Make sure XT doesn't get clobbered in stack frame
{ int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int int } f
alien-invoke gc 3 ;
-[ 861 3 ] [ 42 [ ] each-integer ffi_test_31 ] unit-test
+{ 861 3 } [ 42 [ ] each-integer ffi_test_31 ] unit-test
: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result )
float
{ float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float float } f
alien-invoke ;
-[ 861.0 ] [ 42 [ >float ] each-integer ffi_test_31_point_5 ] unit-test
+{ 861.0 } [ 42 [ >float ] each-integer ffi_test_31_point_5 ] unit-test
FUNCTION: longlong ffi_test_21 ( long x, long y )
-[ 121932631112635269 ]
-[ 123456789 987654321 ffi_test_21 ] unit-test
+{ 121932631112635269 } [ 123456789 987654321 ffi_test_21 ] unit-test
FUNCTION: long ffi_test_22 ( long x, longlong y, longlong z )
-[ 987655432 ]
-[ 1111 121932631112635269 123456789 ffi_test_22 ] unit-test
+{ 987655432 } [ 1111 121932631112635269 123456789 ffi_test_22 ] unit-test
[ 1111 f 123456789 ffi_test_22 ] must-fail
FUNCTION: int ffi_test_12 ( int a, int b, RECT c, int d, int e, int f )
-[ 45 ] [ 1 2 3.0 4.0 5.0 6.0 <RECT> 7 8 9 ffi_test_12 ] unit-test
+{ 45 } [ 1 2 3.0 4.0 5.0 6.0 <RECT> 7 8 9 ffi_test_12 ] unit-test
[ 1 2 { 1 2 3 } 7 8 9 ffi_test_12 ] must-fail
FUNCTION: float ffi_test_23 ( float[3] x, float[3] y )
-[ 32.0 ] [
+{ 32.0 } [
{ 1.0 2.0 3.0 } float >c-array
{ 4.0 5.0 6.0 } float >c-array
ffi_test_23
FUNCTION: test-struct-1 ffi_test_24 ( )
-[ S{ test-struct-1 { x char-array{ 1 } } } ] [ ffi_test_24 ] unit-test
+{ S{ test-struct-1 { x char-array{ 1 } } } } [ ffi_test_24 ] unit-test
STRUCT: test-struct-2 { x char[2] } ;
+stdout+ >>stderr
ascii <process-reader> stream-lines ;
-[ ] [
+{ } [
" USING: alien alien.c-types alien.syntax kernel ;
IN: scratchpad
-
+
: callback-death ( -- callback )
void { } cdecl [ \"Error!\" throw ] alien-callback ;
-
+
: callback-invoke ( callback -- )
void { } cdecl alien-indirect ;
-
+
callback-death callback-invoke"
callback-error-script ascii set-file-contents
] unit-test
! Callback error from initial thread
-[ t ] [ run-vm-with-script "\"Error!\"" swap member? ] unit-test
+{ t } [ run-vm-with-script "\"Error!\"" swap member? ] unit-test
-[ ] [
+{ } [
"USING: alien alien.c-types alien.syntax kernel threads ;
IN: scratchpad
-
+
: callback-death ( -- callback )
void { } cdecl [ \"Error!\" throw ] alien-callback ;
-
+
: callback-invoke ( callback -- )
void { } cdecl alien-indirect ;
-
+
[ callback-death callback-invoke ] in-thread
stop"
callback-error-script ascii set-file-contents
] unit-test
! Callback error from another thread
-[ t ] [ run-vm-with-script "\"Error!\"" swap member? ] unit-test
+{ t } [ run-vm-with-script "\"Error!\"" swap member? ] unit-test
SPECIALIZED-ARRAY: c:double
IN: compiler.tests.float
-[ 3.0 1 2 3 ] [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
-
-[ $[ float type-number ] ] [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
-
-[ 3.0 ] [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
-[ 3.0 ] [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test
-[ 3.0 ] [ 1.0 2.0 [ float+ ] compile-call ] unit-test
-[ 3.0 ] [ 1.0 2.0 [ swap float+ ] compile-call ] unit-test
-
-[ -1.0 ] [ 1.0 [ 2.0 float- ] compile-call ] unit-test
-[ 1.0 ] [ 1.0 [ 2.0 swap float- ] compile-call ] unit-test
-[ -1.0 ] [ 1.0 2.0 [ float- ] compile-call ] unit-test
-[ 1.0 ] [ 1.0 2.0 [ swap float- ] compile-call ] unit-test
-
-[ 6.0 ] [ 3.0 [ 2.0 float* ] compile-call ] unit-test
-[ 6.0 ] [ 3.0 [ 2.0 swap float* ] compile-call ] unit-test
-[ 6.0 ] [ 3.0 2.0 [ float* ] compile-call ] unit-test
-[ 6.0 ] [ 3.0 2.0 [ swap float* ] compile-call ] unit-test
-
-[ 0.5 ] [ 1.0 [ 2.0 float/f ] compile-call ] unit-test
-[ 2.0 ] [ 1.0 [ 2.0 swap float/f ] compile-call ] unit-test
-[ 0.5 ] [ 1.0 2.0 [ float/f ] compile-call ] unit-test
-[ 2.0 ] [ 1.0 2.0 [ swap float/f ] compile-call ] unit-test
-
-[ t ] [ 1.0 2.0 [ float< ] compile-call ] unit-test
-[ t ] [ 1.0 [ 2.0 float< ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 swap float< ] compile-call ] unit-test
-[ f ] [ 1.0 1.0 [ float< ] compile-call ] unit-test
-[ f ] [ 1.0 [ 1.0 float< ] compile-call ] unit-test
-[ f ] [ 1.0 [ 1.0 swap float< ] compile-call ] unit-test
-[ f ] [ 3.0 1.0 [ float< ] compile-call ] unit-test
-[ f ] [ 3.0 [ 1.0 float< ] compile-call ] unit-test
-[ t ] [ 3.0 [ 1.0 swap float< ] compile-call ] unit-test
-
-[ t ] [ 1.0 2.0 [ float<= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 2.0 float<= ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 swap float<= ] compile-call ] unit-test
-[ t ] [ 1.0 1.0 [ float<= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 float<= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 swap float<= ] compile-call ] unit-test
-[ f ] [ 3.0 1.0 [ float<= ] compile-call ] unit-test
-[ f ] [ 3.0 [ 1.0 float<= ] compile-call ] unit-test
-[ t ] [ 3.0 [ 1.0 swap float<= ] compile-call ] unit-test
-
-[ f ] [ 1.0 2.0 [ float> ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 float> ] compile-call ] unit-test
-[ t ] [ 1.0 [ 2.0 swap float> ] compile-call ] unit-test
-[ f ] [ 1.0 1.0 [ float> ] compile-call ] unit-test
-[ f ] [ 1.0 [ 1.0 float> ] compile-call ] unit-test
-[ f ] [ 1.0 [ 1.0 swap float> ] compile-call ] unit-test
-[ t ] [ 3.0 1.0 [ float> ] compile-call ] unit-test
-[ t ] [ 3.0 [ 1.0 float> ] compile-call ] unit-test
-[ f ] [ 3.0 [ 1.0 swap float> ] compile-call ] unit-test
-
-[ f ] [ 1.0 2.0 [ float>= ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 float>= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 2.0 swap float>= ] compile-call ] unit-test
-[ t ] [ 1.0 1.0 [ float>= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 float>= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 swap float>= ] compile-call ] unit-test
-[ t ] [ 3.0 1.0 [ float>= ] compile-call ] unit-test
-[ t ] [ 3.0 [ 1.0 float>= ] compile-call ] unit-test
-[ f ] [ 3.0 [ 1.0 swap float>= ] compile-call ] unit-test
-
-[ f ] [ 1.0 2.0 [ float= ] compile-call ] unit-test
-[ t ] [ 1.0 1.0 [ float= ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 float= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 float= ] compile-call ] unit-test
-[ f ] [ 1.0 [ 2.0 swap float= ] compile-call ] unit-test
-[ t ] [ 1.0 [ 1.0 swap float= ] compile-call ] unit-test
-
-[ t ] [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
-[ t ] [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
-[ f ] [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
-
-[ 313.0 ] [ 313 [ fixnum>float ] compile-call ] unit-test
-[ -313 ] [ -313.5 [ float>fixnum ] compile-call ] unit-test
-[ 313 ] [ 313.5 [ float>fixnum ] compile-call ] unit-test
-[ 315 315.0 ] [ 313 [ 2 fixnum+fast dup fixnum>float ] compile-call ] unit-test
-
-[ t ] [ 0/0. 0/0. [ float-unordered? ] compile-call ] unit-test
-[ t ] [ 0/0. 1.0 [ float-unordered? ] compile-call ] unit-test
-[ t ] [ 1.0 0/0. [ float-unordered? ] compile-call ] unit-test
-[ f ] [ 3.0 1.0 [ float-unordered? ] compile-call ] unit-test
-[ f ] [ 1.0 3.0 [ float-unordered? ] compile-call ] unit-test
-
-[ 1 ] [ 0/0. 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 1 ] [ 0/0. 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 1 ] [ 1.0 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 2 ] [ 3.0 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 2 ] [ 1.0 3.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 3.0 1 2 3 } [ 1.0 2.0 [ float+ 1 2 3 ] compile-call ] unit-test
+
+{ $[ float type-number ] } [ 1.0 [ 2.0 float+ tag ] compile-call ] unit-test
+
+{ 3.0 } [ 1.0 [ 2.0 float+ ] compile-call ] unit-test
+{ 3.0 } [ 1.0 [ 2.0 swap float+ ] compile-call ] unit-test
+{ 3.0 } [ 1.0 2.0 [ float+ ] compile-call ] unit-test
+{ 3.0 } [ 1.0 2.0 [ swap float+ ] compile-call ] unit-test
+
+{ -1.0 } [ 1.0 [ 2.0 float- ] compile-call ] unit-test
+{ 1.0 } [ 1.0 [ 2.0 swap float- ] compile-call ] unit-test
+{ -1.0 } [ 1.0 2.0 [ float- ] compile-call ] unit-test
+{ 1.0 } [ 1.0 2.0 [ swap float- ] compile-call ] unit-test
+
+{ 6.0 } [ 3.0 [ 2.0 float* ] compile-call ] unit-test
+{ 6.0 } [ 3.0 [ 2.0 swap float* ] compile-call ] unit-test
+{ 6.0 } [ 3.0 2.0 [ float* ] compile-call ] unit-test
+{ 6.0 } [ 3.0 2.0 [ swap float* ] compile-call ] unit-test
+
+{ 0.5 } [ 1.0 [ 2.0 float/f ] compile-call ] unit-test
+{ 2.0 } [ 1.0 [ 2.0 swap float/f ] compile-call ] unit-test
+{ 0.5 } [ 1.0 2.0 [ float/f ] compile-call ] unit-test
+{ 2.0 } [ 1.0 2.0 [ swap float/f ] compile-call ] unit-test
+
+{ t } [ 1.0 2.0 [ float< ] compile-call ] unit-test
+{ t } [ 1.0 [ 2.0 float< ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 swap float< ] compile-call ] unit-test
+{ f } [ 1.0 1.0 [ float< ] compile-call ] unit-test
+{ f } [ 1.0 [ 1.0 float< ] compile-call ] unit-test
+{ f } [ 1.0 [ 1.0 swap float< ] compile-call ] unit-test
+{ f } [ 3.0 1.0 [ float< ] compile-call ] unit-test
+{ f } [ 3.0 [ 1.0 float< ] compile-call ] unit-test
+{ t } [ 3.0 [ 1.0 swap float< ] compile-call ] unit-test
+
+{ t } [ 1.0 2.0 [ float<= ] compile-call ] unit-test
+{ t } [ 1.0 [ 2.0 float<= ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 swap float<= ] compile-call ] unit-test
+{ t } [ 1.0 1.0 [ float<= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 float<= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 swap float<= ] compile-call ] unit-test
+{ f } [ 3.0 1.0 [ float<= ] compile-call ] unit-test
+{ f } [ 3.0 [ 1.0 float<= ] compile-call ] unit-test
+{ t } [ 3.0 [ 1.0 swap float<= ] compile-call ] unit-test
+
+{ f } [ 1.0 2.0 [ float> ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 float> ] compile-call ] unit-test
+{ t } [ 1.0 [ 2.0 swap float> ] compile-call ] unit-test
+{ f } [ 1.0 1.0 [ float> ] compile-call ] unit-test
+{ f } [ 1.0 [ 1.0 float> ] compile-call ] unit-test
+{ f } [ 1.0 [ 1.0 swap float> ] compile-call ] unit-test
+{ t } [ 3.0 1.0 [ float> ] compile-call ] unit-test
+{ t } [ 3.0 [ 1.0 float> ] compile-call ] unit-test
+{ f } [ 3.0 [ 1.0 swap float> ] compile-call ] unit-test
+
+{ f } [ 1.0 2.0 [ float>= ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 float>= ] compile-call ] unit-test
+{ t } [ 1.0 [ 2.0 swap float>= ] compile-call ] unit-test
+{ t } [ 1.0 1.0 [ float>= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 float>= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 swap float>= ] compile-call ] unit-test
+{ t } [ 3.0 1.0 [ float>= ] compile-call ] unit-test
+{ t } [ 3.0 [ 1.0 float>= ] compile-call ] unit-test
+{ f } [ 3.0 [ 1.0 swap float>= ] compile-call ] unit-test
+
+{ f } [ 1.0 2.0 [ float= ] compile-call ] unit-test
+{ t } [ 1.0 1.0 [ float= ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 float= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 float= ] compile-call ] unit-test
+{ f } [ 1.0 [ 2.0 swap float= ] compile-call ] unit-test
+{ t } [ 1.0 [ 1.0 swap float= ] compile-call ] unit-test
+
+{ t } [ 0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
+{ t } [ -0.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
+{ f } [ 3.0 [ dup 0.0 float= swap -0.0 float= or ] compile-call ] unit-test
+
+{ 313.0 } [ 313 [ fixnum>float ] compile-call ] unit-test
+{ -313 } [ -313.5 [ float>fixnum ] compile-call ] unit-test
+{ 313 } [ 313.5 [ float>fixnum ] compile-call ] unit-test
+{ 315 315.0 } [ 313 [ 2 fixnum+fast dup fixnum>float ] compile-call ] unit-test
+
+{ t } [ 0/0. 0/0. [ float-unordered? ] compile-call ] unit-test
+{ t } [ 0/0. 1.0 [ float-unordered? ] compile-call ] unit-test
+{ t } [ 1.0 0/0. [ float-unordered? ] compile-call ] unit-test
+{ f } [ 3.0 1.0 [ float-unordered? ] compile-call ] unit-test
+{ f } [ 1.0 3.0 [ float-unordered? ] compile-call ] unit-test
+
+{ 1 } [ 0/0. 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 1 } [ 0/0. 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 1 } [ 1.0 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 2 } [ 3.0 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 2 } [ 1.0 3.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
: two-floats ( a b -- a b ) { float float } declare ; inline
-[ -11.3 ] [ -11.3 17.5 [ two-floats min ] compile-call ] unit-test
-[ -11.3 ] [ 17.5 -11.3 [ two-floats min ] compile-call ] unit-test
-[ 17.5 ] [ -11.3 17.5 [ two-floats max ] compile-call ] unit-test
-[ 17.5 ] [ 17.5 -11.3 [ two-floats max ] compile-call ] unit-test
+{ -11.3 } [ -11.3 17.5 [ two-floats min ] compile-call ] unit-test
+{ -11.3 } [ 17.5 -11.3 [ two-floats min ] compile-call ] unit-test
+{ 17.5 } [ -11.3 17.5 [ two-floats max ] compile-call ] unit-test
+{ 17.5 } [ 17.5 -11.3 [ two-floats max ] compile-call ] unit-test
! Test loops
-[ 30.0 ] [
+{ 30.0 } [
float-array{ 1 2 3 4 } float-array{ 1 2 3 4 }
[ { float-array float-array } declare [ * ] [ + ] 2map-reduce ] compile-call
] unit-test
-[ 30.0 ] [
+{ 30.0 } [
float-array{ 1 2 3 4 }
[ { float-array } declare dup [ * ] [ + ] 2map-reduce ] compile-call
] unit-test
-[ 30.0 ] [
+{ 30.0 } [
float-array{ 1 2 3 4 }
[ { float-array } declare [ dup * ] [ + ] map-reduce ] compile-call
] unit-test
-[ 4.5 ] [
+{ 4.5 } [
float-array{ 1.0 3.5 }
[ { float-array } declare 0.0 [ + ] reduce ] compile-call
] unit-test
-[ float-array{ 2.0 4.5 } ] [
+{ float-array{ 2.0 4.5 } } [
float-array{ 1.0 3.5 }
[ { float-array } declare [ 1 + ] map ] compile-call
] unit-test
-[ t ] [
+{ t } [
[ double-array{ 1.0 2.0 3.0 } 0.0 [ + ] reduce sqrt ] compile-call
2.44948 0.0001 ~
] unit-test
-[ 7.5 3 ] [
+{ 7.5 3 } [
[
double-array{ 1.0 2.0 3.0 }
1.5 [ + ] reduce dup 0.0 < [ 2 ] [ 3 ] if
IN: compiler.tests.intrinsics
! Make sure that intrinsic ops compile to correct code.
-[ ] [ 1 [ drop ] compile-call ] unit-test
-[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
-[ ] [ 1 2 3 [ 3drop ] compile-call ] unit-test
-[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
-[ 1 2 1 2 ] [ 1 2 [ 2dup ] compile-call ] unit-test
-[ 1 2 3 1 2 3 ] [ 1 2 3 [ 3dup ] compile-call ] unit-test
-[ 2 3 1 ] [ 1 2 3 [ rot ] compile-call ] unit-test
-[ 3 1 2 ] [ 1 2 3 [ -rot ] compile-call ] unit-test
-[ 1 1 2 ] [ 1 2 [ dupd ] compile-call ] unit-test
-[ 2 1 3 ] [ 1 2 3 [ swapd ] compile-call ] unit-test
-[ 2 ] [ 1 2 [ nip ] compile-call ] unit-test
-[ 3 ] [ 1 2 3 [ 2nip ] compile-call ] unit-test
-[ 1 2 1 ] [ 1 2 [ over ] compile-call ] unit-test
-[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-call ] unit-test
-[ 2 1 ] [ 1 2 [ swap ] compile-call ] unit-test
-
-[ 1 ] [ { 1 2 } [ 2 slot ] compile-call ] unit-test
-[ 1 ] [ [ { 1 2 } 2 slot ] compile-call ] unit-test
-
-
[ { f f } ] [ 2 f <array> ] unit-test
-
-[ 3 ] [ 3 1 2 2array [ { array } declare [ 2 set-slot ] keep ] compile-call first ] unit-test
-[ 3 ] [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
-[ 3 ] [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
-[ 3 ] [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-call second ] unit-test
-[ 3 ] [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
-[ 3 ] [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
+{ } [ 1 [ drop ] compile-call ] unit-test
+{ } [ 1 2 [ 2drop ] compile-call ] unit-test
+{ } [ 1 2 3 [ 3drop ] compile-call ] unit-test
+{ 1 1 } [ 1 [ dup ] compile-call ] unit-test
+{ 1 2 1 2 } [ 1 2 [ 2dup ] compile-call ] unit-test
+{ 1 2 3 1 2 3 } [ 1 2 3 [ 3dup ] compile-call ] unit-test
+{ 2 3 1 } [ 1 2 3 [ rot ] compile-call ] unit-test
+{ 3 1 2 } [ 1 2 3 [ -rot ] compile-call ] unit-test
+{ 1 1 2 } [ 1 2 [ dupd ] compile-call ] unit-test
+{ 2 1 3 } [ 1 2 3 [ swapd ] compile-call ] unit-test
+{ 2 } [ 1 2 [ nip ] compile-call ] unit-test
+{ 3 } [ 1 2 3 [ 2nip ] compile-call ] unit-test
+{ 1 2 1 } [ 1 2 [ over ] compile-call ] unit-test
+{ 1 2 3 1 } [ 1 2 3 [ pick ] compile-call ] unit-test
+{ 2 1 } [ 1 2 [ swap ] compile-call ] unit-test
+
+{ 1 } [ { 1 2 } [ 2 slot ] compile-call ] unit-test
+{ 1 } [ [ { 1 2 } 2 slot ] compile-call ] unit-test
+
+
{ { f f } } [ 2 f <array> ] unit-test
+
+{ 3 } [ 3 1 2 2array [ { array } declare [ 2 set-slot ] keep ] compile-call first ] unit-test
+{ 3 } [ 3 1 2 [ 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
+{ 3 } [ [ 3 1 2 2array [ 2 set-slot ] keep ] compile-call first ] unit-test
+{ 3 } [ 3 1 2 2array [ [ 3 set-slot ] keep ] compile-call second ] unit-test
+{ 3 } [ 3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
+{ 3 } [ [ 3 1 2 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
! Write barrier hits on the wrong value were causing segfaults
-[ -3 ] [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
-
-[ CHAR: a ] [ 0 "abc" [ string-nth ] compile-call ] unit-test
-[ CHAR: a ] [ 0 [ "abc" string-nth ] compile-call ] unit-test
-[ CHAR: a ] [ [ 0 "abc" string-nth ] compile-call ] unit-test
-[ CHAR: b ] [ 1 "abc" [ string-nth ] compile-call ] unit-test
-[ CHAR: b ] [ 1 [ "abc" string-nth ] compile-call ] unit-test
-[ CHAR: b ] [ [ 1 "abc" string-nth ] compile-call ] unit-test
-
-[ 0x123456 ] [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
-[ 0x123456 ] [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test
-[ 0x123456 ] [ [ 0 "\u123456bc" string-nth ] compile-call ] unit-test
-[ 0x123456 ] [ 1 "a\u123456c" [ string-nth ] compile-call ] unit-test
-[ 0x123456 ] [ 1 [ "a\u123456c" string-nth ] compile-call ] unit-test
-[ 0x123456 ] [ [ 1 "a\u123456c" string-nth ] compile-call ] unit-test
+{ -3 } [ -3 1 2 [ 2array [ 3 set-slot ] keep ] compile-call second ] unit-test
+
+{ CHAR: a } [ 0 "abc" [ string-nth ] compile-call ] unit-test
+{ CHAR: a } [ 0 [ "abc" string-nth ] compile-call ] unit-test
+{ CHAR: a } [ [ 0 "abc" string-nth ] compile-call ] unit-test
+{ CHAR: b } [ 1 "abc" [ string-nth ] compile-call ] unit-test
+{ CHAR: b } [ 1 [ "abc" string-nth ] compile-call ] unit-test
+{ CHAR: b } [ [ 1 "abc" string-nth ] compile-call ] unit-test
+
+{ 0x123456 } [ 0 "\u123456bc" [ string-nth ] compile-call ] unit-test
+{ 0x123456 } [ 0 [ "\u123456bc" string-nth ] compile-call ] unit-test
+{ 0x123456 } [ [ 0 "\u123456bc" string-nth ] compile-call ] unit-test
+{ 0x123456 } [ 1 "a\u123456c" [ string-nth ] compile-call ] unit-test
+{ 0x123456 } [ 1 [ "a\u123456c" string-nth ] compile-call ] unit-test
+{ 0x123456 } [ [ 1 "a\u123456c" string-nth ] compile-call ] unit-test
[ [ 0 special-object ] compile-call ] must-not-fail
-[ ] [ 1 special-object [ 1 set-special-object ] compile-call ] unit-test
-
-[ ] [ 1 [ drop ] compile-call ] unit-test
-[ ] [ [ 1 drop ] compile-call ] unit-test
-[ ] [ [ 1 2 2drop ] compile-call ] unit-test
-[ ] [ 1 [ 2 2drop ] compile-call ] unit-test
-[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
-[ 2 1 ] [ [ 1 2 swap ] compile-call ] unit-test
-[ 2 1 ] [ 1 [ 2 swap ] compile-call ] unit-test
-[ 2 1 ] [ 1 2 [ swap ] compile-call ] unit-test
-[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
-[ 1 1 ] [ [ 1 dup ] compile-call ] unit-test
-[ 1 2 1 ] [ [ 1 2 over ] compile-call ] unit-test
-[ 1 2 1 ] [ 1 [ 2 over ] compile-call ] unit-test
-[ 1 2 1 ] [ 1 2 [ over ] compile-call ] unit-test
-[ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-call ] unit-test
-[ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-call ] unit-test
-[ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-call ] unit-test
-[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-call ] unit-test
-[ 1 1 2 ] [ [ 1 2 dupd ] compile-call ] unit-test
-[ 1 1 2 ] [ 1 [ 2 dupd ] compile-call ] unit-test
-[ 1 1 2 ] [ 1 2 [ dupd ] compile-call ] unit-test
-[ 2 ] [ [ 1 2 nip ] compile-call ] unit-test
-[ 2 ] [ 1 [ 2 nip ] compile-call ] unit-test
-[ 2 ] [ 1 2 [ nip ] compile-call ] unit-test
-
-[ 2 1 "hi" ] [ 1 2 [ swap "hi" ] compile-call ] unit-test
-
-[ 4 ] [ 12 7 [ fixnum-bitand ] compile-call ] unit-test
-[ 4 ] [ 12 [ 7 fixnum-bitand ] compile-call ] unit-test
-[ 4 ] [ [ 12 7 fixnum-bitand ] compile-call ] unit-test
-[ -16 ] [ -1 [ -16 fixnum-bitand ] compile-call ] unit-test
-
-[ 15 ] [ 12 7 [ fixnum-bitor ] compile-call ] unit-test
-[ 15 ] [ 12 [ 7 fixnum-bitor ] compile-call ] unit-test
-[ 15 ] [ [ 12 7 fixnum-bitor ] compile-call ] unit-test
-[ -1 ] [ -1 [ -16 fixnum-bitor ] compile-call ] unit-test
-
-[ 11 ] [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test
-[ 11 ] [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test
-[ 11 ] [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test
-[ 15 ] [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test
-
-[ f ] [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-
-[ t ] [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
-
-[ f ] [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-
-[ t ] [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
-
-[ t ] [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-
-[ f ] [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
-
-[ t ] [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-
-[ f ] [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
-
-[ f ] [ 1 2 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ 1 [ 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
-[ f ] [ [ 1 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 3 3 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ 3 [ 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
-[ t ] [ [ 3 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
-
-[ -1 ] [ 0 [ fixnum-bitnot ] compile-call ] unit-test
-[ -1 ] [ [ 0 fixnum-bitnot ] compile-call ] unit-test
-
-[ 3 ] [ 13 10 [ fixnum-mod ] compile-call ] unit-test
-[ 3 ] [ 13 [ 10 fixnum-mod ] compile-call ] unit-test
-[ 3 ] [ [ 13 10 fixnum-mod ] compile-call ] unit-test
-[ -3 ] [ -13 10 [ fixnum-mod ] compile-call ] unit-test
-[ -3 ] [ -13 [ 10 fixnum-mod ] compile-call ] unit-test
-[ -3 ] [ [ -13 10 fixnum-mod ] compile-call ] unit-test
-
-[ 2 ] [ 4 2 [ fixnum/i ] compile-call ] unit-test
-[ 2 ] [ 4 [ 2 fixnum/i ] compile-call ] unit-test
-[ -2 ] [ 4 [ -2 fixnum/i ] compile-call ] unit-test
-[ 3 1 ] [ 10 3 [ fixnum/mod ] compile-call ] unit-test
-
-[ 2 ] [ 4 2 [ fixnum/i-fast ] compile-call ] unit-test
-[ 2 ] [ 4 [ 2 fixnum/i-fast ] compile-call ] unit-test
-[ -2 ] [ 4 [ -2 fixnum/i-fast ] compile-call ] unit-test
-[ 3 1 ] [ 10 3 [ fixnum/mod-fast ] compile-call ] unit-test
-
-[ 4 ] [ 1 3 [ fixnum+ ] compile-call ] unit-test
-[ 4 ] [ 1 [ 3 fixnum+ ] compile-call ] unit-test
-[ 4 ] [ [ 1 3 fixnum+ ] compile-call ] unit-test
-
-[ 4 ] [ 1 3 [ fixnum+fast ] compile-call ] unit-test
-[ 4 ] [ 1 [ 3 fixnum+fast ] compile-call ] unit-test
-[ 4 ] [ [ 1 3 fixnum+fast ] compile-call ] unit-test
-
-[ -2 ] [ 1 3 [ fixnum-fast ] compile-call ] unit-test
-[ -2 ] [ 1 [ 3 fixnum-fast ] compile-call ] unit-test
-[ -2 ] [ [ 1 3 fixnum-fast ] compile-call ] unit-test
-
-[ 30001 ] [ 1 [ 30000 fixnum+fast ] compile-call ] unit-test
-
-[ 6 ] [ 2 3 [ fixnum*fast ] compile-call ] unit-test
-[ 6 ] [ 2 [ 3 fixnum*fast ] compile-call ] unit-test
-[ 6 ] [ [ 2 3 fixnum*fast ] compile-call ] unit-test
-[ -6 ] [ 2 -3 [ fixnum*fast ] compile-call ] unit-test
-[ -6 ] [ 2 [ -3 fixnum*fast ] compile-call ] unit-test
-[ -6 ] [ [ 2 -3 fixnum*fast ] compile-call ] unit-test
-
-[ 6 ] [ 2 3 [ fixnum* ] compile-call ] unit-test
-[ 6 ] [ 2 [ 3 fixnum* ] compile-call ] unit-test
-[ 6 ] [ [ 2 3 fixnum* ] compile-call ] unit-test
-[ -6 ] [ 2 -3 [ fixnum* ] compile-call ] unit-test
-[ -6 ] [ 2 [ -3 fixnum* ] compile-call ] unit-test
-[ -6 ] [ [ 2 -3 fixnum* ] compile-call ] unit-test
-
-[ 5 ] [ 1 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
-[ 3 ] [ 2 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
-[ 3 ] [ 1 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
-[ 5 ] [ 2 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
-
-[ 8 ] [ 1 3 [ fixnum-shift ] compile-call ] unit-test
-[ 8 ] [ 1 [ 3 fixnum-shift ] compile-call ] unit-test
-[ 8 ] [ [ 1 3 fixnum-shift ] compile-call ] unit-test
-[ -8 ] [ -1 3 [ fixnum-shift ] compile-call ] unit-test
-[ -8 ] [ -1 [ 3 fixnum-shift ] compile-call ] unit-test
-[ -8 ] [ [ -1 3 fixnum-shift ] compile-call ] unit-test
-
-[ 2 ] [ 8 -2 [ fixnum-shift ] compile-call ] unit-test
-[ 2 ] [ 8 [ -2 fixnum-shift ] compile-call ] unit-test
-
-[ 0 ] [ [ 123 -64 fixnum-shift ] compile-call ] unit-test
-[ 0 ] [ 123 -64 [ fixnum-shift ] compile-call ] unit-test
-[ -1 ] [ [ -123 -64 fixnum-shift ] compile-call ] unit-test
-[ -1 ] [ -123 -64 [ fixnum-shift ] compile-call ] unit-test
-
-[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-call ] unit-test
-[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
-[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
-
-[ 8 ] [ 1 3 [ fixnum-shift-fast ] compile-call ] unit-test
-[ 8 ] [ 1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
-[ 8 ] [ 1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
-[ 8 ] [ [ 1 3 fixnum-shift-fast ] compile-call ] unit-test
-[ -8 ] [ -1 3 [ fixnum-shift-fast ] compile-call ] unit-test
-[ -8 ] [ -1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
-[ -8 ] [ -1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
-[ -8 ] [ [ -1 3 fixnum-shift-fast ] compile-call ] unit-test
-
-[ 2 ] [ 8 -2 [ fixnum-shift-fast ] compile-call ] unit-test
-[ 2 ] [ 8 2 [ 15 bitand neg fixnum-shift-fast ] compile-call ] unit-test
-[ 2 ] [ 8 [ -2 fixnum-shift-fast ] compile-call ] unit-test
-
-[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-call ] unit-test
-[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
-[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 32 [ fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
-[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
-
-[ 0x10000000 ] [ 0x1000000 0x10 [ fixnum* ] compile-call ] unit-test
-[ 0x8000000 ] [ -0x8000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
-[ 0x8000000 ] [ -0x7ffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
-
-[ t ] [ 1 26 fixnum-shift dup [ fixnum+ ] compile-call 1 27 fixnum-shift = ] unit-test
-[ -134217729 ] [ 1 27 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
-
-[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-call 1 40 shift = ] unit-test
-[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-call 1 40 shift neg = ] unit-test
-[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-call 1 40 shift = ] unit-test
-[ -351382792 ] [ -43922849 [ 3 fixnum-shift ] compile-call ] unit-test
-
-[ 134217728 ] [ -134217728 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
-
-[ 134217728 0 ] [ -134217728 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
-
-[ t ] [ f [ f eq? ] compile-call ] unit-test
+{ } [ 1 special-object [ 1 set-special-object ] compile-call ] unit-test
+
+{ } [ 1 [ drop ] compile-call ] unit-test
+{ } [ [ 1 drop ] compile-call ] unit-test
+{ } [ [ 1 2 2drop ] compile-call ] unit-test
+{ } [ 1 [ 2 2drop ] compile-call ] unit-test
+{ } [ 1 2 [ 2drop ] compile-call ] unit-test
+{ 2 1 } [ [ 1 2 swap ] compile-call ] unit-test
+{ 2 1 } [ 1 [ 2 swap ] compile-call ] unit-test
+{ 2 1 } [ 1 2 [ swap ] compile-call ] unit-test
+{ 1 1 } [ 1 [ dup ] compile-call ] unit-test
+{ 1 1 } [ [ 1 dup ] compile-call ] unit-test
+{ 1 2 1 } [ [ 1 2 over ] compile-call ] unit-test
+{ 1 2 1 } [ 1 [ 2 over ] compile-call ] unit-test
+{ 1 2 1 } [ 1 2 [ over ] compile-call ] unit-test
+{ 1 2 3 1 } [ [ 1 2 3 pick ] compile-call ] unit-test
+{ 1 2 3 1 } [ 1 [ 2 3 pick ] compile-call ] unit-test
+{ 1 2 3 1 } [ 1 2 [ 3 pick ] compile-call ] unit-test
+{ 1 2 3 1 } [ 1 2 3 [ pick ] compile-call ] unit-test
+{ 1 1 2 } [ [ 1 2 dupd ] compile-call ] unit-test
+{ 1 1 2 } [ 1 [ 2 dupd ] compile-call ] unit-test
+{ 1 1 2 } [ 1 2 [ dupd ] compile-call ] unit-test
+{ 2 } [ [ 1 2 nip ] compile-call ] unit-test
+{ 2 } [ 1 [ 2 nip ] compile-call ] unit-test
+{ 2 } [ 1 2 [ nip ] compile-call ] unit-test
+
+{ 2 1 "hi" } [ 1 2 [ swap "hi" ] compile-call ] unit-test
+
+{ 4 } [ 12 7 [ fixnum-bitand ] compile-call ] unit-test
+{ 4 } [ 12 [ 7 fixnum-bitand ] compile-call ] unit-test
+{ 4 } [ [ 12 7 fixnum-bitand ] compile-call ] unit-test
+{ -16 } [ -1 [ -16 fixnum-bitand ] compile-call ] unit-test
+
+{ 15 } [ 12 7 [ fixnum-bitor ] compile-call ] unit-test
+{ 15 } [ 12 [ 7 fixnum-bitor ] compile-call ] unit-test
+{ 15 } [ [ 12 7 fixnum-bitor ] compile-call ] unit-test
+{ -1 } [ -1 [ -16 fixnum-bitor ] compile-call ] unit-test
+
+{ 11 } [ 12 7 [ fixnum-bitxor ] compile-call ] unit-test
+{ 11 } [ 12 [ 7 fixnum-bitxor ] compile-call ] unit-test
+{ 11 } [ [ 12 7 fixnum-bitxor ] compile-call ] unit-test
+{ 15 } [ -1 [ -16 fixnum-bitxor ] compile-call ] unit-test
+
+{ f } [ 12 7 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 [ 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 7 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 12 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 12 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+
+{ t } [ 12 70 [ fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 [ 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 70 fixnum< [ t ] [ f ] if ] compile-call ] unit-test
+
+{ f } [ 12 7 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 [ 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 7 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 12 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 12 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+
+{ t } [ 12 70 [ fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 [ 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 70 fixnum<= [ t ] [ f ] if ] compile-call ] unit-test
+
+{ t } [ 12 7 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 [ 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 7 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 12 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 12 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+
+{ f } [ 12 70 [ fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 [ 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 70 fixnum> [ t ] [ f ] if ] compile-call ] unit-test
+
+{ t } [ 12 7 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 [ 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 7 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 12 12 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 12 12 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+
+{ f } [ 12 70 [ fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 12 [ 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 12 70 fixnum>= [ t ] [ f ] if ] compile-call ] unit-test
+
+{ f } [ 1 2 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ 1 [ 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
+{ f } [ [ 1 2 eq? [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 3 3 [ eq? [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ 3 [ 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
+{ t } [ [ 3 3 eq? [ t ] [ f ] if ] compile-call ] unit-test
+
+{ -1 } [ 0 [ fixnum-bitnot ] compile-call ] unit-test
+{ -1 } [ [ 0 fixnum-bitnot ] compile-call ] unit-test
+
+{ 3 } [ 13 10 [ fixnum-mod ] compile-call ] unit-test
+{ 3 } [ 13 [ 10 fixnum-mod ] compile-call ] unit-test
+{ 3 } [ [ 13 10 fixnum-mod ] compile-call ] unit-test
+{ -3 } [ -13 10 [ fixnum-mod ] compile-call ] unit-test
+{ -3 } [ -13 [ 10 fixnum-mod ] compile-call ] unit-test
+{ -3 } [ [ -13 10 fixnum-mod ] compile-call ] unit-test
+
+{ 2 } [ 4 2 [ fixnum/i ] compile-call ] unit-test
+{ 2 } [ 4 [ 2 fixnum/i ] compile-call ] unit-test
+{ -2 } [ 4 [ -2 fixnum/i ] compile-call ] unit-test
+{ 3 1 } [ 10 3 [ fixnum/mod ] compile-call ] unit-test
+
+{ 2 } [ 4 2 [ fixnum/i-fast ] compile-call ] unit-test
+{ 2 } [ 4 [ 2 fixnum/i-fast ] compile-call ] unit-test
+{ -2 } [ 4 [ -2 fixnum/i-fast ] compile-call ] unit-test
+{ 3 1 } [ 10 3 [ fixnum/mod-fast ] compile-call ] unit-test
+
+{ 4 } [ 1 3 [ fixnum+ ] compile-call ] unit-test
+{ 4 } [ 1 [ 3 fixnum+ ] compile-call ] unit-test
+{ 4 } [ [ 1 3 fixnum+ ] compile-call ] unit-test
+
+{ 4 } [ 1 3 [ fixnum+fast ] compile-call ] unit-test
+{ 4 } [ 1 [ 3 fixnum+fast ] compile-call ] unit-test
+{ 4 } [ [ 1 3 fixnum+fast ] compile-call ] unit-test
+
+{ -2 } [ 1 3 [ fixnum-fast ] compile-call ] unit-test
+{ -2 } [ 1 [ 3 fixnum-fast ] compile-call ] unit-test
+{ -2 } [ [ 1 3 fixnum-fast ] compile-call ] unit-test
+
+{ 30001 } [ 1 [ 30000 fixnum+fast ] compile-call ] unit-test
+
+{ 6 } [ 2 3 [ fixnum*fast ] compile-call ] unit-test
+{ 6 } [ 2 [ 3 fixnum*fast ] compile-call ] unit-test
+{ 6 } [ [ 2 3 fixnum*fast ] compile-call ] unit-test
+{ -6 } [ 2 -3 [ fixnum*fast ] compile-call ] unit-test
+{ -6 } [ 2 [ -3 fixnum*fast ] compile-call ] unit-test
+{ -6 } [ [ 2 -3 fixnum*fast ] compile-call ] unit-test
+
+{ 6 } [ 2 3 [ fixnum* ] compile-call ] unit-test
+{ 6 } [ 2 [ 3 fixnum* ] compile-call ] unit-test
+{ 6 } [ [ 2 3 fixnum* ] compile-call ] unit-test
+{ -6 } [ 2 -3 [ fixnum* ] compile-call ] unit-test
+{ -6 } [ 2 [ -3 fixnum* ] compile-call ] unit-test
+{ -6 } [ [ 2 -3 fixnum* ] compile-call ] unit-test
+
+{ 5 } [ 1 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
+{ 3 } [ 2 2 [ eq? [ 3 ] [ 5 ] if ] compile-call ] unit-test
+{ 3 } [ 1 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
+{ 5 } [ 2 2 [ fixnum< [ 3 ] [ 5 ] if ] compile-call ] unit-test
+
+{ 8 } [ 1 3 [ fixnum-shift ] compile-call ] unit-test
+{ 8 } [ 1 [ 3 fixnum-shift ] compile-call ] unit-test
+{ 8 } [ [ 1 3 fixnum-shift ] compile-call ] unit-test
+{ -8 } [ -1 3 [ fixnum-shift ] compile-call ] unit-test
+{ -8 } [ -1 [ 3 fixnum-shift ] compile-call ] unit-test
+{ -8 } [ [ -1 3 fixnum-shift ] compile-call ] unit-test
+
+{ 2 } [ 8 -2 [ fixnum-shift ] compile-call ] unit-test
+{ 2 } [ 8 [ -2 fixnum-shift ] compile-call ] unit-test
+
+{ 0 } [ [ 123 -64 fixnum-shift ] compile-call ] unit-test
+{ 0 } [ 123 -64 [ fixnum-shift ] compile-call ] unit-test
+{ -1 } [ [ -123 -64 fixnum-shift ] compile-call ] unit-test
+{ -1 } [ -123 -64 [ fixnum-shift ] compile-call ] unit-test
+
+{ 4294967296 } [ 1 32 [ fixnum-shift ] compile-call ] unit-test
+{ 4294967296 } [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
+{ 4294967296 } [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 32 [ fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
+
+{ 8 } [ 1 3 [ fixnum-shift-fast ] compile-call ] unit-test
+{ 8 } [ 1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
+{ 8 } [ 1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
+{ 8 } [ [ 1 3 fixnum-shift-fast ] compile-call ] unit-test
+{ -8 } [ -1 3 [ fixnum-shift-fast ] compile-call ] unit-test
+{ -8 } [ -1 3 [ 15 bitand fixnum-shift-fast ] compile-call ] unit-test
+{ -8 } [ -1 [ 3 fixnum-shift-fast ] compile-call ] unit-test
+{ -8 } [ [ -1 3 fixnum-shift-fast ] compile-call ] unit-test
+
+{ 2 } [ 8 -2 [ fixnum-shift-fast ] compile-call ] unit-test
+{ 2 } [ 8 2 [ 15 bitand neg fixnum-shift-fast ] compile-call ] unit-test
+{ 2 } [ 8 [ -2 fixnum-shift-fast ] compile-call ] unit-test
+
+{ 4294967296 } [ 1 32 [ fixnum-shift ] compile-call ] unit-test
+{ 4294967296 } [ 1 [ 32 fixnum-shift ] compile-call ] unit-test
+{ 4294967296 } [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 32 [ fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 [ 32 fixnum-shift ] compile-call ] unit-test
+{ -4294967296 } [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-call ] unit-test
+
+{ 0x10000000 } [ 0x1000000 0x10 [ fixnum* ] compile-call ] unit-test
+{ 0x8000000 } [ -0x8000000 >fixnum [ 0 swap fixnum- ] compile-call ] unit-test
+{ 0x8000000 } [ -0x7ffffff >fixnum [ 1 swap fixnum- ] compile-call ] unit-test
+
+{ t } [ 1 26 fixnum-shift dup [ fixnum+ ] compile-call 1 27 fixnum-shift = ] unit-test
+{ -134217729 } [ 1 27 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
+
+{ t } [ 1 20 shift 1 20 shift [ fixnum* ] compile-call 1 40 shift = ] unit-test
+{ t } [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-call 1 40 shift neg = ] unit-test
+{ t } [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-call 1 40 shift = ] unit-test
+{ -351382792 } [ -43922849 [ 3 fixnum-shift ] compile-call ] unit-test
+
+{ 134217728 } [ -134217728 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
+
+{ 134217728 0 } [ -134217728 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
+
+{ t } [ f [ f eq? ] compile-call ] unit-test
cell 8 = [
- [ 0x40400000 ] [
+ { 0x40400000 } [
0x4200 [ 0x7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ]
compile-call
] unit-test
] when
! regression
-[ 3 ] [
+{ 3 } [
100001 f <array> 3 100000 pick set-nth
[ 100000 swap array-nth ] compile-call
] unit-test
-[ 2 ] [ 2 4 [ fixnum-min ] compile-call ] unit-test
-[ 2 ] [ 4 2 [ fixnum-min ] compile-call ] unit-test
-[ 4 ] [ 2 4 [ fixnum-max ] compile-call ] unit-test
-[ 4 ] [ 4 2 [ fixnum-max ] compile-call ] unit-test
-[ -2 ] [ -2 -4 [ fixnum-max ] compile-call ] unit-test
-[ -2 ] [ -4 -2 [ fixnum-max ] compile-call ] unit-test
-[ -4 ] [ -2 -4 [ fixnum-min ] compile-call ] unit-test
-[ -4 ] [ -4 -2 [ fixnum-min ] compile-call ] unit-test
+{ 2 } [ 2 4 [ fixnum-min ] compile-call ] unit-test
+{ 2 } [ 4 2 [ fixnum-min ] compile-call ] unit-test
+{ 4 } [ 2 4 [ fixnum-max ] compile-call ] unit-test
+{ 4 } [ 4 2 [ fixnum-max ] compile-call ] unit-test
+{ -2 } [ -2 -4 [ fixnum-max ] compile-call ] unit-test
+{ -2 } [ -4 -2 [ fixnum-max ] compile-call ] unit-test
+{ -4 } [ -2 -4 [ fixnum-min ] compile-call ] unit-test
+{ -4 } [ -4 -2 [ fixnum-min ] compile-call ] unit-test
! 64-bit overflow
cell 8 = [
- [ t ] [ 1 fixnum-bits 2 - fixnum-shift dup [ fixnum+ ] compile-call 1 fixnum-bits 1 - fixnum-shift = ] unit-test
- [ t ] [ most-negative-fixnum [ -1 fixnum+ ] compile-call first-bignum 1 + neg = ] unit-test
+ { t } [ 1 fixnum-bits 2 - fixnum-shift dup [ fixnum+ ] compile-call 1 fixnum-bits 1 - fixnum-shift = ] unit-test
+ { t } [ most-negative-fixnum [ -1 fixnum+ ] compile-call first-bignum 1 + neg = ] unit-test
- [ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-call 1 80 shift = ] unit-test
- [ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-call 1 80 shift neg = ] unit-test
- [ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
- [ t ] [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
- [ t ] [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
+ { t } [ 1 40 shift 1 40 shift [ fixnum* ] compile-call 1 80 shift = ] unit-test
+ { t } [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-call 1 80 shift neg = ] unit-test
+ { t } [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
+ { t } [ 1 30 shift neg 1 50 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
+ { t } [ 1 50 shift neg 1 30 shift neg [ fixnum* ] compile-call 1 80 shift = ] unit-test
- [ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-call ] unit-test
- [ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-call ] unit-test
- [ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
- [ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-call ] unit-test
- [ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-call ] unit-test
- [ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
+ { 18446744073709551616 } [ 1 64 [ fixnum-shift ] compile-call ] unit-test
+ { 18446744073709551616 } [ 1 [ 64 fixnum-shift ] compile-call ] unit-test
+ { 18446744073709551616 } [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
+ { -18446744073709551616 } [ -1 64 [ fixnum-shift ] compile-call ] unit-test
+ { -18446744073709551616 } [ -1 [ 64 fixnum-shift ] compile-call ] unit-test
+ { -18446744073709551616 } [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
- [ t ] [ most-negative-fixnum -1 [ fixnum/i ] compile-call first-bignum = ] unit-test
+ { t } [ most-negative-fixnum -1 [ fixnum/i ] compile-call first-bignum = ] unit-test
- [ t ] [ most-negative-fixnum -1 [ fixnum/mod ] compile-call [ first-bignum = ] [ zero? ] bi* and ] unit-test
+ { t } [ most-negative-fixnum -1 [ fixnum/mod ] compile-call [ first-bignum = ] [ zero? ] bi* and ] unit-test
- [ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-call ] unit-test
+ { -268435457 } [ 28 2^ [ fixnum-bitnot ] compile-call ] unit-test
] when
! Some randomized tests
ERROR: bug-in-fixnum* x y a b ;
-[ ] [
+{ } [
10000 [
32 random-bits >fixnum
32 random-bits >fixnum
: compiled-fixnum>bignum ( a -- b ) fixnum>bignum ;
-[ bignum ] [ 0 compiled-fixnum>bignum class-of ] unit-test
+{ bignum } [ 0 compiled-fixnum>bignum class-of ] unit-test
-[ ] [
+{ } [
10000 [
32 random-bits >fixnum
dup [ fixnum>bignum ] keep compiled-fixnum>bignum =
: compiled-bignum>fixnum ( a -- b ) bignum>fixnum ;
-[ ] [
+{ } [
10000 [
5 random <iota> [ drop 32 random-bits ] map product >bignum
dup [ bignum>fixnum ] keep compiled-bignum>fixnum =
] unit-test
! Test overflow check removal
-[ t ] [
+{ t } [
most-positive-fixnum 100 - >fixnum
200
[ [ fixnum+ ] compile-call [ bignum>fixnum ] compile-call ] 2keep
=
] unit-test
-[ t ] [
+{ t } [
most-negative-fixnum 100 + >fixnum
-200
[ [ fixnum+ ] compile-call [ bignum>fixnum ] compile-call ] 2keep
=
] unit-test
-[ t ] [
+{ t } [
most-negative-fixnum 100 + >fixnum
200
[ [ fixnum- ] compile-call [ bignum>fixnum ] compile-call ] 2keep
] unit-test
! Test inline allocators
-[ { 1 1 1 } ] [
+{ { 1 1 1 } } [
[ 3 1 <array> ] compile-call
] unit-test
-[ B{ 0 0 0 } ] [
+{ B{ 0 0 0 } } [
[ 3 <byte-array> ] compile-call
] unit-test
-[ 500 ] [
+{ 500 } [
[ 500 <byte-array> length ] compile-call
] unit-test
-[ 1 2 ] [
+{ 1 2 } [
1 2 [ complex boa ] compile-call
dup real-part swap imaginary-part
] unit-test
-[ 1 2 ] [
+{ 1 2 } [
1 2 [ ratio boa ] compile-call dup numerator swap denominator
] unit-test
-[ \ + ] [ \ + [ <wrapper> ] compile-call ] unit-test
+{ \ + } [ \ + [ <wrapper> ] compile-call ] unit-test
-[ B{ 0 0 0 0 0 } ] [
+{ B{ 0 0 0 0 0 } } [
[ 5 <byte-array> ] compile-call
] unit-test
-[ V{ 1 2 } ] [
+{ V{ 1 2 } } [
{ 1 2 3 } 2 [ vector boa ] compile-call
] unit-test
-[ SBUF" hello" ] [
+{ SBUF" hello" } [
"hello world" 5 [ sbuf boa ] compile-call
] unit-test
-[ [ 3 + ] ] [
+{ [ 3 + ] } [
3 [ + ] [ curry ] compile-call
] unit-test
! Alien intrinsics
-[ 3 ] [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-call ] unit-test
-[ 3 ] [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-call ] unit-test
-[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
-[ 3 ] [ B{ 1 2 3 4 5 } 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
+{ 3 } [ B{ 1 2 3 4 5 } 2 [ alien-unsigned-1 ] compile-call ] unit-test
+{ 3 } [ [ B{ 1 2 3 4 5 } 2 alien-unsigned-1 ] compile-call ] unit-test
+{ 3 } [ B{ 1 2 3 4 5 } 2 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
+{ 3 } [ B{ 1 2 3 4 5 } 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
-[ ] [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test
-[ t ] [ "b" get >boolean ] unit-test
+{ } [ B{ 1 2 3 4 5 } malloc-byte-array "b" set ] unit-test
+{ t } [ "b" get >boolean ] unit-test
"b" get [
- [ 3 ] [ "b" get 2 [ alien-unsigned-1 ] compile-call ] unit-test
- [ 3 ] [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-call ] unit-test
- [ 3 ] [ "b" get 2 [ { alien fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
- [ 3 ] [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
+ { 3 } [ "b" get 2 [ alien-unsigned-1 ] compile-call ] unit-test
+ { 3 } [ "b" get [ { alien } declare 2 alien-unsigned-1 ] compile-call ] unit-test
+ { 3 } [ "b" get 2 [ { alien fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
+ { 3 } [ "b" get 2 [ { c-ptr fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
- [ ] [ "b" get free ] unit-test
+ { } [ "b" get free ] unit-test
] when
-[ ] [ "hello world" ascii malloc-string "s" set ] unit-test
+{ } [ "hello world" ascii malloc-string "s" set ] unit-test
"s" get [
- [ "hello world" ] [ "s" get void* <ref> [ { byte-array } declare void* deref ] compile-call ascii alien>string ] unit-test
- [ "hello world" ] [ "s" get void* <ref> [ { c-ptr } declare void* deref ] compile-call ascii alien>string ] unit-test
+ { "hello world" } [ "s" get void* <ref> [ { byte-array } declare void* deref ] compile-call ascii alien>string ] unit-test
+ { "hello world" } [ "s" get void* <ref> [ { c-ptr } declare void* deref ] compile-call ascii alien>string ] unit-test
- [ ] [ "s" get free ] unit-test
+ { } [ "s" get free ] unit-test
] when
-[ ALIEN: 1234 ] [ ALIEN: 1234 [ { alien } declare void* <ref> ] compile-call void* deref ] unit-test
-[ ALIEN: 1234 ] [ ALIEN: 1234 [ { c-ptr } declare void* <ref> ] compile-call void* deref ] unit-test
-[ f ] [ f [ { POSTPONE: f } declare void* <ref> ] compile-call void* deref ] unit-test
+{ ALIEN: 1234 } [ ALIEN: 1234 [ { alien } declare void* <ref> ] compile-call void* deref ] unit-test
+{ ALIEN: 1234 } [ ALIEN: 1234 [ { c-ptr } declare void* <ref> ] compile-call void* deref ] unit-test
+{ f } [ f [ { POSTPONE: f } declare void* <ref> ] compile-call void* deref ] unit-test
-[ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
-[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
+{ 252 } [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
+{ -4 } [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
-[ -100 ] [ -100 char <ref> [ { byte-array } declare char deref ] compile-call ] unit-test
-[ 156 ] [ -100 uchar <ref> [ { byte-array } declare uchar deref ] compile-call ] unit-test
+{ -100 } [ -100 char <ref> [ { byte-array } declare char deref ] compile-call ] unit-test
+{ 156 } [ -100 uchar <ref> [ { byte-array } declare uchar deref ] compile-call ] unit-test
-[ -100 ] [ -100 [ char <ref> ] [ { fixnum } declare ] prepend compile-call char deref ] unit-test
-[ 156 ] [ -100 [ uchar <ref> ] [ { fixnum } declare ] prepend compile-call uchar deref ] unit-test
+{ -100 } [ -100 [ char <ref> ] [ { fixnum } declare ] prepend compile-call char deref ] unit-test
+{ 156 } [ -100 [ uchar <ref> ] [ { fixnum } declare ] prepend compile-call uchar deref ] unit-test
-[ -1000 ] [ -1000 short <ref> [ { byte-array } declare short deref ] compile-call ] unit-test
-[ 64536 ] [ -1000 ushort <ref> [ { byte-array } declare ushort deref ] compile-call ] unit-test
+{ -1000 } [ -1000 short <ref> [ { byte-array } declare short deref ] compile-call ] unit-test
+{ 64536 } [ -1000 ushort <ref> [ { byte-array } declare ushort deref ] compile-call ] unit-test
-[ -1000 ] [ -1000 [ short <ref> ] [ { fixnum } declare ] prepend compile-call short deref ] unit-test
-[ 64536 ] [ -1000 [ ushort <ref> ] [ { fixnum } declare ] prepend compile-call ushort deref ] unit-test
+{ -1000 } [ -1000 [ short <ref> ] [ { fixnum } declare ] prepend compile-call short deref ] unit-test
+{ 64536 } [ -1000 [ ushort <ref> ] [ { fixnum } declare ] prepend compile-call ushort deref ] unit-test
-[ -100000 ] [ -100000 int <ref> [ { byte-array } declare int deref ] compile-call ] unit-test
-[ 4294867296 ] [ -100000 uint <ref> [ { byte-array } declare uint deref ] compile-call ] unit-test
+{ -100000 } [ -100000 int <ref> [ { byte-array } declare int deref ] compile-call ] unit-test
+{ 4294867296 } [ -100000 uint <ref> [ { byte-array } declare uint deref ] compile-call ] unit-test
-[ -100000 ] [ -100000 [ int <ref> ] [ { fixnum } declare ] prepend compile-call int deref ] unit-test
-[ 4294867296 ] [ -100000 [ uint <ref> ] [ { fixnum } declare ] prepend compile-call uint deref ] unit-test
+{ -100000 } [ -100000 [ int <ref> ] [ { fixnum } declare ] prepend compile-call int deref ] unit-test
+{ 4294867296 } [ -100000 [ uint <ref> ] [ { fixnum } declare ] prepend compile-call uint deref ] unit-test
-[ t ] [ pi pi double <ref> double deref = ] unit-test
+{ t } [ pi pi double <ref> double deref = ] unit-test
-[ t ] [ pi double <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
+{ t } [ pi double <ref> [ { byte-array } declare double deref ] compile-call pi = ] unit-test
! Silly
-[ t ] [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test
-[ t ] [ pi c:float <ref> [ { byte-array } declare c:float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
+{ t } [ pi 4 <byte-array> [ [ { float byte-array } declare 0 set-alien-float ] compile-call ] keep c:float deref pi - -0.001 0.001 between? ] unit-test
+{ t } [ pi c:float <ref> [ { byte-array } declare c:float deref ] compile-call pi - -0.001 0.001 between? ] unit-test
-[ t ] [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test
+{ t } [ pi 8 <byte-array> [ [ { float byte-array } declare 0 set-alien-double ] compile-call ] keep double deref pi = ] unit-test
-[ 4 ] [
+{ 4 } [
2 B{ 1 2 3 4 5 6 } <displaced-alien> [
{ alien } declare 1 alien-unsigned-1
] compile-call
] unit-test
-[ ALIEN: 123 ] [
+{ ALIEN: 123 } [
0x123 [ <alien> ] compile-call
] unit-test
-[ ALIEN: 123 ] [
+{ ALIEN: 123 } [
0x123 [ { fixnum } declare <alien> ] compile-call
] unit-test
-[ ALIEN: 123 ] [
+{ ALIEN: 123 } [
[ 0x123 <alien> ] compile-call
] unit-test
-[ f ] [
+{ f } [
0 [ <alien> ] compile-call
] unit-test
-[ f ] [
+{ f } [
0 [ { fixnum } declare <alien> ] compile-call
] unit-test
-[ f ] [
+{ f } [
[ 0 <alien> ] compile-call
] unit-test
-[ ALIEN: 321 ] [
+{ ALIEN: 321 } [
0 ALIEN: 321 [ <displaced-alien> ] compile-call
] unit-test
-[ ALIEN: 321 ] [
+{ ALIEN: 321 } [
0 ALIEN: 321 [ { fixnum c-ptr } declare <displaced-alien> ] compile-call
] unit-test
-[ ALIEN: 321 ] [
+{ ALIEN: 321 } [
ALIEN: 321 [ 0 swap <displaced-alien> ] compile-call
] unit-test
-[ B{ 0 1 2 3 4 } ] [
+{ B{ 0 1 2 3 4 } } [
2 B{ 0 1 2 3 4 } <displaced-alien>
[ 1 swap <displaced-alien> ] compile-call
underlying>>
] unit-test
-[ B{ 0 1 2 3 4 } ] [
+{ B{ 0 1 2 3 4 } } [
2 B{ 0 1 2 3 4 } <displaced-alien>
[ 1 swap { c-ptr } declare <displaced-alien> ] compile-call
underlying>>
] unit-test
-[ ALIEN: 1234 ALIEN: 2234 ] [
+{ ALIEN: 1234 ALIEN: 2234 } [
ALIEN: 234 [
{ c-ptr } declare
[ 0x1000 swap <displaced-alien> ]
B{ 0 0 0 0 } [ { c-ptr } declare void* <ref> ] compile-call
] must-fail
-[
- 4 5
-] [
+{ 4 5 } [
3 [
[
{ [ 4444 ] [ 444 ] [ 44 ] [ 4 ] } dispatch
] compile-call
] unit-test
-[ 1 ] [
+{ 1 } [
8 -3 [ fixnum-shift-fast ] compile-call
] unit-test
-[ 2 ] [
+{ 2 } [
16 -3 [ fixnum-shift-fast ] compile-call
] unit-test
-[ 2 ] [
+{ 2 } [
16 [ -3 fixnum-shift-fast ] compile-call
] unit-test
-[ 8 ] [
+{ 8 } [
1 3 [ fixnum-shift-fast ] compile-call
] unit-test
-[ 8 ] [
+{ 8 } [
1 [ 3 fixnum-shift-fast ] compile-call
] unit-test
TUPLE: alien-accessor-regression { b byte-array } { i fixnum } ;
-[ B{ 0 1 } ] [
+{ B{ 0 1 } } [
B{ 0 0 } 1 alien-accessor-regression boa
dup [
{ alien-accessor-regression } declare
1 slot
] if ;
-[ 0 ] [ f { } mutable-value-bug-1 ] unit-test
+{ 0 } [ f { } mutable-value-bug-1 ] unit-test
: mutable-value-bug-2 ( a b -- c )
swap [
{ tuple } declare 1 slot
] if ;
-[ 0 ] [ t { } mutable-value-bug-2 ] unit-test
+{ 0 } [ t { } mutable-value-bug-2 ] unit-test
]=]
-[ "foo" ] [ "a" parse-regexp ] unit-test
+{ "foo" } [ "a" parse-regexp ] unit-test
USE: tools.test
-[ t ] [ \ expr word-optimized? ] unit-test
-[ t ] [ \ ast>pipeline-expr word-optimized? ] unit-test
+{ t } [ \ expr word-optimized? ] unit-test
+{ t } [ \ ast>pipeline-expr word-optimized? ] unit-test
CONSTANT: blah T{ x }
-[ T{ x } ] [ blah ] unit-test
+{ T{ x } } [ blah ] unit-test
[ \ word-1 [ ] ( a -- b ) define-declared ] with-compilation-unit
-[ "a" ] [ "a" word-2 ] unit-test
+{ "a" } [ "a" word-2 ] unit-test
: word-3 ( a -- b ) 1 + ;
: word-4 ( a -- b c ) 0 swap word-3 swap 1 + ;
-[ 1 1 ] [ 0 word-4 ] unit-test
+{ 1 1 } [ 0 word-4 ] unit-test
[ \ word-3 [ [ 2 + ] bi@ ] ( a b -- c d ) define-declared ] with-compilation-unit
-[ 2 3 ] [ 0 word-4 ] unit-test
+{ 2 3 } [ 0 word-4 ] unit-test
: indirect ( x y ptr -- z )
type-3 { type-2 type-2 } cdecl alien-indirect ;
-[ ] [
+{ } [
"USING: alien.c-types alien.syntax ;
IN: compiler.tests.redefine24 TYPEDEF: int type-2" eval( -- )
] unit-test
-[ 3 ] [ 1 2 callback indirect ] unit-test
+{ 3 } [ 1 2 callback indirect ] unit-test
-[ ] [
+{ } [
"USING: alien.c-types alien.syntax ;
IN: compiler.tests.redefine24
TYPEDEF: float type-1
TYPEDEF: float type-2" eval( -- )
] unit-test
-[ 3 ] [ 1.0 2.0 callback indirect ] unit-test
+{ 3 } [ 1.0 2.0 callback indirect ] unit-test
-[ ] [
+{ } [
"USING: alien.c-types alien.syntax ;
IN: compiler.tests.redefine24
TYPEDEF: float type-3" eval( -- )
] unit-test
-[ 3.0 ] [ 1.0 2.0 callback indirect ] unit-test
+{ 3.0 } [ 1.0 2.0 callback indirect ] unit-test
TUPLE: empty-mixin-member < a-superclass ;
-[ f ] [ empty-mixin-member new empty-mixin? ] unit-test
-[ f ] [ empty-mixin-member new empty-mixin-test-1 ] unit-test
-[ f ] [ empty-mixin-member new empty-mixin-test-2 ] unit-test
+{ f } [ empty-mixin-member new empty-mixin? ] unit-test
+{ f } [ empty-mixin-member new empty-mixin-test-1 ] unit-test
+{ f } [ empty-mixin-member new empty-mixin-test-2 ] unit-test
-[ ] [
+{ } [
[
\ empty-mixin-member \ empty-mixin add-mixin-instance
] with-compilation-unit
] unit-test
-[ t ] [ empty-mixin-member new empty-mixin? ] unit-test
-[ t ] [ empty-mixin-member new empty-mixin-test-1 ] unit-test
-[ t ] [ empty-mixin-member new empty-mixin-test-2 ] unit-test
+{ t } [ empty-mixin-member new empty-mixin? ] unit-test
+{ t } [ empty-mixin-member new empty-mixin-test-1 ] unit-test
+{ t } [ empty-mixin-member new empty-mixin-test-2 ] unit-test
-[ ] [
+{ } [
[
\ empty-mixin forget
\ empty-mixin-member forget
: store-yoo ( -- obj ) redefine-test-26 new T{ yoo } >>a ;
: store-hoo ( -- obj ) redefine-test-26 new T{ hoo } >>a ;
-[ f ] [ redefine-test-26 new a>> ] unit-test
-[ 26 ] [ store-26 a>> ] unit-test
-[ T{ yoo } ] [ store-yoo a>> ] unit-test
+{ f } [ redefine-test-26 new a>> ] unit-test
+{ 26 } [ store-26 a>> ] unit-test
+{ T{ yoo } } [ store-yoo a>> ] unit-test
[ store-26. a>> ] [ bad-slot-value? ] must-fail-with
[ store-hoo a>> ] [ bad-slot-value? ] must-fail-with
-[ ] [
+{ ] [
[
\ foo { integer hoo } define-union-class
] with-compilation-unit
] unit-test
-[ f ] [ redefine-test-26 new a>> ] unit-test
-[ 26 ] [ store-26 a>> ] unit-test
-[ T{ hoo } ] [ store-hoo a>> ] unit-test
+{ f } [ redefine-test-26 new a>> ] unit-test
+{ 26 } [ store-26 a>> ] unit-test
+{ T{ hoo } } [ store-hoo a>> ] unit-test
[ store-26. a>> ] [ bad-slot-value? ] must-fail-with
[ store-yoo a>> ] [ bad-slot-value? ] must-fail-with
[ dup float+ ]
} cleave ;
-[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
+{ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 }
[ 1.0 float-spill-bug ] unit-test
-[ t ] [ \ float-spill-bug word-optimized? ] unit-test
+{ t } [ \ float-spill-bug word-optimized? ] unit-test
: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
{
[ float>fixnum dup fixnum+fast ]
} cleave ;
-[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
+{ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 }
[ 1.0 float-fixnum-spill-bug ] unit-test
-[ t ] [ \ float-fixnum-spill-bug word-optimized? ] unit-test
+{ t } [ \ float-fixnum-spill-bug word-optimized? ] unit-test
: resolve-spill-bug ( a b -- c )
[ 1 fixnum+fast ] bi@ dup 10 fixnum< [
16 narray
] if ;
-[ t ] [ \ resolve-spill-bug word-optimized? ] unit-test
+{ t } [ \ resolve-spill-bug word-optimized? ] unit-test
-[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
+{ 4 } [ 1 1 resolve-spill-bug ] unit-test
: spill-test-1 ( a -- b )
dup 1 fixnum+fast
[ 8 narray [ 8 narray ] dip 2array ] dip 2array
2array ;
-[
+{
{
1
{
}
}
}
-] [ 1 spill-test-1 ] unit-test
+} [ 1 spill-test-1 ] unit-test
: spill-test-2 ( a -- b )
dup 1.0 float+
float*
float* ;
-[ t ] [ 1.0 spill-test-2 1.0 \ spill-test-2 def>> call = ] unit-test
+{ t } [ 1.0 spill-test-2 1.0 \ spill-test-2 def>> call = ] unit-test
: assembly-test-1 ( -- x ) int { } cdecl [ EAX 3 MOV ] alien-assembly ;
-[ 3 ] [ assembly-test-1 ] unit-test
+{ 3 } [ assembly-test-1 ] unit-test
: assembly-test-1 ( -- x ) int { } cdecl [ RAX 3 MOV ] alien-assembly ;
-[ 3 ] [ assembly-test-1 ] unit-test
+{ 3 } [ assembly-test-1 ] unit-test
: assembly-test-2 ( a b -- x )
int { int int } cdecl [
int-regs return-regs at first param-reg-0 MOV
] alien-assembly ;
-[ 23 ] [ 17 6 assembly-test-2 ] unit-test
+{ 23 } [ 17 6 assembly-test-2 ] unit-test
{ B{ 73 131 198 24 } } [
[ T{ ds-loc { n 3 } } %inc ] B{ } make
{ { 136 235 } } [ [ BL CH MOV ] { } make ] unit-test
! immediate operands
-[ { 0xb9 0x01 0x00 0x00 0x00 } ] [ [ ECX 1 MOV ] { } make ] unit-test
-[ { 0xb9 0x01 0x00 0x00 0x00 } ] [ [ RCX 1 MOV ] { } make ] unit-test
+{ { 0xb9 0x01 0x00 0x00 0x00 } } [ [ ECX 1 MOV ] { } make ] unit-test
+{ { 0xb9 0x01 0x00 0x00 0x00 } } [ [ RCX 1 MOV ] { } make ] unit-test
{ { 0x83 0xc1 0x01 } } [ [ ECX 1 ADD ] { } make ] unit-test
{ { 0x81 0xc1 0x96 0x00 0x00 0x00 } } [ [ ECX 150 ADD ] { } make ] unit-test
strings system endian ;
IN: cpu.x86.features.tests
-[ t ] [ sse-version 0 42 between? ] unit-test
-[ t ] [ [ 10000 [ ] times ] count-instructions integer? ] unit-test
+{ t } [ sse-version 0 42 between? ] unit-test
-{ t }
-[
+{ t } [ [ 10000 [ ] times ] count-instructions integer? ] unit-test
+
+{ t } [
0 cpuid [ 4 >le ] map { 1 3 2 } swap nths concat >string
{ "GenuineIntel" "AuthenticAMD" } member?
] unit-test
{ 1 0 } [ define-box ] must-infer-as
-[ T{ float-box f 5.0 } ] [ 5.0 <float-box> ] unit-test
+{ T{ float-box f 5.0 } } [ 5.0 <float-box> ] unit-test
: twice ( word -- )
[ execute ] [ execute ] bi ; inline
>>
-[ 16 ] [ 2 sqsq ] unit-test
+{ 16 } [ 2 sqsq ] unit-test
<<
>>
-[ 4 ] [ 1 3 blah ] unit-test
+{ 4 } [ 1 3 blah ] unit-test
<<
>>
-[ blorgh ] [ blorgh ] unit-test
+{ blorgh } [ blorgh ] unit-test
<<
>>
-[ 2 ] [ 1 snurv ] unit-test
-[ 3.0 ] [ 3.0 snurv ] unit-test
+{ 2 } [ 1 snurv ] unit-test
+{ 3.0 } [ 3.0 snurv ] unit-test
! Does replacing an ordinary word with a functor-generated one work?
-[ [ ] ] [
+{ [ ] } [
"IN: functors.tests
TUPLE: some-tuple ;
] unit-test
: test-redefinition ( -- )
- [ t ] [ "some-word" "functors.tests" lookup-word >boolean ] unit-test
- [ t ] [ "some-tuple" "functors.tests" lookup-word >boolean ] unit-test
- [ t ] [ "some-generic" "functors.tests" lookup-word >boolean ] unit-test
- [ t ] [
+ { t } [ "some-word" "functors.tests" lookup-word >boolean ] unit-test
+ { t } [ "some-tuple" "functors.tests" lookup-word >boolean ] unit-test
+ { t } [ "some-generic" "functors.tests" lookup-word >boolean ] unit-test
+ { t } [
"some-tuple" "functors.tests" lookup-word
"some-generic" "functors.tests" lookup-word lookup-method >boolean
] unit-test ;
- [ t ] [ "some-symbol" "functors.tests" lookup-word >boolean ] unit-test
+ { t } [ "some-symbol" "functors.tests" lookup-word >boolean ] unit-test
test-redefinition
>>
-[ t ] [ \ an-inline-word inline? ] unit-test
-[ f ] [ \ an-inline-word-an-inline-word inline? ] unit-test
+{ t } [ \ an-inline-word inline? ] unit-test
+{ f } [ \ an-inline-word-an-inline-word inline? ] unit-test
<<
>>
-[ t ] [ a-final-tuple final-class? ] unit-test
+{ t } [ a-final-tuple final-class? ] unit-test
literals memory sequences splitting tools.test windows.kernel32
io.files.unique destructors ;
-[ f ] [ "\\foo" absolute-path? ] unit-test
-[ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
-[ t ] [ "\\\\?\\c:\\" absolute-path? ] unit-test
-[ t ] [ "\\\\?\\c:" absolute-path? ] unit-test
-[ t ] [ "c:\\foo" absolute-path? ] unit-test
-[ t ] [ "c:" absolute-path? ] unit-test
-[ t ] [ "c:\\" absolute-path? ] unit-test
-[ f ] [ "/cygdrive/c/builds" absolute-path? ] unit-test
+{ f } [ "\\foo" absolute-path? ] unit-test
+{ t } [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
+{ t } [ "\\\\?\\c:\\" absolute-path? ] unit-test
+{ t } [ "\\\\?\\c:" absolute-path? ] unit-test
+{ t } [ "c:\\foo" absolute-path? ] unit-test
+{ t } [ "c:" absolute-path? ] unit-test
+{ t } [ "c:\\" absolute-path? ] unit-test
+{ f } [ "/cygdrive/c/builds" absolute-path? ] unit-test
-[ "c:\\foo\\" ] [ "c:\\foo\\bar" parent-directory ] unit-test
-[ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test
-[ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test
+{ "c:\\foo\\" } [ "c:\\foo\\bar" parent-directory ] unit-test
+{ "c:\\" } [ "c:\\foo\\" parent-directory ] unit-test
+{ "c:\\" } [ "c:\\foo" parent-directory ] unit-test
! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing
-[ "c:\\" ] [ "c:\\" parent-directory ] unit-test
-[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test
-[ "c:" ] [ "c:" parent-directory ] unit-test
-[ "Z:" ] [ "Z:" parent-directory ] unit-test
+{ "c:\\" } [ "c:\\" parent-directory ] unit-test
+{ "Z:\\" } [ "Z:\\" parent-directory ] unit-test
+{ "c:" } [ "c:" parent-directory ] unit-test
+{ "Z:" } [ "Z:" parent-directory ] unit-test
-[ f ] [ "" root-directory? ] unit-test
-[ t ] [ "\\" root-directory? ] unit-test
-[ t ] [ "\\\\" root-directory? ] unit-test
-[ t ] [ "/" root-directory? ] unit-test
-[ t ] [ "//" root-directory? ] unit-test
-[ t ] [ "c:\\" trim-tail-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" trim-tail-separators root-directory? ] unit-test
-[ f ] [ "c:\\foo" root-directory? ] unit-test
-[ f ] [ "." root-directory? ] unit-test
-[ f ] [ ".." root-directory? ] unit-test
-[ t ] [ "\\\\?\\c:\\" root-directory? ] unit-test
-[ t ] [ "\\\\?\\c:" root-directory? ] unit-test
-[ f ] [ "\\\\?\\c:\\bar" root-directory? ] unit-test
+{ f } [ "" root-directory? ] unit-test
+{ t } [ "\\" root-directory? ] unit-test
+{ t } [ "\\\\" root-directory? ] unit-test
+{ t } [ "/" root-directory? ] unit-test
+{ t } [ "//" root-directory? ] unit-test
+{ t } [ "c:\\" trim-tail-separators root-directory? ] unit-test
+{ t } [ "Z:\\" trim-tail-separators root-directory? ] unit-test
+{ f } [ "c:\\foo" root-directory? ] unit-test
+{ f } [ "." root-directory? ] unit-test
+{ f } [ ".." root-directory? ] unit-test
+{ t } [ "\\\\?\\c:\\" root-directory? ] unit-test
+{ t } [ "\\\\?\\c:" root-directory? ] unit-test
+{ f } [ "\\\\?\\c:\\bar" root-directory? ] unit-test
-[ "\\\\a\\b\\c\\foo.xls" ] [ "//a/b/c/foo.xls" normalize-path ] unit-test
-[ "\\\\a\\b\\c\\foo.xls" ] [ "\\\\a\\b\\c\\foo.xls" normalize-path ] unit-test
+{ "\\\\a\\b\\c\\foo.xls" } [ "//a/b/c/foo.xls" normalize-path ] unit-test
+{ "\\\\a\\b\\c\\foo.xls" } [ "\\\\a\\b\\c\\foo.xls" normalize-path ] unit-test
-[ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
+{ "\\foo\\bar" } [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
-[ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
+{ "\\\\?\\C:\\builds\\factor\\log.txt" } [
"C:\\builds\\factor\\12345\\"
"..\\log.txt" append-path normalize-path
] unit-test
-[ "\\\\?\\C:\\builds\\" ] [
+{ "\\\\?\\C:\\builds\\" } [
"C:\\builds\\factor\\12345\\"
"..\\.." append-path normalize-path
] unit-test
-[ "\\\\?\\C:\\builds\\" ] [
+{ "\\\\?\\C:\\builds\\" } [
"C:\\builds\\factor\\12345\\"
"..\\.." append-path normalize-path
] unit-test
-[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
-[ t ] [ "" resource-path 2 tail file-exists? ] unit-test
+{ "c:\\blah" } [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
+{ t } [ "" resource-path 2 tail file-exists? ] unit-test
! win32-file-attributes
{
USING: tools.test io.pipes io.pipes.unix io.encodings.utf8
io.encodings io namespaces sequences splitting ;
-[ { 0 0 } ] [ { "ls" "grep ." } run-pipeline ] unit-test
+{ { 0 0 } } [ { "ls" "grep ." } run-pipeline ] unit-test
-[ { 0 f 0 } ] [
+{ { 0 f 0 } } [
{
"ls"
[
USING: io.standard-paths io.standard-paths.windows sequences
tools.test ;
-[ t ] [ "cmd.exe" find-in-path "cmd.exe" tail? ] unit-test
+{ t } [ "cmd.exe" find-in-path "cmd.exe" tail? ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: io.streams.string json.prettyprint json.reader tools.test ;
-[
+{
"{
\"a\": 3
}"
-] [
+} [
"{\"a\":3}" json> pprint-json>string
] unit-test
-[ "{ }" ] [ "{ }" json> pprint-json>string ] unit-test
-[ "[ ]" ] [ "[ ]" json> pprint-json>string ] unit-test
-[ "null" ] [ "null" json> pprint-json>string ] unit-test
-[ "false" ] [ "false" json> pprint-json>string ] unit-test
-[ "3" ] [ "3" json> pprint-json>string ] unit-test
-[ "[
+{ "{ }" } [ "{ }" json> pprint-json>string ] unit-test
+{ "[ ]" } [ "[ ]" json> pprint-json>string ] unit-test
+{ "null" } [ "null" json> pprint-json>string ] unit-test
+{ "false" } [ "false" json> pprint-json>string ] unit-test
+{ "3" } [ "3" json> pprint-json>string ] unit-test
+{ "[
3,
4,
5
-]" ] [ "[3,4,5]" json> pprint-json>string ] unit-test
+]" } [ "[3,4,5]" json> pprint-json>string ] unit-test
-[ "{
+{ "{
3: 30,
4: 40,
5: 50
-}" ] [ "{3:30,4:40,5:50}" json> pprint-json>string ] unit-test
+}" } [ "{3:30,4:40,5:50}" json> pprint-json>string ] unit-test
USING: system-info.linux strings splitting sequences
tools.test kernel ;
-[ 6 ] [ uname length ] unit-test
+{ 6 } [ uname length ] unit-test
-[ t ] [ sysname string? ] unit-test
-[ t ] [ nodename string? ] unit-test
-[ t ] [ release string? ] unit-test
-[ t ] [ version string? ] unit-test
-[ t ] [ machine string? ] unit-test
-[ t ] [ domainname string? ] unit-test
+{ t } [ sysname string? ] unit-test
+{ t } [ nodename string? ] unit-test
+{ t } [ release string? ] unit-test
+{ t } [ version string? ] unit-test
+{ t } [ machine string? ] unit-test
+{ t } [ domainname string? ] unit-test
{ t } [
release "." split1 drop { "2" "3" "4" "5" } member?
USING: math math.order strings system-info.windows tools.test
system-info ;
-[ t ] [ cpus integer? ] unit-test
-[ t ] [ username string? ] unit-test
+{ t } [ cpus integer? ] unit-test
+{ t } [ username string? ] unit-test
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test windows.errors strings ;
-IN: windows.errors.tests
-[ t ] [ 0 n>win32-error-string string? ] unit-test
+{ t } [ 0 n>win32-error-string string? ] unit-test
-IN: windows.offscreen.tests
USING: windows.offscreen effects tools.test kernel images ;
{ 1 1 } [ [ [ ] make-bitmap-image ] with-memory-dc ] must-infer-as
-[ t ] [ [ { 10 10 } swap [ ] make-bitmap-image ] with-memory-dc image? ] unit-test
+{ t } [ [ { 10 10 } swap [ ] make-bitmap-image ] with-memory-dc image? ] unit-test
windows.time ;
IN: windows.time.tests
-[ t ] [ windows-1601 [ timestamp>FILETIME FILETIME>timestamp ] keep = ] unit-test
-[ t ] [ windows-time [ windows-time>FILETIME FILETIME>windows-time ] keep = ] unit-test
-[ t ] [ windows-1601 400 years time+ [ timestamp>FILETIME FILETIME>timestamp ] keep = ] unit-test
+{ t } [ windows-1601 [ timestamp>FILETIME FILETIME>timestamp ] keep = ] unit-test
+{ t } [ windows-time [ windows-time>FILETIME FILETIME>windows-time ] keep = ] unit-test
+{ t } [ windows-1601 400 years time+ [ timestamp>FILETIME FILETIME>timestamp ] keep = ] unit-test
"io.encodings.8-bit" require ! for latin encodings
-[ "\u000131" ] [ "vocab:xml/tests/latin5.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/latin1.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/spaces.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf8.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf16.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf16be.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf16le.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test
-[ "\u0000e9" ] [ "vocab:xml/tests/prologless.xml" file>xml children>string ] unit-test
-[ "e" ] [ "vocab:xml/tests/ascii.xml" file>xml children>string ] unit-test
-[ "\u0000e9" "x" ] [ "vocab:xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test
+{ "\u000131" } [ "vocab:xml/tests/latin5.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/latin1.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/spaces.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf8.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf16.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf16be.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf16le.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test
+{ "\u0000e9" } [ "vocab:xml/tests/prologless.xml" file>xml children>string ] unit-test
+{ "e" } [ "vocab:xml/tests/ascii.xml" file>xml children>string ] unit-test
+{ "\u0000e9" "x" } [ "vocab:xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test
: take-char ( char -- string )
1string take-to ;
-[ "hello" ] [ "hello" [ take-rest ] string-parse ] unit-test
-[ 2 3 ] [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test
-[ "hi" " how are you?" ] [ "hi how are you?" [ [ blank? ] take-until take-rest ] string-parse ] unit-test
-[ "foo" ";bar" ] [ "foo;bar" [ CHAR: ; take-char take-rest ] string-parse ] unit-test
-[ "foo " " bar" ] [ "foo and bar" [ "and" take-string take-rest ] string-parse ] unit-test
-[ "baz" ] [ " \n\t baz" [ pass-blank take-rest ] string-parse ] unit-test
+{ "hello" } [ "hello" [ take-rest ] string-parse ] unit-test
+{ 2 3 } [ "12\n123" [ take-rest drop get-line get-column ] string-parse ] unit-test
+{ "hi" " how are you?" } [ "hi how are you?" [ [ blank? ] take-until take-rest ] string-parse ] unit-test
+{ "foo" ";bar" } [ "foo;bar" [ CHAR: ; take-char take-rest ] string-parse ] unit-test
+{ "foo " " bar" } [ "foo and bar" [ "and" take-string take-rest ] string-parse ] unit-test
+{ "baz" } [ " \n\t baz" [ pass-blank take-rest ] string-parse ] unit-test
kernel strings ;
IN: multi-methods.tests
-[ { POSTPONE: f integer } ] [ { f integer } canonicalize-specializer-0 ] unit-test
+{ { POSTPONE: f integer } } [ { f integer } canonicalize-specializer-0 ] unit-test
: setup-canon-test ( -- )
0 args set
: canon-test-1 ( -- seq )
{ integer { cpu x86 } sequence } canonicalize-specializer-1 ;
-[ { { -2 integer } { -1 sequence } { cpu x86 } } ] [
+{ { { -2 integer } { -1 sequence } { cpu x86 } } } [
[
setup-canon-test
canon-test-1
] with-scope
] unit-test
-[ { { 0 integer } { 1 sequence } { 2 x86 } } ] [
+{ { { 0 integer } { 1 sequence } { 2 x86 } } } [
[
setup-canon-test
canon-test-1
] with-scope
] unit-test
-[ { integer sequence x86 } ] [
+{ { integer sequence x86 } } [
[
setup-canon-test
canon-test-1
{ { string { os windows } } "c" }
}
-[
+{
{
{ { object x86 linux } "a" }
{ { object ppc object } "b" }
{ { string object windows } "c" }
}
{ cpu os }
-] [
+} [
example-1 canonicalize-specializers
] unit-test
-[
+{
{
{ { object x86 linux } [ drop drop "a" ] }
{ { object ppc object } [ drop drop "b" ] }
{ { string object windows } [ drop drop "c" ] }
}
[ \ cpu get \ os get ]
-] [
+} [
example-1 prepare-methods
] unit-test
M: integer legacy-test sq ;
M: string legacy-test " hey" append ;
-[ 25 ] [ 5 legacy-test ] unit-test
-[ "hello hey" ] [ "hello" legacy-test ] unit-test
+{ 25 } [ 5 legacy-test ] unit-test
+{ "hello hey" } [ "hello" legacy-test ] unit-test
{ 1 2 3 } some-var set
{ { f t t } } [ { t t f } hook-test ] unit-test
-[ fixnum ] [ 3 hook-test ] unit-test
+{ fixnum } [ 3 hook-test ] unit-test
5.0 some-var set
{ 0 } [ H{ } hook-test ] unit-test
USING: successor tools.test ;
-[ "" ] [ "" successor ] unit-test
-[ "abce" ] [ "abcd" successor ] unit-test
-[ "THX1139" ] [ "THX1138" successor ] unit-test
-[ "<<koalb>>" ] [ "<<koala>>" successor ] unit-test
-[ "2000aaa" ] [ "1999zzz" successor ] unit-test
-[ "AAAA0000" ] [ "ZZZ9999" successor ] unit-test
-[ "**+" ] [ "***" successor ] unit-test
+{ "" } [ "" successor ] unit-test
+{ "abce" } [ "abcd" successor ] unit-test
+{ "THX1139" } [ "THX1138" successor ] unit-test
+{ "<<koalb>>" } [ "<<koala>>" successor ] unit-test
+{ "2000aaa" } [ "1999zzz" successor ] unit-test
+{ "AAAA0000" } [ "ZZZ9999" successor ] unit-test
+{ "**+" } [ "***" successor ] unit-test
FUNCTION: return name ( parameters ) ;
FUNCTION-ALIAS: factor-name return name ( parameters ) ;
+{ ALIEN: 1234 } [ ALIEN: 1234 [ { alien } declare void* <ref> ] compile-call void* deref ] unit-test
+{ ALIEN: 1234 } [ ALIEN: 1234 [ { c-ptr } declare void* <ref> ] compile-call void* deref ] unit-test
+{ f } [ f [ { POSTPONE: f } declare void* <ref> ] compile-call void* deref ] unit-test
+
! Symbols and literals
\ foo
projects / factor.git / commitdiff