Some cleanups and more tests

diff --git a/contrib/random-tester/random-tester.factor b/contrib/random-tester/random-tester.factor
index b6a6ea55e27d78af01d72a0a284c642366f8cc4a..4985df6c70febd8bfa9b0117e509858e473f014f 100644 (file)
--- a/contrib/random-tester/random-tester.factor
+++ b/contrib/random-tester/random-tester.factor
@@ -182,8 +182,24 @@ IN: random-tester
 
 
 SYMBOL: last-quot
-: interp-compile-check ( quot -- )
+SYMBOL: first-arg
+: runtime-check
+    [ last-quot set ] keep
+    [ call ] keep
+    call
+    ! 2dup swap unparse write " " write unparse print
+    = [ last-quot get . "problem in runtime" throw ] unless ;
+
+: runtime-check-1
+    [ last-quot set first-arg set ] 2keep
+    [ call ] 2keep
+    call
+    2dup swap unparse write " " write unparse print
+    = [ "problem in runtime" throw ] unless ;
+
+: interp-runtime-check ( quot -- )
     dup . 
+    ! 0 [ tan tan ] compile-1 drop
     [ last-quot set ] keep
     [ call ] keep compile-1
     2dup swap unparse write " " write unparse print
@@ -191,12 +207,18 @@ SYMBOL: last-quot
 
 : interp-compile-check-1 ( x quot -- )
     .s flush
-    ! dup . flush
     [ last-quot set ] keep
     [ call ] 2keep compile-1
     2dup swap unparse write " " write unparse print
     = [ "problem in math" throw ] unless ;
 
+: interp-compile-check-2 ( x quot -- )
+    .s flush
+    [ last-quot set ] keep
+    [ call ] 3keep compile-1
+    2dup swap unparse write " " write unparse print
+    = [ "problem in math" throw ] unless ;
+
 : interp-compile-check* ( quot -- )
     dup .
     >r 100 200 300 400 r> [ call 4array ] keep
@@ -235,11 +257,13 @@ SYMBOL: last-quot
 : random-float>x-quot ( -- ) random-float float>x nth-rand unit cons ;
 : random-complex>x-quot ( -- ) random-complex complex>x nth-rand unit cons ;
 
-: test-integer>x ( -- ) random-integer>x-quot interp-compile-check ;
-: test-ratio>x ( -- ) random-ratio>x-quot interp-compile-check ;
-: test-float>x ( -- ) random-float>x-quot interp-compile-check ;
-: test-complex>x ( -- ) random-complex>x-quot interp-compile-check ;
+: test-integer>x ( -- ) random-integer>x-quot interp-runtime-check ;
+: test-ratio>x ( -- ) random-ratio>x-quot interp-runtime-check ;
+: test-float>x ( -- ) random-float>x-quot interp-runtime-check ;
+: test-complex>x ( -- ) random-complex>x-quot interp-runtime-check ;
 
+: test-integer>x-runtime ( -- ) random-integer>x-quot runtime-check ;
+: test-integer>x-1-runtime ( -- ) random-integer>x-quot runtime-check ;
 
 : test-integer>x-1 ( -- )
     random-integer integer>x nth-rand unit interp-compile-check-1 ;
@@ -256,27 +280,43 @@ SYMBOL: last-quot
     random-ratio ratio>x-throw nth-rand unit cons interp-compile-check-catch ;
 
 : test-update-xt ( -- )
-    random-integer random-integer 2integer>x nth-rand f cons cons cons update-xt-check ;
+    random-integer random-integer 2integer>x nth-rand unit swons swons update-xt-check ;
 
 ! 2-arg tests
 : test-2integer>x ( -- )
-    random-integer random-integer 2integer>x nth-rand f cons cons cons interp-compile-check ;
+    random-integer random-integer 2integer>x nth-rand unit swons swons interp-runtime-check ;
 
 : test-2ratio>x ( -- )
-    random-ratio random-ratio 2ratio>x nth-rand f cons cons cons interp-compile-check ;
+    random-ratio random-ratio 2ratio>x nth-rand unit swons swons interp-runtime-check ;
 
 : test-2float>x ( -- )
-    random-float random-float 2float>x nth-rand f cons cons cons interp-compile-check ;
+    random-float random-float 2float>x nth-rand unit swons swons interp-runtime-check ;
 
 : test-2complex>x ( -- )
-    random-complex random-complex 2complex>x nth-rand f cons cons cons interp-compile-check ;
+    random-complex random-complex 2complex>x nth-rand unit swons swons interp-runtime-check ;
 
 
 : test-2random>x ( -- )
-    random-number random-number math-2 nth-rand f cons cons cons interp-compile-check ;
+    random-number random-number math-2 nth-rand unit swons swons interp-runtime-check ;
+
+
+
+: test-2integer>x-2 ( -- )
+    random-integer random-integer 2integer>x nth-rand unit interp-compile-check-2 ;
+
+: test-2ratio>x-2 ( -- )
+    random-ratio random-ratio 2ratio>x nth-rand unit interp-compile-check-2 ;
+
+: test-2float>x-2 ( -- )
+    random-float random-float 2float>x nth-rand unit interp-compile-check-2 ;
+
+: test-2complex>x-2 ( -- )
+    random-complex random-complex 2complex>x nth-rand unit interp-compile-check-2 ;
+
+
+! : test-2integer>x-1 ( -- )
+    ! random-integer random-integer-quotation-1 interp-compile-check-1 ;
 
