stack-checker: calling 'boa' on a non-tuple would compile as a no-op rather than an error (reported by Joe Groff); clean up some other error reporting code too

db4
Slava Pestov 2010-07-17 15:57:44 -04:00
parent e3edb2653d
commit e2ceb11337
5 changed files with 19 additions and 15 deletions

View File

@ -1,7 +1,7 @@
USING: compiler.test compiler.units tools.test kernel kernel.private USING: compiler.test 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 quotations compiler.errors arrays memory vocabs parser eval quotations compiler.errors
definitions ; definitions generic.single ;
IN: compiler.tests.simple IN: compiler.tests.simple
! Test empty word ! Test empty word
@ -249,3 +249,6 @@ M: quotation bad-effect-test call ; inline
! Don't want compiler error to stick around ! 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

View File

@ -8,3 +8,9 @@ TUPLE: color red green blue ;
[ T{ color f f f f } ] [ T{ color f f f f } ]
[ [ color new ] compile-call ] unit-test [ [ color new ] compile-call ] unit-test
SYMBOL: foo
[ [ foo new ] compile-call ] must-fail
[ [ foo boa ] compile-call ] must-fail

View File

@ -110,13 +110,11 @@ M: object apply-object push-literal ;
infer-quot-here infer-quot-here
] dip recursive-state set ; ] dip recursive-state set ;
: time-bomb ( error -- ) : time-bomb-quot ( obj generic -- quot )
'[ _ throw ] infer-quot-here ; [ literalize ] [ "default-method" word-prop ] bi* [ ] 2sequence ;
ERROR: bad-call obj ; : time-bomb ( obj generic -- )
time-bomb-quot infer-quot-here ;
M: bad-call summary
drop "call must be given a callable" ;
: infer-literal-quot ( literal -- ) : infer-literal-quot ( literal -- )
dup recursive-quotation? [ dup recursive-quotation? [
@ -127,7 +125,7 @@ M: bad-call summary
[ [ recursion>> ] keep add-local-quotation ] [ [ recursion>> ] keep add-local-quotation ]
bi infer-quot bi infer-quot
] [ ] [
value>> \ bad-call boa time-bomb value>> \ call time-bomb
] if ] if
] if ; ] if ;

View File

@ -156,17 +156,12 @@ M: object infer-call* \ call bad-macro-input ;
\ compose [ infer-compose ] "special" set-word-prop \ compose [ infer-compose ] "special" set-word-prop
ERROR: bad-executable obj ;
M: bad-executable summary
drop "execute must be given a word" ;
: infer-execute ( -- ) : infer-execute ( -- )
pop-literal nip pop-literal nip
dup word? [ dup word? [
apply-object apply-object
] [ ] [
\ bad-executable boa time-bomb \ execute time-bomb
] if ; ] if ;
\ execute [ infer-execute ] "special" set-word-prop \ execute [ infer-execute ] "special" set-word-prop

View File

@ -145,7 +145,9 @@ IN: stack-checker.transforms
[ depends-on-tuple-layout ] [ depends-on-tuple-layout ]
[ [ "boa-check" word-prop [ ] or ] dip ] 2bi [ [ "boa-check" word-prop [ ] or ] dip ] 2bi
'[ @ _ <tuple-boa> ] '[ @ _ <tuple-boa> ]
] [ drop f ] if ] [
\ boa time-bomb
] if
] 1 define-transform ] 1 define-transform
\ boa t "no-compile" set-word-prop \ boa t "no-compile" set-word-prop