basis/html/templates/chloe/chloe-tests.factor

   1 USING: html.templates html.templates.chloe
   2 tools.test io.streams.string kernel sequences ascii boxes
   3 namespaces xml html.components html.forms
   4 splitting furnace accessors
   5 html.templates.chloe.compiler ;
   6 IN: html.templates.chloe.tests
   7
   8 : run-template ( quot -- string )
   9     with-string-writer [ "\r\n\t" member? not ] filter
  10     "?>" split1 nip ; inline
  11
  12 : test-template ( name -- template )
  13     "vocab:html/templates/chloe/test/"
  14     prepend <chloe> ;
  15
  16 [ "Hello world" ] [
  17     [
  18         "test1" test-template call-template
  19     ] run-template
  20 ] unit-test
  21
  22 [ "Blah blah" "Hello world" ] [
  23     [
  24         <box> title set
  25         [
  26             "test2" test-template call-template
  27         ] run-template
  28         title get box>
  29     ] with-scope
  30 ] unit-test
  31
  32 [ "<html><head><title>Hello world</title></head><body>Blah blah</body></html>" ] [
  33     [
  34         [
  35             "test2" test-template call-template
  36         ] "test3" test-template with-boilerplate
  37     ] run-template
  38 ] unit-test
  39
  40 : test4-aux? ( -- ? ) t ;
  41
  42 [ "True" ] [
  43     [
  44         "test4" test-template call-template
  45     ] run-template
  46 ] unit-test
  47
  48 : test5-aux? ( -- ? ) f ;
  49
  50 [ "" ] [
  51     [
  52         "test5" test-template call-template
  53     ] run-template
  54 ] unit-test
  55
  56 [ ] [ begin-form ] unit-test
  57
  58 [ ] [ "A label" "label" set-value ] unit-test
  59
  60 SINGLETON: link-test
  61
  62 M: link-test link-title drop "<Link Title>" ;
  63
  64 M: link-test link-href drop "http://www.apple.com/foo&bar" ;
  65
  66 [ ] [ link-test "link" set-value ] unit-test
  67
  68 [ ] [ "int x = 5;" "code" set-value ] unit-test
  69
  70 [ ] [ "c" "mode" set-value ] unit-test
  71
  72 [ ] [ { 1 2 3 } "inspector" set-value ] unit-test
  73
  74 [ ] [ "<p>a paragraph</p>" "html" set-value ] unit-test
  75
  76 [ ] [ "sheeple" "field" set-value ] unit-test
  77
  78 [ ] [ "a password" "password" set-value ] unit-test
  79
  80 [ ] [ "a\nb\nc" "textarea" set-value ] unit-test
  81
  82 [ ] [ "new york" "choice" set-value ] unit-test
  83
  84 [ ] [ { "new york" "detroit" "minneapolis" } "choices" set-value ] unit-test
  85
  86 [ ] [
  87     [
  88         "test8" test-template call-template
  89     ] run-template drop
  90 ] unit-test
  91
  92 [ ] [ { 1 2 3 } "numbers" set-value ] unit-test
  93
  94 [ "<ul><li>1</li><li>2</li><li>3</li></ul>" ] [
  95     [
  96         "test7" test-template call-template
  97     ] run-template [ blank? not ] filter
  98 ] unit-test
  99
 100 TUPLE: person first-name last-name ;
 101
 102 [ ] [
 103     {
 104         T{ person f "RBaxter" "Unknown" }
 105         T{ person f "Doug" "Coleman" }
 106     } "people" set-value
 107 ] unit-test
 108
 109 [ "<table><tr><td>RBaxter</td><td>Unknown</td></tr><tr><td>Doug</td><td>Coleman</td></tr></table>" ] [
 110     [
 111         "test8" test-template call-template
 112     ] run-template [ blank? not ] filter
 113 ] unit-test
 114
 115 [ ] [
 116     {
 117         H{ { "first-name" "RBaxter" } { "last-name" "Unknown" } }
 118         H{ { "first-name" "Doug"    } { "last-name" "Coleman" } }
 119     } "people" set-value
 120 ] unit-test
 121
 122 [ "<table><tr><td>RBaxter</td><td>Unknown</td></tr><tr><td>Doug</td><td>Coleman</td></tr></table>" ] [
 123     [
 124         "test8" test-template call-template
 125     ] run-template [ blank? not ] filter
 126 ] unit-test
 127
 128 [ ] [ 1 "id" set-value ] unit-test
 129
 130 [ "<a name=\"1\">Hello</a>" ] [
 131     [
 132         "test9" test-template call-template
 133     ] run-template
 134 ] unit-test
 135
 136 [ ] [ H{ { "a" H{ { "b" "c" } } } } values set ] unit-test
 137
 138 [ "<form method=\"post\" action=\"foo\"><div style=\"display: none;\"><input type=\"hidden\" value=\"a\" name=\"__n\"/></div></form>" ] [
 139     [
 140         "test10" test-template call-template
 141     ] run-template
 142 ] unit-test
 143
 144 [ ] [ begin-form ] unit-test
 145
 146 [ ] [
 147     <form> H{ { "first-name" "RBaxter" } { "last-name" "Unknown" } } >>values "person" set-value
 148 ] unit-test
 149
 150 [ "<table><tr><td>RBaxter</td><td>Unknown</td></tr></table>" ] [
 151     [
 152         "test11" test-template call-template
 153     ] run-template [ blank? not ] filter
 154 ] unit-test
 155
 156 [ ] [
 157     begin-form
 158     { "a" "b" } "choices" set-value
 159     "true" "b" set-value
 160 ] unit-test
 161
 162 [ "<input type=\"checkbox\" name=\"a\">a</input><input type=\"checkbox\" checked=\"true\" name=\"b\">b</input>" ] [
 163     [
 164         "test12" test-template call-template
 165     ] run-template
 166 ] unit-test
 167
 168 [
 169     [
 170         "test13" test-template call-template
 171     ] run-template
 172 ] [ error>> T{ unknown-chloe-tag f "this-tag-does-not-exist" } = ] must-fail-with