Fix unit tests

diff --git a/core/alien/compiler/compiler-tests.factor b/core/alien/compiler/compiler-tests.factor
index 5d847e364f0fb73dfae7d40d847958d1b8d9a3e2..eb7652aefd776bf3f0553b86a27a5b7210cd8d59 100755 (executable)
--- a/core/alien/compiler/compiler-tests.factor
+++ b/core/alien/compiler/compiler-tests.factor
@@ -77,7 +77,7 @@ FUNCTION: tiny ffi_test_17 int x ;
 
 [ [ alien-indirect ] infer ] [ inference-error? ] must-fail-with
 
-: indirect-test-1
+: indirect-test-1 ( ptr -- result )
     "int" { } "cdecl" alien-indirect ;
 
 { 1 1 } [ indirect-test-1 ] must-infer-as
@@ -86,7 +86,7 @@ FUNCTION: tiny ffi_test_17 int x ;
 
 [ -1 indirect-test-1 ] must-fail
 
-: indirect-test-2
+: indirect-test-2 ( x y ptr -- result )
     "int" { "int" "int" } "cdecl" alien-indirect gc ;
 
 { 3 1 } [ indirect-test-2 ] must-infer-as
@@ -95,7 +95,7 @@ FUNCTION: tiny ffi_test_17 int x ;
 [ 2 3 "ffi_test_2" f dlsym indirect-test-2 ]
 unit-test
 
-: indirect-test-3
+: indirect-test-3 ( a b c d ptr -- result )
     "int" { "int" "int" "int" "int" } "stdcall" alien-indirect
     gc ;
 
@@ -139,7 +139,7 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3,
 
 ! Make sure XT doesn't get clobbered in stack frame
 
-: ffi_test_31
+: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a ptr -- result y )
     "void"
     f "ffi_test_31"
     { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" }
@@ -286,21 +286,21 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 
 ! Test callbacks
 
-: callback-1 "void" { } "cdecl" [ ] alien-callback ;
+: callback-1 ( -- callback ) "void" { } "cdecl" [ ] alien-callback ;
 
 [ 0 1 ] [ [ callback-1 ] infer dup effect-in swap effect-out ] unit-test
 
 [ t ] [ callback-1 alien? ] unit-test
 
-: callback_test_1 "void" { } "cdecl" alien-indirect ;
+: callback_test_1 ( ptr -- ) "void" { } "cdecl" alien-indirect ;
 
 [ ] [ callback-1 callback_test_1 ] unit-test
 
-: callback-2 "void" { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
+: callback-2 ( -- callback ) "void" { } "cdecl" [ [ 5 throw ] ignore-errors ] alien-callback ;
 
 [ ] [ callback-2 callback_test_1 ] unit-test
 
-: callback-3 "void" { } "cdecl" [ 5 "x" set ] alien-callback ;
+: callback-3 ( -- callback ) "void" { } "cdecl" [ 5 "x" set ] alien-callback ;
 
 [ t ] [
     namestack*
@@ -314,7 +314,7 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
     ] with-scope
 ] unit-test
 
-: callback-4
+: callback-4 ( -- callback )
     "void" { } "cdecl" [ "Hello world" write ] alien-callback
     gc ;
 
@@ -322,14 +322,14 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
     [ callback-4 callback_test_1 ] with-string-writer
 ] unit-test
 
-: callback-5
+: callback-5 ( -- callback )
     "void" { } "cdecl" [ gc ] alien-callback ;
 
 [ "testing" ] [
     "testing" callback-5 callback_test_1
 ] unit-test
 
-: callback-5a
+: callback-5a ( -- callback )
     "void" { } "cdecl" [ 8000000 f <array> drop ] alien-callback ;
 
 ! Hack; if we're on ARM, we probably don't have much RAM, so
@@ -340,26 +340,26 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
 !     ] unit-test
 ! ] unless
 
-: callback-6
+: callback-6 ( -- callback )
     "void" { } "cdecl" [ [ continue ] callcc0 ] alien-callback ;
 
 [ 1 2 3 ] [ callback-6 callback_test_1 1 2 3 ] unit-test
 
