more cleanup in random-tester

apps/random-tester/hang.factor

@@ -1,96 +0,0 @@
-USING: errors generic io kernel lazy-lists math namespaces
-prettyprint random-tester2 sequences tools words ;
-IN: random-tester
-
-: inputs-exhaustive ( -- seq )
-    {
-        -100000000000000000
-        -1
-        0
-        1
-        100000000000000000
-
-        -29/2
-         100000000000000000/999999999999999999
-
-        -1/0.
-        -3.14
-        0.0
-        3.14
-        1/0.
-        0/0.
-
-        C{ 1 -1 }
-    } ;
-
-
-: inert ;
-TUPLE: inert-object ;
-
-: inputs ( -- seq )
-    {
-        0
-        ! -268435457
-        inert
-        T{ inert-object f }
-        -29/2
-        -3.14
-        C{ 1 -1 }
-        W{ 55 }
-        { }
-        f
-        H{ }
-        V{ }
-        ""
-        SBUF" "
-        [ ]
-        DLL" libm.dylib"
-        ALIEN: 1
-        T{ inert-object f }
-    } ;
-
-: cartesian-inputs ( n -- list )
-    >r inputs >list r>
-    1- [ drop inputs >list lcartesian-product ] each ;
-
-: word-inputs ( word -- seq )
-    stack-effect [ effect-in length ] [ drop 2 ] recover
-    cartesian-inputs list>array ;
-    
-: type-error? ( exception -- ? )
-    [ swap execute or ] curry
-    >r { no-method? no-math-method? } f r> reduce ;
-
-: maybe-explode
-    dup sequence? [ [ ] each ] when ;
-
-SYMBOL: err
-SYMBOL: type-error
-SYMBOL: params
-: throws? ( data... quot -- ? )
-    err off type-error off
-    >r
-        dup clone params set
-        maybe-explode
-    r>
-     "<<<<<testing" .
-     .s
-        3dup . . .
-     "-----" . flush
-    [ call ] [ err on ] recover
-     .s
-     ">>>>>tested" .
-    err get [
-        dup type-error? dup [
-            .s
-        ] unless
-        type-error set
-    ] when clear type-error get
-    ;
-
-: test-inputs ( word -- seq )
-    [ word-inputs ] keep
-    unit [
-        throws? not
-    ] curry map ;
-

apps/random-tester/random-tester2.factor

@@ -23,8 +23,6 @@ SYMBOL: wordbank
 
         clear-hash build-graph
 
-        be>
-
         >r r>
 
         set-callstack set-word set-word-prop
@@ -38,10 +36,9 @@ SYMBOL: wordbank
         set-nested-style-stream-style
         set-pathname-string
         set-check-create-vocab
-        <check-create>
+        <check-create> check-create?
         reset-generic forget-class
         create forget-word forget-vocab forget forget-tuple
-        check-create?
         remove-word-prop empty-method
         continue-with <continuation>
 
@@ -59,52 +56,42 @@ SYMBOL: wordbank
         set-word-def set-word-name
         set-word-props set-word-primitive
 
-        close readln read1 read (lines) with-server
-        stream-read
-        stream-readln stream-read1 lines contents stream-copy
-        stream-write log-stream stream-format set-line-reader-cr
-        stream-flush (readln)
-
-        word-xt.
-
         stdio
-
+        close readln (readln) read1 read with-server
-        .s
+        stream-read stream-readln stream-read1 lines (lines)
+        contents stream-copy stream-flush
+        stream-write log-stream stream-format set-line-reader-cr
 
         double>bits float>bits >bignum
 
         intern-slots class-predicates delete (delete) prune memq?
         normalize norm vneg vmax vmin v- v+ [v-]
 
-        bin> oct> le> be> hex> concat string>number
+        bin> oct> le> be> hex> string>number
 
         gensym random-int counter <byte-array>
         <word> <client-stream> <server> <client>
-        <duplex-stream>
+        <duplex-stream> <file-writer> <file-reader> <file-r/w>
-        <file-writer> <file-reader> <file-r/w>
         init-namespaces unxref-word set-global set off on
         nest
         set-restart-obj
         +@ inc dec
 
-        ! 0.0 5000000 condition
-        condition
-        
         changed-words
         callstack namespace namestack global vocabularies
 
         file. (file.) path+ parent-dir directory.
 
-        <continuation> continue-with
+        .s . word-xt.
 
+        <continuation> continue-with
         set-delegate
+
         closure
         
         tabular-output simple-slots
 
-        join
+        join concat
-
-
     }
     { "arrays" "errors" "generic" "graphs" "hashtables" "io"
     "kernel" "math" "namespaces"
@@ -162,17 +149,15 @@ err off
 : run-random-tester2
     100000000000000 [ 6 3 random-test ] times ;
 
-
 ! A worthwhile test that has not been run extensively
 1000 [ drop gensym ] map "syms" set
 
 : pick-one [ length random-int ] keep nth ;
 
-: fooify
+: fooify-test
     "syms" get pick-one
     2000 random-int >quotation
     over set-word-def
     100 random-int zero? [ code-gc ] when
     compile fooify ;
 
-

apps/random-tester/type.factor

@@ -2,28 +2,6 @@ USING: errors generic io kernel lazy-lists math namespaces
 prettyprint random-tester2 sequences tools words ;
 IN: random-tester
 
-: inputs-exhaustive ( -- seq )
-    {
-        -100000000000000000
-        -1
-        0
-        1
-        100000000000000000
-
-        -29/2
-         100000000000000000/999999999999999999
-
-        -1/0.
-        -3.14
-        0.0
-        3.14
-        1/0.
-        0/0.
-
-        C{ 1 -1 }
-    } ;
-
-
 : inert ;
 TUPLE: inert-object ;
 
@@ -72,9 +50,8 @@ SYMBOL: last-time
         dup clone params set
         maybe-explode
     r>
-    dup [ nth-byte ] = [ .s ] when
     ! .s
-    dup last-time get = [ dup . dup last-time set ] unless
+    dup last-time get = [ dup . flush dup last-time set ] unless
     [ call ] [ err on ] recover
     err get [
         dup type-error? dup [