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
sequences.private math.private math combinators strings alien
arrays memory vocabs parser eval quotations compiler.errors
definitions ;
definitions generic.single ;
IN: compiler.tests.simple
! Test empty word
@ -249,3 +249,6 @@ M: quotation bad-effect-test call ; inline
! Don't want compiler error to stick around
[ ] [ [ 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 } ]
[ [ 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
] dip recursive-state set ;
: time-bomb ( error -- )
'[ _ throw ] infer-quot-here ;
: time-bomb-quot ( obj generic -- quot )
[ literalize ] [ "default-method" word-prop ] bi* [ ] 2sequence ;
ERROR: bad-call obj ;
M: bad-call summary
drop "call must be given a callable" ;
: time-bomb ( obj generic -- )
time-bomb-quot infer-quot-here ;
: infer-literal-quot ( literal -- )
dup recursive-quotation? [
@ -127,7 +125,7 @@ M: bad-call summary
[ [ recursion>> ] keep add-local-quotation ]
bi infer-quot
] [
value>> \ bad-call boa time-bomb
value>> \ call time-bomb
] if
] if ;

View File

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

View File

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