add test for diverging words

diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor
index 2aea3245ca9ef9efc990de2648008031daba5bd2..3f4f89ee84a2ceb535416cba20d655df92fbaa03 100644 (file)
--- a/library/platform/native/boot-stage2.factor
+++ b/library/platform/native/boot-stage2.factor
@@ -114,7 +114,7 @@ USE: stdio
     "/library/platform/native/heap-stats.factor"
     "/library/platform/native/gensym.factor"
     "/library/tools/interpreter.factor"
-    "/library/tools/inference.factor"
+!    "/library/tools/inference.factor"
 
     "/library/tools/image.factor"
     "/library/tools/cross-compiler.factor"

diff --git a/library/test/inference.factor b/library/test/inference.factor
index e77ef6d7ae8abb00a4eee3a20f429e7e92423d0a..70e0fb9a8337f26dd7c227d8974a6d135e3ad95f 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -73,6 +73,16 @@ USE: lists
 
 [ [ 1 | 1 ] ] [ [ simple-recursion-2 ] infer ] unit-test
 
+: bad-recursion-1
+    dup [ drop bad-recursion-1 5 ] [ ] ifte ;
+
+[ [ bad-recursion-1 ] infer ] unit-test-fails
+
+: bad-recursion-2
+    dup [ uncons bad-recursion-2 ] [ ] ifte ;
+
+[ [ bad-recursion-2 ] infer ] unit-test-fails
+
 [ [ 2 | 1 ] ] [ [ 2list ] infer ] unit-test
 [ [ 3 | 1 ] ] [ [ 3list ] infer ] unit-test
 [ [ 2 | 1 ] ] [ [ append ] infer ] unit-test

diff --git a/library/tools/inference.factor b/library/tools/inference.factor
index 3ce44ee6c23fc27ce60d8af7ef3836afb501f9be..ed36784827b6f965f546ff59c2158de6e74ac3bd 100644 (file)
--- a/library/tools/inference.factor
+++ b/library/tools/inference.factor
@@ -130,6 +130,14 @@ DEFER: (infer)
     current-word word-name
     " does not have a base case." cat2 throw ;
 
+: check-recursion ( -- )
+    #! If at the location of the recursive call, we're taking
+    #! more items from the stack than producing, we have a
+    #! diverging recursion.
+    d-in get meta-d get vector-length > [
+        current-word word-name " diverges." cat2 throw
+    ] when ;
+
 : recursive-word ( word effect -- )
     #! Handle a recursive call, by either applying a previously
     #! inferred base case, or raising an error.
@@ -139,7 +147,7 @@ DEFER: (infer)
     #! Apply the object's stack effect to the inferencer state.
     dup word? [
         dup recursive-state get assoc [
-            recursive-word
+            check-recursion recursive-word
         ] [
             apply-word
         ] ifte*