unmaintained/random-tester/random-tester.factor

   1 USING: compiler continuations io kernel math namespaces
   2 prettyprint quotations random sequences vectors
   3 compiler.units ;
   4 USING: random-tester.databank random-tester.safe-words
   5 random-tester.random ;
   6 IN: random-tester
   7
   8 SYMBOL: errored
   9 SYMBOL: before
  10 SYMBOL: after
  11 SYMBOL: quot
  12 ERROR: random-tester-error ;
  13
  14 : setup-test ( #data #code -- data... quot )
  15     #! Variable stack effect
  16     >r [ databank random ] times r>
  17     ! 200 300 random-cond ;
  18     ! random-if ;
  19     [ drop \ safe-words get random ] map >quotation ;
  20
  21 : test-compiler ! ( data... quot -- ... )
  22     errored off
  23     dup quot set
  24     datastack 1 head* before set
  25     [ call ] [ drop ] recover
  26     datastack after set
  27     clear
  28     before get [ ] each
  29     quot get [ compile-call ] [ errored on ] recover ;
  30
  31 : do-test ! ( data... quot -- )
  32     .s flush test-compiler
  33     errored get [
  34         datastack after get 2dup = [
  35             2drop
  36         ] [
  37             [ . ] each
  38             "--" print
  39             [ . ] each
  40             quot get .
  41             random-tester-error
  42         ] if
  43     ] unless clear ;
  44
  45 : random-test1 ( #data #code -- )
  46     setup-test do-test ;
  47
  48 : random-test2 ( -- )
  49     3 2 setup-test do-test ;