basis/furnace/furnace-tests.factor

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