-: callback-7
+: callback-7 ( -- callback )
     "void" { } "cdecl" [ 1000 sleep ] alien-callback ;
 
 [ 1 2 3 ] [ callback-7 callback_test_1 1 2 3 ] unit-test
 
 [ f ] [ namespace global eq? ] unit-test
 
-: callback-8
+: callback-8 ( -- callback )
     "void" { } "cdecl" [
         [ continue ] callcc0
     ] alien-callback ;
 
 [ ] [ callback-8 callback_test_1 ] unit-test
 
-: callback-9
+: callback-9 ( -- callback )
     "int" { "int" "int" "int" } "cdecl" [
         + + 1+
     ] alien-callback ;

diff --git a/core/effects/effects-tests.factor b/core/effects/effects-tests.factor
index 234f567f25e9fabbb9d02a11acd610ed7fc53dfc..1c2b2f766d6952f29262a1b2305d3961da79a6c0 100644 (file)
--- a/core/effects/effects-tests.factor
+++ b/core/effects/effects-tests.factor
@@ -1,9 +1,11 @@
 IN: effects.tests
-USING: effects tools.test ;
+USING: effects tools.test prettyprint accessors sequences ;
 
 [ t ] [ 1 1 <effect> 2 2 <effect> effect<= ] unit-test
 [ f ] [ 1 0 <effect> 2 2 <effect> effect<= ] unit-test
 [ t ] [ 2 2 <effect> 2 2 <effect> effect<= ] unit-test
 [ f ] [ 3 3 <effect> 2 2 <effect> effect<= ] unit-test
 [ f ] [ 2 3 <effect> 2 2 <effect> effect<= ] unit-test
-[ t ] [ 2 3 <effect> f effect<= ] unit-test
+[ 2 ] [ (( a b -- c )) in>> length ] unit-test
+[ 1 ] [ (( a b -- c )) out>> length ] unit-test
+[ "(( a b -- c ))" ] [ (( a b -- c )) unparse ] unit-test

diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index 6f4ae2c1d5bccb4cb0983b03ab50f91295aef5b7..7032e58b3fa742a11ec665d0a93a70f5ec076dc2 100755 (executable)
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -101,7 +101,7 @@ TUPLE: pred-test ;
 
 ! regression
 GENERIC: void-generic ( obj -- * )
-: breakage "hi" void-generic ;
+: breakage ( -- * ) "hi" void-generic ;
 [ t ] [ \ breakage compiled? ] unit-test
 [ breakage ] must-fail
 
@@ -116,12 +116,12 @@ GENERIC: void-generic ( obj -- * )
 
 ! another regression
 : constant-branch-fold-0 "hey" ; foldable
-: constant-branch-fold-1 constant-branch-fold-0 "hey" = ; inline
+: constant-branch-fold-1 ( -- ? ) constant-branch-fold-0 "hey" = ; inline
 [ 1 ] [ [ constant-branch-fold-1 [ 1 ] [ 2 ] if ] compile-call ] unit-test
 
 ! another regression
 : foo f ;
-: bar foo 4 4 = and ;
+: bar ( -- ? ) foo 4 4 = and ;
 [ f ] [ bar ] unit-test
 
 ! ensure identities are working in some form
@@ -131,7 +131,7 @@ GENERIC: void-generic ( obj -- * )
 ] unit-test
 
 ! compiling <tuple> with a non-literal class failed
-: <tuple>-regression <tuple> ;
+: <tuple>-regression ( class -- tuple ) <tuple> ;
 
 [ t ] [ \ <tuple>-regression compiled? ] unit-test
 
@@ -254,7 +254,7 @@ TUPLE: silly-tuple a b ;
 [ ] [ [ <tuple> ] dataflow optimize drop ] unit-test
 
 ! Make sure we have sane heuristics
-: should-inline? method flat-length 10 <= ;
+: should-inline? ( generic class -- ? ) method flat-length 10 <= ;
 
 [ t ] [ \ fixnum \ shift should-inline? ] unit-test
 [ f ] [ \ array \ equal? should-inline? ] unit-test
@@ -264,7 +264,7 @@ TUPLE: silly-tuple a b ;
 [ t ] [ \ sbuf \ set-nth-unsafe should-inline? ] unit-test
 
 ! Regression
