FUNCTION: test-struct-2 ffi_test_25 ( )
-[ S{ test-struct-2 { x char-array{ 1 2 } } } ] [ ffi_test_25 ] unit-test
+{ S{ test-struct-2 { x char-array{ 1 2 } } } } [ ffi_test_25 ] unit-test
STRUCT: test-struct-3 { x char[3] } ;
FUNCTION: test-struct-3 ffi_test_26 ( )
-[ S{ test-struct-3 { x char-array{ 1 2 3 } } } ] [ ffi_test_26 ] unit-test
+{ S{ test-struct-3 { x char-array{ 1 2 3 } } } } [ ffi_test_26 ] unit-test
STRUCT: test-struct-4 { x char[4] } ;
FUNCTION: test-struct-4 ffi_test_27 ( )
-[ S{ test-struct-4 { x char-array{ 1 2 3 4 } } } ] [ ffi_test_27 ] unit-test
+{ S{ test-struct-4 { x char-array{ 1 2 3 4 } } } } [ ffi_test_27 ] unit-test
STRUCT: test-struct-5 { x char[5] } ;
FUNCTION: test-struct-5 ffi_test_28 ( )
-[ S{ test-struct-5 { x char-array{ 1 2 3 4 5 } } } ] [ ffi_test_28 ] unit-test
+{ S{ test-struct-5 { x char-array{ 1 2 3 4 5 } } } } [ ffi_test_28 ] unit-test
STRUCT: test-struct-6 { x char[6] } ;
FUNCTION: test-struct-6 ffi_test_29 ( )
-[ S{ test-struct-6 { x char-array{ 1 2 3 4 5 6 } } } ] [ ffi_test_29 ] unit-test
+{ S{ test-struct-6 { x char-array{ 1 2 3 4 5 6 } } } } [ ffi_test_29 ] unit-test
STRUCT: test-struct-7 { x char[7] } ;
FUNCTION: test-struct-7 ffi_test_30 ( )
-[ S{ test-struct-7 { x char-array{ 1 2 3 4 5 6 7 } } } ] [ ffi_test_30 ] unit-test
+{ S{ test-struct-7 { x char-array{ 1 2 3 4 5 6 7 } } } } [ ffi_test_30 ] unit-test
STRUCT: test-struct-8 { x double } { y double } ;
FUNCTION: double ffi_test_32 ( test-struct-8 x, int y )
-[ 9.0 ] [
+{ 9.0 } [
test-struct-8 <struct>
1.0 >>x
2.0 >>y
FUNCTION: double ffi_test_33 ( test-struct-9 x, int y )
-[ 9.0 ] [
+{ 9.0 } [
test-struct-9 <struct>
1.0 >>x
2.0 >>y
FUNCTION: double ffi_test_34 ( test-struct-10 x, int y )
-[ 9.0 ] [
+{ 9.0 } [
test-struct-10 <struct>
1.0 >>x
2 >>y
FUNCTION: double ffi_test_35 ( test-struct-11 x, int y )
-[ 9.0 ] [
+{ 9.0 } [
test-struct-11 <struct>
1 >>x
2 >>y
FUNCTION: double ffi_test_36 ( test-struct-12 x )
-[ 1.23456 ] [ 1.23456 make-struct-12 ffi_test_36 ] unit-test
+{ 1.23456 } [ 1.23456 make-struct-12 ffi_test_36 ] unit-test
FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y )
-[ t ] [ 31 2^ 32 2^ ffi_test_38 63 2^ = ] unit-test
+{ t } [ 31 2^ 32 2^ ffi_test_38 63 2^ = ] unit-test
! Test callbacks
: callback-throws ( -- x )
: callback-1 ( -- callback ) void { } cdecl [ ] alien-callback ;
-[ 0 1 ] [ [ callback-1 ] infer [ in>> length ] [ out>> length ] bi ] unit-test
+{ 0 1 } [ [ callback-1 ] infer [ in>> length ] [ out>> length ] bi ] unit-test
{ t } [ callback-1 [ alien? ] with-callback ] unit-test
: callback-5b ( -- callback )
void { } cdecl [ compact-gc ] alien-callback ;
-[ "testing" ] [
+{ "testing" } [
"testing" callback-5b [ callback_test_1 ] with-callback
] unit-test
: callback-6 ( -- callback )
void { } cdecl [ [ continue ] callcc0 ] alien-callback ;
-[ 1 2 3 ] [
+{ 1 2 3 } [
callback-6 [ callback_test_1 1 2 3 ] with-callback
] unit-test
: callback-7 ( -- callback )
void { } cdecl [ 1000000 sleep ] alien-callback ;
-[ 1 2 3 ] [ callback-7 [ callback_test_1 1 2 3 ] with-callback ] unit-test
+{ 1 2 3 } [ callback-7 [ callback_test_1 1 2 3 ] with-callback ] unit-test
-[ f ] [ namespace global eq? ] unit-test
+{ f } [ namespace global eq? ] unit-test
: callback-8 ( -- callback )
void { } cdecl [ [ ] in-thread yield ] alien-callback ;
-[ ] [ callback-8 [ callback_test_1 ] with-callback ] unit-test
+{ } [ callback-8 [ callback_test_1 ] with-callback ] unit-test
: callback-9 ( -- callback )
int { int int int } cdecl [
FUNCTION: void ffi_test_36_point_5 ( )
-[ ] [ ffi_test_36_point_5 ] unit-test
+{ } [ ffi_test_36_point_5 ] unit-test
FUNCTION: int ffi_test_37 ( void* func )
-[ 1 ] [ callback-9 [ ffi_test_37 ] with-callback ] unit-test
+{ 1 } [ callback-9 [ ffi_test_37 ] with-callback ] unit-test
-[ 7 ] [ callback-9 [ ffi_test_37 ] with-callback ] unit-test
+{ 7 } [ callback-9 [ ffi_test_37 ] with-callback ] unit-test
STRUCT: test_struct_13
{ x1 float }
FUNCTION: int ffi_test_39 ( long a, long b, test_struct_13 s )
-[ 21 ] [ 12347 12347 make-test-struct-13 ffi_test_39 ] unit-test
+{ 21 } [ 12347 12347 make-test-struct-13 ffi_test_39 ] unit-test
! Joe Groff found this problem
STRUCT: double-rect
FUNCTION: test_struct_14 ffi_test_40 ( double x1, double x2 )
-[ 1.0 2.0 ] [
+{ 1.0 2.0 } [
1.0 2.0 ffi_test_40 [ x1>> ] [ x2>> ] bi
] unit-test
FUNCTION: test-struct-12 ffi_test_41 ( int a, double x )
-[ 1 2.0 ] [
+{ 1 2.0 } [
1 2.0 ffi_test_41
[ a>> ] [ x>> ] bi
] unit-test
FUNCTION: test_struct_15 ffi_test_42 ( float x, float y )
-[ 1.0 2.0 ] [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
+{ 1.0 2.0 } [ 1.0 2.0 ffi_test_42 [ x>> ] [ y>> ] bi ] unit-test
: callback-12 ( -- callback )
test_struct_15 { float float } cdecl
: callback-12-test ( x1 x2 callback -- result )
test_struct_15 { float float } cdecl alien-indirect ;
-[ 1.0 2.0 ] [
+{ 1.0 2.0 } [
1.0 2.0 callback-12 [
callback-12-test [ x>> ] [ y>> ] bi
] with-callback
FUNCTION: test_struct_16 ffi_test_43 ( float x, int a )
-[ 1.0 2 ] [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
+{ 1.0 2 } [ 1.0 2 ffi_test_43 [ x>> ] [ a>> ] bi ] unit-test
: callback-13 ( -- callback )
test_struct_16 { float int } cdecl
FUNCTION: test_struct_14 ffi_test_44 ( ) inline
-[ 1.0 2.0 ] [ ffi_test_44 [ x1>> ] [ x2>> ] bi ] unit-test
+{ 1.0 2.0 } [ ffi_test_44 [ x1>> ] [ x2>> ] bi ] unit-test
: stack-frame-bustage ( -- a b ) ffi_test_44 gc 3 ;
FUNCTION: complex-float ffi_test_45 ( int x )
- [ C{ 3.0 0.0 } ] [ 3 ffi_test_45 ] unit-test
+ { C{ 3.0 0.0 } } [ 3 ffi_test_45 ] unit-test
FUNCTION: complex-double ffi_test_46 ( int x )
- [ C{ 3.0 0.0 } ] [ 3 ffi_test_46 ] unit-test
+ { C{ 3.0 0.0 } } [ 3 ffi_test_46 ] unit-test
FUNCTION: complex-float ffi_test_47 ( complex-float x, complex-double y )
- [ C{ 4.0 4.0 } ] [
+ { C{ 4.0 4.0 } } [
C{ 1.0 2.0 }
C{ 1.5 1.0 } ffi_test_47
] unit-test
FUNCTION: short ffi_test_48 ( bool-field-test x )
- [ 123 ] [
+ { 123 } [
bool-field-test <struct>
123 >>parents
ffi_test_48
{ 200 } [
thread-callback-2 [ thread-callback-invoker ] with-callback
] unit-test
-[ 100 ] [ "p" get ?promise ] unit-test
+{ 100 } [ "p" get ?promise ] unit-test
! More alien-assembly tests are in cpu.* vocabs
: assembly-test-1 ( -- ) void { } cdecl [ ] alien-assembly ;
-[ ] [ assembly-test-1 ] unit-test
+{ } [ assembly-test-1 ] unit-test
-[ f ] [ "f-fastcall" library-dll f = ] unit-test
-[ fastcall ] [ "f-fastcall" lookup-library abi>> ] unit-test
+{ f } [ "f-fastcall" library-dll f = ] unit-test
+{ fastcall } [ "f-fastcall" lookup-library abi>> ] unit-test
: ffi_test_49 ( x -- int )
int "f-fastcall" "ffi_test_49" { int } f
3dip
int "f-fastcall" "ffi_test_51" { int int int } f alien-invoke gc ;
-[ 4 ] [ 3 ffi_test_49 ] unit-test
-[ 8 ] [ 3 4 ffi_test_50 ] unit-test
-[ 13 ] [ 3 4 5 ffi_test_51 ] unit-test
-[ 13 22 ] [ 3 4 5 6 7 8 multi_ffi_test_51 ] unit-test
+{ 4 } [ 3 ffi_test_49 ] unit-test
+{ 8 } [ 3 4 ffi_test_50 ] unit-test
+{ 13 } [ 3 4 5 ffi_test_51 ] unit-test
+{ 13 22 } [ 3 4 5 6 7 8 multi_ffi_test_51 ] unit-test
: ffi_test_52 ( x y z -- int )
int "f-fastcall" "ffi_test_52" { int float int } f
FUNCTION: longlong ffi_test_59 ( longlong x )
FUNCTION: ulonglong ffi_test_60 ( ulonglong x )
-[ t ] [ most-positive-fixnum 1 + [ ffi_test_59 ] keep = ] unit-test
-[ t ] [ most-positive-fixnum 1 + [ ffi_test_60 ] keep = ] unit-test
+{ t } [ most-positive-fixnum 1 + [ ffi_test_59 ] keep = ] unit-test
+{ t } [ most-positive-fixnum 1 + [ ffi_test_60 ] keep = ] unit-test
-[ -1 ] [ -1 ffi_test_59 ] unit-test
-[ -1 ] [ 0xffffffffffffffff ffi_test_59 ] unit-test
-[ 0xffffffffffffffff ] [ -1 ffi_test_60 ] unit-test
-[ 0xffffffffffffffff ] [ 0xffffffffffffffff ffi_test_60 ] unit-test
+{ -1 } [ -1 ffi_test_59 ] unit-test
+{ -1 } [ 0xffffffffffffffff ffi_test_59 ] unit-test
+{ 0xffffffffffffffff } [ -1 ffi_test_60 ] unit-test
+{ 0xffffffffffffffff } [ 0xffffffffffffffff ffi_test_60 ] unit-test
! GCC bugs
mingw? [
- [ 13 ] [ 3 4.0 5 ffi_test_52 ] unit-test
+ { 13 } [ 3 4.0 5 ffi_test_52 ] unit-test
- [ 19 ] [ 3 4.0 5 6 ffi_test_53 ] unit-test
+ { 19 } [ 3 4.0 5 6 ffi_test_53 ] unit-test
] unless
-[ S{ test-struct-11 f 7 -1 } ] [ 3 4 ffi_test_57 ] unit-test
+{ S{ test-struct-11 f 7 -1 } } [ 3 4 ffi_test_57 ] unit-test
-[ S{ test-struct-11 f 7 -3 } ] [ 3 4 7 ffi_test_58 ] unit-test
+{ S{ test-struct-11 f 7 -3 } } [ 3 4 7 ffi_test_58 ] unit-test
: fastcall-ii-indirect ( x y ptr -- result )
int { int int } fastcall alien-indirect ;
: fastcall-struct-return-iii-indirect ( x y z ptr -- result )
test-struct-11 { int int int } fastcall alien-indirect ;
-[ 8 ] [
+{ 8 } [
3 4 &: ffi_test_50 fastcall-ii-indirect
] unit-test
-[ 13 ] [
+{ 13 } [
3 4 5 &: ffi_test_51 fastcall-iii-indirect
] unit-test
mingw? [
- [ 13 ] [
+ { 13 } [
3 4.0 5 &: ffi_test_52 fastcall-ifi-indirect
] unit-test
- [ 19 ] [
+ { 19 } [
3 4.0 5 6 &: ffi_test_53 fastcall-ifii-indirect
] unit-test
] unless
-[ S{ test-struct-11 f 7 -1 } ]
-[
+{ S{ test-struct-11 f 7 -1 } } [
3 4 &: ffi_test_57 fastcall-struct-return-ii-indirect
] unit-test
-[ S{ test-struct-11 f 7 -3 } ]
-[
+{ S{ test-struct-11 f 7 -3 } } [
3 4 7 &: ffi_test_58 fastcall-struct-return-iii-indirect
] unit-test
3 4 fastcall-ii-callback [ fastcall-ii-indirect ] with-callback
] unit-test
-[ 13 ] [
+{ 13 } [
3 4 5 fastcall-iii-callback [ fastcall-iii-indirect ] with-callback
] unit-test
-[ 13 ] [
+{ 13 } [
3 4.0 5 fastcall-ifi-callback [ fastcall-ifi-indirect ] with-callback
] unit-test
-[ 19 ] [
+{ 19 } [
3 4.0 5 6 fastcall-ifii-callback [ fastcall-ifii-indirect ] with-callback
] unit-test
-[ S{ test-struct-11 f 7 -1 } ] [
+{ S{ test-struct-11 f 7 -1 } } [
3 4 fastcall-struct-return-ii-callback [
fastcall-struct-return-ii-indirect
] with-callback
] unit-test
-[ S{ test-struct-11 f 7 -3 } ] [
+{ S{ test-struct-11 f 7 -3 } } [
3 4 7 fastcall-struct-return-iii-callback [
fastcall-struct-return-iii-indirect
] with-callback
: x64-regression-2 ( x x x x x c -- y )
int { int int int int int } cdecl alien-indirect ; inline
-[ 661 ] [
+{ 661 } [
100 500 50 10 1 x64-regression-1 [ x64-regression-2 ] with-callback
] unit-test
1.5 >>x 2.0 >>y [ x>> ] [ y>> ] bi * >fixnum
] with-scoped-allocation ;
-[ 3 ] [ blah ] unit-test
+{ 3 } [ blah ] unit-test
: out-param-test-1 ( -- b )
{ int } [ [ 12 ] dip 0 int set-alien-value ] with-out-parameters ;
-[ 12 ] [ out-param-test-1 ] unit-test
+{ 12 } [ out-param-test-1 ] unit-test
: out-param-test-2 ( -- b )
{ { int initial: 12 } } [ drop ] with-out-parameters ;
-[ 12 ] [ out-param-test-2 ] unit-test
+{ 12 } [ out-param-test-2 ] unit-test
: out-param-test-3 ( -- x y )
{ { RECT initial: S{ RECT { x 3 } { y 4 } } } } [ drop ]
with-out-parameters
[ x>> ] [ y>> ] bi ;
-[ 3.0 4.0 ] [ out-param-test-3 ] unit-test
+{ 3.0 4.0 } [ out-param-test-3 ] unit-test
: out-param-callback ( -- a )
void { int pointer: int } cdecl
alien-indirect
] with-out-parameters ;
-[ 12 ] [
+{ 12 } [
6 out-param-callback [ out-param-indirect ] with-callback
] unit-test
TUPLE: some-tuple x ;
-[ T{ some-tuple f 5.0 } ] [
+{ T{ some-tuple f 5.0 } } [
[
some-tuple new
aa-callback-1 [
: anton's-regression ( -- )
f (free) f (free) ;
-[ ] [ anton's-regression ] unit-test
+{ } [ anton's-regression ] unit-test
os windows? [
! in here are still useful.
! Oops!
-[ 5000 ] [ [ 5000 ] compile-call ] unit-test
-[ "hi" ] [ [ "hi" ] compile-call ] unit-test
+{ 5000 } [ [ 5000 ] compile-call ] unit-test
+{ "hi" } [ [ "hi" ] compile-call ] unit-test
-[ 1 2 3 4 ] [ [ 1 2 3 4 ] compile-call ] unit-test
+{ 1 2 3 4 } [ [ 1 2 3 4 ] compile-call ] unit-test
-[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
-[ 0 ] [ 3 [ tag ] compile-call ] unit-test
-[ 0 3 ] [ 3 [ [ tag ] keep ] compile-call ] unit-test
+{ 1 1 } [ 1 [ dup ] compile-call ] unit-test
+{ 0 } [ 3 [ tag ] compile-call ] unit-test
+{ 0 3 } [ 3 [ [ tag ] keep ] compile-call ] unit-test
-[ 2 3 ] [ 3 [ 2 swap ] compile-call ] unit-test
+{ 2 3 } [ 3 [ 2 swap ] compile-call ] unit-test
-[ 2 1 3 4 ] [ 1 2 [ swap 3 4 ] compile-call ] unit-test
+{ 2 1 3 4 } [ 1 2 [ swap 3 4 ] compile-call ] unit-test
-[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-call ] unit-test
+{ 2 3 4 } [ 3 [ 2 swap 4 ] compile-call ] unit-test
-[ { 1 2 3 } { 1 4 3 } 2 2 ]
+{ { 1 2 3 } { 1 4 3 } 2 2 }
[ { 1 2 3 } { 1 4 3 } [ over tag over tag ] compile-call ]
unit-test
! Test literals in either side of a shuffle
-[ 4 1 ] [ 1 [ [ 3 fixnum+ ] keep ] compile-call ] unit-test
+{ 4 1 } [ 1 [ [ 3 fixnum+ ] keep ] compile-call ] unit-test
-[ 2 ] [ 1 2 [ swap fixnum/i ] compile-call ] unit-test
+{ 2 } [ 1 2 [ swap fixnum/i ] compile-call ] unit-test
: foo ( -- ) ;
-[ 3 3 ]
+{ 3 3 }
[ 1.2 [ tag [ foo ] keep ] compile-call ]
unit-test
-[ 1 2 2 ]
+{ 1 2 2 }
[ { 1 2 } [ dup 2 slot swap 3 slot [ foo ] keep ] compile-call ]
unit-test
-[ 3 ]
+{ 3 }
[
global [ 3 \ foo set ] with-variables
\ foo [ global >n get namespaces.private:ndrop ] compile-call
: blech ( x -- ) drop ;
-[ 3 ]
+{ 3 }
[
global [ 3 \ foo set ] with-variables
\ foo [ global [ get ] swap blech call ] compile-call
] unit-test
-[ 3 ]
+{ 3 }
[
global [ 3 \ foo set ] with-variables
\ foo [ global [ get ] swap >n call namespaces.private:ndrop ] compile-call
] unit-test
-[ 3 ]
+{ 3 }
[
global [ 3 \ foo set ] with-variables
\ foo [ global [ get ] with-variables ] compile-call
] unit-test
-[ 12 13 ] [
+{ 12 13 } [
-12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call
] unit-test
-[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test
+{ -1 2 } [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test
-[ 12 13 ] [
+{ 12 13 } [
-12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call
] unit-test
-[ 1 ] [
+{ 1 } [
SBUF" " [ 1 slot 1 [ slot ] keep ] compile-call nip
] unit-test
! Test slow shuffles
-[ 3 1 2 3 4 5 6 7 8 9 ] [
+{ 3 1 2 3 4 5 6 7 8 9 } [
1 2 3 4 5 6 7 8 9
[ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ]
compile-call
] unit-test
-[ 2 2 2 2 2 2 2 2 2 2 1 ] [
+{ 2 2 2 2 2 2 2 2 2 2 1 } [
1 2
[ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call
] unit-test
-[ ] [ [ 9 [ ] times ] compile-call ] unit-test
+{ } [ [ 9 [ ] times ] compile-call ] unit-test
-[ ] [
+{ } [
[
[ 200 dup [ 200 3array ] curry map drop ] times
] [ ( n -- ) define-temp ] with-compilation-unit drop
: try-breaking-dispatch-2 ( -- ? )
1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ;
-[ t ] [
+{ t } [
10000000 [ drop try-breaking-dispatch-2 ] all-integers?
] unit-test
! Regression
: (broken) ( x -- y ) ;
-[ 2.0 { 2.0 0.0 } ] [
+{ 2.0 { 2.0 0.0 } } [
2.0 1.0
[ float/f 0.0 [ drop (broken) ] 2keep 2array ] compile-call
] unit-test
: hellish-bug-3 ( hash array -- )
0 swap hellish-bug-2 drop ;
-[ ] [
+{ } [
H{ { 1 2 } { 3 4 } } dup array>>
[ 0 swap hellish-bug-2 drop ] compile-call
] unit-test
dup not
[ drop 3 ] [ dup tuple? [ drop 4 ] [ drop 5 ] if ] if ;
-[ 3 ] [ f foox ] unit-test
+{ 3 } [ f foox ] unit-test
TUPLE: my-tuple ;
-[ 4 ] [ T{ my-tuple } foox ] unit-test
+{ 4 } [ T{ my-tuple } foox ] unit-test
-[ 5 ] [ "hi" foox ] unit-test
+{ 5 } [ "hi" foox ] unit-test
! Making sure we don't needlessly unbox/rebox
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test
+{ t 3.0 } [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test
+{ t 3.0 } [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test
-[ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
+{ t } [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test
-[ 1 B{ 1 2 3 4 } ] [
+{ 1 B{ 1 2 3 4 } } [
B{ 1 2 3 4 } [
{ byte-array } declare
[ 0 alien-unsigned-1 ] keep
] compile-call
] unit-test
-[ 2 1 ] [
+{ 2 1 } [
2 1
[ 2dup fixnum< [ [ die ] dip ] when ] compile-call
] unit-test
! Regression
: a-dummy ( a -- ) drop "hi" print ;
-[ ] [
+{ } [
1 [
dup 0 2 3dup pick >= [ >= ] [ 2drop f ] if [
drop - >fixnum {
{ tuple vector } 3 slot { word } declare
dup 1 slot 0 fixnum-bitand { [ ] } dispatch ;
-[ t ] [ \ dispatch-alignment-regression word-optimized? ] unit-test
+{ t } [ \ dispatch-alignment-regression word-optimized? ] unit-test
-[ vector ] [ dispatch-alignment-regression ] unit-test
+{ vector } [ dispatch-alignment-regression ] unit-test
! Regression
: bad-value-bug ( a -- b ) [ 3 ] [ 3 ] if f <array> ;
-[ { f f f } ] [ t bad-value-bug ] unit-test
+{ { f f f } } [ t bad-value-bug ] unit-test
! PowerPC regression
TUPLE: id obj ;
: gc-check-bug ( -- )
10000000 [ "hi" 0 (gc-check-bug) drop ] times ;
-[ ] [ gc-check-bug ] unit-test
+{ } [ gc-check-bug ] unit-test
! New optimization
: test-1 ( a -- b ) 8 fixnum-fast { [ "a" ] [ "b" ] } dispatch ;
-[ "a" ] [ 8 test-1 ] unit-test
-[ "b" ] [ 9 test-1 ] unit-test
+{ "a" } [ 8 test-1 ] unit-test
+{ "b" } [ 9 test-1 ] unit-test
: test-2 ( a -- b ) 1 fixnum-fast { [ "a" ] [ "b" ] } dispatch ;
-[ "a" ] [ 1 test-2 ] unit-test
-[ "b" ] [ 2 test-2 ] unit-test
+{ "a" } [ 1 test-2 ] unit-test
+{ "b" } [ 2 test-2 ] unit-test
! I accidentally fixnum/i-fast on PowerPC
-[ { { 1 2 } { 3 4 } } ] [
+{ { { 1 2 } { 3 4 } } } [
{ 1 2 3 4 }
[
[ { array } declare 2 group [ , ] each ] compile-call
] { } make
] unit-test
-[ 2 ] [
+{ 2 } [
{ 1 2 3 4 }
[ { array } declare 2 <groups> length ] compile-call
] unit-test
: fixnum-overflow-control-flow-test ( a b -- c )
[ 1 fixnum- ] [ 2 fixnum- ] if 3 fixnum+fast ;
-[ 3 ] [ 1 t fixnum-overflow-control-flow-test ] unit-test
-[ 2 ] [ 1 f fixnum-overflow-control-flow-test ] unit-test
+{ 3 } [ 1 t fixnum-overflow-control-flow-test ] unit-test
+{ 2 } [ 1 f fixnum-overflow-control-flow-test ] unit-test
! LOL
: blah ( a -- b )
if
] if ;
-[ 4.0 ] [ 2.0 blah ] unit-test
+{ 4.0 } [ 2.0 blah ] unit-test
-[ 4 ] [ 2 [ dup fixnum* ] compile-call ] unit-test
-[ 7 ] [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test
+{ 4 } [ 2 [ dup fixnum* ] compile-call ] unit-test
+{ 7 } [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test
TUPLE: cucumber ;
M: cucumber equal? "The cucumber has no equal" throw ;
-[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
+{ t } [ [ cucumber ] compile-call cucumber eq? ] unit-test
-[ 4294967295 B{ 255 255 255 255 } -1 ]
+{ 4294967295 B{ 255 255 255 255 } -1 }
[
-1 int <ref>
-1 int <ref>
[ linear-scan-regression-1 ]
bi-curry bi-curry interleave ;
-[
+{
{
{ 1 "x" "y" }
{ "x" "y" }
{ "x" "y" }
{ 3 "x" "y" }
}
-] [
+} [
[ { 1 2 3 } "x" "y" linear-scan-regression ] { } make
] unit-test
! Regression from Doug's value numbering changes
-[ t ] [ 2 [ 1 swap fixnum< ] compile-call ] unit-test
-[ 3 ] [ 2 [ 1 swap fixnum< [ 3 ] [ 4 ] if ] compile-call ] unit-test
+{ t } [ 2 [ 1 swap fixnum< ] compile-call ] unit-test
+{ 3 } [ 2 [ 1 swap fixnum< [ 3 ] [ 4 ] if ] compile-call ] unit-test
cell 4 = [
- [ 0 ] [ 101 [ dup fixnum-fast 1 fixnum+fast 20 fixnum-shift-fast 20 fixnum-shift-fast ] compile-call ] unit-test
+ { 0 } [ 101 [ dup fixnum-fast 1 fixnum+fast 20 fixnum-shift-fast 20 fixnum-shift-fast ] compile-call ] unit-test
] when
! Regression from Slava's value numbering changes
-[ 1 ] [ 31337 [ dup fixnum<= [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 1 } [ 31337 [ dup fixnum<= [ 1 ] [ 2 ] if ] compile-call ] unit-test
! Bug with ##return node construction
: return-recursive-bug ( nodes -- ? )
] if
] any? ; inline recursive
-[ t ] [ 3 [ return-recursive-bug ] compile-call ] unit-test
+{ t } [ 3 [ return-recursive-bug ] compile-call ] unit-test
! Coalescing reductions
-[ f ] [ V{ } 0 [ [ vector? ] both? ] compile-call ] unit-test
-[ f ] [ 0 V{ } [ [ vector? ] both? ] compile-call ] unit-test
+{ f } [ V{ } 0 [ [ vector? ] both? ] compile-call ] unit-test
+{ f } [ 0 V{ } [ [ vector? ] both? ] compile-call ] unit-test
-[ f ] [
+{ f } [
f vector [
[ dup [ \ vector eq? ] [ drop f ] if ] dip
dup [ \ vector eq? ] [ drop f ] if
[ drop > ]
} 3|| [ 3drop f ] [ slice boa ] if swap [ [ length ] bi@ ] 2keep ;
-[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test
-[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 0 7 "hello" coalescing-bug-1 ] unit-test
-[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 3 2 "hello" coalescing-bug-1 ] unit-test
-[ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
+{ 0 3 f { 1 2 3 } } [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test
+{ 0 3 f { 1 2 3 } } [ { 1 2 3 } 0 7 "hello" coalescing-bug-1 ] unit-test
+{ 0 3 f { 1 2 3 } } [ { 1 2 3 } 3 2 "hello" coalescing-bug-1 ] unit-test
+{ 2 3 T{ slice f 1 3 "hello" } { 1 2 3 } } [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test
! Another one, found by Dan
: coalescing-bug-2 ( a -- b )
dup dup 10 fixnum< [ 1 fixnum+fast ] when
fixnum+fast 2 fixnum*fast 2 fixnum-fast 2 fixnum*fast 2 fixnum+fast ;
-[ 10 ] [ 1 coalescing-bug-2 ] unit-test
-[ 86 ] [ 11 coalescing-bug-2 ] unit-test
+{ 10 } [ 1 coalescing-bug-2 ] unit-test
+{ 86 } [ 11 coalescing-bug-2 ] unit-test
! Regression in suffix-arrays code
: coalescing-bug-3 ( from/f to/f seq -- slice )
[ min ] keep
] keep <slice> ;
-[ T{ slice f 0 5 "hello" } ] [ f f "hello" coalescing-bug-3 ] unit-test
-[ T{ slice f 1 5 "hello" } ] [ 1 f "hello" coalescing-bug-3 ] unit-test
-[ T{ slice f 0 3 "hello" } ] [ f 3 "hello" coalescing-bug-3 ] unit-test
-[ T{ slice f 1 3 "hello" } ] [ 1 3 "hello" coalescing-bug-3 ] unit-test
-[ T{ slice f 3 3 "hello" } ] [ 4 3 "hello" coalescing-bug-3 ] unit-test
-[ T{ slice f 5 5 "hello" } ] [ 6 f "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 0 5 "hello" } } [ f f "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 1 5 "hello" } } [ 1 f "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 0 3 "hello" } } [ f 3 "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 1 3 "hello" } } [ 1 3 "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 3 3 "hello" } } [ 4 3 "hello" coalescing-bug-3 ] unit-test
+{ T{ slice f 5 5 "hello" } } [ 6 f "hello" coalescing-bug-3 ] unit-test
! Reduction
: coalescing-bug-4 ( a b c -- a b c )
[ [ min ] keep ] dip vector? [ 1 ] [ 2 ] if ;
-[ 2 3 2 ] [ 2 3 "" coalescing-bug-4 ] unit-test
-[ 3 3 2 ] [ 4 3 "" coalescing-bug-4 ] unit-test
-[ 3 3 2 ] [ 4 3 "" coalescing-bug-4 ] unit-test
-[ 2 3 1 ] [ 2 3 V{ } coalescing-bug-4 ] unit-test
-[ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
-[ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
+{ 2 3 2 } [ 2 3 "" coalescing-bug-4 ] unit-test
+{ 3 3 2 } [ 4 3 "" coalescing-bug-4 ] unit-test
+{ 3 3 2 } [ 4 3 "" coalescing-bug-4 ] unit-test
+{ 2 3 1 } [ 2 3 V{ } coalescing-bug-4 ] unit-test
+{ 3 3 1 } [ 4 3 V{ } coalescing-bug-4 ] unit-test
+{ 3 3 1 } [ 4 3 V{ } coalescing-bug-4 ] unit-test
! Global stack analysis dataflow equations are wrong
: some-word ( a -- b ) 2 + ;
dup [ [ drop 1 ] dip ] [ [ some-word ] dip ] if
dup [ [ 1 fixnum+fast ] dip ] [ [ drop 1 ] dip ] if ;
-[ 2 t ] [ 0 t global-dcn-bug-1 ] unit-test
-[ 1 f ] [ 0 f global-dcn-bug-1 ] unit-test
+{ 2 t } [ 0 t global-dcn-bug-1 ] unit-test
+{ 1 f } [ 0 f global-dcn-bug-1 ] unit-test
! Forgot a GC check
: missing-gc-check-1 ( a -- b ) { fixnum } declare <alien> ;
: missing-gc-check-2 ( -- ) 10000000 [ missing-gc-check-1 drop ] each-integer ;
-[ ] [ missing-gc-check-2 ] unit-test
+{ } [ missing-gc-check-2 ] unit-test
-[ 1 "0.169967142900241" ] [ 1.4 [ 1 swap fcos ] compile-call number>string ] unit-test
-[ 1 "0.169967142900241" ] [ 1.4 1 [ swap fcos ] compile-call number>string ] unit-test
-[ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
-[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
+{ 1 "0.169967142900241" } [ 1.4 [ 1 swap fcos ] compile-call number>string ] unit-test
+{ 1 "0.169967142900241" } [ 1.4 1 [ swap fcos ] compile-call number>string ] unit-test
+{ "0.169967142900241" "0.9854497299884601" } [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
+{ 1 "0.169967142900241" "0.9854497299884601" } [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
-[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
+{ 6.0 } [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
! Bug in linearization
-[ 283686952174081 ] [
+{ 283686952174081 } [
B{ 1 1 1 1 } [
{ byte-array } declare
[ 0 2 ] dip
! Bug in CSSA construction
TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-only } ;
-[ 2 ] [
+{ 2 } [
little-endian?
T{ myseq f B{ 1 0 0 0 } B{ 1 0 0 0 } }
T{ myseq f B{ 0 0 0 1 } B{ 0 0 0 1 } } ?
] unit-test
! Bug in linear scan's partial sync point logic
-[ t ] [
+{ t } [
[ 1.0 100 [ fsin ] times 1.0 float+ ] compile-call
1.168852488727981 1.e-9 ~
] unit-test
-[ 65537.0 ] [
+{ 65537.0 } [
[ 2.0 4 [ 2.0 fpow ] times 1.0 float+ ] compile-call
] unit-test
! ##box-displaced-alien is a def-is-use instruction
-[ ALIEN: 3e9 ] [
+{ ALIEN: 3e9 } [
[
f
100 [ 10 swap <displaced-alien> ] times
] unit-test
! Forgot to two-operand shifts
-[ 2 0 ] [
+{ 2 0 } [
1 1
[ [ 0xf bitand ] bi@ [ shift ] [ drop -3 shift ] 2bi ] compile-call
] unit-test
! Alias analysis bug
-[ t ] [
+{ t } [
[
10 10 <byte-array> [ <displaced-alien> underlying>> ] keep eq?
] compile-call
void "libc" "free" { void* } f alien-invoke
] when ;
-[ ] [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
+{ } [ 2000 [ "hello" clone dup gc-root-messup first eq? t assert= ] times ] unit-test
! Write barrier elimination was being done before scheduling and
! GC check insertion, and didn't take subroutine calls into
[ 100 [ ] times ] infer.
;
-[ { { f } } ] [ write-barrier-elim-in-wrong-place ] unit-test
+{ { { f } } } [ write-barrier-elim-in-wrong-place ] unit-test
! GC maps must support derived pointers
: (derived-pointer-test-1) ( -- byte-array )
! Store into the array again
231 over 1 set-alien-unsigned-1 ;
-[ B{ 123 231 } ] [ derived-pointer-test-1 ] unit-test
+{ B{ 123 231 } } [ derived-pointer-test-1 ] unit-test
: fib-count2 ( -- x y ) 0 1 [ dup 4000000 <= ] [ [ + ] keep swap ] while ;
-[ 3524578 5702887 ] [ fib-count2 ] unit-test
+{ 3524578 5702887 } [ fib-count2 ] unit-test
! Stupid repro
USE: compiler.cfg.registers
{ fib-count2 } compile
-[ 3524578 5702887 ] [ fib-count2 ] unit-test
+{ 3524578 5702887 } [ fib-count2 ] unit-test
GENERIC: xyz ( obj -- obj )
M: array xyz xyz ;
-[ t ] [ M\ array xyz word-optimized? ] unit-test
+{ t } [ M\ array xyz word-optimized? ] unit-test
! Test predicate inlining
: pred-test-1 ( a -- b c )
"not a fixnum"
] if ;
-[ 1 "integer" ] [ 1 pred-test-1 ] unit-test
+{ 1 "integer" } [ 1 pred-test-1 ] unit-test
TUPLE: pred-test ;
"not a tuple"
] if ;
-[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-2 ] unit-test
+{ T{ pred-test } "pred-test" } [ T{ pred-test } pred-test-2 ] unit-test
: pred-test-3 ( a -- b c )
dup pred-test? [
"not a tuple"
] if ;
-[ T{ pred-test } "pred-test" ] [ T{ pred-test } pred-test-3 ] unit-test
+{ T{ pred-test } "pred-test" } [ T{ pred-test } pred-test-3 ] unit-test
: inline-test ( a -- b )
"nom" = ;
-[ t ] [ "nom" inline-test ] unit-test
-[ f ] [ "shayin" inline-test ] unit-test
-[ f ] [ 3 inline-test ] unit-test
+{ t } [ "nom" inline-test ] unit-test
+{ f } [ "shayin" inline-test ] unit-test
+{ f } [ 3 inline-test ] unit-test
: fixnum-declarations ( a -- b ) >fixnum 24 shift 1234 bitxor ;
-[ ] [ 1000000 fixnum-declarations . ] unit-test
+{ } [ 1000000 fixnum-declarations . ] unit-test
! regression
: literal-not-branch ( -- ) 0 not [ ] [ ] if ;
-[ ] [ literal-not-branch ] unit-test
+{ } [ literal-not-branch ] unit-test
! regression
: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline recursive
: bad-kill-2 ( a b -- c d ) bad-kill-1 drop ;
-[ 3 ] [ t bad-kill-2 ] unit-test
+{ 3 } [ t bad-kill-2 ] unit-test
! regression
: (the-test) ( x -- y ) dup 0 > [ 1 - (the-test) ] when ; inline recursive
: the-test ( -- x y ) 2 dup (the-test) ;
-[ 2 0 ] [ the-test ] unit-test
+{ 2 0 } [ the-test ] unit-test
! regression
: (double-recursion) ( start end -- )
: double-recursion ( -- ) 0 2 (double-recursion) ;
-[ ] [ double-recursion ] unit-test
+{ } [ double-recursion ] unit-test
! regression
: double-label-1 ( a b c -- d )
: double-label-2 ( a -- b )
dup array? [ ] [ ] if 0 t double-label-1 ;
-[ 0 ] [ 10 <iota> double-label-2 ] unit-test
+{ 0 } [ 10 <iota> double-label-2 ] unit-test
! regression
GENERIC: void-generic ( obj -- * )
: breakage ( -- * ) "hi" void-generic ;
-[ t ] [ \ breakage word-optimized? ] unit-test
+{ t } [ \ breakage word-optimized? ] unit-test
[ breakage ] must-fail
! regression
: branch-fold-regression-1 ( -- m )
10 branch-fold-regression-0 ;
-[ 10 ] [ branch-fold-regression-1 ] unit-test
+{ 10 } [ branch-fold-regression-1 ] unit-test
! another regression
: constant-branch-fold-0 ( -- value ) "hey" ; foldable
: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
-[ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 1 } [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
! another regression
: foo ( -- value ) f ;
: bar ( -- ? ) foo 4 4 = and ;
-[ f ] [ bar ] unit-test
+{ f } [ bar ] unit-test
! compiling <tuple> with a non-literal class failed
: <tuple>-regression ( class -- tuple ) <tuple> ;
-[ t ] [ \ <tuple>-regression word-optimized? ] unit-test
+{ t } [ \ <tuple>-regression word-optimized? ] unit-test
! regression
: constant-fold-2 ( -- value ) f ; foldable
: constant-fold-3 ( -- value ) 4 ; foldable
-[ f t ] [
+{ f t } [
[ constant-fold-2 constant-fold-3 4 = ] compile-call
] unit-test
: constant-fold-4 ( -- value ) f ; foldable
: constant-fold-5 ( -- value ) f ; foldable
-[ f ] [
+{ f } [
[ constant-fold-4 constant-fold-5 or ] compile-call
] unit-test
-[ 5 ] [ 5 [ 0 + ] compile-call ] unit-test
-[ 5 ] [ 5 [ 0 swap + ] compile-call ] unit-test
-
-[ 5 ] [ 5 [ 0 - ] compile-call ] unit-test
-[ -5 ] [ 5 [ 0 swap - ] compile-call ] unit-test
-[ 0 ] [ 5 [ dup - ] compile-call ] unit-test
-
-[ 5 ] [ 5 [ 1 * ] compile-call ] unit-test
-[ 5 ] [ 5 [ 1 swap * ] compile-call ] unit-test
-[ 0 ] [ 5 [ 0 * ] compile-call ] unit-test
-[ 0 ] [ 5 [ 0 swap * ] compile-call ] unit-test
-[ -5 ] [ 5 [ -1 * ] compile-call ] unit-test
-[ -5 ] [ 5 [ -1 swap * ] compile-call ] unit-test
-
-[ 0 ] [ 5 [ 1 mod ] compile-call ] unit-test
-[ 0 ] [ 5 [ 1 rem ] compile-call ] unit-test
-[ 0.5 ] [ 5.5 [ 1 mod ] compile-call ] unit-test
-[ 0.5 ] [ 5.5 [ 1 rem ] compile-call ] unit-test
-
-[ 5 ] [ 5 [ -1 bitand ] compile-call ] unit-test
-[ 0 ] [ 5 [ 0 bitand ] compile-call ] unit-test
-[ 5 ] [ 5 [ -1 swap bitand ] compile-call ] unit-test
-[ 0 ] [ 5 [ 0 swap bitand ] compile-call ] unit-test
-[ 5 ] [ 5 [ dup bitand ] compile-call ] unit-test
-
-[ 5 ] [ 5 [ 0 bitor ] compile-call ] unit-test
-[ -1 ] [ 5 [ -1 bitor ] compile-call ] unit-test
-[ 5 ] [ 5 [ 0 swap bitor ] compile-call ] unit-test
-[ -1 ] [ 5 [ -1 swap bitor ] compile-call ] unit-test
-[ 5 ] [ 5 [ dup bitor ] compile-call ] unit-test
-
-[ 5 ] [ 5 [ 0 bitxor ] compile-call ] unit-test
-[ 5 ] [ 5 [ 0 swap bitxor ] compile-call ] unit-test
-[ -6 ] [ 5 [ -1 bitxor ] compile-call ] unit-test
-[ -6 ] [ 5 [ -1 swap bitxor ] compile-call ] unit-test
-[ 0 ] [ 5 [ dup bitxor ] compile-call ] unit-test
-
-[ 0 ] [ 5 [ 0 swap shift ] compile-call ] unit-test
-[ 5 ] [ 5 [ 0 shift ] compile-call ] unit-test
-
-[ f ] [ 5 [ dup < ] compile-call ] unit-test
-[ t ] [ 5 [ dup <= ] compile-call ] unit-test
-[ f ] [ 5 [ dup > ] compile-call ] unit-test
-[ t ] [ 5 [ dup >= ] compile-call ] unit-test
-
-[ t ] [ 5 [ dup eq? ] compile-call ] unit-test
-[ t ] [ 5 [ dup = ] compile-call ] unit-test
-[ t ] [ 5 [ dup number= ] compile-call ] unit-test
-[ t ] [ \ vector [ \ vector = ] compile-call ] unit-test
+{ 5 } [ 5 [ 0 + ] compile-call ] unit-test
+{ 5 } [ 5 [ 0 swap + ] compile-call ] unit-test
+
+{ 5 } [ 5 [ 0 - ] compile-call ] unit-test
+{ -5 } [ 5 [ 0 swap - ] compile-call ] unit-test
+{ 0 } [ 5 [ dup - ] compile-call ] unit-test
+
+{ 5 } [ 5 [ 1 * ] compile-call ] unit-test
+{ 5 } [ 5 [ 1 swap * ] compile-call ] unit-test
+{ 0 } [ 5 [ 0 * ] compile-call ] unit-test
+{ 0 } [ 5 [ 0 swap * ] compile-call ] unit-test
+{ -5 } [ 5 [ -1 * ] compile-call ] unit-test
+{ -5 } [ 5 [ -1 swap * ] compile-call ] unit-test
+
+{ 0 } [ 5 [ 1 mod ] compile-call ] unit-test
+{ 0 } [ 5 [ 1 rem ] compile-call ] unit-test
+{ 0.5 } [ 5.5 [ 1 mod ] compile-call ] unit-test
+{ 0.5 } [ 5.5 [ 1 rem ] compile-call ] unit-test
+
+{ 5 } [ 5 [ -1 bitand ] compile-call ] unit-test
+{ 0 } [ 5 [ 0 bitand ] compile-call ] unit-test
+{ 5 } [ 5 [ -1 swap bitand ] compile-call ] unit-test
+{ 0 } [ 5 [ 0 swap bitand ] compile-call ] unit-test
+{ 5 } [ 5 [ dup bitand ] compile-call ] unit-test
+
+{ 5 } [ 5 [ 0 bitor ] compile-call ] unit-test
+{ -1 } [ 5 [ -1 bitor ] compile-call ] unit-test
+{ 5 } [ 5 [ 0 swap bitor ] compile-call ] unit-test
+{ -1 } [ 5 [ -1 swap bitor ] compile-call ] unit-test
+{ 5 } [ 5 [ dup bitor ] compile-call ] unit-test
+
+{ 5 } [ 5 [ 0 bitxor ] compile-call ] unit-test
+{ 5 } [ 5 [ 0 swap bitxor ] compile-call ] unit-test
+{ -6 } [ 5 [ -1 bitxor ] compile-call ] unit-test
+{ -6 } [ 5 [ -1 swap bitxor ] compile-call ] unit-test
+{ 0 } [ 5 [ dup bitxor ] compile-call ] unit-test
+
+{ 0 } [ 5 [ 0 swap shift ] compile-call ] unit-test
+{ 5 } [ 5 [ 0 shift ] compile-call ] unit-test
+
+{ f } [ 5 [ dup < ] compile-call ] unit-test
+{ t } [ 5 [ dup <= ] compile-call ] unit-test
+{ f } [ 5 [ dup > ] compile-call ] unit-test
+{ t } [ 5 [ dup >= ] compile-call ] unit-test
+
+{ t } [ 5 [ dup eq? ] compile-call ] unit-test
+{ t } [ 5 [ dup = ] compile-call ] unit-test
+{ t } [ 5 [ dup number= ] compile-call ] unit-test
+{ t } [ \ vector [ \ vector = ] compile-call ] unit-test
GENERIC: detect-number ( obj -- obj )
M: number detect-number ;
[ 10 f [ <array> 0 + detect-number ] compile-call ] must-fail
! Regression
-[ 4 [ + ] ] [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test
+{ 4 [ + ] } [ 2 2 [ [ + ] [ call ] keep ] compile-call ] unit-test
! Regression
: empty-compound ( -- ) ;
: node-successor-f-bug ( x -- * )
[ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
-[ t ] [ \ node-successor-f-bug word-optimized? ] unit-test
+{ t } [ \ node-successor-f-bug word-optimized? ] unit-test
[ [ new ] build-tree optimize-tree ] must-not-fail
] if
] if ;
-[ t ] [ \ lift-throw-tail-regression word-optimized? ] unit-test
-[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
-[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
+{ t } [ \ lift-throw-tail-regression word-optimized? ] unit-test
+{ 3 "an integer" } [ 3 lift-throw-tail-regression ] unit-test
+{ "hi" "a string" } [ "hi" lift-throw-tail-regression ] unit-test
: lift-loop-tail-test-1 ( a quot: ( -- ) -- )
over even? [
\ lift-loop-tail-test-2 def>> must-infer
-[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
+{ 1 2 3 } [ lift-loop-tail-test-2 ] unit-test
! Forgot a recursive inline check
: recursive-inline-hang ( a -- a )
: recursive-inline-hang-1 ( -- a )
{ } recursive-inline-hang ;
-[ t ] [ \ recursive-inline-hang-1 word-optimized? ] unit-test
+{ t } [ \ recursive-inline-hang-1 word-optimized? ] unit-test
DEFER: recursive-inline-hang-3
HINTS: recursive-inline-hang-3 array ;
! Regression
-[ ] [ { 3append-as } compile ] unit-test
+{ } [ { 3append-as } compile ] unit-test
! Wow
: counter-example ( a b c d -- a' b' c' d' )
: counter-example' ( -- a' b' c' d' )
1 2 3.0 3 counter-example ;
-[ 2 4 6.0 0 ] [ counter-example' ] unit-test
+{ 2 4 6.0 0 } [ counter-example' ] unit-test
: member-test ( obj -- ? ) { + - * / /i } member? ;
\ member-test def>> must-infer
[ \ member-test build-tree optimize-tree ] must-not-fail
-[ t ] [ \ + member-test ] unit-test
-[ f ] [ \ append member-test ] unit-test
+{ t } [ \ + member-test ] unit-test
+{ f } [ \ append member-test ] unit-test
! Infinite expansion
TUPLE: cons car cdr ;
PREDICATE: list < improper-list
[ cdr>> list instance? ] [ t ] if* ;
-[ t ] [
+{ t } [
T{ cons f 1 T{ cons f 2 T{ cons f 3 f } } }
[ list instance? ] compile-call
] unit-test
! <tuple> type function bustage
-[ T{ cons } 7 ] [ cons tuple-layout [ [ <tuple> ] [ length ] bi ] compile-call ] unit-test
+{ T{ cons } 7 } [ cons tuple-layout [ [ <tuple> ] [ length ] bi ] compile-call ] unit-test
! Regression
: interval-inference-bug ( obj -- obj x )
dup "a" get { array-capacity } declare >=
[ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
-[ t ] [ \ interval-inference-bug word-optimized? ] unit-test
+{ t } [ \ interval-inference-bug word-optimized? ] unit-test
-[ ] [ 1 "a" set 2 "b" set ] unit-test
-[ 2 3 ] [ 2 interval-inference-bug ] unit-test
-[ 1 4 ] [ 1 interval-inference-bug ] unit-test
-[ 0 5 ] [ 0 interval-inference-bug ] unit-test
+{ } [ 1 "a" set 2 "b" set ] unit-test
+{ 2 3 } [ 2 interval-inference-bug ] unit-test
+{ 1 4 } [ 1 interval-inference-bug ] unit-test
+{ 0 5 } [ 0 interval-inference-bug ] unit-test
: aggressive-flush-regression ( a -- b )
f over [ <array> drop ] dip 1 + ;
: allot-regression ( a -- b )
[ ] curry some-tuple boa ;
-[ T{ some-tuple f [ 3 ] } ] [ 3 allot-regression ] unit-test
+{ T{ some-tuple f [ 3 ] } } [ 3 allot-regression ] unit-test
-[ 1 ] [ B{ 0 0 0 0 } [ 0 alien-signed-4 1 + ] compile-call ] unit-test
-[ 1 ] [ B{ 0 0 0 0 } [ 0 alien-unsigned-4 1 + ] compile-call ] unit-test
-[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-8 1 + ] compile-call ] unit-test
-[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-8 1 + ] compile-call ] unit-test
-[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-cell 1 + ] compile-call ] unit-test
-[ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-cell 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 } [ 0 alien-signed-4 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 } [ 0 alien-unsigned-4 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-8 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-8 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-cell 1 + ] compile-call ] unit-test
+{ 1 } [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-cell 1 + ] compile-call ] unit-test
: deep-find-test ( seq -- ? ) [ 5 = ] deep-find ;
-[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
-[ f ] [ { 1 2 { 3 { 4 } } } deep-find-test ] unit-test
+{ 5 } [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
+{ f } [ { 1 2 { 3 { 4 } } } deep-find-test ] unit-test
-[ B{ 0 1 2 3 4 5 6 7 } ] [ [ 8 <iota> [ ] B{ } map-as ] compile-call ] unit-test
+{ B{ 0 1 2 3 4 5 6 7 } } [ [ 8 <iota> [ ] B{ } map-as ] compile-call ] unit-test
-[ 0 ] [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test
+{ 0 } [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test
! Loop detection problem found by doublec
SYMBOL: counter
: loop-ccc ( -- ) loop-bbb ;
-[ 0 ] [ 0 counter set loop-ccc counter get ] unit-test
+{ 0 } [ 0 counter set loop-ccc counter get ] unit-test
! Type inference issue
-[ 4 3 ] [
+{ 4 3 } [
1 >bignum 2 >bignum
[ { bignum integer } declare [ shift ] keep 1 + ] compile-call
] unit-test
: broken-declaration ( -- ) \ + declare ;
-[ f ] [ \ broken-declaration word-optimized? ] unit-test
+{ f } [ \ broken-declaration word-optimized? ] unit-test
-[ ] [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
+{ } [ [ \ broken-declaration forget ] with-compilation-unit ] unit-test
! Interval inference issue
-[ f ] [
+{ f } [
10 70
[
dup 70 >=
! Modular arithmetic bug
: modular-arithmetic-bug ( a -- b ) >integer 256 mod ;
-[ 1 ] [ 257 modular-arithmetic-bug ] unit-test
-[ -10 ] [ -10 modular-arithmetic-bug ] unit-test
+{ 1 } [ 257 modular-arithmetic-bug ] unit-test
+{ -10 } [ -10 modular-arithmetic-bug ] unit-test
-[ 16 ] [
+{ 16 } [
[
0 2
[
1 + { [ + ] [ - ] [ * ] } dispatch ;
[ 3 4 -1 dispatch-branch-problem ] [ "boo" = ] must-fail-with
-[ -1 ] [ 3 4 0 dispatch-branch-problem ] unit-test
-[ 12 ] [ 3 4 1 dispatch-branch-problem ] unit-test
+{ -1 } [ 3 4 0 dispatch-branch-problem ] unit-test
+{ 12 } [ 3 4 1 dispatch-branch-problem ] unit-test
-[ 1024 bignum ] [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class-of ] unit-test
+{ 1024 bignum } [ 10 [ 1 >bignum swap >fixnum shift ] compile-call dup class-of ] unit-test
TUPLE: grid-mesh-tuple { length read-only } { step read-only } ;
] 2curry times
] keep ;
-[ { 0.5 } ] [ grid-mesh-test-case ] unit-test
+{ { 0.5 } } [ grid-mesh-test-case ] unit-test
-[ { 1 } "bar" ] [ { 1 } [ [ [ [ "foo" throw ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+{ { 1 } "bar" } [ { 1 } [ [ [ [ "foo" throw ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
GENERIC: bad-push-test-case ( a -- b )
M: object bad-push-test-case "foo" throw ; inline
-[ { 1 } "bar" ] [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
+{ { 1 } "bar" } [ { 1 } [ [ [ [ bad-push-test-case ] [ "bar" throw ] recover ] attempt-all f ] [ ] recover ] compile-call ] unit-test
STRUCT: BitmapData { Scan0 void* } ;
-[ ALIEN: 123 ] [
+{ ALIEN: 123 } [
[
{ BitmapData }
[ BitmapData memory>struct ALIEN: 123 >>Scan0 drop ]
[ 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
IN: compiler.tests.simple
! Test empty word
-[ ] [ [ ] compile-call ] unit-test
+{ } [ [ ] compile-call ] unit-test
! Test literals
-[ 1 ] [ [ 1 ] compile-call ] unit-test
-[ 31 ] [ [ 31 ] compile-call ] unit-test
-[ 255 ] [ [ 255 ] compile-call ] unit-test
-[ -1 ] [ [ -1 ] compile-call ] unit-test
-[ 65536 ] [ [ 65536 ] compile-call ] unit-test
-[ -65536 ] [ [ -65536 ] compile-call ] unit-test
-[ "hey" ] [ [ "hey" ] compile-call ] unit-test
+{ 1 } [ [ 1 ] compile-call ] unit-test
+{ 31 } [ [ 31 ] compile-call ] unit-test
+{ 255 } [ [ 255 ] compile-call ] unit-test
+{ -1 } [ [ -1 ] compile-call ] unit-test
+{ 65536 } [ [ 65536 ] compile-call ] unit-test
+{ -65536 } [ [ -65536 ] compile-call ] unit-test
+{ "hey" } [ [ "hey" ] compile-call ] unit-test
! Calls
: no-op ( -- ) ;
-[ ] [ [ no-op ] compile-call ] unit-test
-[ 3 ] [ [ no-op 3 ] compile-call ] unit-test
-[ 3 ] [ [ 3 no-op ] compile-call ] unit-test
+{ } [ [ no-op ] compile-call ] unit-test
+{ 3 } [ [ no-op 3 ] compile-call ] unit-test
+{ 3 } [ [ 3 no-op ] compile-call ] unit-test
: bar ( -- value ) 4 ;
-[ 4 ] [ [ bar no-op ] compile-call ] unit-test
-[ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test
-[ 3 4 ] [ [ 3 no-op bar ] compile-call ] unit-test
+{ 4 } [ [ bar no-op ] compile-call ] unit-test
+{ 4 3 } [ [ no-op bar 3 ] compile-call ] unit-test
+{ 3 4 } [ [ 3 no-op bar ] compile-call ] unit-test
-[ ] [ no-op ] unit-test
+{ } [ no-op ] unit-test
! Conditionals
-[ 1 ] [ t [ [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 2 ] [ f [ [ 1 ] [ 2 ] if ] compile-call ] unit-test
-[ 1 3 ] [ t [ [ 1 ] [ 2 ] if 3 ] compile-call ] unit-test
-[ 2 3 ] [ f [ [ 1 ] [ 2 ] if 3 ] compile-call ] unit-test
+{ 1 } [ t [ [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 2 } [ f [ [ 1 ] [ 2 ] if ] compile-call ] unit-test
+{ 1 3 } [ t [ [ 1 ] [ 2 ] if 3 ] compile-call ] unit-test
+{ 2 3 } [ f [ [ 1 ] [ 2 ] if 3 ] compile-call ] unit-test
-[ "hi" ] [ 0 [ { [ "hi" ] [ "bye" ] } dispatch ] compile-call ] unit-test
-[ "bye" ] [ 1 [ { [ "hi" ] [ "bye" ] } dispatch ] compile-call ] unit-test
+{ "hi" } [ 0 [ { [ "hi" ] [ "bye" ] } dispatch ] compile-call ] unit-test
+{ "bye" } [ 1 [ { [ "hi" ] [ "bye" ] } dispatch ] compile-call ] unit-test
-[ "hi" 3 ] [ 0 [ { [ "hi" ] [ "bye" ] } dispatch 3 ] compile-call ] unit-test
-[ "bye" 3 ] [ 1 [ { [ "hi" ] [ "bye" ] } dispatch 3 ] compile-call ] unit-test
+{ "hi" 3 } [ 0 [ { [ "hi" ] [ "bye" ] } dispatch 3 ] compile-call ] unit-test
+{ "bye" 3 } [ 1 [ { [ "hi" ] [ "bye" ] } dispatch 3 ] compile-call ] unit-test
-[ 4 1 ] [ 0 [ { [ bar 1 ] [ 3 1 ] } dispatch ] compile-call ] unit-test
-[ 3 1 ] [ 1 [ { [ bar 1 ] [ 3 1 ] } dispatch ] compile-call ] unit-test
-[ 4 1 3 ] [ 0 [ { [ bar 1 ] [ 3 1 ] } dispatch 3 ] compile-call ] unit-test
-[ 3 1 3 ] [ 1 [ { [ bar 1 ] [ 3 1 ] } dispatch 3 ] compile-call ] unit-test
+{ 4 1 } [ 0 [ { [ bar 1 ] [ 3 1 ] } dispatch ] compile-call ] unit-test
+{ 3 1 } [ 1 [ { [ bar 1 ] [ 3 1 ] } dispatch ] compile-call ] unit-test
+{ 4 1 3 } [ 0 [ { [ bar 1 ] [ 3 1 ] } dispatch 3 ] compile-call ] unit-test
+{ 3 1 3 } [ 1 [ { [ bar 1 ] [ 3 1 ] } dispatch 3 ] compile-call ] unit-test
-[ 2 3 ] [ 1 [ { [ gc 1 ] [ gc 2 ] } dispatch 3 ] compile-call ] unit-test
+{ 2 3 } [ 1 [ { [ gc 1 ] [ gc 2 ] } dispatch 3 ] compile-call ] unit-test
! Labels
: recursive-test ( ? -- ) [ f recursive-test ] when ; inline recursive
-[ ] [ t [ recursive-test ] compile-call ] unit-test
+{ } [ t [ recursive-test ] compile-call ] unit-test
-[ ] [ t recursive-test ] unit-test
+{ } [ t recursive-test ] unit-test
! Make sure error reporting works
: empty ( -- ) ;
-[ "b" ] [ 1 [ empty { [ "a" ] [ "b" ] } dispatch ] compile-call ] unit-test
+{ "b" } [ 1 [ empty { [ "a" ] [ "b" ] } dispatch ] compile-call ] unit-test
: dummy-if-1 ( -- ) t [ ] [ ] if ;
-[ ] [ dummy-if-1 ] unit-test
+{ } [ dummy-if-1 ] unit-test
: dummy-if-2 ( -- ) f [ ] [ ] if ;
-[ ] [ dummy-if-2 ] unit-test
+{ } [ dummy-if-2 ] unit-test
: dummy-if-3 ( -- n ) t [ 1 ] [ 2 ] if ;
-[ 1 ] [ dummy-if-3 ] unit-test
+{ 1 } [ dummy-if-3 ] unit-test
: dummy-if-4 ( -- n ) f [ 1 ] [ 2 ] if ;
-[ 2 ] [ dummy-if-4 ] unit-test
+{ 2 } [ dummy-if-4 ] unit-test
: dummy-if-5 ( -- n ) 0 dup 1 fixnum<= [ drop 1 ] [ ] if ;
-[ 1 ] [ dummy-if-5 ] unit-test
+{ 1 } [ dummy-if-5 ] unit-test
: dummy-if-6 ( n -- n )
dup 1 fixnum<= [
1 fixnum- dup 1 fixnum- fixnum+
] if ;
-[ 17 ] [ 10 dummy-if-6 ] unit-test
+{ 17 } [ 10 dummy-if-6 ] unit-test
: dead-code-rec ( -- obj )
t [
dead-code-rec
] if ;
-[ 3.2 ] [ dead-code-rec ] unit-test
+{ 3.2 } [ dead-code-rec ] unit-test
: one-rec ( ? -- obj ) [ f one-rec ] [ "hi" ] if ;
-[ "hi" ] [ t one-rec ] unit-test
+{ "hi" } [ t one-rec ] unit-test
: after-if-test ( -- n )
t [ ] [ ] if 5 ;
-[ 5 ] [ after-if-test ] unit-test
+{ 5 } [ after-if-test ] unit-test
DEFER: countdown-b
: countdown-a ( n -- ) dup 0 eq? [ drop ] [ 1 fixnum- countdown-b ] if ;
: countdown-b ( n -- ) dup 0 eq? [ drop ] [ 1 fixnum- countdown-a ] if ;
-[ ] [ 10 countdown-b ] unit-test
+{ } [ 10 countdown-b ] unit-test
: dummy-when-1 ( -- ) t [ ] when ;
-[ ] [ dummy-when-1 ] unit-test
+{ } [ dummy-when-1 ] unit-test
: dummy-when-2 ( -- ) f [ ] when ;
-[ ] [ dummy-when-2 ] unit-test
+{ } [ dummy-when-2 ] unit-test
: dummy-when-3 ( a -- b ) dup [ dup fixnum* ] when ;
-[ 16 ] [ 4 dummy-when-3 ] unit-test
-[ f ] [ f dummy-when-3 ] unit-test
+{ 16 } [ 4 dummy-when-3 ] unit-test
+{ f } [ f dummy-when-3 ] unit-test
: dummy-when-4 ( a b -- a b ) dup [ dup dup fixnum* fixnum* ] when swap ;
-[ 64 f ] [ f 4 dummy-when-4 ] unit-test
-[ f t ] [ t f dummy-when-4 ] unit-test
+{ 64 f } [ f 4 dummy-when-4 ] unit-test
+{ f t } [ t f dummy-when-4 ] unit-test
: dummy-when-5 ( a -- b ) f [ dup fixnum* ] when ;
-[ f ] [ f dummy-when-5 ] unit-test
+{ f } [ f dummy-when-5 ] unit-test
: dummy-unless-1 ( -- ) t [ ] unless ;
-[ ] [ dummy-unless-1 ] unit-test
+{ } [ dummy-unless-1 ] unit-test
: dummy-unless-2 ( -- ) f [ ] unless ;
-[ ] [ dummy-unless-2 ] unit-test
+{ } [ dummy-unless-2 ] unit-test
: dummy-unless-3 ( a -- b ) dup [ drop 3 ] unless ;
-[ 3 ] [ f dummy-unless-3 ] unit-test
-[ 4 ] [ 4 dummy-unless-3 ] unit-test
+{ 3 } [ f dummy-unless-3 ] unit-test
+{ 4 } [ 4 dummy-unless-3 ] unit-test
! Test cond expansion
-[ "even" ] [
+{ "even" } [
[
2 {
{ [ dup 2 mod 0 = ] [ drop "even" ] }
] compile-call
] unit-test
-[ "odd" ] [
+{ "odd" } [
[
3 {
{ [ dup 2 mod 0 = ] [ drop "even" ] }
] compile-call
] unit-test
-[ "neither" ] [
+{ "neither" } [
[
3 {
{ [ dup string? ] [ drop "string" ] }
] compile-call
] unit-test
-[ 3 ] [
+{ 3 } [
[
3 {
{ [ dup fixnum? ] [ ] }
M: array single-combination-test drop ;
M: integer single-combination-test drop ;
-[ 2 3 ] [ 2 3 t single-combination-test ] unit-test
-[ 2 3 ] [ 2 3 4 single-combination-test ] unit-test
-[ 2 f ] [ 2 3 f single-combination-test ] unit-test
+{ 2 3 } [ 2 3 t single-combination-test ] unit-test
+{ 2 3 } [ 2 3 4 single-combination-test ] unit-test
+{ 2 f } [ 2 3 f single-combination-test ] unit-test
DEFER: single-combination-test-2
M: object single-combination-test-2 single-combination-test-3 ;
M: f single-combination-test-2 single-combination-test-4 ;
-[ 3 ] [ t single-combination-test-2 ] unit-test
-[ 3 ] [ 3 single-combination-test-2 ] unit-test
-[ f ] [ f single-combination-test-2 ] unit-test
+{ 3 } [ t single-combination-test-2 ] unit-test
+{ 3 } [ 3 single-combination-test-2 ] unit-test
+{ f } [ f single-combination-test-2 ] unit-test
! Regression
-[ 100 ] [ [ 100 [ [ ] times ] keep ] compile-call ] unit-test
+{ 100 } [ [ 100 [ [ ] times ] keep ] compile-call ] unit-test
! Regression
10 [
[ "compiler.tests.foo" forget-vocab ] with-compilation-unit
- [ t ] [
+ { t } [
"USING: prettyprint words accessors ;
IN: compiler.tests.foo
: (recursive) ( -- ) (recursive) (recursive) ; inline recursive
[ bad-effect-test* ] [ not-compiled? ] must-fail-with
! Don't want compiler error to stick around
-[ ] [ [ M\ quotation bad-effect-test forget ] with-compilation-unit ] unit-test
+{ } [ [ M\ quotation bad-effect-test forget ] with-compilation-unit ] unit-test
! Make sure time bombs literalize
[ [ \ + call ] compile-call ] [ no-method? ] must-fail-with
projects / factor.git / commitdiff