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