(use test http-client spiffy-request-vars intarweb uri-common srfi-1) (define server-uri (sprintf "http://localhost:~a" (server-port))) (define (get path/vars) (let ((val (with-input-from-request (string-append server-uri path/vars) #f read))) (close-all-connections!) val)) (define (post path vars/vals #!optional (query-string-vars/vals '())) (let* ((vars/vals (and (not (null? vars/vals)) (form-urlencode vars/vals))) (resp (with-input-from-request (make-request uri: (uri-reference (make-pathname server-uri (string-append path (if (null? query-string-vars/vals) "" (string-append "?" (form-urlencode query-string-vars/vals)))))) headers: (headers `((content-length ,(string-length vars/vals)) (content-type application/x-www-form-urlencoded))) method: 'POST) (lambda () (print (or vars/vals ""))) read))) (close-all-connections!) resp)) (test-begin "spiffy-request-vars") ;;; Strings (test #f (get "/as-string")) (test #f (get "/wrv-as-string")) (test "" (get "/wrv-as-string?var=")) (test #f (get "/as-nonempty-string?var=")) (test "a" (get "/as-string?var=a")) (test "a" (get "/wrv-as-string?var=a")) (test "a" (get "/as-string?var=a;var=b")) (test "a" (get "/wrv-as-string?var=a;var=b")) (test "1" (get "/as-string?var=1")) (test "1" (get "/wrv-as-string?var=1")) ;;; Symbols (test #f (get "/as-symbol")) (test #f (get "/wrv-as-symbol")) (test '|| (get "/wrv-as-symbol?var=")) (test #f (get "/as-nonempty-symbol?var=")) (test 'a (get "/as-symbol?var=a")) (test 'a (get "/wrv-as-symbol?var=a")) (test 'a (get "/as-symbol?var=a;var=b")) (test 'a (get "/wrv-as-symbol?var=a;var=b")) ;;; Numbers (test #f (get "/as-number")) (test #f (get "/wrv-as-number")) (test #f (get "/wrv-as-number?var=")) (test 3 (get "/as-number?var=3")) (test 3 (get "/wrv-as-number?var=3")) (test #f (get "/as-number?foo=3")) (test #f (get "/wrv-as-number?foo=3")) (test #f (get "/as-number?var=a")) (test #f (get "/wrv-as-number?var=a")) (test #f (get "/as-nonempty-number?var=")) (test 3 (get "/as-nonempty-number?var=3")) ;;; Booleans (test #f (get "/as-boolean")) (test #f (get "/wrv-as-boolean")) (test #f (get "/wrv-as-boolean?var=")) (test #t (get "/as-boolean?var=yes")) (test #t (get "/wrv-as-boolean?var=yes")) (test #t (get "/as-boolean?var=Yes")) (test #t (get "/wrv-as-boolean?var=Yes")) (test #t (get "/as-boolean?var=1")) (test #t (get "/wrv-as-boolean?var=1")) (test #f (get "/as-boolean?var=0")) (test #f (get "/wrv-as-boolean?var=0")) ;;; List (test #f (get "/as-list")) (test #f (get "/wrv-as-list")) (test '("") (get "/wrv-as-list?var=")) (test '("a" "b") (get "/as-list?var=a;var=b")) (test '("a" "b") (get "/wrv-as-list?var=a;var=b")) (test '("a" "b") (get "/as-list?var=a;var=b;varb=4")) (test '("a" "b") (get "/wrv-as-list?var=a;var=b;varb=4")) (test '("c") (get "/as-list?var=c")) (test '("c") (get "/wrv-as-list?var=c")) ;;; Vectors (test #f (get "/as-vector")) (test #f (get "/wrv-as-vector")) (test '#("") (get "/wrv-as-vector?var.0=")) (test '#("a" "b") (get "/as-vector?var.0=a;var.1=b")) (test '#("a" "b") (get "/wrv-as-vector?var.0=a;var.1=b")) (test 3 (vector-length (get "/as-vector?var.0=a;var.1=b;var.2=4;varc=4"))) (test 3 (vector-length (get "/wrv-as-vector?var.0=a;var.1=b;var.2=4;varc=4"))) (test #f (get "/as-vector?var=c")) (test #f (get "/wrv-as-vector?var=c")) (test '#("a" "b") (get "/as-vector?var.0=a;var.1=b;var3=c")) (test '#("a" "b") (get "/wrv-as-vector?var.0=a;var.1=b;var3=c")) ;;; Alists (test #f (get "/as-list")) (test #f (get "/wrv-as-alist")) (test '((A . "")) (get "/wrv-as-alist?var.A=")) (test '((A . "a") (B . "b")) (get "/as-alist?var.A=a;var.B=b")) (test '((A . "a") (B . "b")) (get "/wrv-as-alist?var.A=a;var.B=b")) (test #f (get "/as-alist?var=c")) (test #f (get "/wrv-as-alist?var=c")) ;;; Hash-tables (test #f (get "/as-hash-table")) (test #f (get "/wrv-as-hash-table")) (test #t (let ((res (get "/as-hash-table?var.A=a;var.B=b"))) (lset= equal? res '((A . "a") (B . "b"))))) (test #t (let ((res (get "/wrv-as-hash-table?var.A=a;var.B=b"))) (lset= equal? res '((A . "a") (B . "b"))))) (test '((A . "")) (get "/wrv-as-hash-table?var.A=")) (test #f (get "/as-hash-table?var=c")) (test #f (get "/wrv-as-hash-table?var=c")) ;;; test1 (test '(#f #f 5) (get "/test1")) (test '("10" #f 5) (get "/test1?foo=10")) (test '("10" ("1") 5) (get "/test1?foo=10&bar=1")) (test '("10" ("1" "2") 5) (get "/test1?foo=10&bar=1&bar=2")) (test '("10" ("1" "2") "-8") (get "/test1?foo=10&bar=1&bar=2&baz=-8")) ;;; test2 (test '(#f #f 5) (get "/test2")) (test '("10" #f 5) (get "/test2?foo=10")) (test '("10" ("1") 5) (get "/test2?foo=10&bar=1")) (test '("10" ("1" "2") 5) (get "/test2?foo=10&bar=1&bar=2")) (test '("10" ("1" "2") "-8") (get "/test2?foo=10&bar=1&bar=2&baz=-8")) ;;; test3 (test '(#f #f #f #f) (get "/test3")) (test '(((A . "0") (B . "1")) 0 #("a" "b") #t) (get "/test3?foo.A=0&foo.B=1&bar=0&baz.0=a&baz.1=b&bool=yes")) (test '(#f #f #f #f) (get "/test3?foo=0&bar=a&baz=0&bool=3")) ;;; test4 (test '(#f #f #f #f) (get "/test4")) (test '(((A . "0") (B . "1")) 0 #("a" "b") #t) (get "/test4?foo.A=0&foo.B=1&bar=0&baz.0=a&baz.1=b&bool=yes")) (test '(#f #f #f #f) (get "/test4?foo=0&bar=a&baz=0&bool=3")) ;;; test5 (test '("" "" "") (get "/test5?foo=&bar=&baz=")) (test '("" "2" "") (get "/test5?foo=&bar=2&baz=")) (test '("1" "2" "3") (get "/test5?foo=1&bar=2&baz=3")) ;;; test6 (test '("" "" "") (get "/test6?foo=&bar=&baz=")) (test '("" "2" "") (get "/test6?foo=&bar=2&baz=")) (test '("1" "2" "3") (get "/test6?foo=1&bar=2&baz=3")) ;;; test7 (test '("1" "2" "3" #f) (post "/test7" '((foo . 1) (bar . 2) (baz . 3)) '((blah . 4)))) ;;; test8 (test '(#f #f #f "4") (post "/test8" '((foo . 1) (bar . 2) (baz . 3)) '((blah . 4)))) ;;; test9 (test '("1" "2" "3" #f) (post "/test9" '((foo . 1) (bar . 2) (baz . 3)) '((blah . 4)))) ;;; test10 (test '("1" "2" "3" #f) (post "/test10" '((foo . 1) (bar . 2) (baz . 3)) '((blah . 4)))) ;;; test11 (test '("1" "2" "3" "4") (post "/test11" '((foo . 1) (bar . 2) (baz . 3)) '((blah . 4)))) ;;; ;;; Compound variable names ;;; ;; Vectors (test #f (get "/compound/as-vector")) (test #f (get "/compound/wrv-as-vector")) (test '#("") (get "/compound/wrv-as-vector?var_0=")) (test '#("a" "b") (get "/compound/as-vector?var_0=a;var_1=b")) (test '#("a" "b") (get "/compound/wrv-as-vector?var_0=a;var_1=b")) (test 3 (vector-length (get "/compound/as-vector?var_0=a;var_1=b;var_2=4;varc=4"))) (test 3 (vector-length (get "/compound/wrv-as-vector?var_0=a;var_1=b;var_2=4;varc=4"))) (test #f (get "/compound/as-vector?var=c")) (test #f (get "/compound/wrv-as-vector?var=c")) (test '#("a" "b") (get "/compound/as-vector?var_0=a;var_1=b;var3=c")) (test '#("a" "b") (get "/compound/wrv-as-vector?var_0=a;var_1=b;var3=c")) ;; Alists (test #f (get "/compound/as-list")) (test #f (get "/compound/wrv-as-alist")) (test '((A . "")) (get "/compound/wrv-as-alist?var_A=")) (test '((A . "a") (B . "b")) (get "/compound/as-alist?var_A=a;var_B=b")) (test '((A . "a") (B . "b")) (get "/compound/wrv-as-alist?var_A=a;var_B=b")) (test #f (get "/compound/as-alist?var=c")) (test #f (get "/compound/wrv-as-alist?var=c")) ;; Hash-tables (test #f (get "/compound/as-hash-table")) (test #f (get "/compound/wrv-as-hash-table")) (test #t (let ((res (get "/compound/as-hash-table?var_A=a;var_B=b"))) (lset= equal? res '((A . "a") (B . "b"))))) (test #t (let ((res (get "/compound/wrv-as-hash-table?var_A=a;var_B=b"))) (lset= equal? res '((A . "a") (B . "b"))))) (test '((A . "")) (get "/compound/wrv-as-hash-table?var_A=")) (test #f (get "/compound/as-hash-table?var=c")) (test #f (get "/compound/wrv-as-hash-table?var=c")) ;; test3 (test '(#f #f #f #f) (get "/compound/test3")) (test '(((A . "0") (B . "1")) 0 #("a" "b") #t) (get "/compound/test3?foo_A=0&foo_B=1&bar=0&baz_0=a&baz_1=b&bool=yes")) (test '(#f #f #f #f) (get "/compound/test3?foo=0&bar=a&baz=0&bool=3")) ;; test4 (test '(#f #f #f #f) (get "/compound/test4")) (test '(((A . "0") (B . "1")) 0 #("a" "b") #t) (get "/compound/test4?foo_A=0&foo_B=1&bar=0&baz_0=a&baz_1=b&bool=yes")) (test '(#f #f #f #f) (get "/compound/test4?foo=0&bar=a&baz=0&bool=3")) (test-end "spiffy-request-vars")