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