From 7a251950d863512b9781993f436c1c1f7532670f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 15 Apr 2009 22:16:52 -0500 Subject: [PATCH 01/15] Working on trace tool --- .../tools/continuations/continuations.factor | 12 ++++++ basis/tools/trace/trace-tests.factor | 4 ++ basis/tools/trace/trace.factor | 43 +++++++++++++------ basis/tools/walker/debug/debug.factor | 6 +-- basis/tools/walker/walker.factor | 12 ------ 5 files changed, 48 insertions(+), 29 deletions(-) create mode 100644 basis/tools/trace/trace-tests.factor diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 70ebff90d9..75eeb602fb 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -69,6 +69,18 @@ M: object add-breakpoint ; : (step-into-call-next-method) ( method -- ) next-method-quot (step-into-quot) ; +<< { + (step-into-quot) + (step-into-dip) + (step-into-2dip) + (step-into-3dip) + (step-into-if) + (step-into-dispatch) + (step-into-execute) + (step-into-continuation) + (step-into-call-next-method) +} [ t "no-compile" set-word-prop ] each >> + : change-frame ( continuation quot -- continuation' ) #! Applies quot to innermost call frame of the #! continuation. diff --git a/basis/tools/trace/trace-tests.factor b/basis/tools/trace/trace-tests.factor new file mode 100644 index 0000000000..74f7c40943 --- /dev/null +++ b/basis/tools/trace/trace-tests.factor @@ -0,0 +1,4 @@ +IN: tools.trace.tests +USING: tools.trace tools.test sequences ; + +[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test \ No newline at end of file diff --git a/basis/tools/trace/trace.factor b/basis/tools/trace/trace.factor index 42d4a00ce1..430ea9045b 100644 --- a/basis/tools/trace/trace.factor +++ b/basis/tools/trace/trace.factor @@ -1,21 +1,21 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.promises models tools.continuations kernel -sequences concurrency.messaging locals continuations -threads namespaces namespaces.private make assocs accessors -io strings prettyprint math words effects summary io.styles -classes ; +sequences concurrency.messaging locals continuations threads +namespaces namespaces.private make assocs accessors io strings +prettyprint math math.parser words effects summary io.styles classes +generic.math combinators.short-circuit ; IN: tools.trace : callstack-depth ( callstack -- n ) - callstack>array length ; + callstack>array length 2/ ; SYMBOL: end SYMBOL: exclude-vocabs SYMBOL: include-vocabs -exclude-vocabs { "kernel" "math" "accessors" } swap set-global +exclude-vocabs { "math" "accessors" } swap set-global : include? ( vocab -- ? ) include-vocabs get dup [ member? ] [ 2drop t ] if ; @@ -24,11 +24,22 @@ exclude-vocabs { "kernel" "math" "accessors" } swap set-global exclude-vocabs get dup [ member? ] [ 2drop f ] if ; : into? ( obj -- ? ) - dup word? [ - dup predicate? [ drop f ] [ - vocabulary>> [ include? ] [ exclude? not ] bi and - ] if - ] [ drop t ] if ; + { + [ word? ] + [ predicate? not ] + [ math-generic? not ] + [ + { + [ inline? ] + [ + { + [ vocabulary>> include? ] + [ vocabulary>> exclude? not ] + } 1&& + ] + } 1|| + ] + } 1&& ; TUPLE: trace-step word inputs ; @@ -49,15 +60,19 @@ M: trace-step summary nip short. ] if ; +: print-depth ( continuation -- ) + call>> callstack-depth + [ CHAR: \s write ] + [ number>string write ": " write ] bi ; + : trace-step ( continuation -- continuation' ) dup continuation-current end eq? [ - [ call>> callstack-depth 2/ CHAR: \s write ] + [ print-depth ] [ print-step ] [ dup continuation-current into? [ continuation-step-into ] [ continuation-step ] if - ] - tri + ] tri ] unless ; : trace ( quot -- data ) diff --git a/basis/tools/walker/debug/debug.factor b/basis/tools/walker/debug/debug.factor index f2155ec125..80113607d4 100644 --- a/basis/tools/walker/debug/debug.factor +++ b/basis/tools/walker/debug/debug.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: concurrency.promises models tools.walker kernel -sequences concurrency.messaging locals continuations -threads namespaces namespaces.private assocs accessors ; +USING: concurrency.promises models tools.walker tools.continuations +kernel sequences concurrency.messaging locals continuations threads +namespaces namespaces.private assocs accessors ; IN: tools.walker.debug :: test-walker ( quot -- data ) diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index 72d7cd81cd..a1f18df57a 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -43,18 +43,6 @@ break-hook [ ] ] initialize -<< { - (step-into-quot) - (step-into-dip) - (step-into-2dip) - (step-into-3dip) - (step-into-if) - (step-into-dispatch) - (step-into-execute) - (step-into-continuation) - (step-into-call-next-method) -} [ t "no-compile" set-word-prop ] each >> - ! Messages sent to walker thread SYMBOL: step SYMBOL: step-out From a69d404f743a0ef40e1d0c084fcefe0ec833223c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 16 Apr 2009 16:24:14 -0500 Subject: [PATCH 02/15] Start documenting compiler internals --- basis/compiler/compiler-docs.factor | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index f19225a45c..f92f0015d3 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -1,5 +1,7 @@ -USING: help.markup help.syntax words io parser -assocs words.private sequences compiler.units quotations ; +USING: assocs compiler.cfg.builder compiler.cfg.optimizer +compiler.errors compiler.tree.builder compiler.tree.optimizer +compiler.units help.markup help.syntax io parser quotations +sequences words words.private ; IN: compiler HELP: enable-compiler @@ -18,6 +20,24 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler" { $subsection compile-call } "Higher-level words can be found in " { $link "compilation-units" } "." ; +ARTICLE: "compiler-impl" "Compiler implementation" +"The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop." +$nl +"Words are added to the " { $link compile-queue } " variable as needed and compiled." +{ $subsection compile-queue } +"Once compiled, a word is added to the assoc stored in the " { $link compiled } " variable. When compilation is complete, this assoc is passed to " { $link modify-code-heap } "." +$nl +"The " { $link (compile) } " word performs the actual task of compiling an individual word. The process proceeds as follows:" +{ $list + { "The " { $link frontend } " word calls " { $link build-tree-from-word } ". If this fails, the error is passed to " { $link fail } ". The logic for ignoring compile warnings generated for inline words and macros is located here. If the error is not ignorable, it is added to the global " { $link compiler-errors } " assoc (see " { $link "compiler-errors" } ")." } + { "If the word contains a breakpoint, compilation ends here. Otherwise, all remaining steps execute until machine code is generated. Any further errors thrown by the compiler are not reported as compile errors, but instead are ordinary exceptions. This is because they indicate bugs in the compiler, not errors in user code." } + { "The " { $link frontend } " word then calls " { $link optimize-tree } ". This produces the final optimized tree IR, and this stage of the compiler is complete." } + { "The " { $link backend } " word calls " { $link build-cfg } " followed by " { $link optimize-cfg } " and a few other stages. Finally, it calls " { $link save-asm } ", and adds any uncompiled words called by this word to the compilation queue with " { $link maybe-compile } "." } +} +"If compilation fails, the word is stored in the " { $link compiled } " assoc with a value of " { $link f } ". This causes the VM to compile the word with the non-optimizing compiler." +$nl +"Calling " { $link modify-code-heap } " is handled not by the " { $vocab-link "compiler" } " vocabulary, but rather " { $vocab-link "compiler.units" } ". The optimizing compiler merely provides an implementation of the " { $link recompile } " generic word." ; + ARTICLE: "compiler" "Optimizing compiler" "Factor includes two compilers which work behind the scenes. Words are always compiled, and the compilers do not have to be invoked explicitly. For the most part, compilation is fully transparent. However, there are a few things worth knowing about the compilation process." $nl @@ -31,7 +51,8 @@ $nl "The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information." { $subsection "compiler-errors" } { $subsection "hints" } -{ $subsection "compiler-usage" } ; +{ $subsection "compiler-usage" } +{ $subsection "compiler-impl" } ; ABOUT: "compiler" From 5c345360d00ee879740d08398cd014ff32868cd7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 16 Apr 2009 17:03:03 -0500 Subject: [PATCH 03/15] unbreak my heart, say you'll love me again, factor bootstrap --- basis/tools/annotations/annotations.factor | 2 +- basis/tools/continuations/continuations.factor | 4 ++-- basis/ui/tools/walker/walker-docs.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index 64e6508ab6..2639d48be2 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -3,7 +3,7 @@ USING: accessors kernel math sorting words parser io summary quotations sequences prettyprint continuations effects definitions compiler.units namespaces assocs tools.walker -tools.time generic inspector fry ; +tools.time generic inspector fry tools.continuations ; IN: tools.annotations GENERIC: reset ( word -- ) diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 75eeb602fb..44fc615dfd 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -27,10 +27,10 @@ SYMBOL: break-hook \ break t "break?" set-word-prop - Date: Thu, 16 Apr 2009 23:14:11 -0500 Subject: [PATCH 04/15] Make the walker infer --- basis/compiler/compiler.factor | 21 ++++++++++--------- basis/compiler/tree/builder/builder.factor | 3 +++ .../tree/propagation/inlining/inlining.factor | 6 +++++- .../tools/continuations/continuations.factor | 11 +++++----- core/continuations/continuations.factor | 16 +++++++------- 5 files changed, 32 insertions(+), 25 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 0afe7f1141..e5d88af14a 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -63,19 +63,20 @@ SYMBOLS: +optimized+ +unoptimized+ ; } 1|| ] [ error-type +compiler-warning+ eq? ] bi* and ; -: fail ( word error -- * ) - [ 2dup ignore-error? [ drop f ] when swap compiler-error ] - [ - drop - [ compiled-unxref ] - [ f swap compiled get set-at ] - [ +unoptimized+ save-compiled-status ] - tri - ] 2bi +: (fail) ( word -- * ) + [ compiled-unxref ] + [ f swap compiled get set-at ] + [ +unoptimized+ save-compiled-status ] + tri return ; +: fail ( word error -- * ) + [ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop (fail) ] 2bi ; + : frontend ( word -- nodes ) - [ build-tree-from-word ] [ fail ] recover optimize-tree ; + dup contains-breakpoints? [ (fail) ] [ + [ build-tree-from-word ] [ fail ] recover optimize-tree + ] if ; ! Only switch this off for debugging. SYMBOL: compile-dependencies? diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index dc87d596aa..fe9c2a26a4 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -58,3 +58,6 @@ TUPLE: do-not-compile word ; } cleave ] maybe-cannot-infer ] with-tree-builder ; + +: contains-breakpoints? ( word -- ? ) + def>> [ word? ] filter [ "break?" word-prop ] any? ; diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index f18cfcd3a3..0815351057 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -148,7 +148,11 @@ DEFER: (flat-length) ] sum-outputs ; : should-inline? ( #call word -- ? ) - dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ; + { + { [ dup contains-breakpoints? ] [ 2drop f ] } + { [ dup "inline" word-prop ] [ 2drop t ] } + [ inlining-rank 5 >= ] + } cond ; SYMBOL: history diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 75eeb602fb..1ecb10be6c 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -12,7 +12,6 @@ IN: tools.continuations : after-break ( object -- ) { { [ dup continuation? ] [ (continue) ] } - { [ dup quotation? ] [ call ] } { [ dup not ] [ "Single stepping abandoned" rethrow ] } } cond ; @@ -22,7 +21,7 @@ SYMBOL: break-hook : break ( -- ) continuation callstack >>call - break-hook get call + break-hook get call( continuation -- continuation' ) after-break ; \ break t "break?" set-word-prop @@ -125,14 +124,14 @@ PRIVATE> } [ "step-into" set-word-prop ] assoc-each ! Never step into these words +: don't-step-into ( word -- ) + dup [ execute break ] curry "step-into" set-word-prop ; + { >n ndrop >c c> continue continue-with stop suspend (spawn) -} [ - dup [ execute break ] curry - "step-into" set-word-prop -] each +} [ don't-step-into ] each \ break [ break ] "step-into" set-word-prop diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index e350b24856..56ac4a71e9 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -74,14 +74,14 @@ C: continuation continuation< - set-catchstack - set-namestack - set-retainstack - [ set-datastack ] dip - set-callstack ; - -\ (continue) t "no-compile" set-word-prop + [ + >continuation< + set-catchstack + set-namestack + set-retainstack + [ set-datastack ] dip + set-callstack + ] (( continuation -- * )) call-effect-unsafe ; PRIVATE> From e173d271200157f9be44eebc7645b35bf30df260 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 16 Apr 2009 23:14:26 -0500 Subject: [PATCH 05/15] Adding walker tests --- basis/tools/trace/trace.factor | 2 ++ basis/tools/walker/walker-tests.factor | 22 +++++++++++++++++++++- basis/tools/walker/walker.factor | 6 ++++-- 3 files changed, 27 insertions(+), 3 deletions(-) diff --git a/basis/tools/trace/trace.factor b/basis/tools/trace/trace.factor index 430ea9045b..e2c6bf864b 100644 --- a/basis/tools/trace/trace.factor +++ b/basis/tools/trace/trace.factor @@ -79,3 +79,5 @@ M: trace-step summary [ [ trace-step ] break-hook ] dip [ break ] [ end drop ] surround with-variable ; + +<< \ trace t "no-compile" set-word-prop >> \ No newline at end of file diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor index 3a5877c286..6dabb73e30 100644 --- a/basis/tools/walker/walker-tests.factor +++ b/basis/tools/walker/walker-tests.factor @@ -1,7 +1,8 @@ USING: tools.walker io io.streams.string kernel math math.private namespaces prettyprint sequences tools.test continuations math.parser threads arrays tools.walker.debug -generic.standard sequences.private kernel.private ; +generic.standard sequences.private kernel.private +tools.continuations accessors words ; IN: tools.walker.tests [ { } ] [ @@ -112,3 +113,22 @@ IN: tools.walker.tests [ { } ] [ [ "a" "b" set "c" "d" set [ ] test-walker ] with-scope ] unit-test + +: breakpoint-test ( -- x ) break 1 2 + ; + +\ breakpoint-test don't-step-into + +[ f ] [ \ breakpoint-test optimized>> ] unit-test + +[ { 3 } ] [ [ breakpoint-test ] test-walker ] unit-test + +GENERIC: method-breakpoint-test ( x -- y ) + +TUPLE: method-breakpoint-tuple ; + +M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ; + +\ method-breakpoint-test don't-step-into + +[ { 3 } ] +[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test \ No newline at end of file diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor index a1f18df57a..4208c4420f 100644 --- a/basis/tools/walker/walker.factor +++ b/basis/tools/walker/walker.factor @@ -5,7 +5,7 @@ sequences math namespaces.private continuations.private concurrency.messaging quotations kernel.private words sequences.private assocs models models.arrow arrays accessors generic generic.standard definitions make sbufs -tools.continuations ; +tools.continuations parser ; IN: tools.walker SYMBOL: show-walker-hook ! ( status continuation thread -- ) @@ -35,6 +35,8 @@ DEFER: start-walker-thread : walk ( quot -- quot' ) \ break prefix [ break rethrow ] recover ; +<< \ walk t "no-compile" set-word-prop >> + break-hook [ [ get-walker-thread @@ -159,4 +161,4 @@ SYMBOL: +stopped+ ! For convenience IN: syntax -: B ( -- ) break ; +SYNTAX: B \ break parsed ; From fba80949ebd9d9b4844169f52c90601e12cb30de Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 16 Apr 2009 23:14:41 -0500 Subject: [PATCH 06/15] draw-scaled-texture now uses the display list if there's no scaling to be done --- basis/opengl/textures/textures.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index 76e0c473b9..6bed17f7ab 100755 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -128,7 +128,9 @@ M: single-texture dispose* [ display-list>> [ delete-dlist ] when* ] bi ; M: single-texture draw-scaled-texture - dup texture>> [ draw-textured-rect ] [ 2drop ] if ; + 2dup dim>> = [ nip draw-texture ] [ + dup texture>> [ draw-textured-rect ] [ 2drop ] if + ] if ; TUPLE: multi-texture grid display-list loc disposed ; @@ -166,6 +168,8 @@ TUPLE: multi-texture grid display-list loc disposed ; f multi-texture boa ] with-destructors ; +M: multi-texture draw-scaled-texture nip draw-texture ; + M: multi-texture dispose* grid>> [ [ dispose ] each ] each ; CONSTANT: max-texture-size { 512 512 } From 7fd249333a8939b0f4a8d1fe988df06524e53e19 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 16 Apr 2009 23:14:47 -0500 Subject: [PATCH 07/15] Fix mason.test --- extra/mason/test/test.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index dab9b75528..4c212b07fb 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -25,8 +25,8 @@ M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ; : do-compile-errors ( -- ) compiler-errors get values - compiler-error-messages-file compiler-errors-file + compiler-error-messages-file do-step ; : do-tests ( -- ) From e9e40289999b1e8e9148ced6d6504113e6f271e7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 11:01:58 -0500 Subject: [PATCH 08/15] 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 09/15] 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 10/15] 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 11/15] 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 12/15] 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 13/15] 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 14/15] 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 From 3fc7b222842b18500394a86e35a95851cfcd7ee1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 17 Apr 2009 15:10:50 -0500 Subject: [PATCH 15/15] undo inline --- 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 033ae755cb..ad799f75c9 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 ; inline + [ fc-change-directory ] [ fc-load-file ] if ; : present-dir-element ( element -- string ) [ name>> ] [ directory? ] bi [ "-> " prepend ] when ;