Merge remote branch 'origin/master' into gtk-image-loader

diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index df67cadd78c5d4f849943381815414ab8b5e24db..8b1fc3569f4ce3fdf425f005b68fc11848ac7786 100644 (file)
--- 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 978c27768fc69855f742cc0f6e843126c5bcbe98..e92057faf9ed6e587ceab86d8eee812d9b944f54 100644 (file)
--- 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 7a18133efff7463117a4369910eae64a240958b6..d757e02ca91281707faee2c852a21dfa5de30bc6 100644 (file)
--- 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 979191939222947ac41ea521a78733eb5671d79b..4b43c4c2f18b53c3909c13dbeb70ae5a82a3bde2 100644 (file)
--- 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 610d3f8600ea131684e7327b0268544264ed41b5..d24be0e78355b12c34d79be51324bc8b31370c44 100644 (file)
--- 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
         '[ @ _ <tuple-boa> ]
-    ] [ 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 e713b0f99959b0c0abf00dc86af12565ecea2dbe..7e064ee76b30095a04b7f374a31c02deeea08a9c 100644 (file)
--- 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 d65f4725a9e59258e5c640770c7a2b7a9f99bddc..68bb064328d1769d501494859b99ce399b026583 100644 (file)
--- 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 -- )
+    [ <reversed> [ [ 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 ]
-        [ [ <reversed> [ [ 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 ;