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