-: test-2integer>x-1 ( -- )
-    random-integer random-integer-quotation-1 interp-compile-check-1 ;
 
 : test-2integer>x-throws ( -- )
     [
@@ -301,10 +341,12 @@ SYMBOL: last-quot
         ! test-ratio>x 
         ! test-float>x 
         ! test-complex>x 
-        test-integer>x-1
-        test-ratio>x-1
-        test-float>x-1
-        test-complex>x-1
+
+        ! test-integer>x-1
+        ! test-ratio>x-1
+        ! test-float>x-1
+        ! test-complex>x-1
+
         ! test-integer>x-throws
         ! test-ratio>x-throws
 
@@ -313,7 +355,11 @@ SYMBOL: last-quot
         ! test-2ratio>x
         ! test-2float>x
         ! test-2complex>x
-        test-2integer>x-1
+        test-2integer>x-2
+        test-2ratio>x-2
+        test-2float>x-2
+        test-2complex>x-2
+        ! ! test-2integer>x-1
         ! test-2integer>x-throws
         ! test-^-shift
         ! test-^-ratio
@@ -335,48 +381,48 @@ SYMBOL: last-quot
 : logic-3 ( -- seq ) { between? } ;
 : complex-logic-2 ( -- seq ) { number= = eq? and or } ;
 
-: logic-0-test ( -- ) logic-0 nth-rand unit interp-compile-check ;
+: logic-0-test ( -- ) logic-0 nth-rand unit interp-runtime-check ;
 
 : integer-logic-1-test ( -- )
     [
         random-integer , logic-1 nth-rand ,
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : ratio-logic-1-test ( -- )
     [
         random-ratio , logic-1 nth-rand ,
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : float-logic-1-test ( -- )
     [
         random-float , logic-1 nth-rand ,
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : complex-logic-1-test ( -- )
     [
         random-complex , logic-1 nth-rand ,
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 
 : integer-logic-2-test ( -- )
     [
         random-integer , random-integer , logic-2 nth-rand , 
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : ratio-logic-2-test ( -- )
     [
         random-ratio , random-ratio , logic-2 nth-rand , 
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : float-logic-2-test ( -- )
     [
         random-float , random-float , logic-2 nth-rand , 
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 : complex-logic-2-test ( -- )
     [
         random-complex , random-complex , complex-logic-2 nth-rand , 
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 
 : string-to-math-test ( -- )
@@ -385,19 +431,33 @@ SYMBOL: last-quot
         [ random-integer , \ number>string , ]
         [ random-integer , \ number>string , \ string>number , ]
         } do-one
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
 
 
 : test-float?-when
     [
         random-number , \ dup , \ float? , float>x nth-rand unit , \ when ,
-    ] [ ] make interp-compile-check ;
+    ] [ ] make interp-runtime-check ;
+
+: test-integer?-when-1
+    random-float [
+        \ dup , \ float? , float>x nth-rand unit , \ when ,
+    ] [ ] make interp-compile-check-1 ;
+
+: test-ratio?-when-1
+    random-ratio [
+        \ dup , \ ratio? , ratio>x nth-rand unit , \ when ,
+    ] [ ] make interp-compile-check-1 ;
 
 : test-float?-when-1
     random-float [
         \ dup , \ float? , float>x nth-rand unit , \ when ,
     ] [ ] make interp-compile-check-1 ;
 
+: test-complex?-when-1
+    random-complex [
+        \ dup , \ complex? , complex>x nth-rand unit , \ when ,
+    ] [ ] make interp-compile-check-1 ;
 
 : stack-identity-0
     H{
@@ -481,7 +541,7 @@ SYMBOL: last-quot
         ! when-quot %
     ] [ ] make ;
 
-: test-if ( -- ) nested-ifs interp-compile-check ;
+: test-if ( -- ) nested-ifs interp-runtime-check ;
 
 : random-test ( -- )
     {

diff --git a/contrib/random-tester/random.factor b/contrib/random-tester/random.factor
index ac4bd42007e12adeef79c993baaaaecfa704fec5..2175ddf761ec0a9b4c1e301b638e1380aabaad74 100644 (file)
--- a/contrib/random-tester/random.factor
+++ b/contrib/random-tester/random.factor
@@ -34,7 +34,7 @@ SYMBOL: special-integers
 { } make \ special-integers set
 : special-integers ( -- seq ) \ special-integers get ;
 SYMBOL: special-floats
-[ { 0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ]
+[ { 0.0 -0.0 } % e , pi , 1./0. , -1./0. , 0./0. , epsilon , epsilon neg , ]
 { } make \ special-floats set
 : special-floats ( -- seq ) \ special-floats get ;
 SYMBOL: special-complexes