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