From e8fd85437b45888e3f54b165540b537b7c741dcc Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 23 Oct 2009 03:27:25 -0500
Subject: [PATCH] compiler: fix stack effect inference bug discovered by x6j8x;
 it was possible to define a word which did not compile but could be called
 anyway

---
 basis/compiler/compiler.factor     | 24 +++++++++---------------
 basis/compiler/tests/simple.factor | 13 ++++++++++++-
 2 files changed, 21 insertions(+), 16 deletions(-)

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index 626ab678c0..e58cf0c834 100755
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -55,28 +55,22 @@ SYMBOL: compiled
 
 GENERIC: no-compile? ( word -- ? )
 
-M: word no-compile? "no-compile" word-prop ;
-
 M: method-body no-compile? "method-generic" word-prop no-compile? ;
 
 M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
 
+M: word no-compile?
+    {
+        [ macro? ]
+        [ inline? ]
+        [ "special" word-prop ]
+        [ "no-compile" word-prop ]
+    } 1|| ;
+
 : ignore-error? ( word error -- ? )
     #! Ignore some errors on inline combinators, macros, and special
     #! words such as 'call'.
-    [
-        {
-            [ macro? ]
-            [ inline? ]
-            [ no-compile? ]
-            [ "special" word-prop ]
-        } 1||
-    ] [
-        {
-            [ do-not-compile? ]
-            [ literal-expected? ]
-        } 1||
-    ] bi* and ;
+    [ no-compile? ] [ { [ do-not-compile? ] [ literal-expected? ] } 1|| ] bi* and ;
 
 : finish ( word -- )
     #! Recompile callers if the word's stack effect changed, then
diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor
index da021412fe..a86d5b8c52 100644
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@@ -1,6 +1,7 @@
 USING: compiler compiler.units tools.test kernel kernel.private
 sequences.private math.private math combinators strings alien
-arrays memory vocabs parser eval ;
+arrays memory vocabs parser eval quotations compiler.errors
+definitions ;
 IN: compiler.tests.simple
 
 ! Test empty word
@@ -238,3 +239,13 @@ M: f single-combination-test-2 single-combination-test-4 ;
         "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized?" eval( -- obj )
     ] unit-test
 ] times
+
+! This should not compile
+GENERIC: bad-effect-test ( a -- )
+M: quotation bad-effect-test call ; inline
+: bad-effect-test* ( -- ) [ 1 2 3 ] bad-effect-test ;
+
+[ bad-effect-test* ] [ not-compiled? ] must-fail-with
+
+! Don't want compiler error to stick around
+[ ] [ [ M\ quotation bad-effect-test forget ] with-compilation-unit ] unit-test