Fix compile errors in compiler tests so that they actually test the compiler instead of being useless
parent
51f9da378c
commit
2f4e2735ea
|
@ -270,7 +270,7 @@ cell 8 = [
|
||||||
] when
|
] when
|
||||||
|
|
||||||
! Some randomized tests
|
! Some randomized tests
|
||||||
: compiled-fixnum* fixnum* ;
|
: compiled-fixnum* ( a b -- c ) fixnum* ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
10000 [
|
10000 [
|
||||||
|
@ -281,7 +281,7 @@ cell 8 = [
|
||||||
] times
|
] times
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
: compiled-fixnum>bignum fixnum>bignum ;
|
: compiled-fixnum>bignum ( a -- b ) fixnum>bignum ;
|
||||||
|
|
||||||
[ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test
|
[ bignum ] [ 0 compiled-fixnum>bignum class ] unit-test
|
||||||
|
|
||||||
|
@ -293,7 +293,7 @@ cell 8 = [
|
||||||
] times
|
] times
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
: compiled-bignum>fixnum bignum>fixnum ;
|
: compiled-bignum>fixnum ( a -- b ) bignum>fixnum ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
10000 [
|
10000 [
|
||||||
|
|
|
@ -13,7 +13,7 @@ M: array xyz xyz ;
|
||||||
[ t ] [ \ xyz optimized>> ] unit-test
|
[ t ] [ \ xyz optimized>> ] unit-test
|
||||||
|
|
||||||
! Test predicate inlining
|
! Test predicate inlining
|
||||||
: pred-test-1
|
: pred-test-1 ( a -- b c )
|
||||||
dup fixnum? [
|
dup fixnum? [
|
||||||
dup integer? [ "integer" ] [ "nope" ] if
|
dup integer? [ "integer" ] [ "nope" ] if
|
||||||
] [
|
] [
|
||||||
|
@ -24,7 +24,7 @@ M: array xyz xyz ;
|
||||||
|
|
||||||
TUPLE: pred-test ;
|
TUPLE: pred-test ;
|
||||||
|
|
||||||
: pred-test-2
|
: pred-test-2 ( a -- b c )
|
||||||
dup tuple? [
|
dup tuple? [
|
||||||
dup pred-test? [ "pred-test" ] [ "nope" ] if
|
dup pred-test? [ "pred-test" ] [ "nope" ] if
|
||||||
] [
|
] [
|
||||||
|
@ -33,7 +33,7 @@ TUPLE: pred-test ;
|
||||||
|
|
||||||
[ 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
|
: pred-test-3 ( a -- b c )
|
||||||
dup pred-test? [
|
dup pred-test? [
|
||||||
dup tuple? [ "pred-test" ] [ "nope" ] if
|
dup tuple? [ "pred-test" ] [ "nope" ] if
|
||||||
] [
|
] [
|
||||||
|
@ -42,14 +42,14 @@ TUPLE: pred-test ;
|
||||||
|
|
||||||
[ 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
|
: inline-test ( a -- b )
|
||||||
"nom" = ;
|
"nom" = ;
|
||||||
|
|
||||||
[ t ] [ "nom" inline-test ] unit-test
|
[ t ] [ "nom" inline-test ] unit-test
|
||||||
[ f ] [ "shayin" inline-test ] unit-test
|
[ f ] [ "shayin" inline-test ] unit-test
|
||||||
[ f ] [ 3 inline-test ] unit-test
|
[ f ] [ 3 inline-test ] unit-test
|
||||||
|
|
||||||
: fixnum-declarations >fixnum 24 shift 1234 bitxor ;
|
: fixnum-declarations ( a -- b ) >fixnum 24 shift 1234 bitxor ;
|
||||||
|
|
||||||
[ ] [ 1000000 fixnum-declarations . ] unit-test
|
[ ] [ 1000000 fixnum-declarations . ] unit-test
|
||||||
|
|
||||||
|
@ -61,13 +61,13 @@ TUPLE: pred-test ;
|
||||||
|
|
||||||
! regression
|
! regression
|
||||||
|
|
||||||
: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline
|
: bad-kill-1 ( a b -- c d e ) [ 3 f ] [ dup bad-kill-1 ] if ; inline recursive
|
||||||
: bad-kill-2 bad-kill-1 drop ;
|
: 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
|
! regression
|
||||||
: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline
|
: (the-test) ( x -- y ) dup 0 > [ 1- (the-test) ] when ; inline recursive
|
||||||
: the-test ( -- x y ) 2 dup (the-test) ;
|
: the-test ( -- x y ) 2 dup (the-test) ;
|
||||||
|
|
||||||
[ 2 0 ] [ the-test ] unit-test
|
[ 2 0 ] [ the-test ] unit-test
|
||||||
|
@ -77,7 +77,7 @@ TUPLE: pred-test ;
|
||||||
< [
|
< [
|
||||||
6 1 (double-recursion)
|
6 1 (double-recursion)
|
||||||
3 2 (double-recursion)
|
3 2 (double-recursion)
|
||||||
] when ; inline
|
] when ; inline recursive
|
||||||
|
|
||||||
: double-recursion ( -- ) 0 2 (double-recursion) ;
|
: double-recursion ( -- ) 0 2 (double-recursion) ;
|
||||||
|
|
||||||
|
@ -85,7 +85,7 @@ TUPLE: pred-test ;
|
||||||
|
|
||||||
! regression
|
! regression
|
||||||
: double-label-1 ( a b c -- d )
|
: double-label-1 ( a b c -- d )
|
||||||
[ f double-label-1 ] [ swap nth-unsafe ] if ; inline
|
[ f double-label-1 ] [ swap nth-unsafe ] if ; inline recursive
|
||||||
|
|
||||||
: double-label-2 ( a -- b )
|
: double-label-2 ( a -- b )
|
||||||
dup array? [ ] [ ] if 0 t double-label-1 ;
|
dup array? [ ] [ ] if 0 t double-label-1 ;
|
||||||
|
@ -100,7 +100,7 @@ GENERIC: void-generic ( obj -- * )
|
||||||
|
|
||||||
! regression
|
! regression
|
||||||
: branch-fold-regression-0 ( m -- n )
|
: branch-fold-regression-0 ( m -- n )
|
||||||
t [ ] [ 1+ branch-fold-regression-0 ] if ; inline
|
t [ ] [ 1+ branch-fold-regression-0 ] if ; inline recursive
|
||||||
|
|
||||||
: branch-fold-regression-1 ( -- m )
|
: branch-fold-regression-1 ( -- m )
|
||||||
10 branch-fold-regression-0 ;
|
10 branch-fold-regression-0 ;
|
||||||
|
@ -224,7 +224,7 @@ USE: binary-search.private
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! Regression
|
! Regression
|
||||||
: empty-compound ;
|
: empty-compound ( -- ) ;
|
||||||
|
|
||||||
: node-successor-f-bug ( x -- * )
|
: node-successor-f-bug ( x -- * )
|
||||||
[ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
|
[ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
|
||||||
|
@ -293,7 +293,7 @@ HINTS: recursive-inline-hang-3 array ;
|
||||||
|
|
||||||
! Wow
|
! Wow
|
||||||
: counter-example ( a b c d -- a' b' c' d' )
|
: counter-example ( a b c d -- a' b' c' d' )
|
||||||
dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline
|
dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline recursive
|
||||||
|
|
||||||
: counter-example' ( -- a' b' c' d' )
|
: counter-example' ( -- a' b' c' d' )
|
||||||
1 2 3.0 3 counter-example ;
|
1 2 3.0 3 counter-example ;
|
||||||
|
|
|
@ -90,7 +90,7 @@ M: object xyz ;
|
||||||
[ swap [ call 1+ ] dip ] keep (i-repeat)
|
[ swap [ call 1+ ] dip ] keep (i-repeat)
|
||||||
] if ; inline recursive
|
] if ; inline recursive
|
||||||
|
|
||||||
: i-repeat [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
|
: i-repeat ( n quot -- ) [ { integer } declare ] dip 0 -rot (i-repeat) ; inline
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
[ [ dup xyz drop ] i-repeat ] \ xyz inlined?
|
[ [ dup xyz drop ] i-repeat ] \ xyz inlined?
|
||||||
|
|
Loading…
Reference in New Issue