Fix unit tests

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 ;

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

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

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+ ;

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 ;

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 ;
 

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

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 "" ;

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 ;