Fixing unit tests for stack effect inference changes
Slava Pestov
parent
ad943f6c4c
commit
05f3f9dcb9
|
|
@ -15,5 +15,3 @@ tools.test threads concurrency.count-downs ;
|
|||
[ resume ] curry instant later drop
|
||||
] "test" suspend drop
|
||||
] unit-test
|
||||
|
||||
\ alarm-thread-loop must-infer
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@ IN: alien.c-types.tests
|
|||
USING: alien alien.syntax alien.c-types kernel tools.test
|
||||
sequences system libc alien.strings io.encodings.utf8 ;
|
||||
|
||||
\ expand-constants must-infer
|
||||
|
||||
CONSTANT: xyz 123
|
||||
|
||||
[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
|
||||
|
|
|
|||
|
|
@ -25,6 +25,3 @@ IN: base64.tests
|
|||
|
||||
[ { 33 52 17 40 12 51 33 43 18 33 23 } base64> ]
|
||||
[ malformed-base64? ] must-fail-with
|
||||
|
||||
\ >base64 must-infer
|
||||
\ base64> must-infer
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
IN: binary-search.tests
|
||||
USING: binary-search math.order vectors kernel tools.test ;
|
||||
|
||||
\ sorted-member? must-infer
|
||||
|
||||
[ f ] [ 3 { } [ <=> ] with search drop ] unit-test
|
||||
[ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
|
||||
[ 1 ] [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,9 +2,6 @@ IN: bootstrap.image.tests
|
|||
USING: bootstrap.image bootstrap.image.private tools.test
|
||||
kernel math ;
|
||||
|
||||
\ ' must-infer
|
||||
\ write-image must-infer
|
||||
|
||||
[ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
|
||||
|
||||
[ t ] [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,10 +2,6 @@ USING: arrays calendar kernel math sequences tools.test
|
|||
continuations system math.order threads ;
|
||||
IN: calendar.tests
|
||||
|
||||
\ time+ must-infer
|
||||
\ time* must-infer
|
||||
\ time- must-infer
|
||||
|
||||
[ f ] [ 2004 12 32 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2004 2 30 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
|
||||
[ f ] [ 2003 2 29 0 0 0 instant <timestamp> valid-timestamp? ] unit-test
|
||||
|
|
|
|||
|
|
@ -10,6 +10,6 @@ IN: calendar.format.macros
|
|||
: compiled-test-1 ( -- n )
|
||||
{ [ 1 throw ] [ 2 ] } attempt-all-quots ;
|
||||
|
||||
\ compiled-test-1 must-infer
|
||||
\ compiled-test-1 def>> must-infer
|
||||
|
||||
[ 2 ] [ compiled-test-1 ] unit-test
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ IN: combinators.smart.tests
|
|||
: nested-smart-combo-test ( -- array )
|
||||
[ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
|
||||
|
||||
\ nested-smart-combo-test must-infer
|
||||
\ nested-smart-combo-test def>> must-infer
|
||||
|
||||
[ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@ math.private compiler.tree.builder compiler.tree.optimizer
|
|||
compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
|
||||
kernel.private math ;
|
||||
|
||||
\ build-cfg must-infer
|
||||
|
||||
! Just ensure that various CFGs build correctly.
|
||||
: unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: compiler.cfg.linear-scan.assignment tools.test ;
|
||||
IN: compiler.cfg.linear-scan.assignment.tests
|
||||
|
||||
\ assign-registers must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: compiler.cfg.linearization.tests
|
||||
USING: compiler.cfg.linearization tools.test ;
|
||||
|
||||
\ build-mr must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +0,0 @@
|
|||
IN: compiler.tests
|
||||
USING: words kernel stack-checker alien.strings tools.test
|
||||
compiler.units ;
|
||||
|
||||
[ ] [ [ \ if redefined ] with-compilation-unit [ string>alien ] infer. ] unit-test
|
||||
|
|
@ -261,7 +261,7 @@ USE: binary-search.private
|
|||
: lift-loop-tail-test-2 ( -- a b c )
|
||||
10 [ ] lift-loop-tail-test-1 1 2 3 ;
|
||||
|
||||
\ lift-loop-tail-test-2 must-infer
|
||||
\ lift-loop-tail-test-2 def>> must-infer
|
||||
|
||||
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
|
||||
|
||||
|
|
@ -302,7 +302,7 @@ HINTS: recursive-inline-hang-3 array ;
|
|||
|
||||
: member-test ( obj -- ? ) { + - * / /i } member? ;
|
||||
|
||||
\ member-test must-infer
|
||||
\ member-test def>> must-infer
|
||||
[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
|
||||
[ t ] [ \ + member-test ] unit-test
|
||||
[ f ] [ \ append member-test ] unit-test
|
||||
|
|
@ -325,7 +325,7 @@ PREDICATE: list < improper-list
|
|||
dup "a" get { array-capacity } declare >=
|
||||
[ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
|
||||
|
||||
\ interval-inference-bug must-infer
|
||||
[ t ] [ \ interval-inference-bug optimized>> ] unit-test
|
||||
|
||||
[ ] [ 1 "a" set 2 "b" set ] unit-test
|
||||
[ 2 3 ] [ 2 interval-inference-bug ] unit-test
|
||||
|
|
|
|||
|
|
@ -36,41 +36,3 @@ M: integer method-redefine-generic-2 3 + ;
|
|||
fixnum string [ \ method-redefine-generic-2 method forget ] bi@
|
||||
] with-compilation-unit
|
||||
] unit-test
|
||||
|
||||
! Test ripple-up behavior
|
||||
: hey ( -- ) ;
|
||||
: there ( -- ) hey ;
|
||||
|
||||
[ t ] [ \ hey optimized>> ] unit-test
|
||||
[ t ] [ \ there optimized>> ] 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
|
||||
[ t ] [ \ there optimized>> ] unit-test
|
||||
|
||||
: good ( -- ) ;
|
||||
: bad ( -- ) good ;
|
||||
: ugly ( -- ) bad ;
|
||||
|
||||
[ t ] [ \ good optimized>> ] unit-test
|
||||
[ t ] [ \ bad optimized>> ] unit-test
|
||||
[ t ] [ \ ugly optimized>> ] unit-test
|
||||
|
||||
[ f ] [ \ good compiled-usage assoc-empty? ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval( -- ) ] unit-test
|
||||
|
||||
[ f ] [ \ good optimized>> ] unit-test
|
||||
[ f ] [ \ bad optimized>> ] unit-test
|
||||
[ f ] [ \ ugly optimized>> ] unit-test
|
||||
|
||||
[ t ] [ \ good compiled-usage assoc-empty? ] unit-test
|
||||
|
||||
[ ] [ "IN: compiler.tests : good ( -- ) ;" eval( -- ) ] unit-test
|
||||
|
||||
[ t ] [ \ good optimized>> ] unit-test
|
||||
[ t ] [ \ bad optimized>> ] unit-test
|
||||
[ t ] [ \ ugly optimized>> ] unit-test
|
||||
|
||||
[ f ] [ \ good compiled-usage assoc-empty? ] unit-test
|
||||
|
|
|
|||
|
|
@ -6,5 +6,4 @@ quotations stack-checker ;
|
|||
|
||||
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
|
||||
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
|
||||
[ "blah" "compiler.tests.redefine16" lookup 1quotation infer ] must-fail
|
||||
[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
|
||||
|
|
@ -3,8 +3,6 @@ sequences.private math.private math combinators strings alien
|
|||
arrays memory vocabs parser eval ;
|
||||
IN: compiler.tests
|
||||
|
||||
\ (compile) must-infer
|
||||
|
||||
! Test empty word
|
||||
[ ] [ [ ] compile-call ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,27 @@
|
|||
IN: compiler.tree.builder.tests
|
||||
USING: compiler.tree.builder tools.test sequences kernel
|
||||
compiler.tree ;
|
||||
|
||||
\ build-tree must-infer
|
||||
\ build-tree-with must-infer
|
||||
\ build-tree-from-word must-infer
|
||||
compiler.tree stack-checker stack-checker.errors ;
|
||||
|
||||
: inline-recursive ( -- ) inline-recursive ; inline recursive
|
||||
|
||||
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test
|
||||
|
||||
: bad-recursion-1 ( a -- b )
|
||||
dup [ drop bad-recursion-1 5 ] [ ] if ;
|
||||
|
||||
[ \ bad-recursion-1 build-tree-from-word ] [ inference-error? ] must-fail-with
|
||||
|
||||
FORGET: bad-recursion-1
|
||||
|
||||
: bad-recursion-2 ( obj -- obj )
|
||||
dup [ dup first swap second bad-recursion-2 ] [ ] if ;
|
||||
|
||||
[ \ bad-recursion-2 build-tree-from-word ] [ inference-error? ] must-fail-with
|
||||
|
||||
FORGET: bad-recursion-2
|
||||
|
||||
: bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ;
|
||||
|
||||
[ \ bad-bin build-tree-from-word ] [ inference-error? ] must-fail-with
|
||||
|
||||
FORGET: bad-bin
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: compiler.tree.checker.tests
|
||||
USING: compiler.tree.checker tools.test ;
|
||||
|
||||
\ check-nodes must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -9,8 +9,6 @@ accessors combinators io prettyprint words sequences.deep
|
|||
sequences.private arrays classes kernel.private ;
|
||||
IN: compiler.tree.dead-code.tests
|
||||
|
||||
\ remove-dead-code must-infer
|
||||
|
||||
: count-live-values ( quot -- n )
|
||||
build-tree
|
||||
analyze-recursive
|
||||
|
|
|
|||
|
|
@ -1,8 +1,5 @@
|
|||
IN: compiler.tree.debugger.tests
|
||||
USING: compiler.tree.debugger tools.test sorting sequences io math.order ;
|
||||
|
||||
\ optimized. must-infer
|
||||
\ optimizer-report. must-infer
|
||||
|
||||
[ [ <=> ] sort ] optimized.
|
||||
[ <reversed> [ print ] each ] optimizer-report.
|
||||
|
|
@ -7,8 +7,6 @@ compiler.tree.def-use arrays kernel.private sorting math.order
|
|||
binary-search compiler.tree.checker ;
|
||||
IN: compiler.tree.def-use.tests
|
||||
|
||||
\ compute-def-use must-infer
|
||||
|
||||
[ t ] [
|
||||
[ 1 2 3 ] build-tree compute-def-use drop
|
||||
def-use get {
|
||||
|
|
|
|||
|
|
@ -11,8 +11,6 @@ compiler.tree.propagation.info stack-checker.errors
|
|||
compiler.tree.checker
|
||||
kernel.private ;
|
||||
|
||||
\ escape-analysis must-infer
|
||||
|
||||
GENERIC: count-unboxed-allocations* ( m node -- n )
|
||||
|
||||
: (count-unboxed-allocations) ( m node -- n )
|
||||
|
|
|
|||
|
|
@ -6,9 +6,6 @@ compiler.tree.normalization.renaming
|
|||
compiler.tree compiler.tree.checker
|
||||
sequences accessors tools.test kernel math ;
|
||||
|
||||
\ count-introductions must-infer
|
||||
\ normalize must-infer
|
||||
|
||||
[ 3 ] [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
|
||||
|
||||
[ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: compiler.tree.optimizer tools.test ;
|
||||
IN: compiler.tree.optimizer.tests
|
||||
|
||||
\ optimize-tree must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -12,8 +12,6 @@ specialized-arrays.double system sorting math.libm
|
|||
math.intervals ;
|
||||
IN: compiler.tree.propagation.tests
|
||||
|
||||
\ propagate must-infer
|
||||
|
||||
[ V{ } ] [ [ ] final-classes ] unit-test
|
||||
|
||||
[ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test
|
||||
|
|
|
|||
|
|
@ -10,8 +10,6 @@ compiler.tree.combinators ;
|
|||
[ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test
|
||||
[ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test
|
||||
|
||||
\ analyze-recursive must-infer
|
||||
|
||||
: label-is-loop? ( nodes word -- ? )
|
||||
[
|
||||
{
|
||||
|
|
@ -21,8 +19,6 @@ compiler.tree.combinators ;
|
|||
} 2&&
|
||||
] curry contains-node? ;
|
||||
|
||||
\ label-is-loop? must-infer
|
||||
|
||||
: label-is-not-loop? ( nodes word -- ? )
|
||||
[
|
||||
{
|
||||
|
|
@ -32,8 +28,6 @@ compiler.tree.combinators ;
|
|||
} 2&&
|
||||
] curry contains-node? ;
|
||||
|
||||
\ label-is-not-loop? must-infer
|
||||
|
||||
: loop-test-1 ( a -- )
|
||||
dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive
|
||||
|
||||
|
|
|
|||
|
|
@ -8,8 +8,6 @@ compiler.tree.def-use kernel accessors sequences math
|
|||
math.private sorting math.order binary-search sequences.private
|
||||
slots.private ;
|
||||
|
||||
\ unbox-tuples must-infer
|
||||
|
||||
: test-unboxing ( quot -- )
|
||||
build-tree
|
||||
analyze-recursive
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@ IN: db.pools.tests
|
|||
USING: db.pools tools.test continuations io.files io.files.temp
|
||||
io.directories namespaces accessors kernel math destructors ;
|
||||
|
||||
\ <db-pool> must-infer
|
||||
|
||||
{ 1 0 } [ [ ] with-db-pool ] must-infer-as
|
||||
|
||||
{ 1 0 } [ [ ] with-pooled-db ] must-infer-as
|
||||
|
|
|
|||
|
|
@ -592,17 +592,6 @@ string-encoding-test "STRING_ENCODING_TEST" {
|
|||
[ test-string-encoding ] test-sqlite
|
||||
[ test-string-encoding ] test-postgresql
|
||||
|
||||
! Don't comment these out. These words must infer
|
||||
\ bind-tuple must-infer
|
||||
\ insert-tuple must-infer
|
||||
\ update-tuple must-infer
|
||||
\ delete-tuples must-infer
|
||||
\ select-tuple must-infer
|
||||
\ define-persistent must-infer
|
||||
\ ensure-table must-infer
|
||||
\ create-table must-infer
|
||||
\ drop-table must-infer
|
||||
|
||||
: test-queries ( -- )
|
||||
[ ] [ exam ensure-table ] unit-test
|
||||
[ ] [ 1000 [ random-exam insert-tuple ] times ] unit-test
|
||||
|
|
|
|||
|
|
@ -43,8 +43,6 @@ WHERE
|
|||
|
||||
>>
|
||||
|
||||
\ sqsq must-infer
|
||||
|
||||
[ 16 ] [ 2 sqsq ] unit-test
|
||||
|
||||
<<
|
||||
|
|
|
|||
|
|
@ -1,6 +1,3 @@
|
|||
USING: furnace.auth tools.test ;
|
||||
IN: furnace.auth.tests
|
||||
|
||||
\ logged-in-username must-infer
|
||||
\ <protected> must-infer
|
||||
\ new-realm must-infer
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: furnace.auth.features.edit-profile.tests
|
||||
USING: tools.test furnace.auth.features.edit-profile ;
|
||||
|
||||
\ allow-edit-profile must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: furnace.auth.features.recover-password
|
||||
USING: tools.test furnace.auth.features.recover-password ;
|
||||
|
||||
\ allow-password-recovery must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: furnace.auth.features.registration.tests
|
||||
USING: tools.test furnace.auth.features.registration ;
|
||||
|
||||
\ allow-registration must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: furnace.auth.login.tests
|
||||
USING: tools.test furnace.auth.login ;
|
||||
|
||||
\ <login-realm> must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: furnace.db.tests
|
||||
USING: tools.test furnace.db ;
|
||||
|
||||
\ <db-persistence> must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -26,5 +26,3 @@ TUPLE: blahblah quux ;
|
|||
[ "a string, a fixnum, or an integer" ]
|
||||
[ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test
|
||||
|
||||
\ print-element must-infer
|
||||
\ print-topic must-infer
|
||||
|
|
@ -3,11 +3,6 @@ help.markup help.syntax kernel sequences tools.test words parser
|
|||
namespaces assocs source-files eval ;
|
||||
IN: help.topics.tests
|
||||
|
||||
\ article-name must-infer
|
||||
\ article-title must-infer
|
||||
\ article-content must-infer
|
||||
\ article-parent must-infer
|
||||
|
||||
! Test help cross-referencing
|
||||
|
||||
[ ] [ "Test B" { "Hello world." } <article> { "test" "b" } add-article ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,8 +4,6 @@ io.streams.null accessors inspector html.streams
|
|||
html.components html.forms namespaces
|
||||
xml.writer ;
|
||||
|
||||
\ render must-infer
|
||||
|
||||
[ ] [ begin-form ] unit-test
|
||||
|
||||
[ ] [ 3 "hi" set-value ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
USING: http.client http.client.private http tools.test
|
||||
namespaces urls ;
|
||||
|
||||
\ download must-infer
|
||||
|
||||
[ "localhost" f ] [ "localhost" parse-host ] unit-test
|
||||
[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,6 @@ tools.test kernel namespaces accessors io http math sequences
|
|||
assocs arrays classes words urls ;
|
||||
IN: http.server.dispatchers.tests
|
||||
|
||||
\ find-responder must-infer
|
||||
|
||||
TUPLE: mock-responder path ;
|
||||
|
||||
C: <mock-responder> mock-responder
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@ IN: http.server.redirection.tests
|
|||
USING: http http.server.redirection urls accessors
|
||||
namespaces tools.test present kernel ;
|
||||
|
||||
\ relative-to-request must-infer
|
||||
|
||||
[
|
||||
<request>
|
||||
<url>
|
||||
|
|
|
|||
|
|
@ -4,8 +4,6 @@ IN: http.server.tests
|
|||
|
||||
[ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
|
||||
|
||||
\ make-http-error must-infer
|
||||
|
||||
[ "text/plain; charset=UTF-8" ] [
|
||||
<response>
|
||||
"text/plain" >>content-type
|
||||
|
|
|
|||
|
|
@ -3,9 +3,6 @@ io.directories kernel io.pathnames accessors tools.test
|
|||
sequences io.files.temp ;
|
||||
IN: io.files.info.tests
|
||||
|
||||
\ file-info must-infer
|
||||
\ link-info must-infer
|
||||
|
||||
[ t ] [
|
||||
temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
|
||||
temp-directory "test41" append-path utf8 file-contents "hi41" =
|
||||
|
|
|
|||
|
|
@ -1,6 +1,3 @@
|
|||
IN: io.launcher.tests
|
||||
USING: tools.test io.launcher ;
|
||||
|
||||
\ <process-stream> must-infer
|
||||
\ <process-reader> must-infer
|
||||
\ <process-writer> must-infer
|
||||
|
|
|
|||
|
|
@ -4,8 +4,6 @@ concurrency.mailboxes tools.test destructors io.files.info
|
|||
io.pathnames io.files.temp io.directories.hierarchy ;
|
||||
IN: io.monitors.recursive.tests
|
||||
|
||||
\ pump-thread must-infer
|
||||
|
||||
SINGLETON: mock-io-backend
|
||||
|
||||
TUPLE: counter i ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
IN: io.monitors.windows.nt.tests
|
||||
USING: io.monitors.windows.nt tools.test ;
|
||||
|
||||
\ fill-queue-thread must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -5,7 +5,6 @@ io.backend.unix classes words destructors threads tools.test
|
|||
concurrency.promises byte-arrays locals calendar io.timeouts
|
||||
io.sockets.secure.unix.debug ;
|
||||
|
||||
\ <secure-config> must-infer
|
||||
{ 1 0 } [ [ ] with-secure-context ] must-infer-as
|
||||
|
||||
[ ] [ <promise> "port" set ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,8 +1,2 @@
|
|||
IN: io.styles.tests
|
||||
USING: io.styles tools.test ;
|
||||
|
||||
\ stream-format must-infer
|
||||
\ stream-write-table must-infer
|
||||
\ make-span-stream must-infer
|
||||
\ make-block-stream must-infer
|
||||
\ make-cell-stream must-infer
|
||||
|
|
@ -2,10 +2,6 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test lcs ;
|
||||
|
||||
\ lcs must-infer
|
||||
\ diff must-infer
|
||||
\ levenshtein must-infer
|
||||
|
||||
[ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
|
||||
[ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
|
||||
[ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
IN: locals.backend.tests
|
||||
USING: tools.test locals.backend kernel arrays ;
|
||||
USING: tools.test locals.backend kernel arrays accessors ;
|
||||
|
||||
: get-local-test-1 ( -- x ) 3 1 load-locals 0 get-local 1 drop-locals ;
|
||||
|
||||
\ get-local-test-1 must-infer
|
||||
\ get-local-test-1 def>> must-infer
|
||||
|
||||
[ 3 ] [ get-local-test-1 ] unit-test
|
||||
|
||||
: get-local-test-2 ( -- x ) 3 4 2 load-locals -1 get-local 2 drop-locals ;
|
||||
|
||||
\ get-local-test-2 must-infer
|
||||
\ get-local-test-2 def>> must-infer
|
||||
|
||||
[ 3 ] [ get-local-test-2 ] unit-test
|
||||
|
|
|
|||
|
|
@ -43,8 +43,8 @@ IN: locals.tests
|
|||
|
||||
[ { 1 2 } ] [ 2 let-test-4 ] unit-test
|
||||
|
||||
:: let-test-5 ( a -- b )
|
||||
a [let | a [ ] b [ ] | a b 2array ] ;
|
||||
:: let-test-5 ( a b -- b )
|
||||
a b [let | a [ ] b [ ] | a b 2array ] ;
|
||||
|
||||
[ { 2 1 } ] [ 1 2 let-test-5 ] unit-test
|
||||
|
||||
|
|
@ -129,7 +129,8 @@ write-test-2 "q" set
|
|||
SYMBOL: a
|
||||
|
||||
:: use-test ( a b c -- a b c )
|
||||
USE: kernel ;
|
||||
USE: kernel
|
||||
a b c ;
|
||||
|
||||
[ t ] [ a symbol? ] unit-test
|
||||
|
||||
|
|
@ -171,9 +172,9 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
|
|||
|
||||
[ ] [ \ lambda-generic see ] unit-test
|
||||
|
||||
:: unparse-test-1 ( a -- ) [let | a! [ ] | ] ;
|
||||
:: unparse-test-1 ( a -- ) [let | a! [ 3 ] | ] ;
|
||||
|
||||
[ "[let | a! [ ] | ]" ] [
|
||||
[ "[let | a! [ 3 ] | ]" ] [
|
||||
\ unparse-test-1 "lambda" word-prop body>> first unparse
|
||||
] unit-test
|
||||
|
||||
|
|
@ -286,7 +287,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
{ [ a b > ] [ 5 ] }
|
||||
} cond ;
|
||||
|
||||
\ cond-test must-infer
|
||||
\ cond-test def>> must-infer
|
||||
|
||||
[ 3 ] [ 1 2 cond-test ] unit-test
|
||||
[ 4 ] [ 2 2 cond-test ] unit-test
|
||||
|
|
@ -295,7 +296,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
:: 0&&-test ( a -- ? )
|
||||
{ [ a integer? ] [ a even? ] [ a 10 > ] } 0&& ;
|
||||
|
||||
\ 0&&-test must-infer
|
||||
\ 0&&-test def>> must-infer
|
||||
|
||||
[ f ] [ 1.5 0&&-test ] unit-test
|
||||
[ f ] [ 3 0&&-test ] unit-test
|
||||
|
|
@ -305,7 +306,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
:: &&-test ( a -- ? )
|
||||
{ [ a integer? ] [ a even? ] [ a 10 > ] } && ;
|
||||
|
||||
\ &&-test must-infer
|
||||
\ &&-test def>> must-infer
|
||||
|
||||
[ f ] [ 1.5 &&-test ] unit-test
|
||||
[ f ] [ 3 &&-test ] unit-test
|
||||
|
|
@ -321,7 +322,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
]
|
||||
] ;
|
||||
|
||||
\ let-and-cond-test-1 must-infer
|
||||
\ let-and-cond-test-1 def>> must-infer
|
||||
|
||||
[ 20 ] [ let-and-cond-test-1 ] unit-test
|
||||
|
||||
|
|
@ -332,7 +333,7 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
]
|
||||
] ;
|
||||
|
||||
\ let-and-cond-test-2 must-infer
|
||||
\ let-and-cond-test-2 def>> must-infer
|
||||
|
||||
[ { 10 20 } ] [ let-and-cond-test-2 ] unit-test
|
||||
|
||||
|
|
@ -388,7 +389,7 @@ ERROR: punned-class x ;
|
|||
{ 5 [ a a ^ ] }
|
||||
} case ;
|
||||
|
||||
\ big-case-test must-infer
|
||||
\ big-case-test def>> must-infer
|
||||
|
||||
[ 9 ] [ 3 big-case-test ] unit-test
|
||||
|
||||
|
|
@ -400,7 +401,7 @@ ERROR: punned-class x ;
|
|||
[| x | x 12 + { "howdy" } nth ]
|
||||
} case ;
|
||||
|
||||
\ littledan-case-problem-1 must-infer
|
||||
\ littledan-case-problem-1 def>> must-infer
|
||||
|
||||
[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test
|
||||
[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test
|
||||
|
|
@ -412,7 +413,7 @@ ERROR: punned-class x ;
|
|||
[| x | x a - { "howdy" } nth ]
|
||||
} case ;
|
||||
|
||||
\ littledan-case-problem-2 must-infer
|
||||
\ littledan-case-problem-2 def>> must-infer
|
||||
|
||||
[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test
|
||||
[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test
|
||||
|
|
@ -424,7 +425,7 @@ ERROR: punned-class x ;
|
|||
[| x | x a - { "howdy" } nth ]
|
||||
} cond ;
|
||||
|
||||
\ littledan-cond-problem-1 must-infer
|
||||
\ littledan-cond-problem-1 def>> must-infer
|
||||
|
||||
[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test
|
||||
[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test
|
||||
|
|
@ -448,12 +449,12 @@ ERROR: punned-class x ;
|
|||
: littledan-case-problem-4 ( a -- b )
|
||||
[ 1 + ] littledan-case-problem-3 ;
|
||||
|
||||
\ littledan-case-problem-4 must-infer
|
||||
\ littledan-case-problem-4 def>> must-infer
|
||||
*/
|
||||
|
||||
GENERIC: lambda-method-forget-test ( a -- b )
|
||||
|
||||
M:: integer lambda-method-forget-test ( a -- b ) ;
|
||||
M:: integer lambda-method-forget-test ( a -- b ) a ;
|
||||
|
||||
[ ] [ [ M\ integer lambda-method-forget-test forget ] with-compilation-unit ] unit-test
|
||||
|
||||
|
|
@ -467,7 +468,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
|
|||
:: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
|
||||
: funny-macro-test ( n -- ? ) [ odd? ] (funny-macro-test) ;
|
||||
|
||||
\ funny-macro-test must-infer
|
||||
\ funny-macro-test def>> must-infer
|
||||
|
||||
[ t ] [ 3 funny-macro-test ] unit-test
|
||||
[ f ] [ 2 funny-macro-test ] unit-test
|
||||
|
|
@ -483,11 +484,11 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
|
|||
|
||||
:: FAILdog-1 ( -- b ) { [| c | c ] } ;
|
||||
|
||||
\ FAILdog-1 must-infer
|
||||
\ FAILdog-1 def>> must-infer
|
||||
|
||||
:: FAILdog-2 ( a -- b ) a { [| c | c ] } cond ;
|
||||
|
||||
\ FAILdog-2 must-infer
|
||||
\ FAILdog-2 def>> must-infer
|
||||
|
||||
[ 3 ] [ 3 [| a | \ a ] call ] unit-test
|
||||
|
||||
|
|
@ -518,7 +519,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
|
|||
{ [ is-integer? ] [ is-even? ] [ >10? ] } &&
|
||||
] ;
|
||||
|
||||
\ wlet-&&-test must-infer
|
||||
\ wlet-&&-test def>> must-infer
|
||||
[ f ] [ 1.5 wlet-&&-test ] unit-test
|
||||
[ f ] [ 3 wlet-&&-test ] unit-test
|
||||
[ f ] [ 8 wlet-&&-test ] unit-test
|
||||
|
|
@ -527,13 +528,13 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
|
|||
: fry-locals-test-1 ( -- n )
|
||||
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
|
||||
|
||||
\ fry-locals-test-1 must-infer
|
||||
\ fry-locals-test-1 def>> must-infer
|
||||
[ 10 ] [ fry-locals-test-1 ] unit-test
|
||||
|
||||
:: fry-locals-test-2 ( -- n )
|
||||
[let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
|
||||
|
||||
\ fry-locals-test-2 must-infer
|
||||
\ fry-locals-test-2 def>> must-infer
|
||||
[ 10 ] [ fry-locals-test-2 ] unit-test
|
||||
|
||||
[ 1 ] [ 3 4 [| | '[ [ _ swap - ] call ] call ] call ] unit-test
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ CONSTANT: b 2
|
|||
|
||||
[ 3 ] [ foo ] unit-test
|
||||
[ 3 ] [ { a b } flags ] unit-test
|
||||
\ foo must-infer
|
||||
\ foo def>> must-infer
|
||||
|
||||
[ 1 ] [ { 1 } flags ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -31,6 +31,3 @@ T{ model-tester f f } "tester" set
|
|||
"tester" get
|
||||
"model-c" get value>>
|
||||
] unit-test
|
||||
|
||||
\ model-changed must-infer
|
||||
\ set-model must-infer
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@ USING: kernel tools.test strings namespaces make arrays sequences
|
|||
peg peg.private peg.parsers accessors words math accessors ;
|
||||
IN: peg.tests
|
||||
|
||||
\ parse must-infer
|
||||
|
||||
[ ] [ reset-pegs ] unit-test
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -17,5 +17,3 @@ IN: peg.search.tests
|
|||
"abc 123 def 456" 'integer' [ 2 * number>string ] action replace
|
||||
] unit-test
|
||||
|
||||
\ search must-infer
|
||||
\ replace must-infer
|
||||
|
|
|
|||
|
|
@ -3,10 +3,6 @@ USING: accessors tools.test persistent.vectors
|
|||
persistent.sequences sequences kernel arrays random namespaces
|
||||
vectors math math.order ;
|
||||
|
||||
\ new-nth must-infer
|
||||
\ ppush must-infer
|
||||
\ ppop must-infer
|
||||
|
||||
[ 0 ] [ PV{ } length ] unit-test
|
||||
|
||||
[ 1 ] [ 3 PV{ } ppush length ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,10 +4,6 @@ USING: regexp tools.test kernel sequences regexp.parser regexp.private
|
|||
eval strings multiline accessors ;
|
||||
IN: regexp-tests
|
||||
|
||||
\ <regexp> must-infer
|
||||
\ compile-regexp must-infer
|
||||
\ matches? must-infer
|
||||
|
||||
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
||||
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
||||
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,8 +4,6 @@ namespaces logging accessors assocs sorting smtp.private
|
|||
concurrency.promises system ;
|
||||
IN: smtp.tests
|
||||
|
||||
\ send-email must-infer
|
||||
|
||||
{ 0 0 } [ [ ] with-smtp-connection ] must-infer-as
|
||||
|
||||
[ "hello\nworld" validate-address ] must-fail
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ sequences.private destructors combinators eval locals.backend
|
|||
system compiler.units ;
|
||||
IN: stack-checker.tests
|
||||
|
||||
\ infer. must-infer
|
||||
[ 1234 infer ] must-fail
|
||||
|
||||
{ 0 2 } [ 2 "Hello" ] must-infer-as
|
||||
{ 1 2 } [ dup ] must-infer-as
|
||||
|
|
@ -65,11 +65,6 @@ IN: stack-checker.tests
|
|||
|
||||
{ 1 1 } [ simple-recursion-2 ] must-infer-as
|
||||
|
||||
: bad-recursion-2 ( obj -- obj )
|
||||
dup [ dup first swap second bad-recursion-2 ] [ ] if ;
|
||||
|
||||
[ [ bad-recursion-2 ] infer ] must-fail
|
||||
|
||||
: funny-recursion ( obj -- obj )
|
||||
dup [ funny-recursion 1 ] [ 2 ] if drop ;
|
||||
|
||||
|
|
@ -196,94 +191,11 @@ DEFER: blah4
|
|||
over string? [ 2array throw ] unless
|
||||
] must-infer-as
|
||||
|
||||
! Regression
|
||||
|
||||
! This order of branches works
|
||||
DEFER: do-crap
|
||||
: more-crap ( obj -- ) dup [ drop ] [ dup do-crap call ] if ;
|
||||
: do-crap ( obj -- ) dup [ more-crap ] [ do-crap ] if ;
|
||||
[ [ do-crap ] infer ] must-fail
|
||||
|
||||
! This one does not
|
||||
DEFER: do-crap*
|
||||
: more-crap* ( obj -- ) dup [ drop ] [ dup do-crap* call ] if ;
|
||||
: do-crap* ( obj -- ) dup [ do-crap* ] [ more-crap* ] if ;
|
||||
[ [ do-crap* ] infer ] must-fail
|
||||
|
||||
! Regression
|
||||
: too-deep ( a b -- c )
|
||||
dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline recursive
|
||||
{ 2 1 } [ too-deep ] must-infer-as
|
||||
|
||||
! Error reporting is wrong
|
||||
MATH: xyz ( a b -- c )
|
||||
M: fixnum xyz 2array ;
|
||||
M: float xyz
|
||||
[ 3 ] bi@ swapd [ 2array swap ] dip 2array swap ;
|
||||
|
||||
[ [ xyz ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
! Doug Coleman discovered this one while working on the
|
||||
! calendar library
|
||||
DEFER: A
|
||||
DEFER: B
|
||||
DEFER: C
|
||||
|
||||
: A ( a -- )
|
||||
dup {
|
||||
[ drop ]
|
||||
[ A ]
|
||||
[ \ A no-method ]
|
||||
[ dup C A ]
|
||||
} dispatch ;
|
||||
|
||||
: B ( b -- )
|
||||
dup {
|
||||
[ C ]
|
||||
[ B ]
|
||||
[ \ B no-method ]
|
||||
[ dup B B ]
|
||||
} dispatch ;
|
||||
|
||||
: C ( c -- )
|
||||
dup {
|
||||
[ A ]
|
||||
[ C ]
|
||||
[ \ C no-method ]
|
||||
[ dup B C ]
|
||||
} dispatch ;
|
||||
|
||||
{ 1 0 } [ A ] must-infer-as
|
||||
{ 1 0 } [ B ] must-infer-as
|
||||
{ 1 0 } [ C ] must-infer-as
|
||||
|
||||
! I found this bug by thinking hard about the previous one
|
||||
DEFER: Y
|
||||
: X ( a b -- c d ) dup [ swap Y ] [ ] if ;
|
||||
: Y ( a b -- c d ) X ;
|
||||
|
||||
{ 2 2 } [ X ] must-infer-as
|
||||
{ 2 2 } [ Y ] must-infer-as
|
||||
|
||||
! This one comes from UI code
|
||||
DEFER: #1
|
||||
: #2 ( a b: ( -- ) -- ) dup [ call ] [ 2drop ] if ; inline
|
||||
: #3 ( a -- ) [ #1 ] #2 ;
|
||||
: #4 ( a -- ) dup [ drop ] [ dup #4 dup #3 call ] if ;
|
||||
: #1 ( a -- ) dup [ dup #4 dup #3 ] [ ] if drop ;
|
||||
|
||||
[ \ #4 def>> infer ] must-fail
|
||||
[ [ #1 ] infer ] must-fail
|
||||
|
||||
! Similar
|
||||
DEFER: bar
|
||||
: foo ( a b -- c d ) dup [ 2drop f f bar ] [ ] if ;
|
||||
: bar ( a b -- ) [ 2 2 + ] t foo drop call drop ;
|
||||
|
||||
[ [ foo ] infer ] must-fail
|
||||
|
||||
[ 1234 infer ] must-fail
|
||||
|
||||
! This used to hang
|
||||
[ [ [ dup call ] dup call ] infer ]
|
||||
[ inference-error? ] must-fail-with
|
||||
|
|
@ -311,16 +223,6 @@ DEFER: bar
|
|||
[ [ [ [ drop 3 ] swap call ] dup call ] infer ]
|
||||
[ inference-error? ] must-fail-with
|
||||
|
||||
! This form should not have a stack effect
|
||||
|
||||
: bad-recursion-1 ( a -- b )
|
||||
dup [ drop bad-recursion-1 5 ] [ ] if ;
|
||||
|
||||
[ [ bad-recursion-1 ] infer ] must-fail
|
||||
|
||||
: bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ;
|
||||
[ [ bad-bin ] infer ] must-fail
|
||||
|
||||
[ [ 1 drop-locals ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
! Regression
|
||||
|
|
@ -333,114 +235,14 @@ DEFER: bar
|
|||
|
||||
[ [ 3 [ ] curry 1 2 [ ] 2curry if ] infer ] must-fail
|
||||
|
||||
! Test number protocol
|
||||
\ bitor must-infer
|
||||
\ bitand must-infer
|
||||
\ bitxor must-infer
|
||||
\ mod must-infer
|
||||
\ /i must-infer
|
||||
\ /f must-infer
|
||||
\ /mod must-infer
|
||||
\ + must-infer
|
||||
\ - must-infer
|
||||
\ * must-infer
|
||||
\ / must-infer
|
||||
\ < must-infer
|
||||
\ <= must-infer
|
||||
\ > must-infer
|
||||
\ >= must-infer
|
||||
\ number= must-infer
|
||||
|
||||
! Test object protocol
|
||||
\ = must-infer
|
||||
\ clone must-infer
|
||||
\ hashcode* must-infer
|
||||
|
||||
! Test sequence protocol
|
||||
\ length must-infer
|
||||
\ nth must-infer
|
||||
\ set-length must-infer
|
||||
\ set-nth must-infer
|
||||
\ new must-infer
|
||||
\ new-resizable must-infer
|
||||
\ like must-infer
|
||||
\ lengthen must-infer
|
||||
|
||||
! Test assoc protocol
|
||||
\ at* must-infer
|
||||
\ set-at must-infer
|
||||
\ new-assoc must-infer
|
||||
\ delete-at must-infer
|
||||
\ clear-assoc must-infer
|
||||
\ assoc-size must-infer
|
||||
\ assoc-like must-infer
|
||||
\ assoc-clone-like must-infer
|
||||
\ >alist must-infer
|
||||
{ 1 3 } [ [ 2drop f ] assoc-find ] must-infer-as
|
||||
|
||||
! Test some random library words
|
||||
\ 1quotation must-infer
|
||||
\ string>number must-infer
|
||||
\ get must-infer
|
||||
|
||||
\ push must-infer
|
||||
\ append must-infer
|
||||
\ peek must-infer
|
||||
|
||||
\ reverse must-infer
|
||||
\ member? must-infer
|
||||
\ remove must-infer
|
||||
\ natural-sort must-infer
|
||||
|
||||
\ forget must-infer
|
||||
\ define-class must-infer
|
||||
\ define-tuple-class must-infer
|
||||
\ define-union-class must-infer
|
||||
\ define-predicate-class must-infer
|
||||
\ instance? must-infer
|
||||
\ next-method-quot must-infer
|
||||
|
||||
! Test words with continuations
|
||||
{ 0 0 } [ [ drop ] callcc0 ] must-infer-as
|
||||
{ 0 1 } [ [ 4 swap continue-with ] callcc1 ] must-infer-as
|
||||
{ 2 1 } [ [ + ] [ ] [ ] cleanup ] must-infer-as
|
||||
{ 2 1 } [ [ + ] [ 3drop 0 ] recover ] must-infer-as
|
||||
|
||||
\ dispose must-infer
|
||||
|
||||
! Test stream protocol
|
||||
\ set-timeout must-infer
|
||||
\ stream-read must-infer
|
||||
\ stream-read1 must-infer
|
||||
\ stream-readln must-infer
|
||||
\ stream-read-until must-infer
|
||||
\ stream-write must-infer
|
||||
\ stream-write1 must-infer
|
||||
\ stream-nl must-infer
|
||||
\ stream-flush must-infer
|
||||
|
||||
! Test stream utilities
|
||||
\ lines must-infer
|
||||
\ contents must-infer
|
||||
|
||||
! Test prettyprinting
|
||||
\ . must-infer
|
||||
\ short. must-infer
|
||||
\ unparse must-infer
|
||||
|
||||
\ describe must-infer
|
||||
\ error. must-infer
|
||||
|
||||
! Test odds and ends
|
||||
\ io-thread must-infer
|
||||
|
||||
! Incorrect stack declarations on inline recursive words should
|
||||
! be caught
|
||||
: fooxxx ( a b -- c ) over [ foo ] when ; inline
|
||||
: barxxx ( a b -- c ) fooxxx ;
|
||||
|
||||
[ [ barxxx ] infer ] must-fail
|
||||
|
||||
! A typo
|
||||
{ 1 0 } [ { [ ] } dispatch ] must-infer-as
|
||||
|
||||
|
|
@ -463,7 +265,6 @@ DEFER: deferred-word
|
|||
|
||||
{ 1 1 } [ [ deferred-word ] [ 3 ] if ] must-infer-as
|
||||
|
||||
|
||||
DEFER: an-inline-word
|
||||
|
||||
: normal-word-3 ( -- )
|
||||
|
|
@ -503,9 +304,7 @@ ERROR: custom-error ;
|
|||
] unit-test
|
||||
|
||||
! Regression
|
||||
: missing->r-check ( a -- ) 1 load-locals ;
|
||||
|
||||
[ [ missing->r-check ] infer ] must-fail
|
||||
[ [ 1 load-locals ] infer ] must-fail
|
||||
|
||||
! Corner case
|
||||
[ [ [ f dup ] [ dup ] produce ] infer ] must-fail
|
||||
|
|
@ -513,35 +312,12 @@ ERROR: custom-error ;
|
|||
[ [ [ f dup ] [ ] while ] infer ] must-fail
|
||||
|
||||
: erg's-inference-bug ( -- ) f dup [ erg's-inference-bug ] when ; inline recursive
|
||||
|
||||
[ [ erg's-inference-bug ] infer ] must-fail
|
||||
|
||||
: inference-invalidation-a ( -- ) ;
|
||||
: inference-invalidation-b ( quot -- ) [ inference-invalidation-a ] dip call ; inline
|
||||
: inference-invalidation-c ( a b -- c ) [ + ] inference-invalidation-b ; inline
|
||||
|
||||
[ 7 ] [ 4 3 inference-invalidation-c ] unit-test
|
||||
|
||||
{ 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as
|
||||
|
||||
[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" eval( -- ) ] unit-test
|
||||
|
||||
[ 3 ] [ inference-invalidation-c ] unit-test
|
||||
|
||||
{ 0 1 } [ inference-invalidation-c ] must-infer-as
|
||||
|
||||
GENERIC: inference-invalidation-d ( obj -- )
|
||||
|
||||
M: object inference-invalidation-d inference-invalidation-c 2drop ;
|
||||
|
||||
\ inference-invalidation-d must-infer
|
||||
|
||||
[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" eval( -- ) ] unit-test
|
||||
|
||||
[ [ inference-invalidation-d ] infer ] must-fail
|
||||
FORGET: erg's-inference-bug
|
||||
|
||||
: bad-recursion-3 ( -- ) dup [ [ bad-recursion-3 ] dip ] when ; inline recursive
|
||||
[ [ bad-recursion-3 ] infer ] must-fail
|
||||
FORGET: bad-recursion-3
|
||||
|
||||
: bad-recursion-4 ( -- ) 4 [ dup call roll ] times ; inline recursive
|
||||
[ [ [ ] [ 1 2 3 ] over dup bad-recursion-4 ] infer ] must-fail
|
||||
|
|
@ -562,6 +338,8 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
|
|||
|
||||
[ [ unbalanced-retain-usage ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
FORGET: unbalanced-retain-usage
|
||||
|
||||
DEFER: eee'
|
||||
: ddd' ( ? -- ) [ f eee' ] when ; inline recursive
|
||||
: eee' ( ? -- ) [ swap [ ] ] dip ddd' call ; inline recursive
|
||||
|
|
|
|||
|
|
@ -5,7 +5,12 @@ classes classes.tuple ;
|
|||
|
||||
: compose-n-quot ( word n -- quot' ) <repetition> >quotation ;
|
||||
: compose-n ( quot n -- ) compose-n-quot call ;
|
||||
|
||||
<<
|
||||
\ compose-n [ compose-n-quot ] 2 define-transform
|
||||
\ compose-n t "no-compile" set-word-prop
|
||||
>>
|
||||
|
||||
: compose-n-test ( a b c -- x ) 2 \ + compose-n ;
|
||||
|
||||
[ 6 ] [ 1 2 3 compose-n-test ] unit-test
|
||||
|
|
|
|||
|
|
@ -2,9 +2,6 @@ USING: syndication io kernel io.files tools.test io.encodings.binary
|
|||
calendar urls xml.writer ;
|
||||
IN: syndication.tests
|
||||
|
||||
\ download-feed must-infer
|
||||
\ feed>xml must-infer
|
||||
|
||||
: load-news-file ( filename -- feed )
|
||||
#! Load an news syndication file and process it, returning
|
||||
#! it as an feed tuple.
|
||||
|
|
|
|||
|
|
@ -1,8 +1,5 @@
|
|||
USING: tools.test tools.memory ;
|
||||
IN: tools.memory.tests
|
||||
|
||||
\ room. must-infer
|
||||
[ ] [ room. ] unit-test
|
||||
|
||||
\ heap-stats. must-infer
|
||||
[ ] [ heap-stats. ] unit-test
|
||||
|
|
|
|||
|
|
@ -58,8 +58,8 @@ HELP: must-fail-with
|
|||
{ $notes "This word is used to test error handling code, ensuring that errors thrown by code contain the relevant debugging information." } ;
|
||||
|
||||
HELP: must-infer
|
||||
{ $values { "word/quot" "a quotation or a word" } }
|
||||
{ $description "Ensures that the quotation or word has a static stack effect without running it." }
|
||||
{ $values { "quot" quotation } }
|
||||
{ $description "Ensures that the quotation has a static stack effect without running it." }
|
||||
{ $notes "This word is used to test that code will compile with the optimizing compiler for optimum performance. See " { $link "compiler" } "." } ;
|
||||
|
||||
HELP: must-infer-as
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
IN: tools.test.tests
|
||||
USING: tools.test tools.test.private namespaces kernel sequences ;
|
||||
|
||||
\ test-all must-infer
|
||||
|
||||
: fake-unit-test ( quot -- )
|
||||
[
|
||||
"fake" file set
|
||||
|
|
|
|||
|
|
@ -56,8 +56,7 @@ SYMBOL: file
|
|||
:: (must-infer-as) ( effect quot -- error ? )
|
||||
[ quot infer short-effect effect assert= f f ] [ t ] recover ;
|
||||
|
||||
:: (must-infer) ( word/quot -- error ? )
|
||||
word/quot dup word? [ '[ _ execute ] ] when :> quot
|
||||
:: (must-infer) ( quot -- error ? )
|
||||
[ quot infer drop f f ] [ t ] recover ;
|
||||
|
||||
TUPLE: did-not-fail ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,2 @@
|
|||
IN: ui.event-loop.tests
|
||||
USING: ui.event-loop tools.test ;
|
||||
|
||||
\ event-loop must-infer
|
||||
|
|
|
|||
|
|
@ -1,4 +1,2 @@
|
|||
IN: ui.gadgets.books.tests
|
||||
USING: tools.test ui.gadgets.books ;
|
||||
|
||||
\ <book> must-infer
|
||||
|
|
|
|||
|
|
@ -28,10 +28,6 @@ T{ foo-gadget } <toolbar> "t" set
|
|||
} <radio-buttons> "religion" set
|
||||
] unit-test
|
||||
|
||||
\ <radio-buttons> must-infer
|
||||
|
||||
\ <checkbox> must-infer
|
||||
|
||||
[ 0 ] [
|
||||
"religion" get gadget-child value>>
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -42,8 +42,6 @@ IN: ui.gadgets.editors.tests
|
|||
] with-grafted-gadget
|
||||
] unit-test
|
||||
|
||||
\ <editor> must-infer
|
||||
|
||||
"hello" <model> <model-field> "field" set
|
||||
|
||||
"field" get [
|
||||
|
|
|
|||
|
|
@ -152,16 +152,3 @@ M: mock-gadget ungraft*
|
|||
|
||||
{ { f f } { f t } { t f } { t t } } [ notify-combo ] assoc-each
|
||||
] with-string-writer print
|
||||
|
||||
\ <gadget> must-infer
|
||||
\ unparent must-infer
|
||||
\ add-gadget must-infer
|
||||
\ add-gadgets must-infer
|
||||
\ clear-gadget must-infer
|
||||
|
||||
\ relayout must-infer
|
||||
\ relayout-1 must-infer
|
||||
\ pref-dim must-infer
|
||||
|
||||
\ graft* must-infer
|
||||
\ ungraft* must-infer
|
||||
|
|
@ -104,5 +104,3 @@ dup layout
|
|||
model>> dependencies>> [ range-max value>> ] map
|
||||
{ 0 0 } =
|
||||
] unit-test
|
||||
|
||||
\ <scroller> must-infer
|
||||
|
|
|
|||
|
|
@ -1,5 +1,2 @@
|
|||
IN: ui.gestures.tests
|
||||
USING: tools.test ui.gestures ;
|
||||
|
||||
\ handle-gesture must-infer
|
||||
\ send-queued-gesture must-infer
|
||||
|
|
@ -26,5 +26,3 @@ io.streams.string math help help.markup accessors ;
|
|||
[ ] [
|
||||
[ { $operations \ + } print-element ] with-string-writer drop
|
||||
] unit-test
|
||||
|
||||
\ object-operations must-infer
|
||||
|
|
@ -1,4 +1,2 @@
|
|||
IN: ui.render.tests
|
||||
USING: ui.render tools.test ;
|
||||
|
||||
\ draw-gadget must-infer
|
||||
|
|
@ -1,5 +1,4 @@
|
|||
IN: ui.tools.browser.tests
|
||||
USING: tools.test ui.gadgets.debug ui.tools.browser math ;
|
||||
|
||||
\ <browser-gadget> must-infer
|
||||
[ ] [ \ + <browser-gadget> [ ] with-grafted-gadget ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,6 +1,4 @@
|
|||
IN: ui.tools.inspector.tests
|
||||
USING: tools.test ui.tools.inspector math models ;
|
||||
|
||||
\ <inspector-gadget> must-infer
|
||||
|
||||
[ ] [ \ + <model> <inspector-gadget> com-edit-slot ] unit-test
|
||||
|
|
@ -6,8 +6,6 @@ threads arrays generic threads accessors listener math
|
|||
calendar concurrency.promises io ui.tools.common ;
|
||||
IN: ui.tools.listener.tests
|
||||
|
||||
\ <interactor> must-infer
|
||||
|
||||
[
|
||||
[ ] [ <interactor> <pane> <pane-stream> >>output "interactor" set ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
USING: ui.tools.profiler tools.test ;
|
||||
|
||||
\ profiler-window must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
USING: ui.tools.walker tools.test ;
|
||||
IN: ui.tools.walker.tests
|
||||
|
||||
\ <walker-gadget> must-infer
|
||||
|
|
|
|||
|
|
@ -1,5 +1,2 @@
|
|||
IN: ui.tests
|
||||
USING: ui ui.private tools.test ;
|
||||
|
||||
\ open-window must-infer
|
||||
\ update-ui must-infer
|
||||
|
|
@ -4,10 +4,6 @@ USING: unicode.case tools.test namespaces strings unicode.normalize
|
|||
unicode.case.private ;
|
||||
IN: unicode.case.tests
|
||||
|
||||
\ >upper must-infer
|
||||
\ >lower must-infer
|
||||
\ >title must-infer
|
||||
|
||||
[ "Hello How Are You? I'm Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
|
||||
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
|
||||
[ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test
|
||||
|
|
|
|||
|
|
@ -5,8 +5,6 @@ IN: unix.groups.tests
|
|||
|
||||
[ ] [ all-groups drop ] unit-test
|
||||
|
||||
\ all-groups must-infer
|
||||
|
||||
[ t ] [ real-group-name string? ] unit-test
|
||||
[ t ] [ effective-group-name string? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,11 +3,8 @@
|
|||
USING: tools.test unix.users kernel strings math ;
|
||||
IN: unix.users.tests
|
||||
|
||||
|
||||
[ ] [ all-users drop ] unit-test
|
||||
|
||||
\ all-users must-infer
|
||||
|
||||
[ t ] [ real-user-name string? ] unit-test
|
||||
[ t ] [ effective-user-name string? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -38,6 +38,4 @@ word wrap.">
|
|||
[ "aaa bb\ncccc\nddddd" ] [ "aaa bb cccc ddddd" 6 wrap-string ] unit-test
|
||||
[ "aaa bb\nccccccc\nddddddd" ] [ "aaa bb ccccccc ddddddd" 6 wrap-string ] unit-test
|
||||
|
||||
\ wrap-string must-infer
|
||||
|
||||
[ "a b c d e f\ng h" ] [ "a b c d e f g h" 11 wrap-string ] unit-test
|
||||
|
|
|
|||
|
|
@ -79,4 +79,3 @@ IN: wrap.words.tests
|
|||
} 35 35 wrap-words [ { } like ] map
|
||||
] unit-test
|
||||
|
||||
\ wrap-words must-infer
|
||||
|
|
|
|||
|
|
@ -33,8 +33,6 @@ TAG: neg calculate
|
|||
calc-arith
|
||||
] unit-test
|
||||
|
||||
\ calc-arith must-infer
|
||||
|
||||
XML-NS: foo http://blah.com
|
||||
|
||||
[ T{ name { main "bling" } { url "http://blah.com" } } ] [ "bling" foo ] unit-test
|
||||
|
|
@ -90,7 +88,6 @@ XML-NS: foo http://blah.com
|
|||
[ "<x>3</x>" ] [ 3 [XML <x><-></x> XML] xml>string ] unit-test
|
||||
[ "<x></x>" ] [ f [XML <x><-></x> XML] xml>string ] unit-test
|
||||
|
||||
\ <XML must-infer
|
||||
[ [XML <-> XML] ] must-infer
|
||||
[ [XML <foo><-></foo> <bar val=<->/> XML] ] must-infer
|
||||
|
||||
|
|
|
|||
|
|
@ -7,9 +7,7 @@ xml.traversal continuations assocs io.encodings.binary
|
|||
sequences.deep accessors io.streams.string ;
|
||||
|
||||
! This is insufficient
|
||||
\ read-xml must-infer
|
||||
[ [ drop ] each-element ] must-infer
|
||||
\ string>xml must-infer
|
||||
|
||||
SYMBOL: xml-file
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -5,9 +5,6 @@ xml.writer.private io.streams.string xml.traversal sequences
|
|||
io.encodings.utf8 io.files accessors io.directories math math.parser ;
|
||||
IN: xml.writer.tests
|
||||
|
||||
\ write-xml must-infer
|
||||
\ xml>string must-infer
|
||||
\ pprint-xml must-infer
|
||||
! Add a test for pprint-xml with sensitive-tags
|
||||
|
||||
[ "foo" ] [ T{ name { main "foo" } } name>string ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,8 +3,6 @@ USING: xmode.code2html xmode.catalog
|
|||
tools.test multiline splitting memoize
|
||||
kernel io.streams.string xml.writer ;
|
||||
|
||||
\ htmlize-file must-infer
|
||||
|
||||
[ ] [ \ (load-mode) reset-memoized ] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -1,7 +1,3 @@
|
|||
IN: checksums.tests
|
||||
USING: checksums tools.test ;
|
||||
|
||||
\ checksum-bytes must-infer
|
||||
\ checksum-stream must-infer
|
||||
\ checksum-lines must-infer
|
||||
\ checksum-file must-infer
|
||||
|
|
|
|||
|
|
@ -7,12 +7,6 @@ random stack-checker effects kernel.private sbufs math.order
|
|||
classes.tuple accessors ;
|
||||
IN: classes.algebra.tests
|
||||
|
||||
\ class< must-infer
|
||||
\ class-and must-infer
|
||||
\ class-or must-infer
|
||||
\ flatten-class must-infer
|
||||
\ flatten-builtin-class must-infer
|
||||
|
||||
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;
|
||||
|
||||
: class-or* ( cls1 cls2 cls3 -- ? ) [ class-or ] dip class= ;
|
||||
|
|
|
|||
|
|
@ -599,7 +599,7 @@ must-fail-with
|
|||
|
||||
: foo ( a b -- c ) declared-types boa ;
|
||||
|
||||
\ foo must-infer
|
||||
\ foo def>> must-infer
|
||||
|
||||
[ T{ declared-types f 0 "hi" } ] [ 0.0 "hi" foo ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ IN: combinators.tests
|
|||
{ [ dup 2 mod 1 = ] [ drop "odd" ] }
|
||||
} cond ;
|
||||
|
||||
\ cond-test-1 must-infer
|
||||
\ cond-test-1 def>> must-infer
|
||||
|
||||
[ "even" ] [ 2 cond-test-1 ] unit-test
|
||||
[ "odd" ] [ 3 cond-test-1 ] unit-test
|
||||
|
|
@ -54,7 +54,7 @@ IN: combinators.tests
|
|||
[ drop "something else" ]
|
||||
} cond ;
|
||||
|
||||
\ cond-test-2 must-infer
|
||||
\ cond-test-2 def>> must-infer
|
||||
|
||||
[ "true" ] [ t cond-test-2 ] unit-test
|
||||
[ "false" ] [ f cond-test-2 ] unit-test
|
||||
|
|
@ -67,7 +67,7 @@ IN: combinators.tests
|
|||
{ [ dup f = ] [ drop "false" ] }
|
||||
} cond ;
|
||||
|
||||
\ cond-test-3 must-infer
|
||||
\ cond-test-3 def>> must-infer
|
||||
|
||||
[ "something else" ] [ t cond-test-3 ] unit-test
|
||||
[ "something else" ] [ f cond-test-3 ] unit-test
|
||||
|
|
@ -77,7 +77,7 @@ IN: combinators.tests
|
|||
{
|
||||
} cond ;
|
||||
|
||||
\ cond-test-4 must-infer
|
||||
\ cond-test-4 def>> must-infer
|
||||
|
||||
[ cond-test-4 ] [ class \ no-cond = ] must-fail-with
|
||||
|
||||
|
|
@ -168,7 +168,7 @@ IN: combinators.tests
|
|||
{ 4 [ "four" ] }
|
||||
} case ;
|
||||
|
||||
\ case-test-1 must-infer
|
||||
\ case-test-1 def>> must-infer
|
||||
|
||||
[ "two" ] [ 2 case-test-1 ] unit-test
|
||||
|
||||
|
|
@ -186,7 +186,7 @@ IN: combinators.tests
|
|||
[ sq ]
|
||||
} case ;
|
||||
|
||||
\ case-test-2 must-infer
|
||||
\ case-test-2 def>> must-infer
|
||||
|
||||
[ 25 ] [ 5 case-test-2 ] unit-test
|
||||
|
||||
|
|
@ -204,7 +204,7 @@ IN: combinators.tests
|
|||
[ sq ]
|
||||
} case ;
|
||||
|
||||
\ case-test-3 must-infer
|
||||
\ case-test-3 def>> must-infer
|
||||
|
||||
[ "an array" ] [ { 1 2 3 } case-test-3 ] unit-test
|
||||
|
||||
|
|
@ -222,7 +222,7 @@ CONSTANT: case-const-2 2
|
|||
[ drop "demasiado" ]
|
||||
} case ;
|
||||
|
||||
\ case-test-4 must-infer
|
||||
\ case-test-4 def>> must-infer
|
||||
|
||||
[ "uno" ] [ 1 case-test-4 ] unit-test
|
||||
[ "dos" ] [ 2 case-test-4 ] unit-test
|
||||
|
|
@ -239,7 +239,7 @@ CONSTANT: case-const-2 2
|
|||
[ drop "demasiado" print ]
|
||||
} case ;
|
||||
|
||||
\ case-test-5 must-infer
|
||||
\ case-test-5 def>> must-infer
|
||||
|
||||
[ ] [ 1 case-test-5 ] unit-test
|
||||
|
||||
|
|
@ -296,7 +296,7 @@ CONSTANT: case-const-2 2
|
|||
{ 3 [ "three" ] }
|
||||
} case ;
|
||||
|
||||
\ test-case-6 must-infer
|
||||
\ test-case-6 def>> must-infer
|
||||
|
||||
[ "three" ] [ 3 test-case-6 ] unit-test
|
||||
[ "do-not-call" ] [ \ do-not-call test-case-6 ] unit-test
|
||||
|
|
@ -343,7 +343,7 @@ CONSTANT: case-const-2 2
|
|||
{ \ ] [ "KFC" ] }
|
||||
} case ;
|
||||
|
||||
\ test-case-7 must-infer
|
||||
\ test-case-7 def>> must-infer
|
||||
|
||||
[ "plus" ] [ \ + test-case-7 ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -107,4 +107,4 @@ SYMBOL: error-counter
|
|||
|
||||
[ { 4 } ] [ { 2 2 } [ + ] with-datastack ] unit-test
|
||||
|
||||
\ with-datastack must-infer
|
||||
[ with-datastack ] must-infer
|
||||
|
|
|
|||
|
|
@ -4,9 +4,6 @@ io.files io.files.private io.files.temp io.files.unique kernel
|
|||
make math sequences system threads tools.test generic.standard ;
|
||||
IN: io.files.tests
|
||||
|
||||
\ exists? must-infer
|
||||
\ (exists?) must-infer
|
||||
|
||||
[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
|
||||
|
||||
[ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
|
||||
|
|
|
|||
|
|
@ -6,8 +6,6 @@ vocabs vocabs.loader accessors eval combinators lexer
|
|||
vocabs.parser words.symbol multiline source-files.errors ;
|
||||
IN: parser.tests
|
||||
|
||||
\ run-file must-infer
|
||||
|
||||
[
|
||||
[ 1 [ 2 [ 3 ] 4 ] 5 ]
|
||||
[ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval( -- a b c ) ]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
IN: contributors.tests
|
||||
USING: contributors tools.test ;
|
||||
|
||||
\ contributors must-infer
|
||||
[ ] [ contributors ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,9 +3,6 @@
|
|||
USING: infix.ast infix.parser infix.tokenizer tools.test ;
|
||||
IN: infix.parser.tests
|
||||
|
||||
\ parse-infix must-infer
|
||||
\ build-infix-ast must-infer
|
||||
|
||||
[ T{ ast-number { value 1 } } ] [ "1" build-infix-ast ] unit-test
|
||||
[ T{ ast-negation f T{ ast-number { value 1 } } } ]
|
||||
[ "-1" build-infix-ast ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,7 +3,6 @@
|
|||
USING: infix.ast infix.tokenizer tools.test ;
|
||||
IN: infix.tokenizer.tests
|
||||
|
||||
\ tokenize-infix must-infer
|
||||
[ V{ T{ ast-number f 1 } } ] [ "1" tokenize-infix ] unit-test
|
||||
[ V{ T{ ast-number f 1.02 } CHAR: * T{ ast-number f 3 } } ] [ "1.02*3" tokenize-infix ] unit-test
|
||||
[ V{ T{ ast-number f 3 } CHAR: / CHAR: ( T{ ast-number f 3 } CHAR: + T{ ast-number f 4 } CHAR: ) } ]
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue