extra/mason/test/test.factor

   1 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs benchmark bootstrap.stage2
   4 compiler.errors source-files.errors generic help.html help.lint
   5 io.directories io.encodings.utf8 io.files kernel mason.common
   6 math namespaces prettyprint sequences sets sorting tools.test
   7 tools.time words system io tools.errors vocabs vocabs.files
   8 vocabs.hierarchy vocabs.errors vocabs.refresh locals
   9 source-files compiler.units ;
  10 IN: mason.test
  11
  12 : do-load ( -- )
  13     "" (load)
  14     [ keys load-all-vocabs-file to-file ]
  15     [ load-all-errors-file utf8 [ load-failures. ] with-file-writer ]
  16     bi ;
  17
  18 GENERIC: word-vocabulary ( word -- vocabulary )
  19
  20 M: word word-vocabulary vocabulary>> ;
  21
  22 M: method word-vocabulary "method-generic" word-prop word-vocabulary ;
  23
  24 :: do-step ( errors summary-file details-file -- )
  25     errors
  26     [ error-type +linkage-error+ eq? not ] filter
  27     [ file>> ] map members natural-sort summary-file to-file
  28     errors details-file utf8 [ errors. ] with-file-writer ;
  29
  30 : do-tests ( -- )
  31     test-all test-failures get
  32     test-all-vocabs-file
  33     test-all-errors-file
  34     do-step ;
  35
  36 : cleanup-tests ( -- )
  37     ! Free up some code heap space
  38     [
  39         vocabs [ vocab-tests [ forget-source ] each ] each
  40     ] with-compilation-unit ;
  41
  42 : do-help-lint ( -- )
  43     help-lint-all lint-failures get values
  44     help-lint-vocabs-file
  45     help-lint-errors-file
  46     do-step ;
  47
  48 : do-benchmarks ( -- )
  49     run-benchmarks
  50     [ benchmarks-file to-file ] [
  51         [ keys benchmark-error-vocabs-file to-file ]
  52         [ benchmark-error-messages-file utf8 [ benchmark-errors. ] with-file-writer ] bi
  53     ] bi* ;
  54
  55 : do-compile-errors ( -- )
  56     compiler-errors get values
  57     compiler-errors-file
  58     compiler-error-messages-file
  59     do-step ;
  60
  61 : check-boot-image ( -- )
  62     "" to-refresh drop 2dup [ empty? not ] either?
  63     [
  64         "Boot image is out of date. Changed vocabs:" print
  65         members [ print ] each
  66         flush
  67         1 exit
  68     ] [ 2drop ] if ;
  69
  70 : do-all ( -- )
  71     ".." [
  72         bootstrap-time get boot-time-file to-file
  73         check-boot-image
  74         [ do-load ] benchmark load-time-file to-file
  75         [ generate-help ] benchmark html-help-time-file to-file
  76         [ do-tests ] benchmark test-time-file to-file
  77         cleanup-tests
  78         [ do-help-lint ] benchmark help-lint-time-file to-file
  79         [ do-benchmarks ] benchmark benchmark-time-file to-file
  80         do-compile-errors
  81     ] with-directory ;
  82
  83 MAIN: do-all