compiler: fix stack effect inference bug discovered by x6j8x; it was possible to define a word which did not compile but could be called anyway

db4
Slava Pestov 2009-10-23 03:27:25 -05:00
parent a5d4f9cf16
commit e8fd85437b
2 changed files with 21 additions and 16 deletions

View File

@ -55,28 +55,22 @@ SYMBOL: compiled
GENERIC: no-compile? ( word -- ? ) GENERIC: no-compile? ( word -- ? )
M: word no-compile? "no-compile" word-prop ;
M: method-body no-compile? "method-generic" word-prop no-compile? ; M: method-body no-compile? "method-generic" word-prop no-compile? ;
M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ; M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
: ignore-error? ( word error -- ? ) M: word no-compile?
#! Ignore some errors on inline combinators, macros, and special
#! words such as 'call'.
[
{ {
[ macro? ] [ macro? ]
[ inline? ] [ inline? ]
[ no-compile? ]
[ "special" word-prop ] [ "special" word-prop ]
} 1|| [ "no-compile" word-prop ]
] [ } 1|| ;
{
[ do-not-compile? ] : ignore-error? ( word error -- ? )
[ literal-expected? ] #! Ignore some errors on inline combinators, macros, and special
} 1|| #! words such as 'call'.
] bi* and ; [ no-compile? ] [ { [ do-not-compile? ] [ literal-expected? ] } 1|| ] bi* and ;
: finish ( word -- ) : finish ( word -- )
#! Recompile callers if the word's stack effect changed, then #! Recompile callers if the word's stack effect changed, then

View File

@ -1,6 +1,7 @@
USING: compiler compiler.units tools.test kernel kernel.private USING: compiler compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings alien sequences.private math.private math combinators strings alien
arrays memory vocabs parser eval ; arrays memory vocabs parser eval quotations compiler.errors
definitions ;
IN: compiler.tests.simple IN: compiler.tests.simple
! Test empty word ! Test empty word
@ -238,3 +239,13 @@ M: f single-combination-test-2 single-combination-test-4 ;
"USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj ) "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj )
] unit-test ] unit-test
] times ] times
! This should not compile
GENERIC: bad-effect-test ( a -- )
M: quotation bad-effect-test call ; inline
: bad-effect-test* ( -- ) [ 1 2 3 ] bad-effect-test ;
[ 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