From e9e40289999b1e8e9148ced6d6504113e6f271e7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 11:01:58 -0500 Subject: [PATCH 1/7] remove 1+ a couple places, working on compile errors --- extra/advice/advice-tests.factor | 4 ++-- extra/advice/advice.factor | 12 +++++++++--- extra/webapps/counter/counter.factor | 4 ++-- 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/extra/advice/advice-tests.factor b/extra/advice/advice-tests.factor index a141489a0f..396687e733 100644 --- a/extra/advice/advice-tests.factor +++ b/extra/advice/advice-tests.factor @@ -25,7 +25,7 @@ IN: advice.tests foo ] unit-test - : bar ( a -- b ) 1+ ; + : bar ( a -- b ) 1 + ; \ bar make-advised { 11 } [ @@ -91,4 +91,4 @@ IN: advice.tests ! [ 3 5 quux ] with-string-writer"> eval ! ] unit-test -] with-scope \ No newline at end of file +] with-scope diff --git a/extra/advice/advice.factor b/extra/advice/advice.factor index 9c0963469e..44280456c1 100644 --- a/extra/advice/advice.factor +++ b/extra/advice/advice.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences fry words assocs linked-assocs tools.annotations -coroutines lexer parser quotations arrays namespaces continuations ; +coroutines lexer parser quotations arrays namespaces continuations +summary ; IN: advice SYMBOLS: before after around advised in-advice? ; @@ -45,8 +46,13 @@ PRIVATE> : remove-advice ( name word loc -- ) word-prop delete-at ; +ERROR: ad-do-it-error ; + +M: ad-do-it-error summary + drop "ad-do-it should only be called inside 'around' advice" ; + : ad-do-it ( input -- result ) - in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ; + in-advice? get [ ad-do-it-error ] unless coyield ; : make-advised ( word -- ) [ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] @@ -60,4 +66,4 @@ SYNTAX: ADVISE: ! word adname location => word adname quot loc scan-word scan scan-word parse-definition swap [ spin ] dip advise ; SYNTAX: UNADVISE: - scan-word parsed \ unadvise parsed ; \ No newline at end of file + scan-word parsed \ unadvise parsed ; diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor index d62096fffc..2fa9b5fb1d 100644 --- a/extra/webapps/counter/counter.factor +++ b/extra/webapps/counter/counter.factor @@ -25,8 +25,8 @@ M: counter-app init-session* drop 0 count sset ; : ( -- responder ) counter-app new-dispatcher - [ 1+ ] "inc" add-responder - [ 1- ] "dec" add-responder + [ 1 + ] "inc" add-responder + [ 1 - ] "dec" add-responder "" add-responder ; ! Deployment example From d3c87db85f39b2b79f563da0f4b1c99b38974941 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 11:14:16 -0500 Subject: [PATCH 2/7] fixing compiler warnings --- extra/coroutines/coroutines.factor | 7 ++++--- extra/graph-theory/graph-theory.factor | 9 ++++----- .../numerical-integration/numerical-integration.factor | 8 ++++---- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/extra/coroutines/coroutines.factor b/extra/coroutines/coroutines.factor index 51276336e3..6b334822c0 100644 --- a/extra/coroutines/coroutines.factor +++ b/extra/coroutines/coroutines.factor @@ -19,9 +19,10 @@ TUPLE: coroutine resumecc exitcc originalcc ; : coresume ( v co -- result ) [ >>exitcc - resumecc>> call + resumecc>> call( -- ) #! At this point, the coroutine quotation must have terminated - #! normally (without calling coyield, coreset, or coterminate). This shouldn't happen. + #! normally (without calling coyield, coreset, or coterminate). + #! This shouldn't happen. f over ] callcc1 2nip ; @@ -47,4 +48,4 @@ TUPLE: coroutine resumecc exitcc originalcc ; : coreset ( v -- ) current-coro get dup originalcc>> >>resumecc - exitcc>> continue-with ; \ No newline at end of file + exitcc>> continue-with ; diff --git a/extra/graph-theory/graph-theory.factor b/extra/graph-theory/graph-theory.factor index b14832dc03..1b4224c864 100644 --- a/extra/graph-theory/graph-theory.factor +++ b/extra/graph-theory/graph-theory.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 William Schlieper ! See http://factorcode.org/license.txt for BSD license. - -USING: kernel combinators fry continuations sequences arrays vectors assocs hashtables heaps namespaces ; - +USING: kernel combinators fry continuations sequences arrays +vectors assocs hashtables heaps namespaces ; IN: graph-theory MIXIN: graph @@ -35,7 +34,7 @@ M: graph num-vertices vertices length ; M: graph num-edges - [ vertices ] [ '[ _ adjlist length ] map sum ] bi ; + [ vertices ] [ '[ _ adjlist length ] sigma ] bi ; M: graph adjlist [ vertices ] [ swapd '[ _ swap _ adj? ] filter ] bi ; @@ -88,5 +87,5 @@ PRIVATE> : topological-sort ( graph -- seq/f ) dup dag? - [ V{ } swap [ drop ] [ prefix ] [ ] full-depth-first drop ] + [ V{ } clone swap [ drop ] [ prefix ] [ ] full-depth-first drop ] [ drop f ] if ; diff --git a/extra/math/numerical-integration/numerical-integration.factor b/extra/math/numerical-integration/numerical-integration.factor index 6b46ba0243..261f33c4f3 100644 --- a/extra/math/numerical-integration/numerical-integration.factor +++ b/extra/math/numerical-integration/numerical-integration.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel sequences namespaces make math math.ranges -math.vectors vectors ; +USING: kernel math math.ranges math.vectors namespaces +sequences ; IN: math.numerical-integration SYMBOL: num-steps @@ -15,7 +15,7 @@ SYMBOL: num-steps length 2 / 2 - { 2 4 } concat { 1 4 } { 1 } surround ; -: integrate-simpson ( from to f -- x ) +: integrate-simpson ( from to quot -- x ) [ setup-simpson-range dup ] dip map dup generate-simpson-weights - v. swap [ third ] keep first - 6 / * ; + v. swap [ third ] keep first - 6 / * ; inline From b994b9a4dc6b588c4fe693d951c861fae86966cc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 11:14:41 -0500 Subject: [PATCH 3/7] move graph-theory to unmaintained: no unit tests and compile errors --- {extra => unmaintained}/graph-theory/authors.txt | 0 {extra => unmaintained}/graph-theory/graph-theory-docs.factor | 0 {extra => unmaintained}/graph-theory/graph-theory.factor | 0 {extra => unmaintained}/graph-theory/reversals/reversals.factor | 0 {extra => unmaintained}/graph-theory/sparse/sparse.factor | 0 {extra => unmaintained}/graph-theory/summary.txt | 0 {extra => unmaintained}/graph-theory/tags.txt | 0 7 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/graph-theory/authors.txt (100%) rename {extra => unmaintained}/graph-theory/graph-theory-docs.factor (100%) rename {extra => unmaintained}/graph-theory/graph-theory.factor (100%) rename {extra => unmaintained}/graph-theory/reversals/reversals.factor (100%) rename {extra => unmaintained}/graph-theory/sparse/sparse.factor (100%) rename {extra => unmaintained}/graph-theory/summary.txt (100%) rename {extra => unmaintained}/graph-theory/tags.txt (100%) diff --git a/extra/graph-theory/authors.txt b/unmaintained/graph-theory/authors.txt similarity index 100% rename from extra/graph-theory/authors.txt rename to unmaintained/graph-theory/authors.txt diff --git a/extra/graph-theory/graph-theory-docs.factor b/unmaintained/graph-theory/graph-theory-docs.factor similarity index 100% rename from extra/graph-theory/graph-theory-docs.factor rename to unmaintained/graph-theory/graph-theory-docs.factor diff --git a/extra/graph-theory/graph-theory.factor b/unmaintained/graph-theory/graph-theory.factor similarity index 100% rename from extra/graph-theory/graph-theory.factor rename to unmaintained/graph-theory/graph-theory.factor diff --git a/extra/graph-theory/reversals/reversals.factor b/unmaintained/graph-theory/reversals/reversals.factor similarity index 100% rename from extra/graph-theory/reversals/reversals.factor rename to unmaintained/graph-theory/reversals/reversals.factor diff --git a/extra/graph-theory/sparse/sparse.factor b/unmaintained/graph-theory/sparse/sparse.factor similarity index 100% rename from extra/graph-theory/sparse/sparse.factor rename to unmaintained/graph-theory/sparse/sparse.factor diff --git a/extra/graph-theory/summary.txt b/unmaintained/graph-theory/summary.txt similarity index 100% rename from extra/graph-theory/summary.txt rename to unmaintained/graph-theory/summary.txt diff --git a/extra/graph-theory/tags.txt b/unmaintained/graph-theory/tags.txt similarity index 100% rename from extra/graph-theory/tags.txt rename to unmaintained/graph-theory/tags.txt From e85d8c17ac2e4d6b854d12d360506ffb19bca93c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 11:21:30 -0500 Subject: [PATCH 4/7] fix compile error --- extra/4DNav/file-chooser/file-chooser.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/4DNav/file-chooser/file-chooser.factor b/extra/4DNav/file-chooser/file-chooser.factor index ad799f75c9..033ae755cb 100755 --- a/extra/4DNav/file-chooser/file-chooser.factor +++ b/extra/4DNav/file-chooser/file-chooser.factor @@ -111,7 +111,7 @@ file-chooser H{ : line-selected-action ( file-chooser -- ) dup list>> list-value dup directory? - [ fc-change-directory ] [ fc-load-file ] if ; + [ fc-change-directory ] [ fc-load-file ] if ; inline : present-dir-element ( element -- string ) [ name>> ] [ directory? ] bi [ "-> " prepend ] when ; From aad6a3d504d6a3bc7c177b5d605c1c6aba73b845 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 12:45:57 -0500 Subject: [PATCH 5/7] fixing compiler error in core --- core/classes/classes-tests.factor | 6 +- core/classes/mixin/mixin-tests.factor | 4 +- core/classes/tuple/parser/parser-tests.factor | 22 ++--- core/classes/tuple/tuple-tests.factor | 88 ++++++++--------- core/classes/union/union-tests.factor | 6 +- core/compiler/units/units-tests.factor | 4 +- core/generic/generic-tests.factor | 20 ++-- core/generic/standard/standard-tests.factor | 2 +- core/memory/memory-tests.factor | 2 +- core/parser/parser-tests.factor | 94 +++++++++---------- core/slots/slots-tests.factor | 4 +- core/vocabs/loader/loader-tests.factor | 2 +- core/words/alias/alias-tests.factor | 4 +- core/words/words-tests.factor | 24 ++--- 14 files changed, 141 insertions(+), 141 deletions(-) diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor index 673c108b27..f5ea84afa5 100644 --- a/core/classes/classes-tests.factor +++ b/core/classes/classes-tests.factor @@ -29,10 +29,10 @@ M: method-forget-class method-forget-test ; ] unit-test ! Minor leak -[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test +[ ] [ "IN: classes.tests TUPLE: forget-me ;" (( -- )) eval ] unit-test [ ] [ f \ word set-global ] unit-test -[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test -[ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test +[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" (( -- )) eval ] unit-test +[ ] [ "IN: classes.tests FORGET: forget-me" (( -- )) eval ] unit-test [ 0 ] [ [ word? ] instances [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor index 376eace4ed..1beafd003a 100644 --- a/core/classes/mixin/mixin-tests.factor +++ b/core/classes/mixin/mixin-tests.factor @@ -42,7 +42,7 @@ INSTANCE: integer mx1 [ t ] [ mx1 integer class<= ] unit-test [ t ] [ mx1 number class<= ] unit-test -"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval +"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" (( -- )) eval [ t ] [ array mx1 class<= ] unit-test [ f ] [ mx1 number class<= ] unit-test @@ -118,4 +118,4 @@ MIXIN: move-instance-declaration-mixin [ ] [ "IN: classes.mixin.tests.a" "move-mixin-test-1" parse-stream drop ] unit-test -[ { string } ] [ move-instance-declaration-mixin members ] unit-test \ No newline at end of file +[ { string } ] [ move-instance-declaration-mixin members ] unit-test diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 22b5784269..9d0c268add 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -50,20 +50,20 @@ TUPLE: test-8 { b integer read-only } ; DEFER: foo -[ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" eval ] +[ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" (( -- )) eval ] [ error>> invalid-slot-name? ] must-fail-with -[ "IN: classes.tuple.parser.tests TUPLE: foo :" eval ] +[ "IN: classes.tuple.parser.tests TUPLE: foo :" (( -- )) eval ] [ error>> invalid-slot-name? ] must-fail-with -[ "IN: classes.tuple.parser.tests TUPLE: foo" eval ] +[ "IN: classes.tuple.parser.tests TUPLE: foo" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with 2 [ - [ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" eval ] + [ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" (( -- )) eval ] [ error>> no-initial-value? ] must-fail-with @@ -71,14 +71,14 @@ must-fail-with ] times 2 [ - [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval ] + [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" (( -- )) eval ] [ error>> bad-initial-value? ] must-fail-with [ f ] [ \ foo tuple-class? ] unit-test ] times -[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" eval ] +[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" (( -- )) eval ] [ error>> duplicate-slot-names? ] must-fail-with @@ -107,7 +107,7 @@ TUPLE: parsing-corner-case x ; " f" " 3" "}" - } "\n" join eval + } "\n" join (( -- tuple )) eval ] unit-test [ T{ parsing-corner-case f 3 } ] [ @@ -116,7 +116,7 @@ TUPLE: parsing-corner-case x ; "T{ parsing-corner-case" " { x 3 }" "}" - } "\n" join eval + } "\n" join (( -- tuple )) eval ] unit-test [ T{ parsing-corner-case f 3 } ] [ @@ -125,7 +125,7 @@ TUPLE: parsing-corner-case x ; "T{ parsing-corner-case {" " x 3 }" "}" - } "\n" join eval + } "\n" join (( -- tuple )) eval ] unit-test @@ -133,12 +133,12 @@ TUPLE: parsing-corner-case x ; { "USE: classes.tuple.parser.tests T{ parsing-corner-case" " { x 3 }" - } "\n" join eval + } "\n" join (( -- tuple )) eval ] [ error>> unexpected-eof? ] must-fail-with [ { "USE: classes.tuple.parser.tests T{ parsing-corner-case {" " x 3 }" - } "\n" join eval + } "\n" join (( -- tuple )) eval ] [ error>> unexpected-eof? ] must-fail-with diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index 75d733b213..451420268d 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -27,7 +27,7 @@ C: redefinition-test [ t ] [ "redefinition-test" get redefinition-test? ] unit-test -"IN: classes.tuple.tests TUPLE: redefinition-test ;" eval +"IN: classes.tuple.tests TUPLE: redefinition-test ;" (( -- )) eval [ t ] [ "redefinition-test" get redefinition-test? ] unit-test @@ -39,7 +39,7 @@ C: point [ ] [ 100 200 "p" set ] unit-test ! Use eval to sequence parsing explicitly -[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" (( -- )) eval ] unit-test [ 100 ] [ "p" get x>> ] unit-test [ 200 ] [ "p" get y>> ] unit-test @@ -51,7 +51,7 @@ C: point [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" (( -- )) eval ] unit-test [ 2 ] [ "p" get tuple-size ] unit-test @@ -89,7 +89,7 @@ C: empty [ t length ] [ object>> t eq? ] must-fail-with [ "" ] -[ "IN: classes.tuple.test TUPLE: constructor-test ; C: constructor-test" eval word name>> ] unit-test +[ "IN: classes.tuple.test TUPLE: constructor-test ; C: constructor-test" (( -- )) eval word name>> ] unit-test TUPLE: size-test a b c d ; @@ -102,7 +102,7 @@ GENERIC: ( a -- b ) TUPLE: yo-momma ; -[ ] [ "IN: classes.tuple.tests C: yo-momma" eval ] unit-test +[ ] [ "IN: classes.tuple.tests C: yo-momma" (( -- )) eval ] unit-test [ f ] [ \ generic? ] unit-test @@ -204,7 +204,7 @@ C: erg's-reshape-problem : cons-test-1 ( -- tuple ) \ erg's-reshape-problem new ; : cons-test-2 ( a b c d -- tuple ) \ erg's-reshape-problem boa ; -[ ] [ "IN: classes.tuple.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: erg's-reshape-problem a b c d e f ;" (( -- )) eval ] unit-test [ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test @@ -281,13 +281,13 @@ test-server-slot-values ] unit-test [ - "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval + "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" (( -- )) eval ] must-fail ! Dynamically changing inheritance hierarchy TUPLE: electronic-device ; -[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ;" (( -- )) eval ] unit-test [ f ] [ electronic-device laptop class<= ] unit-test [ t ] [ server electronic-device class<= ] unit-test @@ -303,17 +303,17 @@ TUPLE: electronic-device ; [ f ] [ "server" get laptop? ] unit-test [ t ] [ "server" get server? ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ;" (( -- )) eval ] unit-test [ f ] [ "laptop" get electronic-device? ] unit-test [ t ] [ "laptop" get computer? ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ;" (( -- )) eval ] unit-test test-laptop-slot-values test-server-slot-values -[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ;" (( -- )) eval ] unit-test test-laptop-slot-values test-server-slot-values @@ -326,7 +326,7 @@ TUPLE: make-me-some-accessors voltage grounded? ; [ ] [ "laptop" get 220 >>voltage drop ] unit-test [ ] [ "server" get 110 >>voltage drop ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ;" (( -- )) eval ] unit-test test-laptop-slot-values test-server-slot-values @@ -334,7 +334,7 @@ test-server-slot-values [ 220 ] [ "laptop" get voltage>> ] unit-test [ 110 ] [ "server" get voltage>> ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ;" (( -- )) eval ] unit-test test-laptop-slot-values test-server-slot-values @@ -343,7 +343,7 @@ test-server-slot-values [ 110 ] [ "server" get voltage>> ] unit-test ! Reshaping superclass and subclass simultaneously -[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ;" (( -- )) eval ] unit-test test-laptop-slot-values test-server-slot-values @@ -364,11 +364,11 @@ C: test2 test-a/b -[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" (( -- )) eval ] unit-test test-a/b -[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" (( -- )) eval ] unit-test test-a/b @@ -393,19 +393,19 @@ T{ move-up-2 f "a" "b" "c" } "move-up" set test-move-up -[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" (( -- )) eval ] unit-test test-move-up -[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" (( -- )) eval ] unit-test test-move-up -[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" (( -- )) eval ] unit-test test-move-up -[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" (( -- )) eval ] unit-test ! Constructors must be recompiled when changing superclass TUPLE: constructor-update-1 xxx ; @@ -416,7 +416,7 @@ C: constructor-update-2 { 3 1 } [ ] must-infer-as -[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" (( -- )) eval ] unit-test { 5 1 } [ ] must-infer-as @@ -431,7 +431,7 @@ UNION: redefinition-problem' redefinition-problem integer ; TUPLE: redefinition-problem-2 ; -"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval +"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" (( -- )) eval [ t ] [ 3 redefinition-problem'? ] unit-test @@ -472,7 +472,7 @@ USE: vocabs ] with-compilation-unit ] unit-test -[ "USE: words T{ word }" eval ] +[ "USE: words T{ word }" (( -- )) eval ] [ error>> T{ no-method f word new } = ] must-fail-with @@ -485,7 +485,7 @@ must-fail-with [ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test -: accessor-exists? ( class name -- ? ) +: accessor-exists? ( name -- ? ) [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip ">>" append "accessors" lookup method >boolean ; @@ -520,13 +520,13 @@ TUPLE: another-forget-accessors-test ; [ f ] [ t parser-notes? [ [ - "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval + "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" (( -- )) eval ] with-string-writer empty? ] with-variable ] unit-test ! Missing error check -[ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail +[ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" (( -- )) eval ] must-fail ! Class forget messyness TUPLE: subclass-forget-test ; @@ -535,7 +535,7 @@ TUPLE: subclass-forget-test-1 < subclass-forget-test ; TUPLE: subclass-forget-test-2 < subclass-forget-test ; TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ; -[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval ] unit-test +[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" (( -- )) eval ] unit-test [ { subclass-forget-test-2 } ] [ subclass-forget-test-2 class-usages ] @@ -549,7 +549,7 @@ unit-test [ f ] [ subclass-forget-test-2 tuple-class? ] unit-test [ subclass-forget-test-3 new ] must-fail -[ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" eval ] must-fail +[ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" (( -- )) eval ] must-fail ! More DEFER: subclass-reset-test @@ -562,11 +562,11 @@ GENERIC: break-me ( obj -- ) [ ] [ [ M\ integer break-me forget ] with-compilation-unit ] unit-test [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test ;" "subclass-reset-test" parse-stream drop ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" eval ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" eval ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" (( -- )) eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" (( -- )) eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" (( -- )) eval ] unit-test -[ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" (( -- )) eval ] unit-test [ ] [ "IN: classes.tuple.tests : subclass-reset-test ( -- ) ;" "subclass-reset-test" parse-stream drop ] unit-test @@ -576,7 +576,7 @@ GENERIC: break-me ( obj -- ) [ t ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test -[ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" (( -- )) eval ] unit-test [ f ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test @@ -632,7 +632,7 @@ TUPLE: reshape-test x ; T{ reshape-test f "hi" } "tuple" set -[ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" (( -- )) eval ] unit-test [ f ] [ \ reshape-test \ (>>x) method ] unit-test @@ -640,11 +640,11 @@ T{ reshape-test f "hi" } "tuple" set [ "hi" ] [ "tuple" get x>> ] unit-test -[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" (( -- )) eval ] unit-test [ 0 ] [ "tuple" get x>> ] unit-test -[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" (( -- )) eval ] unit-test [ 0 ] [ "tuple" get x>> ] unit-test @@ -660,20 +660,20 @@ ERROR: error-class-test a b c ; [ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test [ f ] [ \ error-class-test "inline" word-prop ] unit-test -[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval ] +[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" (( -- )) eval ] [ error>> error>> redefine-error? ] must-fail-with DEFER: error-y [ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test -[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval ] unit-test +[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" (( -- )) eval ] unit-test [ f ] [ \ error-y tuple-class? ] unit-test [ t ] [ \ error-y generic? ] unit-test -[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" (( -- )) eval ] unit-test [ t ] [ \ error-y tuple-class? ] unit-test @@ -694,7 +694,7 @@ DEFER: error-y ] unit-test [ ] [ - "IN: sequences TUPLE: reversed { seq read-only } ;" eval + "IN: sequences TUPLE: reversed { seq read-only } ;" (( -- )) eval ] unit-test TUPLE: bogus-hashcode-1 x ; @@ -735,14 +735,14 @@ SLOT: kex DEFER: redefine-tuple-twice -[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" (( -- )) eval ] unit-test [ t ] [ \ redefine-tuple-twice symbol? ] unit-test -[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval ] unit-test +[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" (( -- )) eval ] unit-test [ t ] [ \ redefine-tuple-twice deferred? ] unit-test -[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" (( -- )) eval ] unit-test -[ t ] [ \ redefine-tuple-twice symbol? ] unit-test \ No newline at end of file +[ t ] [ \ redefine-tuple-twice symbol? ] unit-test diff --git a/core/classes/union/union-tests.factor b/core/classes/union/union-tests.factor index 57b742595f..47f726c03b 100644 --- a/core/classes/union/union-tests.factor +++ b/core/classes/union/union-tests.factor @@ -26,13 +26,13 @@ M: union-1 generic-update-test drop "union-1" ; [ t ] [ union-1 number class<= ] unit-test [ "union-1" ] [ 1.0 generic-update-test ] unit-test -"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" eval +"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" (( -- )) eval [ t ] [ bignum union-1 class<= ] unit-test [ f ] [ union-1 number class<= ] unit-test [ "union-1" ] [ { 1.0 } generic-update-test ] unit-test -"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" eval +"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" (( -- )) eval [ f ] [ union-1 union-class? ] unit-test [ t ] [ union-1 predicate-class? ] unit-test @@ -58,7 +58,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ; [ t ] [ fixnum redefine-bug-2 class<= ] unit-test [ t ] [ quotation redefine-bug-2 class<= ] unit-test -[ ] [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" eval ] unit-test +[ ] [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" (( -- )) eval ] unit-test [ t ] [ bignum redefine-bug-1 class<= ] unit-test [ f ] [ fixnum redefine-bug-2 class<= ] unit-test diff --git a/core/compiler/units/units-tests.factor b/core/compiler/units/units-tests.factor index 464e17025d..d3a390dc56 100644 --- a/core/compiler/units/units-tests.factor +++ b/core/compiler/units/units-tests.factor @@ -56,6 +56,6 @@ observer add-definition-observer DEFER: nesting-test -[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" eval ] unit-test +[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" (( -- )) eval ] unit-test -observer remove-definition-observer \ No newline at end of file +observer remove-definition-observer diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index f28332353e..d0a7b28bc6 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -65,11 +65,11 @@ M: number union-containment drop 2 ; [ 2 ] [ 1.0 union-containment ] unit-test ! Testing recovery from bad method definitions -"IN: generic.tests GENERIC: unhappy ( x -- x )" eval +"IN: generic.tests GENERIC: unhappy ( x -- x )" (( -- )) eval [ - "IN: generic.tests M: dictionary unhappy ;" eval + "IN: generic.tests M: dictionary unhappy ;" (( -- )) eval ] must-fail -[ ] [ "IN: generic.tests GENERIC: unhappy ( x -- x )" eval ] unit-test +[ ] [ "IN: generic.tests GENERIC: unhappy ( x -- x )" (( -- )) eval ] unit-test GENERIC# complex-combination 1 ( a b -- c ) M: string complex-combination drop ; @@ -177,7 +177,7 @@ M: f generic-forget-test-3 ; [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test -[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" eval ] unit-test +[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" (( -- )) eval ] unit-test [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test @@ -193,7 +193,7 @@ M: integer a-generic a-word ; [ t ] [ "m" get \ a-word usage memq? ] unit-test -[ ] [ "IN: generic.tests : a-generic ( -- ) ;" eval ] unit-test +[ ] [ "IN: generic.tests : a-generic ( -- ) ;" (( -- )) eval ] unit-test [ f ] [ "m" get \ a-word usage memq? ] unit-test @@ -207,25 +207,25 @@ M: integer a-generic a-word ; M: boii jeah ; GENERIC: jeah* ( a -- b ) M: boii jeah* jeah ; - "> eval + "> (( -- )) eval <" IN: compiler.tests FORGET: boii - "> eval + "> (( -- )) eval <" IN: compiler.tests TUPLE: boii ; M: boii jeah ; - "> eval + "> (( -- )) eval ] unit-test ! call-next-method cache test GENERIC: c-n-m-cache ( a -- b ) ! Force it to be unoptimized -M: fixnum c-n-m-cache { } [ ] like call call-next-method ; +M: fixnum c-n-m-cache { } [ ] like call( -- ) call-next-method ; M: integer c-n-m-cache 1 + ; M: number c-n-m-cache ; @@ -244,4 +244,4 @@ GENERIC: move-method-generic ( a -- b ) [ ] [ "IN: generic.tests.a" "move-method-test-1" parse-stream drop ] unit-test -[ { string } ] [ \ move-method-generic order ] unit-test \ No newline at end of file +[ { string } ] [ \ move-method-generic order ] unit-test diff --git a/core/generic/standard/standard-tests.factor b/core/generic/standard/standard-tests.factor index a6269135f4..420dd16991 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/standard/standard-tests.factor @@ -66,7 +66,7 @@ M: circle area radius>> sq pi * ; GENERIC: perimiter ( shape -- n ) -: rectangle-perimiter ( n -- n ) + 2 * ; +: rectangle-perimiter ( l w -- n ) + 2 * ; M: rectangle perimiter [ width>> ] [ height>> ] bi diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor index 995c7e6064..670c21d6ff 100644 --- a/core/memory/memory-tests.factor +++ b/core/memory/memory-tests.factor @@ -15,7 +15,7 @@ IN: memory.tests [ [ ] instances ] must-infer ! Code GC wasn't kicking in when needed -: leak-step ( -- ) 800000 f 1quotation call drop ; +: leak-step ( -- ) 800000 f 1quotation call( -- obj ) drop ; : leak-loop ( -- ) 100 [ leak-step ] times ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 9e1fcb95bd..491bc1884a 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -10,43 +10,43 @@ IN: parser.tests [ [ 1 [ 2 [ 3 ] 4 ] 5 ] - [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ] + [ "1\n[\n2\n[\n3\n]\n4\n]\n5" (( -- a b c )) eval ] unit-test [ t t f f ] - [ "t t f f" eval ] + [ "t t f f" (( -- ? ? ? ? )) eval ] unit-test [ "hello world" ] - [ "\"hello world\"" eval ] + [ "\"hello world\"" (( -- string )) eval ] unit-test [ "\n\r\t\\" ] - [ "\"\\n\\r\\t\\\\\"" eval ] + [ "\"\\n\\r\\t\\\\\"" (( -- string )) eval ] unit-test [ "hello world" ] [ "IN: parser.tests : hello ( -- str ) \"hello world\" ;" - eval "USE: parser.tests hello" eval + (( -- )) eval "USE: parser.tests hello" (( -- string )) eval ] unit-test [ ] - [ "! This is a comment, people." eval ] + [ "! This is a comment, people." (( -- )) eval ] unit-test ! Test escapes [ " " ] - [ "\"\\u000020\"" eval ] + [ "\"\\u000020\"" (( -- string )) eval ] unit-test [ "'" ] - [ "\"\\u000027\"" eval ] + [ "\"\\u000027\"" (( -- string )) eval ] unit-test ! Test EOL comments in multiline strings. - [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test + [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" (( -- string )) eval ] unit-test [ word ] [ \ f class ] unit-test @@ -68,7 +68,7 @@ IN: parser.tests [ \ baz "declared-effect" word-prop terminated?>> ] unit-test - [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test + [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" (( -- )) eval ] unit-test [ t ] [ "effect-parsing-test" "parser.tests" lookup @@ -79,14 +79,14 @@ IN: parser.tests [ \ effect-parsing-test "declared-effect" word-prop ] unit-test ! Funny bug - [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval ] unit-test + [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." (( -- n )) eval ] unit-test - [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail + [ "IN: parser.tests : missing-- ( a b ) ;" (( -- )) eval ] must-fail ! These should throw errors - [ "HEX: zzz" eval ] must-fail - [ "OCT: 999" eval ] must-fail - [ "BIN: --0" eval ] must-fail + [ "HEX: zzz" (( -- obj )) eval ] must-fail + [ "OCT: 999" (( -- obj )) eval ] must-fail + [ "BIN: --0" (( -- obj )) eval ] must-fail ! Another funny bug [ t ] [ @@ -102,14 +102,14 @@ IN: parser.tests ] unit-test DEFER: foo - "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval + "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" (( -- )) eval - [ ] [ "USE: parser.tests foo" eval ] unit-test + [ ] [ "USE: parser.tests foo" (( -- )) eval ] unit-test - "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval + "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" (( -- )) eval [ t ] [ - "USE: parser.tests \\ foo" eval + "USE: parser.tests \\ foo" (( -- word )) eval "foo" "parser.tests" lookup eq? ] unit-test @@ -269,12 +269,12 @@ IN: parser.tests ] unit-test [ ] [ - "IN: parser.tests : ( -- ) ; : bogus ( -- ) ;" + "IN: parser.tests : ( -- ) ; : bogus ( -- error ) ;" "bogus-error" parse-stream drop ] unit-test [ ] [ - "IN: parser.tests TUPLE: bogus-error ; C: bogus-error : bogus ( -- ) ;" + "IN: parser.tests TUPLE: bogus-error ; C: bogus-error : bogus ( -- error ) ;" "bogus-error" parse-stream drop ] unit-test @@ -339,16 +339,16 @@ IN: parser.tests ] [ error>> error>> error>> redefine-error? ] must-fail-with [ ] [ - "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval + "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" (( -- )) eval ] unit-test [ - "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval + "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" (( -- )) eval ] must-fail ] with-file-vocabs [ ] [ - "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval + "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" (( -- )) eval ] unit-test [ t ] [ @@ -422,31 +422,31 @@ IN: parser.tests ] unit-test [ - "USE: this-better-not-exist" eval + "USE: this-better-not-exist" (( -- )) eval ] must-fail -[ ": foo ;" eval ] [ error>> error>> no-current-vocab? ] must-fail-with +[ ": foo ;" (( -- )) eval ] [ error>> error>> no-current-vocab? ] must-fail-with -[ 92 ] [ "CHAR: \\" eval ] unit-test -[ 92 ] [ "CHAR: \\\\" eval ] unit-test +[ 92 ] [ "CHAR: \\" (( -- n )) eval ] unit-test +[ 92 ] [ "CHAR: \\\\" (( -- n )) eval ] unit-test [ ] [ { "IN: parser.tests" - "USING: math arrays ;" - "GENERIC: change-combination ( a -- b )" - "M: integer change-combination 1 ;" - "M: array change-combination 2 ;" + "USING: math arrays kernel ;" + "GENERIC: change-combination ( obj a -- b )" + "M: integer change-combination 2drop 1 ;" + "M: array change-combination 2drop 2 ;" } "\n" join "change-combination-test" parse-stream drop ] unit-test [ ] [ { "IN: parser.tests" - "USING: math arrays ;" - "GENERIC# change-combination 1 ( a -- b )" - "M: integer change-combination 1 ;" - "M: array change-combination 2 ;" + "USING: math arrays kernel ;" + "GENERIC# change-combination 1 ( obj a -- b )" + "M: integer change-combination 2drop 1 ;" + "M: array change-combination 2drop 2 ;" } "\n" join "change-combination-test" parse-stream drop ] unit-test @@ -463,7 +463,7 @@ IN: parser.tests ] unit-test [ [ ] ] [ - "IN: parser.tests : staging-problem-test-1 ( -- ) 1 ; : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" + "IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -472,7 +472,7 @@ IN: parser.tests [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test [ [ ] ] [ - "IN: parser.tests << : staging-problem-test-1 ( -- ) 1 ; >> : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" + "IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -480,10 +480,10 @@ IN: parser.tests [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test -[ "DEFER: blahy" eval ] [ error>> error>> no-current-vocab? ] must-fail-with +[ "DEFER: blahy" (( -- )) eval ] [ error>> error>> no-current-vocab? ] must-fail-with [ - "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" eval + "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" (( -- )) eval ] [ error>> staging-violation? ] must-fail-with @@ -491,12 +491,12 @@ IN: parser.tests ! Bogus error message DEFER: blahy -[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval ] +[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" (( -- )) eval ] [ error>> error>> def>> \ blahy eq? ] must-fail-with [ ] [ f lexer set f file set "Hello world" note. ] unit-test -[ "CHAR: \\u9999999999999" eval ] must-fail +[ "CHAR: \\u9999999999999" (( -- n )) eval ] must-fail SYMBOLS: a b c ; @@ -506,15 +506,15 @@ SYMBOLS: a b c ; DEFER: blah -[ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval ] unit-test -[ ] [ "IN: parser.tests SYMBOLS: blah ;" eval ] unit-test +[ ] [ "IN: parser.tests GENERIC: blah ( -- )" (( -- )) eval ] unit-test +[ ] [ "IN: parser.tests SYMBOLS: blah ;" (( -- )) eval ] unit-test [ f ] [ \ blah generic? ] unit-test [ t ] [ \ blah symbol? ] unit-test DEFER: blah1 -[ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval ] +[ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" (( -- )) eval ] [ error>> error>> def>> \ blah1 eq? ] must-fail-with @@ -545,10 +545,10 @@ EXCLUDE: qualified.tests.bar => x ; [ 3 ] [ x ] unit-test [ 4 ] [ y ] unit-test -[ "IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ] +[ "IN: qualified.tests FROM: qualified.tests => doesnotexist ;" (( -- )) eval ] [ error>> no-word-error? ] must-fail-with -[ "IN: qualified.tests RENAME: doesnotexist qualified.tests => blahx" eval ] +[ "IN: qualified.tests RENAME: doesnotexist qualified.tests => blahx" (( -- )) eval ] [ error>> no-word-error? ] must-fail-with ! Two similar bugs diff --git a/core/slots/slots-tests.factor b/core/slots/slots-tests.factor index 767cec4830..d76f1ffb07 100644 --- a/core/slots/slots-tests.factor +++ b/core/slots/slots-tests.factor @@ -25,12 +25,12 @@ TUPLE: hello length ; [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test ! See if declarations are cleared on redefinition -[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only } ;" eval ] unit-test +[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only } ;" (( -- )) eval ] unit-test [ t ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test -[ ] [ "IN: slots.tests TUPLE: r/w-test foo ;" eval ] unit-test +[ ] [ "IN: slots.tests TUPLE: r/w-test foo ;" (( -- )) eval ] unit-test [ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 87531caee4..b43ab08c2c 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -143,7 +143,7 @@ IN: vocabs.loader.tests forget-junk [ { } ] [ - "IN: xabbabbja" eval "xabbabbja" vocab-files + "IN: xabbabbja" (( -- )) eval "xabbabbja" vocab-files ] unit-test [ "xabbabbja" forget-vocab ] with-compilation-unit diff --git a/core/words/alias/alias-tests.factor b/core/words/alias/alias-tests.factor index 0278a4d4b9..e0bfba5cc1 100644 --- a/core/words/alias/alias-tests.factor +++ b/core/words/alias/alias-tests.factor @@ -2,5 +2,5 @@ USING: math eval tools.test effects ; IN: words.alias.tests ALIAS: foo + -[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval ] unit-test -[ (( -- value )) ] [ \ foo stack-effect ] unit-test \ No newline at end of file +[ ] [ "IN: words.alias.tests CONSTANT: foo 5" (( -- )) eval ] unit-test +[ (( -- value )) ] [ \ foo stack-effect ] unit-test diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 305541119b..7eb1025039 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -6,7 +6,7 @@ IN: words.tests [ 4 ] [ [ - "poo" "words.tests" create [ 2 2 + ] define + "poo" "words.tests" create [ 2 2 + ] (( -- n )) define-declared ] with-compilation-unit "poo" "words.tests" lookup execute ] unit-test @@ -51,7 +51,7 @@ SYMBOL: a-symbol ! See if redefining a generic as a colon def clears some ! word props. GENERIC: testing ( a -- b ) -"IN: words.tests : testing ( -- ) ;" eval +"IN: words.tests : testing ( -- ) ;" (( -- )) eval [ f ] [ \ testing generic? ] unit-test @@ -88,7 +88,7 @@ DEFER: calls-a-gensym [ \ calls-a-gensym gensym dup "x" set 1quotation - define + (( x -- x )) define-declared ] with-compilation-unit ] unit-test @@ -116,10 +116,10 @@ DEFER: x [ ] [ "no-loc" "words.tests" create drop ] unit-test [ f ] [ "no-loc" "words.tests" lookup where ] unit-test -[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval ] unit-test +[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" (( -- )) eval ] unit-test [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test -[ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test +[ ] [ "IN: words.tests : test-last ( -- ) ;" (( -- )) eval ] unit-test [ "test-last" ] [ word name>> ] unit-test ! regression @@ -146,15 +146,15 @@ SYMBOL: quot-uses-b [ forget ] with-compilation-unit ] when* -[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval ] +[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" (( -- )) eval ] [ error>> undefined? ] must-fail-with [ ] [ - "IN: words.tests GENERIC: symbol-generic ( -- )" eval + "IN: words.tests GENERIC: symbol-generic ( -- )" (( -- )) eval ] unit-test [ ] [ - "IN: words.tests SYMBOL: symbol-generic" eval + "IN: words.tests SYMBOL: symbol-generic" (( -- )) eval ] unit-test [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test @@ -174,14 +174,14 @@ SYMBOL: quot-uses-b [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test ! Regressions -[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" (( -- )) eval ] unit-test [ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" (( -- )) eval ] unit-test [ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" (( -- )) eval ] unit-test [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test -[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test +[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" (( -- )) eval ] unit-test [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test [ { } ] From dba4c0d58952b196e5eecb681dd8a0e23d939d5b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 12:46:04 -0500 Subject: [PATCH 6/7] fixing compiler errors in basis --- basis/compiler/tests/folding.factor | 4 +-- basis/compiler/tests/redefine1.factor | 12 ++++---- basis/compiler/tests/redefine10.factor | 4 +-- basis/compiler/tests/redefine11.factor | 2 +- basis/compiler/tests/redefine12.factor | 2 +- basis/compiler/tests/redefine2.factor | 2 +- basis/compiler/tests/redefine3.factor | 2 +- basis/compiler/tests/redefine4.factor | 2 +- basis/compiler/tests/redefine5.factor | 4 +-- basis/compiler/tests/redefine6.factor | 4 +-- basis/compiler/tests/redefine7.factor | 4 +-- basis/compiler/tests/redefine8.factor | 4 +-- basis/compiler/tests/redefine9.factor | 4 +-- basis/compiler/tests/simple.factor | 2 +- .../tree/cleanup/cleanup-tests.factor | 4 +-- .../normalization/normalization-tests.factor | 12 ++++---- .../tree/propagation/propagation-tests.factor | 4 +-- .../tree/recursive/recursive-tests.factor | 2 +- basis/delegate/delegate-tests.factor | 12 ++++---- basis/fry/fry-tests.factor | 2 +- basis/help/crossref/crossref-tests.factor | 4 +-- .../help/definitions/definitions-tests.factor | 2 +- basis/help/syntax/syntax-tests.factor | 4 +-- basis/help/topics/topics-tests.factor | 2 +- basis/listener/listener-tests.factor | 4 +-- basis/locals/locals-tests.factor | 28 +++++++++---------- basis/macros/macros-tests.factor | 4 +-- basis/memoize/memoize-tests.factor | 4 +-- basis/peg/ebnf/ebnf-tests.factor | 10 +++---- basis/prettyprint/prettyprint-tests.factor | 26 ++++++++--------- basis/regexp/parser/parser-tests.factor | 2 +- basis/regexp/regexp-tests.factor | 6 ++-- .../stack-checker/stack-checker-tests.factor | 6 ++-- .../annotations/annotations-tests.factor | 4 +-- 34 files changed, 96 insertions(+), 98 deletions(-) diff --git a/basis/compiler/tests/folding.factor b/basis/compiler/tests/folding.factor index d6868fd034..c2de317e83 100644 --- a/basis/compiler/tests/folding.factor +++ b/basis/compiler/tests/folding.factor @@ -12,7 +12,7 @@ IN: compiler.tests IN: compiler.tests.folding GENERIC: foldable-generic ( a -- b ) foldable M: integer foldable-generic f ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -20,7 +20,7 @@ IN: compiler.tests USING: math arrays ; IN: compiler.tests.folding : fold-test ( -- x ) 10 foldable-generic ; - "> eval + "> (( -- )) eval ] unit-test [ t ] [ diff --git a/basis/compiler/tests/redefine1.factor b/basis/compiler/tests/redefine1.factor index 0875967bd2..db45c6af17 100644 --- a/basis/compiler/tests/redefine1.factor +++ b/basis/compiler/tests/redefine1.factor @@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ; [ 6 ] [ method-redefine-test-1 ] unit-test -[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval ] unit-test +[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" (( -- )) eval ] unit-test [ 7 ] [ method-redefine-test-1 ] unit-test @@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ; [ 6 ] [ method-redefine-test-2 ] unit-test -[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval ] unit-test +[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" (( -- )) eval ] unit-test [ 7 ] [ method-redefine-test-2 ] unit-test @@ -43,10 +43,10 @@ M: integer method-redefine-generic-2 3 + ; [ t ] [ \ hey optimized>> ] unit-test [ t ] [ \ there optimized>> ] unit-test -[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test +[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" (( -- )) eval ] unit-test [ f ] [ \ hey optimized>> ] unit-test [ f ] [ \ there optimized>> ] unit-test -[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test +[ ] [ "IN: compiler.tests : hey ( -- ) ;" (( -- )) eval ] unit-test [ t ] [ \ there optimized>> ] unit-test : good ( -- ) ; @@ -59,7 +59,7 @@ M: integer method-redefine-generic-2 3 + ; [ f ] [ \ good compiled-usage assoc-empty? ] unit-test -[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test +[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" (( -- )) eval ] unit-test [ f ] [ \ good optimized>> ] unit-test [ f ] [ \ bad optimized>> ] unit-test @@ -67,7 +67,7 @@ M: integer method-redefine-generic-2 3 + ; [ t ] [ \ good compiled-usage assoc-empty? ] unit-test -[ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test +[ ] [ "IN: compiler.tests : good ( -- ) ;" (( -- )) eval ] unit-test [ t ] [ \ good optimized>> ] unit-test [ t ] [ \ bad optimized>> ] unit-test diff --git a/basis/compiler/tests/redefine10.factor b/basis/compiler/tests/redefine10.factor index 8a6fb8a313..de14a068ab 100644 --- a/basis/compiler/tests/redefine10.factor +++ b/basis/compiler/tests/redefine10.factor @@ -13,7 +13,7 @@ IN: compiler.tests MIXIN: my-mixin INSTANCE: fixnum my-mixin : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -21,7 +21,7 @@ IN: compiler.tests USE: math IN: compiler.tests.redefine10 INSTANCE: float my-mixin - "> eval + "> (( -- )) eval ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine11.factor b/basis/compiler/tests/redefine11.factor index 18b1a3a430..2135d31606 100644 --- a/basis/compiler/tests/redefine11.factor +++ b/basis/compiler/tests/redefine11.factor @@ -17,7 +17,7 @@ IN: compiler.tests M: my-mixin my-generic drop 0 ; M: object my-generic drop 1 ; : my-inline ( -- b ) { } my-generic ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ diff --git a/basis/compiler/tests/redefine12.factor b/basis/compiler/tests/redefine12.factor index 87dc4596e9..2ff16f0cca 100644 --- a/basis/compiler/tests/redefine12.factor +++ b/basis/compiler/tests/redefine12.factor @@ -15,6 +15,6 @@ M: object g drop t ; TUPLE: jeah ; -[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval ] unit-test +[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" (( -- )) eval ] unit-test [ f ] [ T{ jeah } h ] unit-test diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor index 5a28b28261..b61f53d14c 100644 --- a/basis/compiler/tests/redefine2.factor +++ b/basis/compiler/tests/redefine2.factor @@ -5,7 +5,7 @@ arrays words assocs eval words.symbol ; DEFER: redefine2-test -[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test +[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" (( -- )) eval ] unit-test [ t ] [ \ redefine2-test symbol? ] unit-test diff --git a/basis/compiler/tests/redefine3.factor b/basis/compiler/tests/redefine3.factor index b25b5a1a5e..0835f8cfba 100644 --- a/basis/compiler/tests/redefine3.factor +++ b/basis/compiler/tests/redefine3.factor @@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ; [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test -[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval ] unit-test +[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" (( -- )) eval ] unit-test [ "wake up" ] [ sheeple-test ] unit-test [ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor index 2f21777801..29d5da6394 100644 --- a/basis/compiler/tests/redefine4.factor +++ b/basis/compiler/tests/redefine4.factor @@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ; [ "" ] [ [ declaration-test ] with-string-writer ] unit-test -[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval ] unit-test +[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" (( -- )) eval ] unit-test [ "X" ] [ [ declaration-test ] with-string-writer ] unit-test diff --git a/basis/compiler/tests/redefine5.factor b/basis/compiler/tests/redefine5.factor index ac1619b857..8db28b52d5 100644 --- a/basis/compiler/tests/redefine5.factor +++ b/basis/compiler/tests/redefine5.factor @@ -14,7 +14,7 @@ IN: compiler.tests GENERIC: my-generic ( a -- b ) M: object my-generic [ <=> ] sort ; : my-inline ( a -- b ) my-generic ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -23,7 +23,7 @@ IN: compiler.tests IN: compiler.tests.redefine5 TUPLE: my-tuple ; M: my-tuple my-generic drop 0 ; - "> eval + "> (( -- )) eval ] unit-test [ 0 ] [ diff --git a/basis/compiler/tests/redefine6.factor b/basis/compiler/tests/redefine6.factor index 73225c55b8..df9c35dc42 100644 --- a/basis/compiler/tests/redefine6.factor +++ b/basis/compiler/tests/redefine6.factor @@ -14,7 +14,7 @@ IN: compiler.tests MIXIN: my-mixin M: my-mixin my-generic drop 0 ; : my-inline ( a -- b ) { my-mixin } declare my-generic ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -24,7 +24,7 @@ IN: compiler.tests TUPLE: my-tuple ; M: my-tuple my-generic drop 1 ; INSTANCE: my-tuple my-mixin - "> eval + "> (( -- )) eval ] unit-test [ 1 ] [ diff --git a/basis/compiler/tests/redefine7.factor b/basis/compiler/tests/redefine7.factor index 164a2e3831..fd6d5a9564 100644 --- a/basis/compiler/tests/redefine7.factor +++ b/basis/compiler/tests/redefine7.factor @@ -13,7 +13,7 @@ IN: compiler.tests MIXIN: my-mixin INSTANCE: fixnum my-mixin : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -21,7 +21,7 @@ IN: compiler.tests USE: math IN: compiler.tests.redefine7 INSTANCE: float my-mixin - "> eval + "> (( -- )) eval ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine8.factor b/basis/compiler/tests/redefine8.factor index c8b3377632..8a8d832dbf 100644 --- a/basis/compiler/tests/redefine8.factor +++ b/basis/compiler/tests/redefine8.factor @@ -16,7 +16,7 @@ IN: compiler.tests ! We add the bogus quotation here to hinder inlining ! since otherwise we cannot trigger this bug. M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -24,7 +24,7 @@ IN: compiler.tests USE: math IN: compiler.tests.redefine8 INSTANCE: float my-mixin - "> eval + "> (( -- )) eval ] unit-test [ 2.0 ] [ diff --git a/basis/compiler/tests/redefine9.factor b/basis/compiler/tests/redefine9.factor index 7b0f8a2e9c..63cf002cc9 100644 --- a/basis/compiler/tests/redefine9.factor +++ b/basis/compiler/tests/redefine9.factor @@ -16,7 +16,7 @@ IN: compiler.tests ! We add the bogus quotation here to hinder inlining ! since otherwise we cannot trigger this bug. M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ; - "> eval + "> (( -- )) eval ] unit-test [ ] [ @@ -25,7 +25,7 @@ IN: compiler.tests IN: compiler.tests.redefine9 TUPLE: my-tuple ; INSTANCE: my-tuple my-mixin - "> eval + "> (( -- )) eval ] unit-test [ diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor index d53b864b06..23fee84ae2 100644 --- a/basis/compiler/tests/simple.factor +++ b/basis/compiler/tests/simple.factor @@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ; 10 [ [ "compiler.tests.foo" forget-vocab ] with-compilation-unit [ t ] [ - "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval + "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" (( -- obj )) eval ] unit-test ] times diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 7de092d84a..c533f78916 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ; [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2) ] if ; inline recursive -: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline +: annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline [ f ] [ [ { bignum } declare annotate-entry-test-2 ] @@ -519,4 +519,4 @@ cell-bits 32 = [ [ t ] [ [ { integer integer } declare + drop ] { + +-integer-integer } inlined? -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/compiler/tree/normalization/normalization-tests.factor b/basis/compiler/tree/normalization/normalization-tests.factor index 5ac3c57abe..2097f4ebdd 100644 --- a/basis/compiler/tree/normalization/normalization-tests.factor +++ b/basis/compiler/tree/normalization/normalization-tests.factor @@ -17,7 +17,7 @@ sequences accessors tools.test kernel math ; [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test -: foo ( -- ) swap ; inline recursive +: foo ( a b -- b a ) swap ; inline recursive : recursive-inputs ( nodes -- n ) [ #recursive? ] find nip child>> first in-d>> length ; @@ -34,18 +34,18 @@ sequences accessors tools.test kernel math ; [ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test DEFER: bbb -: aaa ( x -- ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive -: bbb ( x -- ) [ drop 0 ] dip aaa ; inline recursive +: aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive +: bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive [ ] [ [ bbb ] test-normalization ] unit-test -: ccc ( -- ) ccc drop 1 ; inline recursive +: ccc ( obj -- 1 ) ccc drop 1 ; inline recursive [ ] [ [ ccc ] test-normalization ] unit-test DEFER: eee -: ddd ( -- ) eee ; inline recursive -: eee ( -- ) swap ddd ; inline recursive +: ddd ( a b -- a b ) eee ; inline recursive +: eee ( a b -- a b ) swap ddd ; inline recursive [ ] [ [ eee ] test-normalization ] unit-test diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 5dd647ae89..5b9b49811f 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -680,11 +680,11 @@ TUPLE: littledan-2 { from read-only } { to read-only } ; : (littledan-3-test) ( x -- ) length 1+ f (littledan-3-test) ; inline recursive -: littledan-3-test ( x -- ) +: littledan-3-test ( -- ) 0 f (littledan-3-test) ; inline [ ] [ [ littledan-3-test ] final-classes drop ] unit-test [ V{ 0 } ] [ [ { } length ] final-literals ] unit-test -[ V{ 1 } ] [ [ { } length 1+ f length ] final-literals ] unit-test \ No newline at end of file +[ V{ 1 } ] [ [ { } length 1+ f length ] final-literals ] unit-test diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor index d548d58bc6..971675d367 100644 --- a/basis/compiler/tree/recursive/recursive-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -57,7 +57,7 @@ compiler.tree.combinators ; \ (each-integer) label-is-loop? ] unit-test -: loop-test-2 ( a -- ) +: loop-test-2 ( a b -- a' ) dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive [ t ] [ diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index cf822b40a3..34ff4ba079 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -35,7 +35,7 @@ M: hello bing hello-test ; [ 3 ] [ 1 0 2 whoa ] unit-test [ 3 ] [ 1 0 f 2 whoa ] unit-test -[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval ] times ] unit-test +[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" (( -- )) eval ] times ] unit-test [ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } ] [ baz protocol-consult ] unit-test [ H{ } ] [ bee protocol-consult ] unit-test @@ -63,22 +63,22 @@ CONSULT: beta hey value>> 1- ; [ 0 ] [ 1 three ] unit-test [ { hey } ] [ alpha protocol-users ] unit-test [ { hey } ] [ beta protocol-users ] unit-test -[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval ] unit-test +[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" (( -- )) eval ] unit-test [ f ] [ hey \ two method ] unit-test [ f ] [ hey \ four method ] unit-test -[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval ] unit-test +[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" (( -- )) eval ] unit-test [ { hey } ] [ alpha protocol-users ] unit-test [ { hey } ] [ beta protocol-users ] unit-test [ 2 ] [ 1 one ] unit-test [ 0 ] [ 1 two ] unit-test [ 0 ] [ 1 three ] unit-test [ 0 ] [ 1 four ] unit-test -[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval ] unit-test +[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" (( -- )) eval ] unit-test [ 2 ] [ 1 one ] unit-test [ -1 ] [ 1 two ] unit-test [ -1 ] [ 1 three ] unit-test [ -1 ] [ 1 four ] unit-test -[ ] [ "IN: delegate.tests FORGET: alpha" eval ] unit-test +[ ] [ "IN: delegate.tests FORGET: alpha" (( -- )) eval ] unit-test [ f ] [ hey \ one method ] unit-test TUPLE: slot-protocol-test-1 a b ; @@ -196,4 +196,4 @@ DEFER: seq-delegate seq-delegate sequence-protocol \ protocol-consult word-prop key? -] unit-test \ No newline at end of file +] unit-test diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index d240e6f233..89fbaf31b6 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -56,7 +56,7 @@ sequences eval accessors ; 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call ] unit-test -[ "USING: fry locals.backend ; f '[ load-local _ ]" eval ] +[ "USING: fry locals.backend ; f '[ load-local _ ]" (( -- quot )) eval ] [ error>> >r/r>-in-fry-error? ] must-fail-with [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [ diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor index 2e01330d73..44122a3a64 100644 --- a/basis/help/crossref/crossref-tests.factor +++ b/basis/help/crossref/crossref-tests.factor @@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays io.streams.string continuations debugger compiler.units eval ; [ ] [ - "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval + "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" (( -- )) eval ] unit-test [ $subsection ] [ @@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ; ] unit-test [ ] [ - "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval + "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" (( -- )) eval ] unit-test [ ] [ diff --git a/basis/help/definitions/definitions-tests.factor b/basis/help/definitions/definitions-tests.factor index 7bb66eca02..783a95dd5c 100644 --- a/basis/help/definitions/definitions-tests.factor +++ b/basis/help/definitions/definitions-tests.factor @@ -32,7 +32,7 @@ IN: help.definitions.tests "hello" "help.definitions.tests" lookup "help" word-prop ] unit-test - [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval ] unit-test + [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" (( -- )) eval ] unit-test [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test diff --git a/basis/help/syntax/syntax-tests.factor b/basis/help/syntax/syntax-tests.factor index e7438edd4d..db94f53b01 100644 --- a/basis/help/syntax/syntax-tests.factor +++ b/basis/help/syntax/syntax-tests.factor @@ -4,12 +4,12 @@ IN: help.syntax.tests [ [ "foobar" ] [ - "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval + "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" (( -- )) eval "help.syntax.tests" vocab vocab-help ] unit-test [ { "foobar" } ] [ - "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval + "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" (( -- )) eval "help.syntax.tests" vocab vocab-help ] unit-test diff --git a/basis/help/topics/topics-tests.factor b/basis/help/topics/topics-tests.factor index f53bdee9c7..f4f17a10e5 100644 --- a/basis/help/topics/topics-tests.factor +++ b/basis/help/topics/topics-tests.factor @@ -29,7 +29,7 @@ SYMBOL: foo } "\n" join [ "testfile" source-file file set - eval + (( -- )) eval ] with-scope ] unit-test diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index 0616794939..12b639c262 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -25,7 +25,7 @@ SYNTAX: hello "Hi" print ; "\\ + 1 2 3 4" parse-interactive "cont" get continue-with ] ignore-errors - "USE: debugger :1" eval + "USE: debugger :1" (( -- quot )) eval ] callcc1 ] unit-test ] with-file-vocabs @@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ; [ [ ] [ - "IN: listener.tests : hello ( -- )\n\"world\" ;" parse-interactive + "IN: listener.tests : hello ( -- string )\n\"world\" ;" parse-interactive drop ] unit-test ] with-file-vocabs diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 5e61c1ddfd..42ea3322f1 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -261,7 +261,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" -[ ] [ new-definition eval ] unit-test +[ ] [ new-definition (( -- )) eval ] unit-test [ t ] [ [ \ a-word-with-locals see ] with-string-writer @@ -461,7 +461,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ "USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]" - eval call + (( -- )) eval call ] [ error>> >r/r>-in-fry-error? ] must-fail-with :: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline @@ -473,10 +473,10 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ f ] [ 2 funny-macro-test ] unit-test ! Some odd parser corner cases -[ "USE: locals [let" eval ] [ error>> unexpected-eof? ] must-fail-with -[ "USE: locals [let |" eval ] [ error>> unexpected-eof? ] must-fail-with -[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with -[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with +[ "USE: locals [let" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with +[ "USE: locals [let |" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with +[ "USE: locals [let | a" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with +[ "USE: locals [|" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with [ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test [ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test @@ -491,19 +491,19 @@ M:: integer lambda-method-forget-test ( a -- b ) ; [ 3 ] [ 3 [| a | \ a ] call ] unit-test -[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval ] must-fail +[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail -[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval ] must-fail +[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail -[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval ] must-fail +[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail -[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval ] must-fail +[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" (( -- )) eval ] must-fail -[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail +[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" (( -- )) eval ] must-fail -[ "USE: locals [| | { :> a } ]" eval ] must-fail +[ "USE: locals [| | { :> a } ]" (( -- )) eval ] must-fail -[ "USE: locals 3 :> a" eval ] must-fail +[ "USE: locals 3 :> a" (( -- )) eval ] must-fail [ 3 ] [ 3 [| | :> a a ] call ] unit-test @@ -584,4 +584,4 @@ M: integer ed's-bug neg ; :: ed's-test-case ( a -- b ) { [ a ed's-bug ] } && ; -[ t ] [ \ ed's-test-case optimized>> ] unit-test \ No newline at end of file +[ t ] [ \ ed's-test-case optimized>> ] unit-test diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor index 91aa6880e6..40b3d59b39 100644 --- a/basis/macros/macros-tests.factor +++ b/basis/macros/macros-tests.factor @@ -13,11 +13,11 @@ unit-test [ t ] [ \ see-test macro? ] unit-test [ t ] [ - "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval + "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup (( -- )) eval [ \ see-test see ] with-string-writer = ] unit-test [ f ] [ \ see-test macro? ] unit-test -[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test +[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" (( -- )) eval ] unit-test diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor index 54378bd37e..22b4406f32 100644 --- a/basis/memoize/memoize-tests.factor +++ b/basis/memoize/memoize-tests.factor @@ -9,7 +9,7 @@ MEMO: fib ( m -- n ) [ 89 ] [ 10 fib ] unit-test -[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail +[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" (( -- )) eval ] must-fail MEMO: see-test ( a -- b ) reverse ; @@ -17,7 +17,7 @@ MEMO: see-test ( a -- b ) reverse ; [ [ \ see-test see ] with-string-writer ] unit-test -[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test +[ ] [ "IN: memoize.tests : fib ( -- ) ;" (( -- )) eval ] unit-test [ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test diff --git a/basis/peg/ebnf/ebnf-tests.factor b/basis/peg/ebnf/ebnf-tests.factor index cc83a55c7e..cc414a798e 100644 --- a/basis/peg/ebnf/ebnf-tests.factor +++ b/basis/peg/ebnf/ebnf-tests.factor @@ -444,12 +444,12 @@ foo= 'd' "ad" parser4 ] unit-test -{ t } [ - "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF]" eval drop t +{ } [ + "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n' => [[ drop \"\n\" ]] EBNF] drop" (( -- )) eval ] unit-test [ - "USING: peg.ebnf ; " eval drop + "USING: peg.ebnf ; " (( -- )) eval drop ] must-fail { t } [ @@ -521,12 +521,12 @@ Tok = Spaces (Number | Special ) "\\" [EBNF foo="\\" EBNF] ] unit-test -[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail +[ "USE: peg.ebnf [EBNF EBNF]" (( -- )) eval ] must-fail [ <" USE: peg.ebnf [EBNF lol = a lol = b - EBNF] "> eval + EBNF] "> (( -- )) eval ] [ error>> [ redefined-rule? ] [ name>> "lol" = ] bi and ] must-fail-with diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 799d500c18..afec29ff61 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -90,7 +90,7 @@ unit-test [ \ blah see ] with-string-writer "\n" ?tail drop 6 tail* ] unit-test -: check-see ( expect name -- ) +: check-see ( expect name -- ? ) [ use [ clone ] change @@ -105,6 +105,7 @@ unit-test GENERIC: method-layout ( a -- b ) M: complex method-layout + drop "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ; @@ -116,8 +117,9 @@ M: object method-layout ; [ { - "USING: math prettyprint.tests ;" + "USING: kernel math prettyprint.tests ;" "M: complex method-layout" + " drop" " \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\"" " ;" "" @@ -180,15 +182,15 @@ DEFER: parse-error-file "string-layout-test" string-layout check-see ] unit-test -: narrow-test ( -- str ) +: narrow-test ( -- array ) { "USING: arrays combinators continuations kernel sequences ;" "IN: prettyprint.tests" - ": narrow-layout ( obj -- )" + ": narrow-layout ( obj1 obj2 -- obj3 )" " {" " { [ dup continuation? ] [ append ] }" " { [ dup not ] [ drop reverse ] }" - " { [ dup pair? ] [ delete ] }" + " { [ dup pair? ] [ [ delete ] keep ] }" " } cond ;" } ; @@ -196,7 +198,7 @@ DEFER: parse-error-file "narrow-layout" narrow-test check-see ] unit-test -: another-narrow-test ( -- str ) +: another-narrow-test ( -- array ) { "IN: prettyprint.tests" ": another-narrow-layout ( -- obj )" @@ -252,19 +254,15 @@ M: class-see-layout class-see-layout ; ! Regression [ t ] [ "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n" - dup eval + dup (( -- )) eval "generic-decl-test" "prettyprint.tests" lookup [ see ] with-string-writer = ] unit-test -[ [ + ] ] [ - [ \ + (step-into-execute) ] (remove-breakpoints) -] unit-test - -[ [ (step-into-execute) ] ] [ - [ (step-into-execute) ] (remove-breakpoints) -] unit-test +[ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test +[ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test + [ [ 2 2 + . ] ] [ [ 2 2 \ + (step-into-execute) . ] (remove-breakpoints) ] unit-test diff --git a/basis/regexp/parser/parser-tests.factor b/basis/regexp/parser/parser-tests.factor index 5ea9753fba..0e12014eef 100644 --- a/basis/regexp/parser/parser-tests.factor +++ b/basis/regexp/parser/parser-tests.factor @@ -4,7 +4,7 @@ IN: regexp.parser.tests : regexp-parses ( string -- ) [ [ ] ] dip '[ _ parse-regexp drop ] unit-test ; -: regexp-fails ( string -- ) +: regexp-fails ( string -- regexp ) '[ _ parse-regexp ] must-fail ; { diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2234386803..ae013a7719 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -262,11 +262,11 @@ IN: regexp-tests ! Comment inside a regular expression [ t ] [ "ac" "a(?#boo)c" matches? ] unit-test -[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test +[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" (( -- )) eval ] unit-test -[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test +[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" (( -- )) eval ] unit-test -[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test +[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" (( -- )) eval ] unit-test [ "ab" ] [ "ab" "(a|ab)(bc)?" first-match >string ] unit-test [ "abc" ] [ "abc" "(a|ab)(bc)?" first-match >string ] unit-test diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 117b6845b8..d8f61661d5 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -524,7 +524,7 @@ ERROR: custom-error ; { 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as -[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" eval ] unit-test +[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" (( -- )) eval ] unit-test [ 3 ] [ inference-invalidation-c ] unit-test @@ -536,7 +536,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ; \ inference-invalidation-d must-infer -[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" eval ] unit-test +[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" (( -- )) eval ] unit-test [ [ inference-invalidation-d ] infer ] must-fail @@ -587,4 +587,4 @@ DEFER: eee' [ forget-test ] must-infer [ ] [ [ \ forget-test forget ] with-compilation-unit ] unit-test -[ forget-test ] must-infer \ No newline at end of file +[ forget-test ] must-infer diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index 9fa9d1e2aa..0c92cb567b 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -18,7 +18,7 @@ M: integer some-generic 1+ ; [ 4 ] [ 3 some-generic ] unit-test -[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" eval ] unit-test +[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" (( -- )) eval ] unit-test [ 2 ] [ 3 some-generic ] unit-test @@ -33,7 +33,7 @@ M: object another-generic ; \ another-generic watch -[ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" eval ] unit-test +[ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" (( -- )) eval ] unit-test [ ] [ \ another-generic reset ] unit-test From 364ea217efb9216cce934d131ecc39322ff3f84a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 14:44:08 -0500 Subject: [PATCH 7/7] fix more compiler errors --- .../exchangers/exchangers-tests.factor | 2 +- basis/concurrency/flags/flags-tests.factor | 2 +- basis/furnace/sessions/sessions-tests.factor | 4 ++-- basis/hash2/hash2-tests.factor | 2 +- basis/heaps/heaps-tests.factor | 2 +- basis/math/intervals/intervals-tests.factor | 18 +++++++++--------- basis/mirrors/mirrors-tests.factor | 2 +- .../hashtables/hashtables-tests.factor | 6 +++--- .../mersenne-twister-tests.factor | 2 +- basis/threads/threads-tests.factor | 2 +- basis/tools/deploy/shaker/shaker.factor | 6 +++--- core/combinators/combinators-tests.factor | 2 +- core/continuations/continuations-tests.factor | 4 ++-- core/kernel/kernel-tests.factor | 6 +++--- extra/lint/lint-tests.factor | 2 +- .../partial-continuations-tests.factor | 2 +- 16 files changed, 32 insertions(+), 32 deletions(-) diff --git a/basis/concurrency/exchangers/exchangers-tests.factor b/basis/concurrency/exchangers/exchangers-tests.factor index 569b1a72c2..3b5b014fe3 100644 --- a/basis/concurrency/exchangers/exchangers-tests.factor +++ b/basis/concurrency/exchangers/exchangers-tests.factor @@ -3,7 +3,7 @@ USING: sequences tools.test concurrency.exchangers concurrency.count-downs concurrency.promises locals kernel threads ; -:: exchanger-test ( -- ) +:: exchanger-test ( -- string ) [let | ex [ ] c [ 2 ] diff --git a/basis/concurrency/flags/flags-tests.factor b/basis/concurrency/flags/flags-tests.factor index a666293316..05ff74b03f 100644 --- a/basis/concurrency/flags/flags-tests.factor +++ b/basis/concurrency/flags/flags-tests.factor @@ -11,7 +11,7 @@ kernel threads locals accessors calendar ; [ f ] [ flag-test-1 ] unit-test -:: flag-test-2 ( -- ) +:: flag-test-2 ( -- ? ) [let | f [ ] | [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop f lower-flag diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index b325c778cf..99855c76fa 100644 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -22,7 +22,7 @@ M: foo call-responder* "x" [ 1+ ] schange "x" sget number>string "text/html" ; -: url-responder-mock-test ( -- ) +: url-responder-mock-test ( -- string ) [ "GET" >>method @@ -34,7 +34,7 @@ M: foo call-responder* [ write-response-body drop ] with-string-writer ] with-destructors ; -: sessions-mock-test ( -- ) +: sessions-mock-test ( -- string ) [ "GET" >>method diff --git a/basis/hash2/hash2-tests.factor b/basis/hash2/hash2-tests.factor index 6f97c7c3d5..15bbcb36ef 100644 --- a/basis/hash2/hash2-tests.factor +++ b/basis/hash2/hash2-tests.factor @@ -4,7 +4,7 @@ IN: hash2.tests [ t ] [ 1 2 { 1 2 } 2= ] unit-test [ f ] [ 1 3 { 1 2 } 2= ] unit-test -: sample-hash ( -- ) +: sample-hash ( -- hash ) 5 dup 2 3 "foo" roll set-hash2 dup 4 2 "bar" roll set-hash2 diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index 7e780cbe5e..b476107562 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -54,7 +54,7 @@ IN: heaps.tests : sort-entries ( entries -- entries' ) [ [ key>> ] compare ] sort ; -: delete-test ( n -- ? ) +: delete-test ( n -- obj1 obj2 ) [ random-alist [ heap-push-all ] keep diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 378ca2fb4b..8b43456901 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -255,11 +255,11 @@ IN: math.intervals.tests 0 pick interval-contains? over first \ recip eq? and [ 2drop t ] [ - [ [ random-element ] dip first execute ] 2keep - second execute interval-contains? + [ [ random-element ] dip first execute( a -- b ) ] 2keep + second execute( a -- b ) interval-contains? ] if ; -[ t ] [ 80000 [ drop unary-test ] all? ] unit-test +[ t ] [ 80000 iota [ drop unary-test ] all? ] unit-test : random-binary-op ( -- pair ) { @@ -286,11 +286,11 @@ IN: math.intervals.tests 0 pick interval-contains? over first { / /i mod rem } member? and [ 3drop t ] [ - [ [ [ random-element ] bi@ ] dip first execute ] 3keep - second execute interval-contains? + [ [ [ random-element ] bi@ ] dip first execute( a b -- c ) ] 3keep + second execute( a b -- c ) interval-contains? ] if ; -[ t ] [ 80000 [ drop binary-test ] all? ] unit-test +[ t ] [ 80000 iota [ drop binary-test ] all? ] unit-test : random-comparison ( -- pair ) { @@ -305,7 +305,7 @@ IN: math.intervals.tests [ [ [ random-element ] bi@ ] dip first execute ] 3keep second execute dup incomparable eq? [ 2drop t ] [ = ] if ; -[ t ] [ 40000 [ drop comparison-test ] all? ] unit-test +[ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test [ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test @@ -322,7 +322,7 @@ IN: math.intervals.tests [ t ] [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test ! Test that commutative interval ops really are -: random-interval-or-empty ( -- ) +: random-interval-or-empty ( -- obj ) 10 random 0 = [ empty-interval ] [ random-interval ] if ; : random-commutative-op ( -- op ) @@ -333,7 +333,7 @@ IN: math.intervals.tests } random ; [ t ] [ - 80000 [ + 80000 iota [ drop random-interval-or-empty random-interval-or-empty random-commutative-op diff --git a/basis/mirrors/mirrors-tests.factor b/basis/mirrors/mirrors-tests.factor index aad033600a..b5bac614ff 100644 --- a/basis/mirrors/mirrors-tests.factor +++ b/basis/mirrors/mirrors-tests.factor @@ -56,6 +56,6 @@ TUPLE: color ! Test reshaping with a mirror 1 2 3 color boa "mirror" set -[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval ] unit-test +[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" (( -- )) eval ] unit-test [ 1 ] [ "red" "mirror" get at ] unit-test diff --git a/basis/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor index 5ed72e5d59..eea31dd34e 100644 --- a/basis/persistent/hashtables/hashtables-tests.factor +++ b/basis/persistent/hashtables/hashtables-tests.factor @@ -83,7 +83,7 @@ M: hash-0-b hashcode* 2drop 0 ; : random-string ( -- str ) 1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ; -: random-assocs ( -- hash phash ) +: random-assocs ( n -- hash phash ) [ random-string ] replicate [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ] [ PH{ } clone swap [ spin new-at ] each-index ] @@ -92,7 +92,7 @@ M: hash-0-b hashcode* 2drop 0 ; : ok? ( assoc1 assoc2 -- ? ) [ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ; -: test-persistent-hashtables-1 ( n -- ) +: test-persistent-hashtables-1 ( n -- ? ) random-assocs ok? ; [ t ] [ 10 test-persistent-hashtables-1 ] unit-test @@ -106,7 +106,7 @@ M: hash-0-b hashcode* 2drop 0 ; [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test -: test-persistent-hashtables-2 ( n -- ) +: test-persistent-hashtables-2 ( n -- ? ) random-assocs dup keys [ [ nip over delete-at ] [ swap pluck-at nip ] 3bi diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index fe58e3d07c..c35d7488ac 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests 100 [ 100 random ] replicate ; : test-rng ( seed quot -- ) - [ ] dip with-random ; + [ ] dip with-random ; inline [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test diff --git a/basis/threads/threads-tests.factor b/basis/threads/threads-tests.factor index adac84338d..610a664c7b 100644 --- a/basis/threads/threads-tests.factor +++ b/basis/threads/threads-tests.factor @@ -31,7 +31,7 @@ yield [ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with -:: spawn-namespace-test ( -- ) +:: spawn-namespace-test ( -- ? ) [let | p [ ] g [ gensym ] | [ g "x" set diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 3bb9ae72ac..2fc1ada108 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -374,9 +374,9 @@ SYMBOL: deploy-vocab [:c] [print-error] '[ - [ _ execute ] [ - _ execute nl - _ execute + [ _ execute( obj -- ) ] [ + _ execute( obj -- ) nl + _ execute( obj -- ) ] recover ] % ] if diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index 76f9f63c49..a8049f709e 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -357,7 +357,7 @@ DEFER: corner-case-1 [ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test -: test-case-8 ( n -- ) +: test-case-8 ( n -- string ) { { 1 [ "foo" ] } } case ; diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor index 34a4ed2879..2111cce358 100644 --- a/core/continuations/continuations-tests.factor +++ b/core/continuations/continuations-tests.factor @@ -3,7 +3,7 @@ continuations debugger parser memory arrays words kernel.private accessors eval ; IN: continuations.tests -: (callcc1-test) ( -- ) +: (callcc1-test) ( n obj -- n' obj ) [ 1- dup ] dip ?push over 0 = [ "test-cc" get continue-with ] when (callcc1-test) ; @@ -59,7 +59,7 @@ IN: continuations.tests ! : callstack-overflow callstack-overflow f ; ! [ callstack-overflow ] must-fail -: don't-compile-me ( -- ) { } [ ] each ; +: don't-compile-me ( n -- ) { } [ ] each ; : foo ( -- ) callstack "c" set 3 don't-compile-me ; : bar ( -- a b ) 1 foo 2 ; diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 63346f4701..84a356805b 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -27,7 +27,7 @@ IN: kernel.tests [ ] [ :c ] unit-test -: (overflow-d-alt) ( -- ) 3 ; +: (overflow-d-alt) ( -- n ) 3 ; : overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ; @@ -107,7 +107,7 @@ IN: kernel.tests ! Regression : (loop) ( a b c d -- ) [ pick ] dip swap [ pick ] dip swap - < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline + < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive : loop ( obj obj -- ) H{ } values swap [ dup length swap ] dip 0 -roll (loop) ; @@ -168,4 +168,4 @@ IN: kernel.tests [ 3 -1 5/6 ] [ 1 2 3 4 5 6 [ + ] [ - ] [ / ] 2tri* ] unit-test -[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 2tri@ ] unit-test \ No newline at end of file +[ { 1 2 } { 3 4 } { 5 6 } ] [ 1 2 3 4 5 6 [ 2array ] 2tri@ ] unit-test diff --git a/extra/lint/lint-tests.factor b/extra/lint/lint-tests.factor index 70035f1854..7326bc65b0 100644 --- a/extra/lint/lint-tests.factor +++ b/extra/lint/lint-tests.factor @@ -2,7 +2,7 @@ USING: io lint kernel math tools.test ; IN: lint.tests ! Don't write code like this -: lint1 ( -- ) [ "hi" print ] [ ] if ; ! when +: lint1 ( obj -- ) [ "hi" print ] [ ] if ; ! when [ { { lint1 { [ [ ] if ] } } } ] [ \ lint1 lint-word ] unit-test diff --git a/extra/partial-continuations/partial-continuations-tests.factor b/extra/partial-continuations/partial-continuations-tests.factor index 7e876b0934..d6fdefd1aa 100644 --- a/extra/partial-continuations/partial-continuations-tests.factor +++ b/extra/partial-continuations/partial-continuations-tests.factor @@ -7,7 +7,7 @@ SYMBOL: sum : range ( r from to -- n ) over - 1 + rot [ -rot [ over + pick call drop ] each 2drop f - ] bshift 2nip ; + ] bshift 2nip ; inline [ 55 ] [ 0 sum set