Changeset 13597 in project


Ignore:
Timestamp:
03/08/09 17:33:15 (11 years ago)
Author:
sjamaan
Message:

Fix pragma parser and te parser, and add tests

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

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/header-parsers.scm

    r13447 r13597  
    334334                   (no-cache . ,splitter))))))
    335335
    336 ;; This too
    337 (define (pragma-parser name value headers)
    338   (update-header-contents! name (list (vector (parse-parameters value 0 `()) '())) headers))
    339 
    340 ;; This one includes q parser
    341 (define (te-parser name value headers)
    342   (update-header-contents! name (list (vector (parse-parameters value 0 `((q . ,quality-parser))) '())) headers))
     336(define pragma-parser
     337  (multiple (key/values `())))
     338
     339(define te-parser
     340  (multiple (key/values `((q . ,quality-parser)))))
    343341
    344342;; Cookie headers are also braindead: there can be several cookies in one header,
     
    431429                       ((pair? contents) ; alist?
    432430                        (let ((attribute (symbol->http-name (car contents))))
    433                          (if (eq? (cdr contents) #t)
    434                              (unparse-token attribute)
    435                              (sprintf "~A=~A"
    436                                       attribute
    437                                       (unparse-token (cdr contents))))))
     431                          (if (eq? (cdr contents) #t)
     432                              (unparse-token attribute)
     433                              (sprintf "~A=~A"
     434                                       attribute
     435                                       (unparse-token (cdr contents))))))
    438436                       ((uri-reference? contents) (unparse-token (uri->string contents)))
    439437                       (else (unparse-token contents))))
  • release/4/intarweb/trunk/tests/run.scm

    r13443 r13597  
    143143      (test "private without value"
    144144            '(private . #t) (assq 'private (header-values 'cache-control headers))))
     145    (let ((headers (test-read-headers "Cache-control: private=\"accept-encoding, accept-ranges\"\r\nCache-control: must-revalidate")))
     146      (test "private with values"
     147            '(private . (accept-encoding accept-ranges))
     148            (assq 'private (header-values 'cache-control headers)))
     149      (test "Acts like a multi-header"
     150            '(must-revalidate . #t) (assq 'must-revalidate (header-values 'cache-control headers)))))
     151
     152  (test-group "pragma-parser"
     153    (let ((headers (test-read-headers "Pragma: custom-value=10, no-cache")))
     154      (test "value"
     155            '(custom-value . "10")
     156            (assq 'custom-value (header-values 'pragma headers)))
     157      (test "no value"
     158            '(no-cache . #t) (assq 'no-cache (header-values 'pragma headers))))
    145159    (let ((headers (test-read-headers "Cache-control: private=\"accept-encoding, accept-ranges\"\r\nCache-control: must-revalidate")))
    146160      (test "private with values"
Note: See TracChangeset for help on using the changeset viewer.