diff --git a/basis/bit-vectors/bit-vectors-tests.factor b/basis/bit-vectors/bit-vectors-tests.factor index 31327999e7..41efdbd0d2 100644 --- a/basis/bit-vectors/bit-vectors-tests.factor +++ b/basis/bit-vectors/bit-vectors-tests.factor @@ -3,7 +3,7 @@ USING: tools.test bit-vectors vectors sequences kernel math ; [ 0 ] [ 123 length ] unit-test -: do-it +: do-it ( seq -- ) 1234 swap [ [ even? ] dip push ] curry each ; [ t ] [ diff --git a/basis/byte-vectors/byte-vectors-tests.factor b/basis/byte-vectors/byte-vectors-tests.factor index 9a100d9795..bd7510c95f 100644 --- a/basis/byte-vectors/byte-vectors-tests.factor +++ b/basis/byte-vectors/byte-vectors-tests.factor @@ -4,7 +4,7 @@ prettyprint ; [ 0 ] [ 123 length ] unit-test -: do-it +: do-it ( seq -- seq ) 123 [ over push ] each ; [ t ] [ diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor index 00d5730745..b6d8e74072 100644 --- a/basis/calendar/calendar-tests.factor +++ b/basis/calendar/calendar-tests.factor @@ -148,7 +148,7 @@ IN: calendar.tests [ t ] [ 123456789000000 [ micros>timestamp timestamp>micros ] keep = ] unit-test [ t ] [ 123456789123456000 [ micros>timestamp timestamp>micros ] keep = ] unit-test -: checktime+ now dup clone [ rot time+ drop ] keep = ; +: checktime+ ( duration -- ? ) now dup clone [ rot time+ drop ] keep = ; [ t ] [ 5 seconds checktime+ ] unit-test diff --git a/basis/cocoa/cocoa-tests.factor b/basis/cocoa/cocoa-tests.factor index d77435a8ad..4b5af2e39d 100644 --- a/basis/cocoa/cocoa-tests.factor +++ b/basis/cocoa/cocoa-tests.factor @@ -13,7 +13,7 @@ CLASS: { [ gc "x" set 2drop ] } ; -: test-foo +: test-foo ( -- ) Foo -> alloc -> init dup 1.0 2.0 101.0 102.0 -> foo: -> release ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index af77ce6ac1..50d7f044d1 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -285,7 +285,7 @@ paste "PASTE" [ test-cascade ] test-postgresql [ test-restrict ] test-postgresql -: test-repeated-insert +: test-repeated-insert ( -- ) [ ] [ person ensure-table ] unit-test [ ] [ person1 get insert-tuple ] unit-test [ person1 get insert-tuple ] must-fail ; @@ -458,7 +458,7 @@ TUPLE: bignum-test id m n o ; swap >>n swap >>m ; -: test-bignum +: test-bignum ( -- ) bignum-test "BIGNUM_TEST" { { "id" "ID" +db-assigned-id+ } @@ -478,7 +478,7 @@ TUPLE: bignum-test id m n o ; TUPLE: secret n message ; C: secret -: test-random-id +: test-random-id ( -- ) secret "SECRET" { { "n" "ID" +random-id+ system-random-generator } diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor index 9bf07a5330..cf822b40a3 100644 --- a/basis/delegate/delegate-tests.factor +++ b/basis/delegate/delegate-tests.factor @@ -41,13 +41,13 @@ M: hello bing hello-test ; [ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ; inline\n" ] [ [ baz see ] with-string-writer ] unit-test -GENERIC: one +GENERIC: one ( a -- b ) M: integer one ; -GENERIC: two +GENERIC: two ( a -- b ) M: integer two ; -GENERIC: three +GENERIC: three ( a -- b ) M: integer three ; -GENERIC: four +GENERIC: four ( a -- b ) M: integer four ; PROTOCOL: alpha one two ; diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor index 7189450394..d240e6f233 100644 --- a/basis/fry/fry-tests.factor +++ b/basis/fry/fry-tests.factor @@ -34,7 +34,7 @@ sequences eval accessors ; { "a" "b" "c" } swap map ] unit-test -: funny-dip '[ [ @ ] dip ] call ; inline +: funny-dip ( obj quot -- ) '[ [ @ ] dip ] call ; inline [ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test diff --git a/basis/furnace/actions/actions-tests.factor b/basis/furnace/actions/actions-tests.factor index 60a526fb24..cefeda0481 100644 --- a/basis/furnace/actions/actions-tests.factor +++ b/basis/furnace/actions/actions-tests.factor @@ -7,7 +7,7 @@ IN: furnace.actions.tests [ "a" param "b" param [ string>number ] bi@ + ] >>display "action-1" set -: lf>crlf "\n" split "\r\n" join ; +: lf>crlf ( string -- string' ) "\n" split "\r\n" join ; STRING: action-request-test-1 GET http://foo/bar?a=12&b=13 HTTP/1.1 diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor index c591b848ec..1d5aa43c7b 100644 --- a/basis/furnace/furnace-tests.factor +++ b/basis/furnace/furnace-tests.factor @@ -4,7 +4,7 @@ http.server furnace furnace.utilities tools.test kernel namespaces accessors io.streams.string urls xml.writer ; TUPLE: funny-dispatcher < dispatcher ; -: funny-dispatcher new-dispatcher ; +: ( -- dispatcher ) funny-dispatcher new-dispatcher ; TUPLE: base-path-check-responder ; diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index 14cdce3811..b325c778cf 100644 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -6,7 +6,7 @@ io.streams.string io.files io.files.temp io.directories splitting destructors sequences db db.tuples db.sqlite continuations urls math.parser furnace furnace.utilities ; -: with-session +: with-session ( session quot -- ) [ [ [ save-session-after ] [ session set ] bi ] dip call ] with-destructors ; inline @@ -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 ( -- ) [ "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 ( -- ) [ "GET" >>method @@ -45,7 +45,7 @@ M: foo call-responder* [ write-response-body drop ] with-string-writer ] with-destructors ; -: +: ( -- action ) [ [ ] "text/plain" exit-with ] >>display ; diff --git a/basis/hash2/hash2-tests.factor b/basis/hash2/hash2-tests.factor index 5f1f072736..6f97c7c3d5 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 ( -- ) 5 dup 2 3 "foo" roll set-hash2 dup 4 2 "bar" roll set-hash2 diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor index 47c3105436..2e01330d73 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 5d83afae88..7bb66eca02 100644 --- a/basis/help/definitions/definitions-tests.factor +++ b/basis/help/definitions/definitions-tests.factor @@ -7,7 +7,7 @@ IN: help.definitions.tests [ [ 4 ] [ - "IN: help.definitions.tests USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" "foo" + "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -20,7 +20,7 @@ IN: help.definitions.tests ] unit-test [ 2 ] [ - "IN: help.definitions.tests USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" "foo" + "IN: help.definitions.tests USING: help.syntax ; : hello ( -- ) ; ARTICLE: \"hello\" \"world\" ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -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/markup/markup-tests.factor b/basis/help/markup/markup-tests.factor index 74bc45d36c..9b928f3691 100644 --- a/basis/help/markup/markup-tests.factor +++ b/basis/help/markup/markup-tests.factor @@ -11,7 +11,7 @@ TUPLE: blahblah quux ; [ ] [ \ >>quux print-topic ] unit-test [ ] [ \ blahblah? print-topic ] unit-test -: fooey "fooey" throw ; +: fooey ( -- * ) "fooey" throw ; [ ] [ \ fooey print-topic ] unit-test diff --git a/basis/html/templates/chloe/chloe-tests.factor b/basis/html/templates/chloe/chloe-tests.factor index 86f86a8468..fd786d355d 100644 --- a/basis/html/templates/chloe/chloe-tests.factor +++ b/basis/html/templates/chloe/chloe-tests.factor @@ -5,7 +5,7 @@ splitting unicode.categories furnace accessors html.templates.chloe.compiler ; IN: html.templates.chloe.tests -: run-template +: run-template ( quot -- string ) with-string-writer [ "\r\n\t" member? not ] filter "?>" split1 nip ; inline @@ -37,7 +37,7 @@ IN: html.templates.chloe.tests ] run-template ] unit-test -: test4-aux? t ; +: test4-aux? ( -- ? ) t ; [ "True" ] [ [ @@ -45,7 +45,7 @@ IN: html.templates.chloe.tests ] run-template ] unit-test -: test5-aux? f ; +: test5-aux? ( -- ? ) f ; [ "" ] [ [ diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 0d4282b1d7..bc906fad44 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -13,7 +13,7 @@ IN: http.tests [ "application/octet-stream" binary ] [ "application/octet-stream" parse-content-type ] unit-test -: lf>crlf "\n" split "\r\n" join ; +: lf>crlf ( string -- string' ) "\n" split "\r\n" join ; STRING: read-request-test-1 POST /bar HTTP/1.1 @@ -180,14 +180,14 @@ accessors namespaces threads http.server.responses http.server.redirection furnace.redirection http.server.dispatchers db.tuples ; -: add-quit-action +: add-quit-action ( responder -- responder ) [ stop-this-server "Goodbye" "text/html" ] >>display "quit" add-responder ; -: test-db-file "test.db" temp-file ; +: test-db-file ( -- path ) "test.db" temp-file ; -: test-db test-db-file ; +: test-db ( -- db ) test-db-file ; [ test-db-file delete-file ] ignore-errors @@ -268,7 +268,7 @@ test-db [ test-httpd ] unit-test -: 404? [ download-failed? ] [ response>> code>> 404 = ] bi and ; +: 404? ( response -- ? ) [ download-failed? ] [ response>> code>> 404 = ] bi and ; ! This should give a 404 not an infinite redirect loop [ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with diff --git a/basis/io/backend/unix/unix-tests.factor b/basis/io/backend/unix/unix-tests.factor index 2e94d7a2df..ed054d7958 100644 --- a/basis/io/backend/unix/unix-tests.factor +++ b/basis/io/backend/unix/unix-tests.factor @@ -5,7 +5,7 @@ io.streams.duplex destructors make io.launcher ; IN: io.backend.unix.tests ! Unix domain stream sockets -: socket-server "unix-domain-socket-test" temp-file ; +: socket-server ( -- path ) "unix-domain-socket-test" temp-file ; [ [ socket-server delete-file ] ignore-errors @@ -33,8 +33,8 @@ yield ] { } make ] unit-test -: datagram-server "unix-domain-datagram-test" temp-file ; -: datagram-client "unix-domain-datagram-test-2" temp-file ; +: datagram-server ( -- path ) "unix-domain-datagram-test" temp-file ; +: datagram-client ( -- path ) "unix-domain-datagram-test-2" temp-file ; ! Unix domain datagram sockets [ datagram-server delete-file ] ignore-errors @@ -104,7 +104,7 @@ datagram-client [ ] [ "d" get dispose ] unit-test ! Test error behavior -: another-datagram "unix-domain-datagram-test-3" temp-file ; +: another-datagram ( -- path ) "unix-domain-datagram-test-3" temp-file ; [ another-datagram delete-file ] ignore-errors diff --git a/basis/io/encodings/utf16n/utf16n-tests.factor b/basis/io/encodings/utf16n/utf16n-tests.factor index 5e7d1af8f5..9f3f35ff2a 100644 --- a/basis/io/encodings/utf16n/utf16n-tests.factor +++ b/basis/io/encodings/utf16n/utf16n-tests.factor @@ -2,7 +2,7 @@ USING: accessors alien.c-types kernel io.encodings.utf16 io.streams.byte-array tools.test ; IN: io.encodings.utf16n -: correct-endian +: correct-endian ( obj -- ? ) code>> little-endian? [ utf16le = ] [ utf16be = ] if ; [ t ] [ B{ } utf16n correct-endian ] unit-test diff --git a/basis/io/streams/duplex/duplex-tests.factor b/basis/io/streams/duplex/duplex-tests.factor index 860702c563..4903db2b1b 100644 --- a/basis/io/streams/duplex/duplex-tests.factor +++ b/basis/io/streams/duplex/duplex-tests.factor @@ -5,13 +5,13 @@ IN: io.streams.duplex.tests ! Test duplex stream close behavior TUPLE: closing-stream < disposable ; -: closing-stream new ; +: ( -- stream ) closing-stream new ; M: closing-stream dispose* drop ; TUPLE: unclosable-stream ; -: unclosable-stream new ; +: ( -- stream ) unclosable-stream new ; M: unclosable-stream dispose "Can't close me!" throw ; diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor index 00f1cca678..0616794939 100644 --- a/basis/listener/listener-tests.factor +++ b/basis/listener/listener-tests.factor @@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ; [ [ ] [ - "IN: listener.tests : hello\n\"world\" ;" parse-interactive + "IN: listener.tests : hello ( -- )\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 558fa78494..8e3b59fe69 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -192,14 +192,14 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ; DEFER: xyzzy [ ] [ - "IN: locals.tests USE: math GENERIC: xyzzy M: integer xyzzy ;" + "IN: locals.tests USE: math GENERIC: xyzzy ( a -- b ) M: integer xyzzy ;" "lambda-generic-test" parse-stream drop ] unit-test [ 10 ] [ 10 xyzzy ] unit-test [ ] [ - "IN: locals.tests USE: math USE: locals GENERIC: xyzzy M:: integer xyzzy ( n -- ) 5 ;" + "IN: locals.tests USE: math USE: locals GENERIC: xyzzy ( a -- b ) M:: integer xyzzy ( n -- x ) 5 ;" "lambda-generic-test" parse-stream drop ] unit-test @@ -245,7 +245,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; [ 5 ] [ 1 next-method-test ] unit-test -: no-with-locals-test { 1 2 3 } [| x | x 3 + ] map ; +: no-with-locals-test ( -- seq ) { 1 2 3 } [| x | x 3 + ] map ; [ { 4 5 6 } ] [ no-with-locals-test ] unit-test @@ -259,7 +259,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; :: a-word-with-locals ( a b -- ) ; -: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" ; +CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n" [ ] [ new-definition eval ] unit-test @@ -268,7 +268,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ; new-definition = ] unit-test -: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" ; +CONSTANT: method-definition "USING: locals locals.tests sequences ;\nM:: sequence method-with-locals ( a -- y ) a reverse ;\n" GENERIC: method-with-locals ( x -- y ) diff --git a/basis/macros/macros-tests.factor b/basis/macros/macros-tests.factor index 7d93ce8a9e..91aa6880e6 100644 --- a/basis/macros/macros-tests.factor +++ b/basis/macros/macros-tests.factor @@ -2,16 +2,22 @@ IN: macros.tests USING: tools.test macros math kernel arrays vectors io.streams.string prettyprint parser eval see ; -MACRO: see-test ( a b -- c ) + ; +MACRO: see-test ( a b -- quot ) + ; -[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- c ) + ;\n" ] +[ t ] [ \ see-test macro? ] unit-test + +[ "USING: macros math ;\nIN: macros.tests\nMACRO: see-test ( a b -- quot ) + ;\n" ] [ [ \ see-test see ] with-string-writer ] unit-test +[ t ] [ \ see-test macro? ] unit-test + [ t ] [ "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 diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index f64c88388a..a86b711340 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -7,14 +7,14 @@ IN: macros > 1 ; + in>> { "quot" } ; PRIVATE> : define-macro ( word definition effect -- ) real-macro-effect - [ drop "macro" set-word-prop ] [ [ memoize-quot [ call ] append ] keep define-declared ] + [ drop "macro" set-word-prop ] 3bi ; SYNTAX: MACRO: (:) define-macro ; diff --git a/basis/models/models-tests.factor b/basis/models/models-tests.factor index 67155b8303..f875fa3140 100644 --- a/basis/models/models-tests.factor +++ b/basis/models/models-tests.factor @@ -4,7 +4,7 @@ IN: models.tests TUPLE: model-tester hit? ; -: model-tester new ; +: ( -- model-tester ) model-tester new ; M: model-tester model-changed nip t >>hit? drop ; diff --git a/basis/models/range/range-tests.factor b/basis/models/range/range-tests.factor index 50c0365728..e9119e8452 100644 --- a/basis/models/range/range-tests.factor +++ b/basis/models/range/range-tests.factor @@ -3,7 +3,7 @@ USING: arrays generic kernel math models namespaces sequences assocs tools.test models.range ; ! Test -: setup-range 0 0 0 255 ; +: setup-range ( -- range ) 0 0 0 255 ; ! clamp-value should not go past range ends [ 0 ] [ -10 setup-range clamp-value ] unit-test diff --git a/basis/persistent/heaps/heaps-tests.factor b/basis/persistent/heaps/heaps-tests.factor index cecd6dab53..3a1f910532 100644 --- a/basis/persistent/heaps/heaps-tests.factor +++ b/basis/persistent/heaps/heaps-tests.factor @@ -1,9 +1,9 @@ USING: persistent.heaps tools.test ; IN: persistent.heaps.tests -: test-input +CONSTANT: test-input { { "hello" 3 } { "goodbye" 2 } { "whatever" 5 } - { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } ; + { "foo" 1 } { "bar" -1 } { "baz" -7 } { "bing" 0 } } [ { { "baz" -7 } { "bar" -1 } { "bing" 0 } { "foo" 1 } diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index aaaf6b80d1..7e37aa0da5 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -63,7 +63,7 @@ unit-test [ "USING: math ;\nIN: prettyprint.tests\n: bar ( x -- y ) 2 + ;\n" ] [ [ \ bar see ] with-string-writer ] unit-test -: blah +: blah ( a a a a a a a a a a a a a a a a a a a a -- ) drop drop drop @@ -102,7 +102,7 @@ unit-test ] keep = ] with-scope ; -GENERIC: method-layout +GENERIC: method-layout ( a -- b ) M: complex method-layout "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" @@ -135,7 +135,7 @@ M: object method-layout ; [ \ method-layout see-methods ] with-string-writer "\n" split ] unit-test -: soft-break-test +: soft-break-test ( -- str ) { "USING: kernel math sequences strings ;" "IN: prettyprint.tests" @@ -152,7 +152,7 @@ M: object method-layout ; DEFER: parse-error-file -: another-soft-break-test +: another-soft-break-test ( -- str ) { "USING: make sequences ;" "IN: prettyprint.tests" @@ -166,7 +166,7 @@ DEFER: parse-error-file check-see ] unit-test -: string-layout +: string-layout ( -- str ) { "USING: accessors debugger io kernel ;" "IN: prettyprint.tests" @@ -187,7 +187,7 @@ DEFER: parse-error-file \ send soft "break-after" set-word-prop -: final-soft-break-test +: final-soft-break-test ( -- str ) { "USING: kernel sequences ;" "IN: prettyprint.tests" @@ -202,7 +202,7 @@ DEFER: parse-error-file "final-soft-break-layout" final-soft-break-test check-see ] unit-test -: narrow-test +: narrow-test ( -- str ) { "USING: arrays combinators continuations kernel sequences ;" "IN: prettyprint.tests" @@ -218,7 +218,7 @@ DEFER: parse-error-file "narrow-layout" narrow-test check-see ] unit-test -: another-narrow-test +: another-narrow-test ( -- str ) { "IN: prettyprint.tests" ": another-narrow-layout ( -- obj )" @@ -326,7 +326,7 @@ INTERSECTION: intersection-see-test sequence number ; TUPLE: started-out-hustlin' ; -GENERIC: ended-up-ballin' +GENERIC: ended-up-ballin' ( a -- b ) M: started-out-hustlin' ended-up-ballin' ; inline diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor index 99c6d0e255..d23c8be84b 100644 --- a/basis/serialize/serialize-tests.factor +++ b/basis/serialize/serialize-tests.factor @@ -7,7 +7,7 @@ sequences math prettyprint parser classes math.constants io.encodings.binary random assocs serialize.private ; IN: serialize.tests -: test-serialize-cell +: test-serialize-cell ( a -- ? ) 2^ random dup binary [ serialize-cell ] with-byte-writer binary [ deserialize-cell ] with-byte-reader = ; @@ -27,7 +27,7 @@ TUPLE: serialize-test a b ; C: serialize-test -: objects +CONSTANT: objects { f t @@ -52,7 +52,7 @@ C: serialize-test << 1 [ 2 ] curry parsed >> { { "a" "bc" } { "de" "fg" } } H{ { "a" "bc" } { "de" "fg" } } - } ; + } : check-serialize-1 ( obj -- ? ) "=====" print diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index 7e377aedd9..f47852aca7 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -2,7 +2,7 @@ USING: tools.test tools.annotations tools.time math parser eval io.streams.string kernel strings ; IN: tools.annotations.tests -: foo ; +: foo ( -- ) ; \ foo watch [ ] [ foo ] unit-test diff --git a/basis/tools/crossref/crossref-tests.factor b/basis/tools/crossref/crossref-tests.factor index d4f2fea2e5..d08a17fd02 100755 --- a/basis/tools/crossref/crossref-tests.factor +++ b/basis/tools/crossref/crossref-tests.factor @@ -3,7 +3,7 @@ tools.crossref tools.test parser namespaces source-files generic definitions ; IN: tools.crossref.tests -GENERIC: foo +GENERIC: foo ( a b -- c ) M: integer foo + ; diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor index f802676583..3a5877c286 100644 --- a/basis/tools/walker/walker-tests.factor +++ b/basis/tools/walker/walker-tests.factor @@ -36,7 +36,7 @@ IN: tools.walker.tests [ 2 2 fixnum+ ] test-walker ] unit-test -: foo 2 2 fixnum+ ; +: foo ( -- x ) 2 2 fixnum+ ; [ { 8 } ] [ [ foo 4 fixnum+ ] test-walker diff --git a/basis/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor index 6d1706ee74..0aa12f7279 100644 --- a/basis/ui/gadgets/buttons/buttons-tests.factor +++ b/basis/ui/gadgets/buttons/buttons-tests.factor @@ -5,9 +5,9 @@ IN: ui.gadgets.buttons.tests TUPLE: foo-gadget ; -: com-foo-a ; +: com-foo-a ( -- ) ; -: com-foo-b ; +: com-foo-b ( -- ) ; \ foo-gadget "toolbar" f { { f com-foo-a } diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor index baeb320447..03219c66fd 100644 --- a/basis/ui/gadgets/gadgets-tests.factor +++ b/basis/ui/gadgets/gadgets-tests.factor @@ -119,14 +119,14 @@ M: mock-gadget ungraft* [ { f f } ] [ "g" get graft-state>> ] unit-test ] with-variable - : add-some-children + : add-some-children ( gadget -- gadget ) 3 [ over >>model "g" get over add-gadget drop swap 1+ number>string set ] each ; - : status-flags + : status-flags ( -- seq ) { "g" "1" "2" "3" } [ get graft-state>> ] map prune ; : notify-combo ( ? ? -- ) diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor index 2947ce242d..0c47af0214 100644 --- a/basis/ui/gadgets/panes/panes-tests.factor +++ b/basis/ui/gadgets/panes/panes-tests.factor @@ -5,7 +5,7 @@ help.stylesheet splitting tools.test.ui models math summary inspector accessors help.topics see ; IN: ui.gadgets.panes.tests -: #children "pane" get children>> length ; +: #children ( -- n ) "pane" get children>> length ; [ ] [ "pane" set ] unit-test diff --git a/basis/ui/operations/operations-tests.factor b/basis/ui/operations/operations-tests.factor index fe7a8b52c5..4612ea79b0 100644 --- a/basis/ui/operations/operations-tests.factor +++ b/basis/ui/operations/operations-tests.factor @@ -3,7 +3,7 @@ USING: ui.operations ui.commands prettyprint kernel namespaces tools.test ui.gadgets ui.gadgets.editors parser io io.streams.string math help help.markup accessors ; -: my-pprint pprint ; +: my-pprint ( obj -- ) pprint ; [ drop t ] \ my-pprint [ ] f operation boa "op" set diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor index cd56dd876e..63df55b71a 100644 --- a/basis/ui/tools/listener/listener-tests.factor +++ b/basis/ui/tools/listener/listener-tests.factor @@ -68,7 +68,7 @@ IN: ui.tools.listener.tests [ ] [ >>output "interactor" set ] unit-test -: text "Hello world.\nThis is a test." ; +CONSTANT: text "Hello world.\nThis is a test." [ ] [ text "interactor" get set-editor-string ] unit-test diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index cac206bf3c..74eea9506c 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -2,7 +2,7 @@ IN: urls.tests USING: urls urls.private tools.test arrays kernel assocs present accessors ; -: urls +CONSTANT: urls { { T{ url @@ -80,7 +80,7 @@ arrays kernel assocs present accessors ; } "ftp://slava:secret@ftp.kernel.org/" } - } ; + } urls [ [ 1array ] [ [ >url ] curry ] bi* unit-test diff --git a/core/classes/singleton/singleton-tests.factor b/core/classes/singleton/singleton-tests.factor index d9011ad776..9d0bb7d16f 100644 --- a/core/classes/singleton/singleton-tests.factor +++ b/core/classes/singleton/singleton-tests.factor @@ -13,7 +13,7 @@ GENERIC: zammo ( obj -- str ) SINGLETON: word-and-singleton -: word-and-singleton 3 ; +: word-and-singleton ( -- x ) 3 ; [ t ] [ \ word-and-singleton word-and-singleton? ] unit-test [ 3 ] [ word-and-singleton ] unit-test diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index be7d93873e..76f9f63c49 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -288,7 +288,7 @@ CONSTANT: case-const-2 2 } case ] unit-test -: do-not-call "do not call" throw ; +: do-not-call ( -- * ) "do not call" throw ; : test-case-6 ( obj -- value ) { diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor index d5bd0da663..34a4ed2879 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) ( -- ) [ 1- dup ] dip ?push over 0 = [ "test-cc" get continue-with ] when (callcc1-test) ; @@ -59,10 +59,10 @@ IN: continuations.tests ! : callstack-overflow callstack-overflow f ; ! [ callstack-overflow ] must-fail -: don't-compile-me { } [ ] each ; +: don't-compile-me ( -- ) { } [ ] each ; -: foo callstack "c" set 3 don't-compile-me ; -: bar 1 foo 2 ; +: foo ( -- ) callstack "c" set 3 don't-compile-me ; +: bar ( -- a b ) 1 foo 2 ; [ 1 3 2 ] [ bar ] unit-test diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor index e09a88aee4..f9d0770d02 100644 --- a/core/destructors/destructors-tests.factor +++ b/core/destructors/destructors-tests.factor @@ -21,7 +21,7 @@ T{ dispose-dummy } "b" set TUPLE: dummy-obj destroyed? ; -: dummy-obj new ; +: ( -- obj ) dummy-obj new ; TUPLE: dummy-destructor obj ; @@ -30,10 +30,10 @@ C: dummy-destructor M: dummy-destructor dispose ( obj -- ) obj>> t >>destroyed? drop ; -: destroy-always +: destroy-always ( obj -- ) &dispose drop ; -: destroy-later +: destroy-later ( obj -- ) |dispose drop ; [ t ] [ diff --git a/core/io/test/no-trailing-eol.factor b/core/io/test/no-trailing-eol.factor index 959f145bf5..e6ac5760aa 100644 --- a/core/io/test/no-trailing-eol.factor +++ b/core/io/test/no-trailing-eol.factor @@ -1,4 +1,4 @@ IN: io.tests USE: math -: foo 2 2 + ; +: foo ( -- x ) 2 2 + ; FORGET: foo \ No newline at end of file diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor index 4d725e57f8..63346f4701 100644 --- a/core/kernel/kernel-tests.factor +++ b/core/kernel/kernel-tests.factor @@ -21,21 +21,21 @@ IN: kernel.tests [ ] [ :c ] unit-test -: overflow-d 3 overflow-d ; +: overflow-d ( -- ) 3 overflow-d ; [ overflow-d ] [ { "kernel-error" 12 f f } = ] must-fail-with [ ] [ :c ] unit-test -: (overflow-d-alt) 3 ; +: (overflow-d-alt) ( -- ) 3 ; -: overflow-d-alt (overflow-d-alt) overflow-d-alt ; +: overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ; [ overflow-d-alt ] [ { "kernel-error" 12 f f } = ] must-fail-with [ ] [ [ :c ] with-string-writer drop ] unit-test -: overflow-r 3 load-local overflow-r ; +: overflow-r ( -- ) 3 load-local overflow-r ; [ overflow-r ] [ { "kernel-error" 14 f f } = ] must-fail-with @@ -99,7 +99,7 @@ IN: kernel.tests [ ] [ :c ] unit-test ! Doesn't compile; important -: foo 5 + 0 [ ] each ; +: foo ( a -- b ) 5 + 0 [ ] each ; [ drop foo ] must-fail [ ] [ :c ] unit-test @@ -115,7 +115,7 @@ IN: kernel.tests [ loop ] must-fail ! Discovered on Windows -: total-failure-1 "" [ ] map unimplemented ; +: total-failure-1 ( -- ) "" [ ] map unimplemented ; [ total-failure-1 ] must-fail diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 2616e5fadb..3ba414fe6b 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -27,7 +27,7 @@ IN: parser.tests [ "hello world" ] [ - "IN: parser.tests : hello \"hello world\" ;" + "IN: parser.tests : hello ( -- str ) \"hello world\" ;" eval "USE: parser.tests hello" eval ] unit-test @@ -78,12 +78,8 @@ IN: parser.tests [ T{ effect f { "a" "b" } { "d" } f } ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test - [ ] [ "IN: parser.tests : effect-parsing-test ;" eval ] unit-test - - [ f ] [ \ effect-parsing-test "declared-effect" word-prop ] unit-test - ! Funny bug - [ 2 ] [ "IN: parser.tests : \0. 2 ; \0." eval ] unit-test + [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval ] unit-test [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail @@ -110,7 +106,7 @@ IN: parser.tests [ ] [ "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 @@ -120,7 +116,7 @@ IN: parser.tests ! Test smudging [ 1 ] [ - "IN: parser.tests : smudge-me ;" "foo" + "IN: parser.tests : smudge-me ( -- ) ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -129,7 +125,7 @@ IN: parser.tests [ t ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test [ ] [ - "IN: parser.tests : smudge-me-more ;" "foo" + "IN: parser.tests : smudge-me-more ( -- ) ;" "foo" parse-stream drop ] unit-test @@ -137,7 +133,7 @@ IN: parser.tests [ f ] [ "smudge-me" "parser.tests" lookup >boolean ] unit-test [ 3 ] [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ; M: string smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ; M: string smudge-me ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -151,7 +147,7 @@ IN: parser.tests ] unit-test [ 2 ] [ - "IN: parser.tests USING: math strings ; GENERIC: smudge-me M: integer smudge-me ;" "foo" + "IN: parser.tests USING: math strings ; GENERIC: smudge-me ( a -- b ) M: integer smudge-me ;" "foo" parse-stream drop "foo" source-file definitions>> first assoc-size @@ -190,7 +186,7 @@ IN: parser.tests [ ] [ "a" source-files get delete-at 2 [ - "IN: parser.tests DEFER: x : y x ; : x y ;" + "IN: parser.tests DEFER: x : y ( -- ) x ; : x ( -- ) y ;" "a" parse-stream drop ] times ] unit-test @@ -198,7 +194,7 @@ IN: parser.tests "a" source-files get delete-at [ - "IN: parser.tests : x ; : y 3 throw ; this is an error" + "IN: parser.tests : x ( -- ) ; : y ( -- * ) 3 throw ; this is an error" "a" parse-stream ] [ source-file-error? ] must-fail-with @@ -207,7 +203,7 @@ IN: parser.tests ] unit-test [ f ] [ - "IN: parser.tests : x ;" + "IN: parser.tests : x ( -- ) ;" "a" parse-stream drop "y" "parser.tests" lookup @@ -215,18 +211,18 @@ IN: parser.tests ! Test new forward definition logic [ ] [ - "IN: axx : axx ;" + "IN: axx : axx ( -- ) ;" "axx" parse-stream drop ] unit-test [ ] [ - "USE: axx IN: bxx : bxx ; : cxx axx bxx ;" + "USE: axx IN: bxx : bxx ( -- ) ; : cxx ( -- ) axx bxx ;" "bxx" parse-stream drop ] unit-test ! So we move the bxx word to axx... [ ] [ - "IN: axx : axx ; : bxx ;" + "IN: axx : axx ( -- ) ; : bxx ( -- ) ;" "axx" parse-stream drop ] unit-test @@ -234,7 +230,7 @@ IN: parser.tests ! And reload the file that uses it... [ ] [ - "USE: axx IN: bxx : cxx axx bxx ;" + "USE: axx IN: bxx ( -- ) : cxx ( -- ) axx bxx ;" "bxx" parse-stream drop ] unit-test @@ -243,17 +239,17 @@ IN: parser.tests ! Turning a generic into a non-generic could cause all ! kinds of funnyness [ ] [ - "IN: ayy USE: kernel GENERIC: ayy M: object ayy ;" + "IN: ayy USE: kernel GENERIC: ayy ( a -- b ) M: object ayy ;" "ayy" parse-stream drop ] unit-test [ ] [ - "IN: ayy USE: kernel : ayy ;" + "IN: ayy USE: kernel : ayy ( -- ) ;" "ayy" parse-stream drop ] unit-test [ ] [ - "IN: azz TUPLE: my-class ; GENERIC: a-generic" + "IN: azz TUPLE: my-class ; GENERIC: a-generic ( a -- b )" "azz" parse-stream drop ] unit-test @@ -263,7 +259,7 @@ IN: parser.tests ] unit-test [ ] [ - "IN: azz GENERIC: a-generic" + "IN: azz GENERIC: a-generic ( a -- b )" "azz" parse-stream drop ] unit-test @@ -273,12 +269,12 @@ IN: parser.tests ] unit-test [ ] [ - "IN: parser.tests : ; : bogus ;" + "IN: parser.tests : ( -- ) ; : bogus ( -- ) ;" "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 ( -- ) ;" "bogus-error" parse-stream drop ] unit-test @@ -298,7 +294,7 @@ IN: parser.tests ] unit-test [ - "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test?" + "IN: parser.tests TUPLE: another-pred-test ; GENERIC: another-pred-test? ( a -- b )" "removing-the-predicate" parse-stream ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -313,7 +309,7 @@ IN: parser.tests ] unit-test [ - "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ;" + "IN: parser.tests TUPLE: class-redef-test ; SYMBOL: class-redef-test : class-redef-test ( -- ) ;" "redefining-a-class-3" parse-stream drop ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -338,7 +334,7 @@ IN: parser.tests ] [ error>> error>> error>> no-word-error? ] must-fail-with [ - "IN: parser.tests : foo ; TUPLE: foo ;" + "IN: parser.tests : foo ( -- ) ; TUPLE: foo ;" "redefining-a-class-4" parse-stream drop ] [ error>> error>> error>> redefine-error? ] must-fail-with @@ -369,7 +365,7 @@ IN: parser.tests 2 [ [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-5" parse-stream drop ] unit-test @@ -381,14 +377,14 @@ IN: parser.tests [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-5" parse-stream drop ] unit-test [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test [ ] [ - "IN: parser.tests TUPLE: foo ; GENERIC: foo" + "IN: parser.tests TUPLE: foo ; GENERIC: foo ( a -- b )" "redefining-a-class-7" parse-stream drop ] unit-test @@ -438,7 +434,7 @@ IN: parser.tests { "IN: parser.tests" "USING: math arrays ;" - "GENERIC: change-combination" + "GENERIC: change-combination ( a -- b )" "M: integer change-combination 1 ;" "M: array change-combination 2 ;" } "\n" join "change-combination-test" parse-stream drop @@ -448,7 +444,7 @@ IN: parser.tests { "IN: parser.tests" "USING: math arrays ;" - "GENERIC# change-combination 1" + "GENERIC# change-combination 1 ( a -- b )" "M: integer change-combination 1 ;" "M: array change-combination 2 ;" } "\n" join "change-combination-test" parse-stream drop @@ -467,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 ( -- ) 1 ; : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -476,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 ( -- ) 1 ; >> : staging-problem-test-2 ( -- ) staging-problem-test-1 ;" "staging-problem-test" parse-stream ] unit-test @@ -495,7 +491,7 @@ 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 @@ -510,7 +506,7 @@ SYMBOLS: a b c ; DEFER: blah -[ ] [ "IN: parser.tests GENERIC: 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 @@ -523,13 +519,13 @@ DEFER: blah1 must-fail-with IN: qualified.tests.foo -: x 1 ; -: y 5 ; +: x ( -- a ) 1 ; +: y ( -- a ) 5 ; IN: qualified.tests.bar -: x 2 ; -: y 4 ; +: x ( -- a ) 2 ; +: y ( -- a ) 4 ; IN: qualified.tests.baz -: x 3 ; +: x ( -- a ) 3 ; QUALIFIED: qualified.tests.foo QUALIFIED: qualified.tests.bar diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 4241999bcd..87531caee4 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -132,7 +132,7 @@ IN: vocabs.loader.tests "vocabs.loader.test.d" vocab source-loaded?>> ] unit-test -: forget-junk +: forget-junk ( -- ) [ { "2" "a" "b" "d" "e" "f" } [ diff --git a/core/vocabs/loader/test/d/d.factor b/core/vocabs/loader/test/d/d.factor index e4f1c02a3a..a07695f1c3 100644 --- a/core/vocabs/loader/test/d/d.factor +++ b/core/vocabs/loader/test/d/d.factor @@ -1,3 +1,3 @@ IN: vocabs.loader.test.d -: foo iterate-next ; \ No newline at end of file +: foo ( -- ) iterate-next ; \ No newline at end of file diff --git a/extra/advice/advice-tests.factor b/extra/advice/advice-tests.factor index be16150c2e..a141489a0f 100644 --- a/extra/advice/advice-tests.factor +++ b/extra/advice/advice-tests.factor @@ -7,7 +7,7 @@ IN: advice.tests [ [ ad-do-it ] must-fail - : foo "foo" ; + : foo ( -- str ) "foo" ; \ foo make-advised { "bar" "foo" } [ diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 869158bf72..ba3438e37d 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,44 +1,45 @@ -USING: words kernel sequences locals locals.parser -locals.definitions accessors parser namespaces continuations -summary definitions generalizations arrays ; -IN: descriptive - -ERROR: descriptive-error args underlying word ; - -M: descriptive-error summary - word>> "The " swap name>> " word encountered an error." - 3append ; - -> rethrower - [ recover ] 2curry ; -PRIVATE> - -: define-descriptive ( word def effect -- ) - [ drop "descriptive-definition" set-word-prop ] - [ [ dupd [descriptive] ] dip define-declared ] - 3bi ; - -SYNTAX: DESCRIPTIVE: (:) define-descriptive ; - -PREDICATE: descriptive < word - "descriptive-definition" word-prop ; - -M: descriptive definer drop \ DESCRIPTIVE: \ ; ; - -M: descriptive definition - "descriptive-definition" word-prop ; - -SYNTAX: DESCRIPTIVE:: (::) define-descriptive ; - -INTERSECTION: descriptive-lambda descriptive lambda-word ; - -M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ; - -M: descriptive-lambda definition - "lambda" word-prop body>> ; +USING: words kernel sequences locals locals.parser +locals.definitions accessors parser namespaces continuations +summary definitions generalizations arrays ; +IN: descriptive + +ERROR: descriptive-error args underlying word ; + +M: descriptive-error summary + word>> "The " swap name>> " word encountered an error." + 3append ; + +> rethrower [ recover ] 2curry ; + +PRIVATE> + +: define-descriptive ( word def effect -- ) + [ drop "descriptive-definition" set-word-prop ] + [ [ [ dup ] 2dip [descriptive] ] keep define-declared ] + 3bi ; + +SYNTAX: DESCRIPTIVE: (:) define-descriptive ; + +PREDICATE: descriptive < word + "descriptive-definition" word-prop ; + +M: descriptive definer drop \ DESCRIPTIVE: \ ; ; + +M: descriptive definition + "descriptive-definition" word-prop ; + +SYNTAX: DESCRIPTIVE:: (::) define-descriptive ; + +INTERSECTION: descriptive-lambda descriptive lambda-word ; + +M: descriptive-lambda definer drop \ DESCRIPTIVE:: \ ; ; + +M: descriptive-lambda definition + "lambda" word-prop body>> ; diff --git a/extra/infix/infix-tests.factor b/extra/infix/infix-tests.factor index 7e8e2dfcc9..5e3d5d67cb 100644 --- a/extra/infix/infix-tests.factor +++ b/extra/infix/infix-tests.factor @@ -31,8 +31,6 @@ IN: infix.tests [ f ] [ 2 \ gcd check-word ] unit-test ! multiple return values [ f ] [ 1 \ drop check-word ] unit-test ! no return value [ f ] [ 1 \ lcm check-word ] unit-test ! takes 2 args -: no-stack-effect-declared + ; -[ 0 \ no-stack-effect-declared check-word ] must-fail : qux ( -- x ) 2 ; [ t ] [ 0 \ qux check-word ] unit-test diff --git a/extra/lint/lint-tests.factor b/extra/lint/lint-tests.factor index e2ca8816d9..70035f1854 100644 --- a/extra/lint/lint-tests.factor +++ b/extra/lint/lint-tests.factor @@ -9,6 +9,6 @@ IN: lint.tests : lint2 ( n -- n' ) 1 + ; ! 1+ [ { [ 1 + ] } ] [ \ lint2 lint ] unit-test -: lint3 dup -rot ; ! tuck +: lint3 ( a b -- b a b ) dup -rot ; ! tuck [ { { lint3 { [ dup -rot ] } } } ] [ \ lint3 lint-word ] unit-test diff --git a/extra/math/analysis/analysis-tests.factor b/extra/math/analysis/analysis-tests.factor index 5b537c2621..1c11162a68 100644 --- a/extra/math/analysis/analysis-tests.factor +++ b/extra/math/analysis/analysis-tests.factor @@ -2,8 +2,7 @@ USING: kernel math math.functions tools.test math.analysis math.constants ; IN: math.analysis.tests -: eps - .00000001 ; +CONSTANT: eps .00000001 [ t ] [ -9000000000000000000000000000000000000000000 gamma 1/0. = ] unit-test [ t ] [ -1.5 gamma 2.363271801207344 eps ~ ] unit-test diff --git a/extra/multi-methods/tests/canonicalize.factor b/extra/multi-methods/tests/canonicalize.factor index 991551c009..91982de95c 100644 --- a/extra/multi-methods/tests/canonicalize.factor +++ b/extra/multi-methods/tests/canonicalize.factor @@ -4,11 +4,11 @@ kernel strings ; [ { POSTPONE: f integer } ] [ { f integer } canonicalize-specializer-0 ] unit-test -: setup-canon-test +: setup-canon-test ( -- ) 0 args set V{ } clone hooks set ; -: canon-test-1 +: canon-test-1 ( -- seq ) { integer { cpu x86 } sequence } canonicalize-specializer-1 ; [ { { -2 integer } { -1 sequence } { cpu x86 } } ] [ @@ -36,12 +36,12 @@ kernel strings ; ] with-scope ] unit-test -: example-1 +CONSTANT: example-1 { { { { cpu x86 } { os linux } } "a" } { { { cpu ppc } } "b" } { { string { os windows } } "c" } - } ; + } [ { diff --git a/extra/multi-methods/tests/legacy.factor b/extra/multi-methods/tests/legacy.factor index f4bd0a00b2..b6d732643f 100644 --- a/extra/multi-methods/tests/legacy.factor +++ b/extra/multi-methods/tests/legacy.factor @@ -1,7 +1,7 @@ IN: multi-methods.tests USING: math strings sequences tools.test ; -GENERIC: legacy-test +GENERIC: legacy-test ( a -- b ) M: integer legacy-test sq ; M: string legacy-test " hey" append ; diff --git a/extra/sequences/n-based/n-based-tests.factor b/extra/sequences/n-based/n-based-tests.factor index 7ee5bd649f..eed5540cb3 100644 --- a/extra/sequences/n-based/n-based-tests.factor +++ b/extra/sequences/n-based/n-based-tests.factor @@ -3,7 +3,7 @@ USING: kernel accessors assocs sequences sequences.n-based tools.test ; IN: sequences.n-based.tests -: months +: months ( -- assoc ) V{ "January" "February" diff --git a/extra/svg/svg-tests.factor b/extra/svg/svg-tests.factor index 932904eff4..71b30cd175 100644 --- a/extra/svg/svg-tests.factor +++ b/extra/svg/svg-tests.factor @@ -106,7 +106,7 @@ STRING: test-svg-string ; -: test-svg-path +: test-svg-path ( -- obj ) test-svg-string string>xml body>> children-tags first ; [ { T{ moveto f { -1.0 -1.0 } f } T{ lineto f { 2.0 2.0 } t } } ] diff --git a/extra/units/units-tests.factor b/extra/units/units-tests.factor index 9b450ed18b..96497b8bbc 100755 --- a/extra/units/units-tests.factor +++ b/extra/units/units-tests.factor @@ -15,7 +15,7 @@ IN: units.tests [ t ] [ 1 m 2 m 3 m 3array d-product 6 m^3 = ] unit-test [ t ] [ 3 m d-recip 1/3 { } { m } = ] unit-test -: km/L km 1 L d/ ; -: mpg miles 1 gallons d/ ; +: km/L ( n -- d ) km 1 L d/ ; +: mpg ( n -- d ) miles 1 gallons d/ ; [ t ] [ 100 10 / km/L [ mpg ] undo 23 1 ~ ] unit-test