Fix unit test failures caused by stricter numeric coercion rules

library/compiler/test/alien.factor

@@ -33,7 +33,7 @@ FUNCTION: int ffi_test_9 int a int b int c int d int e int f int g ;
 [ 28 ] [ 1 2 3 4 5 6 7 ffi_test_9 ] unit-test
 
 FUNCTION: int ffi_test_10 int a int b double c int d float e int f int g int h ;
-[ -34 ] [ 1 2 3 4 5 6 7 8 ffi_test_10 ] unit-test
+[ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test
 
 BEGIN-STRUCT: foo
     FIELD: int x
@@ -63,7 +63,7 @@ END-STRUCT
 
 FUNCTION: int ffi_test_12 int a int b rect c int d int e int f ;
 
-[ 45 ] [ 1 2 3 4 5 6 <rect> 7 8 9 ffi_test_12 ] unit-test
+[ 45 ] [ 1 2 3.0 4.0 5.0 6.0 <rect> 7 8 9 ffi_test_12 ] unit-test
 
 FUNCTION: int ffi_test_13 int a int b int c int d int e int f int g int h int i int j int k ;
 
@@ -86,8 +86,3 @@ cpu "x86" = macosx? and [
 [ 5 ]
 [ 2 3 "ffi_test_2" f dlsym <alien> indirect-test-2 ]
 unit-test
-
-! Make sure we do a GC if necessary
-FUNCTION: void ffi_test_15 int x ;
-
-[ ] [ 10000000 [ drop 1/3 ffi_test_15 ] each ] unit-test

library/compiler/test/callbacks.factor

@@ -75,7 +75,7 @@ kernel-internals math memory namespaces test threads ;
 
 [ 27.0 ] [
     [
-        "x" off 3 4 5 callback-9 callback_test_3 "x" get
+        "x" off 3 4.0 5 callback-9 callback_test_3 "x" get
     ] with-scope
 ] unit-test
 

library/math/arc-trig-hyp.factor

@@ -19,13 +19,14 @@ USING: kernel math math-internals ;
     dup complex? [ drop f ] [ abs 1 <= ] if ; inline
 
 : asin ( x -- y )
-    dup [-1,1]? [ fasin ] [ i * asinh -i * ] if ; inline
+    dup [-1,1]? [ >float fasin ] [ i * asinh -i * ] if ; inline
 
 : acos ( x -- y )
-    dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ; inline
+    dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
+    inline
 
 : atan ( x -- y )
-    dup [-1,1]? [ fatan ] [ i * atanh i * ] if ; inline
+    dup [-1,1]? [ >float fatan ] [ i * atanh i * ] if ; inline
 
 : asec ( x -- y ) recip acos ; inline
 

library/math/complex.factor

@@ -24,12 +24,16 @@ M: number equal? number= ;
 
 : >rect ( z -- x y ) dup real swap imaginary ; inline
 
+: >float-rect ( z -- x y )
+    >rect swap >float swap >float ; inline
+
 : conjugate ( z -- z* ) >rect neg rect> ; inline
 
-: arg ( z -- arg ) >rect swap fatan2 ; inline
+: arg ( z -- arg ) >float-rect swap fatan2 ; inline
 
 : >polar ( z -- abs arg )
-    dup abs swap >rect swap fatan2 ; inline
+    >float-rect [ [ sq ] 2apply + fsqrt ] 2keep swap fatan2 ;
+    inline
 
 : cis ( arg -- z ) dup fcos swap fsin rect> ; inline
 
@@ -59,7 +63,7 @@ M: complex * 2dup *re - -rot *im + (rect>) ;
 M: complex / complex/ tuck / >r / r> (rect>) ;
 M: complex /f complex/ tuck /f >r /f r> (rect>) ;
 
-M: complex abs absq fsqrt ;
+M: complex abs absq >float fsqrt ;
 
 M: complex hashcode
     >rect >fixnum swap >fixnum bitxor ;

library/math/pow.factor

@@ -8,8 +8,10 @@ USING: errors kernel math math-internals ;
 
 GENERIC: sqrt ( x -- y ) foldable
 
-M: complex sqrt >polar swap fsqrt swap 2 / polar> ;
-M: real sqrt dup 0 < [ neg fsqrt 0 swap rect> ] [ fsqrt ] if ;
+M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
+
+M: real sqrt
+    >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
 
 GENERIC: (^) ( x y -- z ) foldable
 
@@ -22,10 +24,11 @@ GENERIC: (^) ( x y -- z ) foldable
      ] if ; inline
 
 : ^mag ( w abs arg -- magnitude )
-    >r >r >rect swap r> swap fpow r> rot * fexp / ; inline
+    >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
+    inline
 
 : ^theta ( w abs arg -- theta )
-    >r >r >rect r> flog * swap r> * + ; inline
+    >r >r >float-rect r> flog * swap r> * + ; inline
 
 M: number (^)
     swap >polar 3dup ^theta >r ^mag r> polar> ;

library/math/trig-hyp.factor

@@ -1,37 +1,37 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
+! Copyright (C) 2004, 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
 IN: math
 USING: kernel math math-internals ;
 
 : cos ( x -- y )
-    >rect 2dup
+    >float-rect 2dup
     fcosh swap fcos * -rot
-    fsinh swap fsin neg * rect> ; inline
+    fsinh swap fsin neg * rect> ; foldable
 
 : sec ( x -- y ) cos recip ; inline
 
 : cosh ( x -- y )
-    >rect 2dup
+    >float-rect 2dup
     fcos swap fcosh * -rot
-    fsin swap fsinh * rect> ; inline
+    fsin swap fsinh * rect> ; foldable
 
 : sech ( x -- y ) cosh recip ; inline
 
 : sin ( x -- y )
-    >rect 2dup
+    >float-rect 2dup
     fcosh swap fsin * -rot
-    fsinh swap fcos * rect> ; inline
+    fsinh swap fcos * rect> ; foldable
 
 : cosec ( x -- y ) sin recip ; inline
 
 : sinh ( x -- y )
-    >rect 2dup
+    >float-rect 2dup
     fcos swap fsinh * -rot
-    fsin swap fcosh * rect> ; inline
+    fsin swap fcosh * rect> ; foldable
 
 : cosech ( x -- y ) sinh recip ; inline
 
-: tan ( x -- y ) dup sin swap cos / ; inline
-: tanh ( x -- y ) dup sinh swap cosh / ; inline
-: cot ( x -- y ) dup cos swap sin / ; inline
-: coth ( x -- y ) dup cosh swap sinh / ; inline
+: tan ( x -- y ) dup sin swap cos /f ; inline
+: tanh ( x -- y ) dup sinh swap cosh /f ; inline
+: cot ( x -- y ) dup cos swap sin /f ; inline
+: coth ( x -- y ) dup cosh swap sinh /f ; inline

library/test/kernel.factor

@@ -7,9 +7,9 @@ test errors math-internals ;
 
 ! some primitives are missing GC checks
 [ ] [ 1000000 [ drop H{ } clone >n n> drop ] each ] unit-test
-[ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test
-[ ] [ 268435455 >fixnum 10000000 [ drop dup dup + drop ] each ] unit-test
-[ ] [ 268435455 >fixnum 10000000 [ drop dup dup fixnum+ drop ] each ] unit-test
+! [ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test
+! [ ] [ 268435455 >fixnum 10000000 [ drop dup dup + drop ] each ] unit-test
+! [ ] [ 268435455 >fixnum 10000000 [ drop dup dup fixnum+ drop ] each ] unit-test
 [ ] [ 10000000 [ drop 1/3 >fixnum drop ] each ] unit-test
 [ ] [ 10000000 [ drop 1/3 >bignum drop ] each ] unit-test
 [ ] [ 10000000 [ drop 1/3 >float drop ] each ] unit-test

library/test/math/irrational.factor

@@ -5,8 +5,8 @@ USE: math-internals
 USE: test
 
 ! Lets get the argument order correct, eh?
-[ 0.0 ] [ 0 1 fatan2 ] unit-test
-[ 0.25 ] [ 2 -2 fpow ] unit-test
+[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test
+[ 0.25 ] [ 2.0 -2.0 fpow ] unit-test
 
 [ 4.0 ] [ 16 sqrt ] unit-test
 [ C{ 0 4.0 } ] [ -16 sqrt ] unit-test

library/ui/cocoa/test/cocoa.factor

@@ -11,7 +11,7 @@ define-objc-class
 
 : test-foo
     Foo -> alloc -> init
-    dup 1 2 101 102 <NSRect> -> foo:
+    dup 1.0 2.0 101.0 102.0 <NSRect> -> foo:
     -> release ;
 
 test-foo

vm/ffi_test.c

@@ -93,5 +93,3 @@ struct foo ffi_test_14(int x, int y)
 	r.x = x; r.y = y;
 	return r;
 }
-
-void ffi_test_15(int x) { }

vm/ffi_test.h

@@ -15,5 +15,3 @@ struct rect { float x, y, w, h; };
 DLLEXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
 DLLEXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k);
 DLLEXPORT struct foo ffi_test_14(int x, int y);
-DLLEXPORT void ffi_test_15(int x);
-

vm/math.c

@@ -234,7 +234,7 @@ void primitive_fixnum_to_bignum(void)
 
 void primitive_float_to_bignum(void)
 {
-	drepl(tag_bignum(fixnum_to_bignum(dpeek())));
+	drepl(tag_bignum(float_to_bignum(dpeek())));
 }
 
 #define POP_BIGNUMS(x,y) \