-: lift-throw-tail-regression
+: lift-throw-tail-regression ( obj -- obj str )
     dup integer? [ "an integer" ] [
         dup string? [ "a string" ] [
             "error" throw
@@ -294,7 +294,7 @@ TUPLE: silly-tuple a b ;
 GENERIC: generic-inline-test ( x -- y )
 M: integer generic-inline-test ;
 
-: generic-inline-test-1
+: generic-inline-test-1 ( -- x )
     1
     generic-inline-test
     generic-inline-test
@@ -319,7 +319,7 @@ M: integer generic-inline-test ;
 
 HINTS: recursive-inline-hang array ;
 
-: recursive-inline-hang-1
+: recursive-inline-hang-1 ( -- a )
     { } recursive-inline-hang ;
 
 [ t ] [ \ recursive-inline-hang-1 compiled? ] unit-test
@@ -350,7 +350,7 @@ USE: sequences.private
 
 [ 2 4 6.0 0 ] [ counter-example' ] unit-test
 
-: member-test { + - * / /i } member? ;
+: member-test ( obj -- ? ) { + - * / /i } member? ;
 
 \ member-test must-infer
 [ ] [ \ member-test word-dataflow optimize 2drop ] unit-test

diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor
index f33e975c9a1de1d1cb6f8a7b54ffe1899d79cca1..e3cf84910913162e26a5d9f7bdad2a70a71909f3 100755 (executable)
--- a/extra/calendar/calendar.factor
+++ b/extra/calendar/calendar.factor
@@ -91,13 +91,13 @@ PRIVATE>
     [ hour>> ] [ minute>> ] [ second>> ] tri ;
 
 MEMO: instant ( -- dt ) 0 0 0 0 0 0 <duration> ;
-: years ( n -- dt ) instant swap >>year ;
-: months ( n -- dt ) instant swap >>month ;
-: days ( n -- dt ) instant swap >>day ;
+: years ( n -- dt ) instant clone swap >>year ;
+: months ( n -- dt ) instant clone swap >>month ;
+: days ( n -- dt ) instant clone swap >>day ;
 : weeks ( n -- dt ) 7 * days ;
-: hours ( n -- dt ) instant swap >>hour ;
-: minutes ( n -- dt ) instant swap >>minute ;
-: seconds ( n -- dt ) instant swap >>second ;
+: hours ( n -- dt ) instant clone swap >>hour ;
+: minutes ( n -- dt ) instant clone swap >>minute ;
+: seconds ( n -- dt ) instant clone swap >>second ;
 : milliseconds ( n -- dt ) 1000 / seconds ;
 
 GENERIC: leap-year? ( obj -- ? )
@@ -274,14 +274,15 @@ M: timestamp time-
 M: duration time-
     before time+ ;
 
-MEMO: <zero> ( -- timestamp ) 0 0 0 0 0 0 instant <timestamp> ;
+MEMO: <zero> ( -- timestamp )
+0 0 0 0 0 0 instant <timestamp> ;
 
 : valid-timestamp? ( timestamp -- ? )
     clone instant >>gmt-offset
     dup <zero> time- <zero> time+ = ;
 
-: unix-1970 ( -- timestamp )
-    1970 1 1 0 0 0 instant <timestamp> ; foldable
+MEMO: unix-1970 ( -- timestamp )
+    1970 1 1 0 0 0 instant <timestamp> ;
 
 : millis>timestamp ( n -- timestamp )
     >r unix-1970 r> milliseconds time+ ;

diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor
index c13f08c2937fb2114d793bfde1424428a78a320c..9e4802c2ef02242e95b1af7eb6eb2417142d7464 100755 (executable)
--- a/extra/documents/documents.factor
+++ b/extra/documents/documents.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io kernel math models namespaces sequences strings
-splitting combinators unicode.categories math.order accessors ;
+USING: accessors arrays io kernel math models namespaces
+sequences strings splitting combinators unicode.categories
+math.order ;
 IN: documents
 
 : +col ( loc n -- newloc ) >r first2 r> + 2array ;

diff --git a/extra/help/help.factor b/extra/help/help.factor
index e7ad29a74192a2b9468f29279bf1471f4087ec34..d3c899ece79bdd38a19d34c9c35730f2cf314e9e 100755 (executable)
--- a/extra/help/help.factor
+++ b/extra/help/help.factor
@@ -50,7 +50,7 @@ M: word article-title
         word-name
     ] [
         [ word-name ]
-        [ stack-effect [ effect>string " " prepend ] [ "" if ] if* ] bi
+        [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
         append
     ] if ;
 

diff --git a/extra/locals/backend/backend-tests.factor b/extra/locals/backend/backend-tests.factor
index 41caa87fae49545d768c41537ab9bbf76ad34e3b..935271450947509a8c54105b7ab4ceaf265bf2ab 100644 (file)
--- a/extra/locals/backend/backend-tests.factor
+++ b/extra/locals/backend/backend-tests.factor
@@ -5,34 +5,35 @@ USING: tools.test locals.backend kernel arrays ;
 
 [ 4 ] [ 3 4 >r >r 2 get-local 2 drop-locals ] unit-test
 
-: get-local-test-1 3 >r 1 get-local r> drop ;
+: get-local-test-1 ( -- x ) 3 >r 1 get-local r> drop ;
 
-{ 0 1 } [ get-local-test-1 ] must-infer-as
+\ get-local-test-1 must-infer
 
 [ 3 ] [ get-local-test-1 ] unit-test
 
-: get-local-test-2 3 4 >r >r 2 get-local 2 drop-locals ;
+: get-local-test-2 ( -- x ) 3 4 >r >r 2 get-local 2 drop-locals ;
 
-{ 0 1 } [ get-local-test-2 ] must-infer-as
+\ get-local-test-2 must-infer
 
 [ 4 ] [ get-local-test-2 ] unit-test
 
-: get-local-test-3 3 4 >r >r 2 get-local r> r> 2array ;
+: get-local-test-3 ( -- a b ) 3 4 >r >r 2 get-local r> r> 2array ;
 
-{ 0 2 } [ get-local-test-3 ] must-infer-as
+\ get-local-test-3 must-infer
 
 [ 4 { 3 4 } ] [ get-local-test-3 ] unit-test
 
-: get-local-test-4 3 4 >r >r r> r> dup swap >r swap >r r> r> 2array ;
+: get-local-test-4 ( -- a b )
+    3 4 >r >r r> r> dup swap >r swap >r r> r> 2array ;
 
-{ 0 2 } [ get-local-test-4 ] must-infer-as
+\ get-local-test-4 must-infer
 
 [ 4 { 3 4 } ] [ get-local-test-4 ] unit-test
 
 [ 1 2 ] [ 1 2 2 load-locals r> r> ] unit-test
 
-: load-locals-test-1 1 2 2 load-locals r> r> ;
+: load-locals-test-1 ( -- a b ) 1 2 2 load-locals r> r> ;
 
-{ 0 2 } [ load-locals-test-1 ] must-infer-as
+\ load-locals-test-1 must-infer
 
 [ 1 2 ] [ load-locals-test-1 ] unit-test

diff --git a/extra/present/present.factor b/extra/present/present.factor
index 1fae84184a6239a3d299d0fd7526b9d897b0844a..3ccc1afe40c646b9f89becec8e69f5a0d23d8f84 100644 (file)
--- a/extra/present/present.factor
+++ b/extra/present/present.factor
@@ -12,4 +12,6 @@ M: string present ;
 
 M: word present word-name ;
 
+M: effect present effect>string ;
+
 M: f present drop "" ;

diff --git a/extra/tools/profiler/profiler-tests.factor b/extra/tools/profiler/profiler-tests.factor
index 450a024a1e90d8fc8fed10b0d686555060c3d9a0..335733d1092199255c673b0c0333a3530aff0c7c 100755 (executable)
--- a/extra/tools/profiler/profiler-tests.factor
+++ b/extra/tools/profiler/profiler-tests.factor
@@ -20,9 +20,9 @@ alien tools.profiler.private sequences ;
 
 [ ] [ \ + usage-profile. ] unit-test
 
-: callback-test "void" { } "cdecl" [ ] alien-callback ;
+: callback-test ( -- callback ) "void" { } "cdecl" [ ] alien-callback ;
 
-: indirect-test "void" { } "cdecl" alien-indirect ;
+: indirect-test ( callback -- ) "void" { } "cdecl" alien-indirect ;
 
 : foobar ;