assert-depth now has a static stack effect. This fixes a UI unit test failure

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 4be90a5a950773f1d679466d4c957da24531300a..1c5342b3893f020c5ad61a8c5e07a1b9ce306dfe 100644 (file)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -91,7 +91,7 @@ class-init-hooks global [ H{ } clone or ] change-at
 
 : (objc-class) ( name word -- class )
     2dup execute dup [ 2nip ] [
-        drop over class-init-hooks get at [ call ] when*
+        drop over class-init-hooks get at [ assert-depth ] when*
         2dup execute dup [ 2nip ] [
             2drop "No such class: " prepend throw
         ] if

diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor
index c7d505d86afbe24a08ed3a1c5dc5756c4340953f..0a392733acc12d02cc575a4ab8415e5ad383f4d2 100644 (file)
--- a/basis/help/lint/lint.factor
+++ b/basis/help/lint/lint.factor
@@ -67,7 +67,7 @@ IN: help.lint
         vocab-exists? [ "$vocab-link to non-existent vocabulary" throw ] unless
     ] each ;
 
-: check-rendering ( word element -- )
+: check-rendering ( element -- )
     [ print-topic ] with-string-writer drop ;
 
 : all-word-help ( words -- seq )
@@ -87,13 +87,14 @@ M: help-error error.
 : check-word ( word -- )
     dup word-help [
         [
-            dup word-help [
-                2dup check-examples
-                2dup check-values
-                2dup check-see-also
-                2dup nip check-modules
-                2dup drop check-rendering
-            ] assert-depth 2drop
+            dup word-help '[
+                _ _ {
+                    [ check-examples ]
+                    [ check-values ]
+                    [ check-see-also ]
+                    [ [ check-rendering ] [ check-modules ] bi* ]
+                } 2cleave
+            ] assert-depth
         ] check-something
     ] [ drop ] if ;
 
@@ -101,9 +102,9 @@ M: help-error error.
 
 : check-article ( article -- )
     [
-        dup article-content [
-            2dup check-modules check-rendering
-        ] assert-depth 2drop
+        dup article-content
+        '[ _ check-rendering _ check-modules ]
+        assert-depth
     ] check-something ;
 
 : files>vocabs ( -- assoc )

diff --git a/basis/tools/test/test-docs.factor b/basis/tools/test/test-docs.factor
index f19ffb83a48fef4a78bbc454ead25de32be69b8c..3cabff457f270a2258cfb302289859bb867a59cc 100644 (file)
--- a/basis/tools/test/test-docs.factor
+++ b/basis/tools/test/test-docs.factor
@@ -86,7 +86,7 @@ HELP: test-all
 { $description "Runs unit tests for all loaded vocabularies." } ;
 
 HELP: run-all-tests
-{ $values { "prefix" "a vocabulary name" } { "failures" "an association list of unit test failures" } }
+{ $values { "failures" "an association list of unit test failures" } }
 { $description "Runs unit tests for all loaded vocabularies and outputs unit test failures as documented in " { $link "tools.test.failure" } "." } ;
 
 HELP: test-failures.

diff --git a/basis/tools/test/test-tests.factor b/basis/tools/test/test-tests.factor
new file mode 100644 (file)
index 0000000..4733356
--- /dev/null
+++ b/basis/tools/test/test-tests.factor
@@ -0,0 +1,4 @@
+IN: tools.test.tests
+USING: tools.test ;
+
+\ test-all must-infer

diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor
index 080db863387b16c5eef5376c665df36332ef39ef..704a7f1bd5430d828ff504b1228f48ad382bf259 100644 (file)
--- a/basis/tools/test/test.factor
+++ b/basis/tools/test/test.factor
@@ -88,7 +88,7 @@ SYMBOL: this-test
 : test ( prefix -- )
     run-tests test-failures. ;
 
-: run-all-tests ( prefix -- failures )
+: run-all-tests ( -- failures )
     "" run-tests ;
 
 : test-all ( -- )

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 3afc0a3c3d1ce853714e12a00a540c3be8a8143e..8d1d9f0d2af040be7d2ada809cdf131fbf4e53ff 100644 (file)
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -29,17 +29,9 @@ $nl
 $nl
 "A combinator which can help with implementing methods on " { $link hashcode* } ":"
 { $subsection recursive-hashcode }
-{ $subsection "assertions" }
 { $subsection "combinators-quot" }
 { $see-also "quotations" "dataflow" } ;
 
-ARTICLE: "assertions" "Assertions"
-"Some words to make assertions easier to enforce:"
-{ $subsection assert }
-{ $subsection assert= }
-"Runtime stack depth checking:"
-{ $subsection assert-depth } ;
-
 ABOUT: "combinators"
 
 HELP: cleave
@@ -167,7 +159,3 @@ HELP: dispatch ( n array -- )
 { $values { "n" "a fixnum" } { "array" "an array of quotations" } }
 { $description "Calls the " { $snippet "n" } "th quotation in the array." }
 { $warning "This word is in the " { $vocab-link "kernel.private" } " vocabulary because it is an implementation detail used by the generic word system to accelerate method dispatch. It does not perform type or bounds checks, and user code should not need to call it directly." } ;
-
-HELP: assert-depth
-{ $values { "quot" "a quotation" } }
-{ $description "Runs a quotation. Throws an error if the total number of elements on the stack is not the same before and after the quotation runs." } ;

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 68eef2369102295366a10b203d881776dc8d8c88..6edec815da18e18c460578e5a983eeca8f6077fd 100644 (file)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -134,22 +134,6 @@ ERROR: no-case ;
         [ drop linear-case-quot ]
     } cond ;
 
-! assert-depth
-: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
-    2dup [ length ] bi@ min tuck [ tail ] 2bi@ ;
-
-ERROR: relative-underflow stack ;
-
-ERROR: relative-overflow stack ;
-
-: assert-depth ( quot -- )
-    [ datastack ] dip dip [ datastack ] dip
-    2dup [ length ] compare {
-        { +lt+ [ trim-datastacks nip relative-underflow ] }
-        { +eq+ [ 2drop ] }
-        { +gt+ [ trim-datastacks drop relative-overflow ] }
-    } case ; inline
-
 ! recursive-hashcode
 : recursive-hashcode ( n obj quot -- code )
     pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline

diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor
index f57be71ca8cd05de6f2514fde8ac43af6093102a..363248216281cc009a825933b18bb82576dd9fb9 100644 (file)
--- a/core/continuations/continuations-docs.factor
+++ b/core/continuations/continuations-docs.factor
@@ -83,6 +83,7 @@ $nl
 { $subsection with-return }
 "Reflecting the datastack:"
 { $subsection with-datastack }
+{ $subsection assert-depth }
 "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
 { $subsection "continuations.private" } ;
 
@@ -216,6 +217,10 @@ HELP: with-datastack
     { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
 } ;
 
+HELP: assert-depth
+{ $values { "quot" "a quotation" } }
+{ $description "Runs a quotation. Throws an error if the quotation attempts to take input values from the stack, or leave outputs on the stack." } ;
+
 HELP: <continuation>
 { $description "Constructs a new continuation." }
 { $notes "User code should call " { $link continuation } " instead." } ;

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 0f55009608e2f687902b7d3ef4d262cf78415981..c7056856b601c70143af297b64977cb689fdf61a 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -114,6 +114,9 @@ SYMBOL: return-continuation
         ] 3 (throw)
     ] callcc1 2nip ;
 
+: assert-depth ( quot -- )
+    { } swap with-datastack { } assert= ; inline
+
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 5ee12ddedc265d803768d0c6836b0de0ea575ea7..01ef8d480da6071fdcd162ac79fbefa561519d94 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -887,6 +887,11 @@ $nl
 "An object can be cloned; the clone has distinct identity but equal value:"
 { $subsection clone } ;
 
+ARTICLE: "assertions" "Assertions"
+"Some words to make assertions easier to enforce:"
+{ $subsection assert }
+{ $subsection assert= } ;
+
 ARTICLE: "dataflow" "Data and control flow"
 { $subsection "evaluator" }
 { $subsection "words" }
@@ -902,6 +907,7 @@ ARTICLE: "dataflow" "Data and control flow"
 { $subsection "compositional-combinators" }
 { $subsection "combinators" }
 "Advanced topics:"
+{ $subsection "assertions" }
 { $subsection "implementing-combinators" }
 { $subsection "errors" }
 { $subsection "continuations" } ;

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index 1e93a762f2cc8dd3e7cc7ec9db9d4a10eeae4637..cc97b78eb65a1e98bffa4e05825770ca4f727490 100644 (file)
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -5,6 +5,8 @@ sorting classes.tuple compiler.units debugger vocabs
 vocabs.loader accessors eval combinators lexer ;
 IN: parser.tests
 
+\ run-file must-infer
+
 [
     [ 1 [ 2 [ 3 ] 4 ] 5 ]
     [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
@@ -400,7 +402,7 @@ IN: parser.tests
 ] times
 
 [ "resource:core/parser/test/assert-depth.factor" run-file ]
-[ stack>> { 1 2 3 } sequence= ]
+[ got>> { 1 2 3 } sequence= ]
 must-fail-with
 
 2 [

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 49ab0eb7d488125aaa02652eaed96b22acc1e83c..3f3af935b66eace173b3eafe986ac959e8d496c4 100644 (file)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -307,7 +307,7 @@ print-use-hook global [ [ ] or ] change-at
     ] recover ;
 
 : run-file ( file -- )
-    [ dup parse-file call ] assert-depth drop ;
+    [ parse-file call ] curry assert-depth ;
 
 : ?run-file ( path -- )
     dup exists? [ run-file ] [ drop ] if ;