* guile-www-2.9 (www cgi) Tests for query-string parsing
@ 2005-04-12 1:16 Alan Grover
0 siblings, 0 replies; 2+ messages in thread
From: Alan Grover @ 2005-04-12 1:16 UTC (permalink / raw)
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
awgrover@mail.msen.com
+1.734.476.0969
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-guile
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: guile-www-2.9 (www cgi) Tests for query-string parsing
@ 2005-04-14 0:48 Thien-Thi Nguyen
0 siblings, 0 replies; 2+ messages in thread
From: Thien-Thi Nguyen @ 2005-04-14 0:48 UTC (permalink / raw)
Cc: bug-guile
[-- Attachment #1: Type: text/plain, Size: 836 bytes --]
From: Alan Grover <awgrover@mail.msen.com>
Date: Mon, 11 Apr 2005 21:16:26 -0400
This script [...]
thanks for posting this. i have touched it up a bit (attached), and
used it to verify operation of recently installed changes to cgi.scm
(available, along w/ other changes, from cvs). the "not necessary"
comment reflects the thinking that introducing a var is a step away
from the encapsulation work that cgi.scm needs prior to the next
guile-www release.
basically, it's ok to add procedures to the module's interface, but
not so ok to add data structures. if possible, it's even better to
avoid adding new interface elements altogether, instead extending
the current procedures by adding optional args, so that they work w/
old code.
more on this later...
thi
________________________________________________________
[-- Attachment #2: ag-check --]
[-- Type: application/octet-stream, Size: 3947 bytes --]
#!/bin/sh
exec ${GUILE-guile} --debug -s $0 "$@" # -*-scheme-*-
!#
;;(set! %load-path (cons "/home/ttn/build/GNU/guile-www" %load-path))
(load-from-path "/home/ttn/build/GNU/guile-www/cgi.scm")
(use-modules (www cgi))
(use-modules (srfi srfi-1))
(use-modules (www url))
; 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)
(define (print-if bool test-results)
"print if bool eq t-or-f"
(for-each (lambda (res)
(and (eq? bool (car res))
(simple-format #t "~S\n" res)))
test-results))
(define (comparer 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)))
(cgi:init)
(cgi:names)))
(other-url-encode-bad (string->list "+%=&")))
(define (encode s)
(url:encode s other-url-encode-bad))
(define (assemble-key-value name)
(if (not name)
"<no-name>"
(let* ((enc-key (if name
(encode name)
"<no-enc-name>"))
(raw-values (if name
(cgi:values name)
"<no-values>")))
(if (not raw-values)
enc-key
;; no "="
(join "&" (map (lambda (v)
(string-append
enc-key (if (or (not v)
(equal? v ""))
""
(string-append
"=" (encode v)))))
raw-values))))))
(define (rebuild-key-values)
(if (or (not qstring-names)
(eq? qstring-names '()) )
(list "")
(map assemble-key-value qstring-names)))
(let ((rebuilt-qstring (join "&" (rebuild-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)
;; ttn-sez: unnecessary
;;- cgi:names-values
)))))
(let ((results (map comparer test-values)))
;; Print 'em
(print-if #t results)
(display " ---Fails:") (newline)
(print-if #f results)))
(do-test)
[-- Attachment #3: Type: text/plain, Size: 137 bytes --]
_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://lists.gnu.org/mailman/listinfo/bug-guile
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2005-04-14 0:48 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2005-04-12 1:16 guile-www-2.9 (www cgi) Tests for query-string parsing Alan Grover
-- strict thread matches above, loose matches on Subject: below --
2005-04-14 0:48 Thien-Thi Nguyen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).