steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add unit test and fix USING:

db4
Slava Pestov 2008-02-13 20:14:48 -06:00
parent 6f1dc49fa8
commit 803e49b129
2 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/optimizer/control/control.factor
View File

@ -145,9 +145,6 @@ M: #call-label detect-loops*
: clone-node ( node -- newnode ) : clone-node ( node -- newnode )
clone dup [ clone ] modify-values ; clone dup [ clone ] modify-values ;
: detach-node-successor ( node -- successor )
dup node-successor #terminate rot set-node-successor ;
! BEFORE ! BEFORE
! !
! #if ----> #merge ----> B ----> #return/#values ! #if ----> #merge ----> B ----> #return/#values
@ -261,6 +258,9 @@ M: #dispatch optimize-node*
] if ] if
] when ; ] when ;
: detach-node-successor ( node -- successor )
dup node-successor #terminate rot set-node-successor ;
: lift-loop-tail? ( #label -- tail/f ) : lift-loop-tail? ( #label -- tail/f )
dup node-successor node-successor [ dup node-successor node-successor [
dup node-param swap node-child find-final-if dup [ dup node-param swap node-child find-final-if dup [

12
core/optimizer/optimizer-tests.factor
View File

@ -301,3 +301,15 @@ TUPLE: silly-tuple a b ;
[ t ] [ \ array \ nth-unsafe should-inline? ] unit-test [ t ] [ \ array \ nth-unsafe should-inline? ] unit-test
[ t ] [ \ growable \ nth-unsafe should-inline? ] unit-test [ t ] [ \ growable \ nth-unsafe should-inline? ] unit-test
[ t ] [ \ sbuf \ set-nth-unsafe should-inline? ] unit-test [ t ] [ \ sbuf \ set-nth-unsafe should-inline? ] unit-test
! Regression
: lift-throw-tail-regression
dup integer? [ "an integer" ] [
dup string? [ "a string" ] [
"error" throw
] if
] if ;
[ t ] [ \ lift-throw-tail-regression compiled? ] unit-test
[ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
[ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test