basis/help/markup/markup-tests.factor

   1 USING: accessors arrays assocs definitions fry generic help
   2 help.markup io.streams.string kernel math namespaces parser
   3 sequences sets strings tools.test words ;
   4 IN: help.markup.tests
   5
   6 : with-markup-test ( quot -- )
   7     [ f last-element ] dip
   8     '[ _ with-string-writer ] with-variable ; inline
   9
  10 TUPLE: blahblah quux ;
  11
  12 { "int" } [ [ { "int" } $instance ] with-markup-test ] unit-test
  13
  14 { } [ \ quux>> print-topic ] unit-test
  15 { } [ \ >>quux print-topic ] unit-test
  16 { } [ \ blahblah? print-topic ] unit-test
  17
  18 : fooey ( -- * ) "fooey" throw ;
  19
  20 { } [ \ fooey print-topic ] unit-test
  21
  22 { } [ gensym print-topic ] unit-test
  23
  24 { "a string" }
  25 [ [ { $or string } print-element ] with-markup-test ] unit-test
  26
  27 { "a string or an integer" }
  28 [ [ { $or string integer } print-element ] with-markup-test ] unit-test
  29
  30 { "a string, a fixnum, or an integer" }
  31 [ [ { $or string fixnum integer } print-element ] with-markup-test ] unit-test
  32
  33 ! Layout
  34
  35 { "span" }
  36 [ [ { "span" } print-content ] with-markup-test ] unit-test
  37
  38 { "span1span2" }
  39 [ [ { "span1" "span2" } print-content ] with-markup-test ] unit-test
  40
  41 { "span1\n\nspan2" }
  42 [ [ { "span1" { $nl } "span2" } print-content ] with-markup-test ] unit-test
  43
  44 { "\nspan" }
  45 [ [ { { $nl } "span" } print-content ] with-markup-test ] unit-test
  46
  47 { "2 2 +\nspan" }
  48 [ [ { { $code "2 2 +" } "span" } print-content ] with-markup-test ] unit-test
  49
  50 { "2 2 +" }
  51 [ [ { { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
  52
  53 { "span\n2 2 +" }
  54 [ [ { "span" { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
  55
  56 { "\n2 2 +" }
  57 [ [ { { $nl } { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
  58
  59 { "span\n\n2 2 +" }
  60 [ [ { "span" { $nl } { $code "2 2 +" } } print-content ] with-markup-test ] unit-test
  61
  62 { "Heading" }
  63 [ [ { { $heading "Heading" } } print-content ] with-markup-test ] unit-test
  64
  65 { "Heading1\n\nHeading2" }
  66 [ [ { { $heading "Heading1" } { $heading "Heading2" } } print-content ] with-markup-test ] unit-test
  67
  68 { "span\n\nHeading" }
  69 [ [ { "span" { $heading "Heading" } } print-content ] with-markup-test ] unit-test
  70
  71 { "\nHeading" }
  72 [ [ { { $nl } { $heading "Heading" } } print-content ] with-markup-test ] unit-test
  73
  74 { "span\n\nHeading" }
  75 [ [ { "span" { $nl } { $heading "Heading" } } print-content ] with-markup-test ] unit-test
  76
  77 : word-related-words ( word -- word related-words )
  78     dup [ "related" word-prop ] [ 1array ] bi diff ;
  79
  80 SYMBOLS:
  81     1foo 2foo 3foo
  82     1bar 2bar 3bar ;
  83
  84 {
  85     1foo { 2foo 3foo }
  86     1bar { 2bar 3bar }
  87
  88     1foo { 1bar }
  89     2foo { 3foo }
  90     2bar { 3bar }
  91 } [
  92     { 1foo 2foo 3foo } related-words
  93     { 1bar 2bar 3bar } related-words
  94
  95     1foo word-related-words
  96     1bar word-related-words
  97
  98     { 2foo 3foo } related-words
  99     { 1foo 1bar } related-words
 100
 101     1foo word-related-words
 102     2foo word-related-words
 103     2bar word-related-words
 104 ] unit-test