extra/help/lint/coverage/coverage-tests.factor

   1 USING: accessors english eval help.lint.coverage
   2 help.lint.coverage.private help.markup help.syntax kernel
   3 literals math math.matrices multiline sequences sorting
   4 tools.test vocabs ;
   5 IN: help.lint.coverage.tests
   6
   7 <PRIVATE
   8 : an-empty-word-with-a-unique-name ( a v -- x y ) ;
   9 : a-nonexistent-word ( a v -- x y ) ;
  10 : a-defined-word ( x -- x ) ;
  11
  12 HELP: an-empty-word-with-a-unique-name { $examples } ;
  13 HELP: a-nonexistent-word ;
  14 HELP: a-defined-word { $examples { $example "USING: prettyprint ; " "1 ." "1" } } ;
  15 PRIVATE>
  16
  17 { t } [ \ an-empty-word-with-a-unique-name empty-examples? ] unit-test
  18 { f } [ \ a-nonexistent-word empty-examples? ] unit-test
  19 { f } [ \ a-defined-word empty-examples? ] unit-test
  20 { f } [ \ keep empty-examples? ] unit-test
  21
  22 { { $description $values } } [ \ an-empty-word-with-a-unique-name missing-sections natural-sort ] unit-test
  23 { { $description $values } } [ \ a-defined-word missing-sections natural-sort ] unit-test
  24 { { } } [ \ keep missing-sections ] unit-test
  25
  26 { { "a.b" "a.b.c" } } [ { "a.b" "a.b.private" "a.b.c.private" "a.b.c" } filter-private ] unit-test
  27
  28 { "sections" } [ 0 "section" ?pluralize ] unit-test
  29 { "section" } [ 1 "section" ?pluralize ] unit-test
  30 { "sections" } [ 10 "section" ?pluralize ] unit-test
  31
  32 { { $examples } } [ \ an-empty-word-with-a-unique-name word-defines-sections ] unit-test
  33 { { $examples } } [ \ a-defined-word word-defines-sections ] unit-test
  34 { { } } [ \ a-nonexistent-word word-defines-sections ] unit-test
  35 { { $values $description $examples } } [ \ keep word-defines-sections ] unit-test
  36 { { $values $contract $examples } } [ \ <word-help-coverage> word-defines-sections ] unit-test
  37
  38 { an-empty-word-with-a-unique-name } [ "an-empty-word-with-a-unique-name" find-word ] unit-test
  39
  40 { { } } [ \ zero-matrix? missing-sections ] unit-test
  41 { t } [ \ word-help-coverage? <word-help-coverage> 100%-coverage?>> ] unit-test
  42 { t } [ \ zero-matrix? <word-help-coverage> 100%-coverage?>> ] unit-test
  43
  44 {
  45   V{ "[" { $[ "math" dup lookup-vocab ] } "] " { "zero?" zero? } ": " }
  46 } [
  47   V{ } clone \ zero? (assemble-word-metadata)
  48 ] unit-test
  49 {
  50   V{ "empty " { "$examples" $examples } "; " }
  51 } [
  52   V{ } clone word-help-coverage new t >>empty-examples? (assemble-empty-examples)
  53 ] unit-test
  54
  55 {
  56   V{ "needs help " "sections: " { { "$description" $description } " and " { "$examples" $examples } } }
  57 } [
  58   V{ } clone word-help-coverage new { $description $examples } >>omitted-sections (assemble-omitted-sections)
  59 ] unit-test
  60 {
  61   V{ "needs help " "section: " { { "$description" $description } } }
  62 } [
  63   V{ } clone word-help-coverage new { $description } >>omitted-sections (assemble-omitted-sections)
  64 ] unit-test
  65 {
  66   V{ "full help coverage" }
  67 } [
  68   V{ } clone word-help-coverage new t >>100%-coverage? (assemble-full-coverage)
  69 ] unit-test
  70
  71 ! make sure this doesn't throw an error (would signify an issue with ignored-words)
  72 [ { $io-error $prettyprinting-note $nl } [ <word-help-coverage> ] map ] must-not-fail
  73
  74
  75 ! Lint system is written weirdly, there's no way to invoke it and get the output
  76 ! Instead, it writes to lint-failures.
  77 { t }
  78 [
  79     [[
  80         USING: assocs definitions math kernel namespaces help.syntax
  81         help.lint help.lint.private continuations compiler.units ;
  82         IN: help.lint.tests
  83         <<
  84         : add-stuff ( x y -- z ) + ;
  85
  86         HELP: add-stuff ;
  87         >>
  88         [
  89             H{ } clone lint-failures [
  90                 \ add-stuff check-word lint-failures get
  91                 assoc-empty? [ "help-lint is broken" throw ] when
  92             ] with-variable t
  93         ] [
  94             [ \ add-stuff forget ] with-compilation-unit
  95         ] [
  96             f
  97         ] cleanup
  98     ]] eval( -- ? )
  99 ] unit-test
 100
 101
 102 ! clean up broken words
 103 [[
 104   USING: definitions compiler.units ;
 105   IN: help.lint.coverage.tests.private
 106 [
 107     \ an-empty-word-with-a-unique-name forget
 108     \ a-nonexistent-word forget
 109     \ a-defined-word forget
 110 ] with-compilation-unit
 111 ]] eval( -- )