dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Modernize (web http) a bit

Browse source 
* module/web/http.scm: Modernize the Guile Scheme by using more match,
  when, unless, and non-tail conversion.  No functional change, with the
  exception of fixing a bug in write-key-value-list for symbols like
  100-continue that shouldn't print as #{100-continue}#.
* test-suite/tests/web-http.test (pass-if-only-parse):
  (pass-if-reparse, pass-if-parse): Arrange to also serialize and
  reparse values from pass-if-parse.  Apply to all existing tests except
  fragments where we don't expect fragments to be written out.
This commit is contained in:
Andy Wingo 2017-02-08 08:01:55 +01:00
commit 8c50060ae9
2 changed files with 377 additions and 357 deletions
Download patch file Download diff file Expand all files Collapse all files

27
test-suite/tests/web-http.test
View file

@ -39,7 +39,7 @@
#t
(error "unexpected exception" message args))))))))
(define-syntax pass-if-parse
(define-syntax pass-if-only-parse
(syntax-rules ()
((_ sym str val)
(pass-if (format #f "~a: ~s -> ~s" 'sym str val)
@ -47,6 +47,23 @@
val)
(valid-header? 'sym val))))))
(define-syntax-rule (pass-if-reparse sym val)
(pass-if-equal (format #f "~a: ~s reparse" 'sym val) val
(let ((str (call-with-output-string
(lambda (port)
(write-header 'sym val port)))))
(call-with-values (lambda () (read-header (open-input-string str)))
(lambda (sym* val*)
(unless (eq? 'sym sym*) (error "unexpected header"))
val*)))))
(define-syntax pass-if-parse
(syntax-rules ()
((_ sym str val)
(begin
(pass-if-only-parse sym str val)
(pass-if-reparse sym val)))))
(define-syntax pass-if-round-trip
(syntax-rules ()
((_ str)
@ -368,10 +385,10 @@
(pass-if-parse etag "foo" '("foo" . #t))
(pass-if-parse location "http://other-place"
(build-uri 'http #:host "other-place"))
(pass-if-parse location "#foo"
(build-uri-reference #:fragment "foo"))
(pass-if-parse location "/#foo"
(build-uri-reference #:path "/" #:fragment "foo"))
(pass-if-only-parse location "#foo"
(build-uri-reference #:fragment "foo"))
(pass-if-only-parse location "/#foo"
(build-uri-reference #:path "/" #:fragment "foo"))
(pass-if-parse location "/foo"
(build-uri-reference #:path "/foo"))
(pass-if-parse location "//server/foo"