Fix remaining text failures

db4
Slava Pestov 2009-02-23 23:25:13 -06:00
parent eaad0c7660
commit 901bcccc1c
6 changed files with 18 additions and 19 deletions

View File

@ -49,7 +49,7 @@ SYMBOL: +failed+
H{ } clone generic-dependencies set H{ } clone generic-dependencies set
f swap compiler-error ; f swap compiler-error ;
: fail ( word error -- * ) : fail ( word error -- )
[ swap compiler-error ] [ swap compiler-error ]
[ [
drop drop
@ -112,9 +112,6 @@ t compile-dependencies? set-global
: decompile ( word -- ) : decompile ( word -- )
f 2array 1array modify-code-heap ; f 2array 1array modify-code-heap ;
: compile-call ( quot -- )
[ dup infer define-temp ] with-compilation-unit execute ;
: optimized-recompile-hook ( words -- alist ) : optimized-recompile-hook ( words -- alist )
[ [
<hashed-dlist> compile-queue set <hashed-dlist> compile-queue set

View File

@ -55,7 +55,7 @@ TUPLE: pred-test ;
! regression ! regression
: literal-not-branch 0 not [ ] [ ] if ; : literal-not-branch ( -- ) 0 not [ ] [ ] if ;
[ ] [ literal-not-branch ] unit-test [ ] [ literal-not-branch ] unit-test
@ -108,12 +108,12 @@ GENERIC: void-generic ( obj -- * )
[ 10 ] [ branch-fold-regression-1 ] unit-test [ 10 ] [ branch-fold-regression-1 ] unit-test
! another regression ! another regression
: constant-branch-fold-0 "hey" ; foldable : constant-branch-fold-0 ( -- value ) "hey" ; foldable
: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline : 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 ! another regression
: foo f ; : foo ( -- value ) f ;
: bar ( -- ? ) foo 4 4 = and ; : bar ( -- ? ) foo 4 4 = and ;
[ f ] [ bar ] unit-test [ f ] [ bar ] unit-test
@ -134,15 +134,15 @@ M: slice foozul ;
] unit-test ] unit-test
! regression ! regression
: constant-fold-2 f ; foldable : constant-fold-2 ( -- value ) f ; foldable
: constant-fold-3 4 ; foldable : constant-fold-3 ( -- value ) 4 ; foldable
[ f t ] [ [ f t ] [
[ constant-fold-2 constant-fold-3 4 = ] compile-call [ constant-fold-2 constant-fold-3 4 = ] compile-call
] unit-test ] unit-test
: constant-fold-4 f ; foldable : constant-fold-4 ( -- value ) f ; foldable
: constant-fold-5 f ; foldable : constant-fold-5 ( -- value ) f ; foldable
[ f ] [ [ f ] [
[ constant-fold-4 constant-fold-5 or ] compile-call [ constant-fold-4 constant-fold-5 or ] compile-call
@ -247,7 +247,7 @@ USE: binary-search.private
[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
: lift-loop-tail-test-1 ( a quot -- ) : lift-loop-tail-test-1 ( a quot: ( -- ) -- )
over even? [ over even? [
[ [ 3 - ] dip call ] keep lift-loop-tail-test-1 [ [ 3 - ] dip call ] keep lift-loop-tail-test-1
] [ ] [
@ -256,11 +256,13 @@ USE: binary-search.private
] [ ] [
[ [ 2 - ] dip call ] keep lift-loop-tail-test-1 [ [ 2 - ] dip call ] keep lift-loop-tail-test-1
] if ] if
] if ; inline ] if ; inline recursive
: lift-loop-tail-test-2 : lift-loop-tail-test-2 ( -- a b c )
10 [ ] lift-loop-tail-test-1 1 2 3 ; 10 [ ] lift-loop-tail-test-1 1 2 3 ;
\ lift-loop-tail-test-2 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 ! Forgot a recursive inline check

View File

@ -18,13 +18,13 @@ IN: compiler.tests
[ "hey" ] [ [ "hey" ] compile-call ] unit-test [ "hey" ] [ [ "hey" ] compile-call ] unit-test
! Calls ! Calls
: no-op ; : no-op ( -- ) ;
[ ] [ [ no-op ] compile-call ] unit-test [ ] [ [ no-op ] compile-call ] unit-test
[ 3 ] [ [ no-op 3 ] compile-call ] unit-test [ 3 ] [ [ no-op 3 ] compile-call ] unit-test
[ 3 ] [ [ 3 no-op ] compile-call ] unit-test [ 3 ] [ [ 3 no-op ] compile-call ] unit-test
: bar 4 ; : bar ( -- value ) 4 ;
[ 4 ] [ [ bar no-op ] compile-call ] unit-test [ 4 ] [ [ bar no-op ] compile-call ] unit-test
[ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test [ 4 3 ] [ [ no-op bar 3 ] compile-call ] unit-test

View File

@ -474,7 +474,7 @@ cell-bits 32 = [
] unit-test ] unit-test
! A reduction ! A reduction
: buffalo-sauce f ; : buffalo-sauce ( -- value ) f ;
: steak ( -- ) : steak ( -- )
buffalo-sauce [ steak ] when ; inline recursive buffalo-sauce [ steak ] when ; inline recursive

View File

@ -87,7 +87,7 @@ compiler.tree.combinators ;
] contains-node? ] contains-node?
] unit-test ] unit-test
: blah f ; : blah ( -- value ) f ;
DEFER: a DEFER: a

View File

@ -1,6 +1,6 @@
IN: tools.profiler.tests IN: tools.profiler.tests
USING: accessors tools.profiler tools.test kernel memory math USING: accessors tools.profiler tools.test kernel memory math
threads alien tools.profiler.private sequences compiler.units threads alien tools.profiler.private sequences compiler
words ; words ;
[ t ] [ [ t ] [