basis/furnace/furnace-tests.factor

   1 USING: http http.server.dispatchers http.server.responses
   2 http.server furnace furnace.utilities tools.test kernel
   3 namespaces accessors io.streams.string urls xml.writer ;
   4 IN: furnace.tests
   5
   6 TUPLE: funny-dispatcher < dispatcher ;
   7
   8 : <funny-dispatcher> ( -- dispatcher ) funny-dispatcher new-dispatcher ;
   9
  10 TUPLE: base-path-check-responder ;
  11
  12 C: <base-path-check-responder> base-path-check-responder
  13
  14 M: base-path-check-responder call-responder*
  15     2drop
  16     "$funny-dispatcher" resolve-base-path
  17     "text/plain" <content> ;
  18
  19 [ ] [
  20     <dispatcher>
  21         <dispatcher>
  22             <funny-dispatcher>
  23                 <base-path-check-responder> "c" add-responder
  24             "b" add-responder
  25         "a" add-responder
  26     main-responder set
  27 ] unit-test
  28
  29 [ "/a/b/" ] [
  30     V{ } responder-nesting set
  31     "a/b/c" split-path main-responder get call-responder body>>
  32 ] unit-test
  33
  34 [ "<input type=\"hidden\" value=\"&amp;&amp;&amp;\" name=\"foo\"/>" ]
  35 [ "&&&" "foo" hidden-form-field xml>string ]
  36 unit-test
  37
  38 [ f ] [ <request> request [ referrer ] with-variable ] unit-test
  39
  40 [ t ] [ URL" http://foo" dup url [ same-host? ] with-variable ] unit-test
  41
  42 [ f ] [ f URL" http://foo" url [ same-host? ] with-variable ] unit-test