[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile-www-2.9 (www cgi) Tests for query-string parsing
From: |
Alan Grover |
Subject: |
guile-www-2.9 (www cgi) Tests for query-string parsing |
Date: |
Mon, 11 Apr 2005 21:16:26 -0400 |
User-agent: |
Mozilla Thunderbird 0.7 (X11/20040615) |
This script tests several interesting cases of query-strings. Add more
tests to the obvious list (either a string, or a cons pair of the string
and the expected result). There is a bunch of my debug messages in the
file, which are turned off. Works under guile 1.6.4.
Line wrapping mangled!
---
#!/bin/sh
#guile --debug -s $0
guile --debug -c "(set! %load-path (cons \".\" %load-path)) (load \"$0\")"
exit;
!#
(use-modules (www cgi))
(use-modules (srfi srfi-1))
(use-modules (www url))
(define kDebug #f)
(if kDebug
(use-modules (awg debug))
(define (debug . x) #f))
; Various query-string test values
; After parsing, the test will reassemble the query-string and see if it
matches
; Does not round-trip a "+" correctly: comes back as a %20 encoded value
(define test-values (list
""
"noval"
(cons "noval2=" "noval2")
"val=1"
(cons "noval&" "noval")
(cons "val=a&val=" "val=a&val")
(cons "val=1&" "val=1")
(cons "val=a=b" "val=a%3db")
(cons "val=a&=b" "val=a&=b")
"noval&noval2"
"val=1&noval2"
"val=1&val2=2"
"val=a&val"
(cons "val=a+b" "val=a%20b")
(cons "=bad-term" "=bad-term")
(cons "noval1&&noval2" "noval1&noval2")
"val=a&val=b"
"val&val"
"with%26amper=with%3dequal"
"with%3damper"
(cons "val=a&val2=c&val=b" "val=a&val=b&val2=c")
"a=1&b=2&c=3"
))
(define (join binder str-list)
"join binder list => appends the list together with binder between"
(fold-right
(lambda (head done) (if (eq? done '()) head
(string-append head binder done)))
'()
str-list))
(define (do-test)
(letrec (
(print-if (lambda (bool test-results)
"print if bool eq t-or-f"
; could have been a foreach
(define (_print-if aResult)
(let* ( (status (car aResult)))
(if (eq? status bool) (begin
(display aResult ) (newline)))))
(for-each _print-if test-results)))
(comparer (lambda (qstring-or-pair)
"parse via cgi:init, reassemble, test for equal?"
(let* (
(qstring (if (pair? qstring-or-pair)
(car qstring-or-pair) qstring-or-pair))
(explicit-wanted (if (pair?
qstring-or-pair) (cdr qstring-or-pair) #f))
(qstring-names
(begin (environ (list
(string-append "QUERY_STRING=" qstring)))
(debug "qstring '"
qstring "'")
(cgi:init)
(cgi:names) ))
(other-url-encode-bad (string->list
"+%=&"))
(assemble-key-value (lambda (name)
(if (not name)
"<no-name>"
(let* (
(enc-key (if
name (url:encode name other-url-encode-bad) "<no-enc-name>"))
(raw-values (if
name (cgi:values name) "<no-values>"))
(assemble-one
(lambda (raw-value)
(debug
"\t\traw " enc-key " => '" raw-value "'")
(string-append
enc-key
(if (or (not raw-value) (equal? raw-value ""))
""
(string-append "=" (url:encode raw-value
other-url-encode-bad))))))
)
(if (not
raw-values )
enc-key
; no "="
(join
"&" (map assemble-one raw-values)))
))))
(rebuilt-key-values
(begin
(debug "cgi:names "
qstring-names "\n")
(if (or (not
qstring-names) (eq? qstring-names '()) )
(list "")
(map
assemble-key-value qstring-names) )))
(rebuilt-qstring (join "&"
rebuilt-key-values))
; + and %20 are the same, so normalize
(normalized-qstring (or explicit-wanted
qstring))
)
(list (equal? normalized-qstring
rebuilt-qstring) (list (list 'qstring qstring) (list 'wanted
normalized-qstring) (list 'rebuilt rebuilt-qstring) cgi:names-values)))))
)
; collect results
; why can't I put this in the letrec?
(define results (map comparer test-values))
; Print 'em
(print-if #t results)
(display " ---Fails:") (newline)
(print-if #f results)
))
(do-test)
--
Alan Grover
address@hidden
+1.734.476.0969
- guile-www-2.9 (www cgi) Tests for query-string parsing,
Alan Grover <=