Changeset 11832 in project


Ignore:
Timestamp:
08/31/08 23:27:47 (13 years ago)
Author:
sjamaan
Message:

Add write response tests

Location:
release/4/intarweb/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/intarweb.scm

    r11831 r11832  
    281281           (make-property-condition 'exn 'message msg))))
    282282
    283 (defstruct request method uri major minor (headers '()) port)
     283(defstruct request
     284  (method 'GET) uri (major 1) (minor 1) (headers '()) port)
    284285
    285286;; Perhaps we should have header parsers indexed by version or
     
    375376    (if (memq 'chunked (header-values 'transfer-encoding
    376377                                      (request-headers request)))
    377         (update-request request port: (chunked-output-port (request-port request)))
     378        (update-request request
     379                        port: (chunked-output-port (request-port request)))
    378380        request)))
    379381
     
    397399;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    398400
    399 (defstruct response code reason major minor (headers '()) port)
     401(defstruct response
     402  (code 200) (reason "OK") (major 1) (minor 1) (headers '()) port)
    400403
    401404(define (http-0.9-response-unparser response)
     
    412415(define (http-1.0-response-unparser response)
    413416  (and-let* (((= (response-major response) 1))
    414              ((= (response-major response) 0))
     417             ((= (response-minor response) 0))
    415418             (o (response-port response)))
    416419    (write-response-line response)
     
    430433    (if (memq 'chunked (header-values 'transfer-encoding
    431434                                      (response-headers response)))
    432         (update-response response port: (chunked-output-port (response-port response)))
     435        (update-response response
     436                         port: (chunked-output-port (response-port response)))
    433437        response)))
    434438
     
    493497(define (http-0.9-response-parser line in)
    494498  (make-response code: 200 reason: "OK"
    495                  major: 0
    496                  minor: 9
     499                 major: 0 minor: 9
    497500                 ;; XXX This is wrong, it re-inserts \r\n, while it may have
    498501                 ;; been a \n only. To work around this, we'd have to write
    499502                 ;; a custom read-line procedure.
     503                 ;; However, it does not matter much because HTTP 0.9 is only
     504                 ;; defined to ever return text/html, no binary or any other
     505                 ;; content type.
    500506                 port: (call-with-input-string (string-append line "\r\n")
    501507                         (lambda (str)
  • release/4/intarweb/trunk/tests/run.scm

    r11831 r11832  
    466466            (read-string #f (response-port res))))))
    467467
     468(define (test-write-response res . outputs)
     469  (call-with-output-string
     470    (lambda (out)
     471      (response-port-set! res out)
     472      (let ((r (write-response res)))
     473       (for-each (lambda (output)
     474                   (display output (response-port r)))
     475                 outputs)))))
     476
     477(test-group "Write response"
     478  (test-group "HTTP/0.9"
     479    (let ((res (make-response major: 0 minor: 9
     480                              code: 200 reason: "OK")))
     481      (test "Headers ignored"
     482            "These are the contents\r\n"
     483            (test-write-response
     484             (update-response res headers: (make-headers `((foo bar))))
     485             "These are the contents\r\n"))))
     486  (test-group "HTTP/1.0"
     487    (let ((res (make-response major: 1 minor: 0
     488                              code: 200 reason: "OK")))
     489      (test "Headers used"
     490            "HTTP/1.0 200 OK\r\nFoo: bar\r\n\r\nThese are the contents\r\n"
     491            (test-write-response
     492             (update-response res headers: (make-headers `((foo bar))))
     493             "These are the contents\r\n"))
     494      (test "Status code"
     495            "HTTP/1.0 303 See other\r\n\r\nThese are the contents\r\n"
     496            (test-write-response
     497             (update-response res code: 303 reason: "See other")
     498             "These are the contents\r\n"))
     499      (test "Chunking ignored"
     500            "HTTP/1.0 200 OK\r\nTransfer-Encoding: chunked\r\n\r\nfoo1234567890"
     501            (test-write-response
     502             (update-response
     503              res
     504              headers: (make-headers `((transfer-encoding chunked))))
     505             "foo" "1234567890"))))
     506  (test-group "HTTP/1.1"
     507   (let ((res (make-response major: 1 minor: 1
     508                             code: 200 reason: "OK")))
     509     (test "Headers used"
     510           "HTTP/1.1 200 OK\r\nFoo: bar\r\n\r\nThese are the contents\r\n"
     511            (test-write-response
     512             (update-response res headers: (make-headers `((foo bar))))
     513             "These are the contents\r\n"))
     514     (test "Status code"
     515           "HTTP/1.1 303 See other\r\n\r\nThese are the contents\r\n"
     516           (test-write-response
     517            (update-response res code: 303 reason: "See other")
     518            "These are the contents\r\n"))
     519     (test "Chunking"
     520           "HTTP/1.1 200 OK\r\nTransfer-Encoding: chunked\r\n\r\n3\r\nfoo\r\na\r\n1234567890\r\n"
     521           (test-write-response
     522            (update-response
     523             res
     524             headers: (make-headers `((transfer-encoding chunked))))
     525            "foo" "1234567890")))))
    468526
    469527;; TODO:
Note: See TracChangeset for help on using the changeset viewer.