diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index df67cadd78..8b1fc3569f 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -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 diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor index 978c27768f..e92057faf9 100644 --- a/basis/compiler/tests/tuples.factor +++ b/basis/compiler/tests/tuples.factor @@ -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 diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor index 7a18133eff..d757e02ca9 100644 --- a/basis/stack-checker/backend/backend.factor +++ b/basis/stack-checker/backend/backend.factor @@ -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 ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 9791919392..4b43c4c2f1 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -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 diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 610d3f8600..d24be0e783 100644 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -145,7 +145,9 @@ IN: stack-checker.transforms [ depends-on-tuple-layout ] [ [ "boa-check" word-prop [ ] or ] dip ] 2bi '[ @ _ ] - ] [ drop f ] if + ] [ + \ boa time-bomb + ] if ] 1 define-transform \ boa t "no-compile" set-word-prop diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index e713b0f999..7e064ee76b 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -129,6 +129,7 @@ M: world request-focus-on ( child gadget -- ) [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ; GENERIC# apply-world-attributes 1 ( world attributes -- world ) + M: world apply-world-attributes { [ title>> >>title ] @@ -166,15 +167,11 @@ flush-layout-cache-hook [ [ ] ] initialize GENERIC: begin-world ( world -- ) GENERIC: end-world ( world -- ) - GENERIC: resize-world ( world -- ) -M: world begin-world - drop ; -M: world end-world - drop ; -M: world resize-world - drop ; +M: world begin-world drop ; +M: world end-world drop ; +M: world resize-world drop ; M: world dim<< [ call-next-method ] diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index d65f4725a9..68bb064328 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -81,6 +81,9 @@ M: world graft* [ [ clean-up-broken-window ] [ ui-error ] bi* ] recover ] bi ; +: dispose-window-resources ( world -- ) + [ [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ; + M: world ungraft* { [ set-gl-context ] @@ -89,9 +92,9 @@ M: world ungraft* [ hand-clicked close-global ] [ hand-gadget close-global ] [ end-world ] - [ [ [ [ dispose ] when* ] each V{ } clone ] change-window-resources drop ] - [ [ (close-window) f ] change-handle drop ] + [ dispose-window-resources ] [ unfocus-world ] + [ [ (close-window) f ] change-handle drop ] [ promise>> t swap fulfill ] } cleave ;