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
parent
e3edb2653d
commit
e2ceb11337
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue