Permalink
Browse files

Expanded tests, including tests for enum-arg and requestless controll…

…ers.
  • Loading branch information...
1 parent 8260d7e commit 0f5373129daf4289338c498ab730222497eb2c0c @davegurnell davegurnell committed Aug 29, 2009
Showing with 287 additions and 176 deletions.
  1. +7 −167 all-dispatch-tests.ss
  2. +53 −0 arg-tests.ss
  3. +155 −0 codec-tests.ss
  4. +64 −0 requestless-tests.ss
  5. +8 −9 test-base.ss
View
@@ -2,173 +2,13 @@
(require "test-base.ss")
-(require srfi/19
- (mirrors-in)
- (unlib-in time)
- "main.ss")
-
-; Test data --------------------------------------
-
-; request integer integer -> real
-(define-controller (divide-numbers request num den)
- #:access? (not (zero? den))
- (/ num den))
-
-; request integer integer -> integer
-(define-controller (add-numbers request first second)
- (+ first second))
-
-; Leave subtract-numbers undefined.
-
-; request boolean boolean -> boolean
-(define-controller (and-booleans request first second)
- (if (and (boolean? first) (boolean? second))
- (and first second)
- (raise-type-error #f "booleans" (list first second))))
-
-; request time-utc time-utc -> boolean
-(define-controller (time-after request first second)
- (if (and (time-utc? first) (time-utc? second))
- (time>? first second)
- (raise-type-error #f "time-utcs" (list first second))))
-
-; string -> request
-(define (test-request url)
- (make-request #"GET" (string->url url) null null #f "1.2.3.4" 80 "4.3.2.1"))
+(require "arg-tests.ss"
+ "codec-tests.ss"
+ "requestless-tests.ss")
; Tests ------------------------------------------
-(define all-dispatch-tests
- (test-suite "dispatch"
-
- (test-case "site-dispatch : divide-numbers"
- (check-equal? (site-dispatch math (test-request "/divide/8/2")) 4)
- (check-equal? (site-dispatch math (test-request "/divide/8/4")) 2))
-
- (test-case "site-dispatch : add-numbers"
- #;(check-equal? (site-dispatch math (test-request "/add/1")) 1)
- (check-equal? (site-dispatch math (test-request "/add/1/2")) 3)
- #;(check-equal? (site-dispatch math (test-request "/add/1/2/3")) 6))
-
- (test-case "site-dispatch : controller undefined"
- (check-pred response/full? (site-dispatch math (test-request "/subtract/1/2")))
- (parameterize ([default-controller-undefined-responder
- (lambda (controller request . args)
- (cons (controller-id controller) args))])
- (check-equal? (site-dispatch math (test-request "/subtract/1/2"))
- '(subtract-numbers 1 2))))
-
- (test-case "site-dispatch : access denied"
- (check-pred response/full? (site-dispatch math (test-request "/divide/8/0")))
- (parameterize ([default-access-denied-responder
- (lambda (controller request . args)
- (cons (controller-id controller) args))])
- (check-equal? (site-dispatch math (test-request "/divide/8/0"))
- '(divide-numbers 8 0))))
-
- (test-case "site-dispatch : controller not found"
- (check-exn exn:dispatch? (cut site-dispatch math (test-request "/undefined"))))
-
- (test-case "site-dispatch : anchor / query string / url-params"
- (check-equal? (site-dispatch math (test-request "/divide/8/2#anchor")) 4)
- (check-equal? (site-dispatch math (test-request "/divide/8/4;((a . b))")) 2)
- (check-equal? (site-dispatch math (test-request "/divide/8/8?a=b&c=d")) 1))
-
- (test-case "controller-url : divide-numbers"
- (check-equal? (controller-url divide-numbers 8 2) "/divide/8/2")
- (check-equal? (controller-url divide-numbers 8 4) "/divide/8/4"))
-
- (test-case "controller-url : add-numbers"
- (check-equal? (controller-url add-numbers 1 2) "/add/1/2"))
-
- (test-case "controller-access? : divide-numbers"
- (check-true (controller-access? divide-numbers (test-request "foo") 8 2))
- (check-false (controller-access? divide-numbers (test-request "foo") 8 0)))
-
- (test-case "controller-link : no arguments"
- (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 4)]
- [mirrors (link-ref)]
- [sexp (parameterize ([current-link-format 'sexp]) (link-ref))]
- [sexps (parameterize ([current-link-format 'sexps]) (link-ref))])
- (check-pred xml? mirrors)
- (check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\">/divide/8/4</a>")
- (check-equal? sexp '(a ([href "/divide/8/4"]) "/divide/8/4"))
- (check-equal? sexps '((a ([href "/divide/8/4"]) "/divide/8/4")))))
-
- (test-case "controller-link : all arguments"
- (let* ([link-ref (lambda (body)
- (controller-link
- divide-numbers
- (test-request "foo") 8 4
- #:id 'id
- #:class 'class
- #:title "title"
- #:body body))]
- [mirrors (link-ref "body")]
- [sexp (parameterize ([current-link-format 'sexp]) (link-ref "body"))]
- [sexps (parameterize ([current-link-format 'sexps]) (link-ref '("body")))])
- (check-pred xml? mirrors)
- (check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\" id=\"id\" class=\"class\" title=\"title\">body</a>")
- (check-equal? sexp '(a ([href "/divide/8/4"] [id "id"] [class "class"] [title "title"]) "body"))
- (check-equal? sexps '((a ([href "/divide/8/4"] [id "id"] [class "class"] [title "title"]) "body")))))
-
- (test-case "controller-link : no access : hide"
- (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0)]
- [mirrors (link-ref)]
- [sexp (parameterize ([current-link-format 'sexp]) (link-ref))]
- [sexps (parameterize ([current-link-format 'sexps]) (link-ref))])
- (check-pred xml? mirrors)
- (check-pred xml-empty? mirrors)
- (check-equal? sexp '(span))
- (check-equal? sexps null)))
-
- (test-case "controller-link : no access : span"
- (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'span #:id 'id #:class 'class #:title "title")]
- [mirrors (link-ref)]
- [sexp (parameterize ([current-link-format 'sexp]) (link-ref))]
- [sexps (parameterize ([current-link-format 'sexps]) (link-ref))])
- (check-pred xml? mirrors)
- (check-equal? (xml->string mirrors) "<span id=\"id\" class=\"no-access-link class\" title=\"title\">/divide/8/0</span>")
- (check-equal? sexp '(span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0"))
- (check-equal? sexps '((span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0")))))
-
- (test-case "controller-link : no access : body"
- (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'body)]
- [mirrors (link-ref)]
- [sexp (parameterize ([current-link-format 'sexp]) (link-ref))]
- [sexps (parameterize ([current-link-format 'sexps]) (link-ref))])
- (check-pred xml? mirrors)
- (check-equal? (xml->string mirrors) "/divide/8/0")
- (check-equal? sexp "/divide/8/0")
- (check-equal? sexps '("/divide/8/0"))))
-
- (test-equal? "site-controllers"
- (map controller-id (site-controllers math))
- '(divide-numbers
- add-numbers
- subtract-numbers
- and-booleans
- time-after))
-
- (test-case "default-controller-wrapper"
- (parameterize ([default-controller-wrapper
- (lambda (controller request . args)
- (add1 (apply (controller-body-proc controller) request args)))])
- (check-equal? (site-dispatch math (test-request "/divide/8/2")) 5)))
-
- (test-case "boolean-arg"
- (check-equal? (site-dispatch math (test-request "/and/yes/yes")) #t)
- (check-equal? (site-dispatch math (test-request "/and/true/true")) #t)
- (check-equal? (site-dispatch math (test-request "/and/y/y")) #t)
- (check-equal? (site-dispatch math (test-request "/and/yes/no")) #f)
- (check-equal? (site-dispatch math (test-request "/and/yes/false")) #f)
- (check-equal? (site-dispatch math (test-request "/and/yes/n")) #f)
- (check-equal? (controller-url and-booleans #t #f) "/and/yes/no"))
-
- (test-case "time-utc-arg"
- (check-equal? (site-dispatch math (test-request "/after/20090102/20090101")) #t)
- (check-equal? (site-dispatch math (test-request "/after/20090101/20090102")) #f))))
-
-; Provide statements -----------------------------
-
-(provide all-dispatch-tests)
+(define/provide-test-suite all-dispatch-tests
+ arg-tests
+ codec-tests
+ requestless-tests)
View
@@ -0,0 +1,53 @@
+#lang scheme/base
+
+(require "test-base.ss")
+
+(require srfi/19
+ (mirrors-in)
+ (unlib-in enumeration time)
+ "main.ss")
+
+; Test data --------------------------------------
+
+(define-enum options (a b c))
+
+(define-site args
+ ([("/bool/" (boolean-arg)) test-bool]
+ [("/time/" (time-utc-arg "~Y~m~d")) test-time]
+ [("/enum/" (enum-arg options)) test-enum]))
+
+(define-controller (test-bool request arg) arg)
+(define-controller (test-time request arg) arg)
+(define-controller (test-enum request arg) arg)
+
+; Tests ------------------------------------------
+
+(define/provide-test-suite arg-tests
+
+ (test-case "boolean-arg"
+ (check-equal? (site-dispatch args (test-request "/bool/yes")) #t)
+ (check-equal? (site-dispatch args (test-request "/bool/true")) #t)
+ (check-equal? (site-dispatch args (test-request "/bool/y")) #t)
+ (check-equal? (site-dispatch args (test-request "/bool/1")) #t)
+ (check-equal? (site-dispatch args (test-request "/bool/no")) #f)
+ (check-equal? (site-dispatch args (test-request "/bool/false")) #f)
+ (check-equal? (site-dispatch args (test-request "/bool/n")) #f)
+ (check-equal? (site-dispatch args (test-request "/bool/0")) #f)
+ (check-equal? (controller-url test-bool #t) "/bool/yes")
+ (check-equal? (controller-url test-bool #f) "/bool/no"))
+
+ (test-case "time-utc-arg"
+ (check-equal? (site-dispatch args (test-request "/time/20090102"))
+ (date->time-utc (make-date 0 0 0 0 2 1 2009 (current-time-zone-offset))))
+ (check-equal? (controller-url test-time (date->time-utc (make-date 0 0 0 0 2 1 2009 (current-time-zone-offset))))
+ "/time/20090102"))
+
+ (test-case "enum-arg"
+ (check-not-exn
+ (lambda ()
+ (check-equal? (site-dispatch args (test-request "/enum/a")) 'a)
+ (check-equal? (site-dispatch args (test-request "/enum/b")) 'b)
+ (check-equal? (site-dispatch args (test-request "/enum/c")) 'c)
+ (check-equal? (controller-url test-enum 'a) "/enum/a")
+ (check-equal? (controller-url test-enum 'b) "/enum/b")
+ (check-equal? (controller-url test-enum 'c) "/enum/c")))))
View
@@ -0,0 +1,155 @@
+#lang scheme/base
+
+(require "test-base.ss")
+
+(require srfi/19
+ (mirrors-in)
+ (unlib-in time)
+ "main.ss")
+
+(require/expose web-server/dispatchers/dispatch
+ (exn:dispatcher?))
+
+; Test data --------------------------------------
+
+(define-site math
+ ([("/divide/" (integer-arg) "/" (integer-arg)) divide-numbers]
+ [("/add/" (integer-arg) "/" (integer-arg)) add-numbers]
+ [("/subtract/" (integer-arg) "/" (integer-arg)) subtract-numbers]
+ [("/and/" (boolean-arg) "/" (boolean-arg)) and-booleans]
+ [("/after/" (time-utc-arg "~Y~m~d") "/" (time-utc-arg "~Y~m~d")) time-after]))
+
+; request integer integer -> real
+(define-controller (divide-numbers request num den)
+ #:access? (not (zero? den))
+ (/ num den))
+
+; request integer integer -> integer
+(define-controller (add-numbers request first second)
+ (+ first second))
+
+; Leave subtract-numbers undefined.
+
+; request boolean boolean -> boolean
+(define-controller (and-booleans request first second)
+ (if (and (boolean? first) (boolean? second))
+ (and first second)
+ (raise-type-error #f "booleans" (list first second))))
+
+; request time-utc time-utc -> boolean
+(define-controller (time-after request first second)
+ (if (and (time-utc? first) (time-utc? second))
+ (time>? first second)
+ (raise-type-error #f "time-utcs" (list first second))))
+
+; Tests ------------------------------------------
+
+(define/provide-test-suite codec-tests
+
+ (test-case "site-dispatch : divide-numbers"
+ (check-equal? (site-dispatch math (test-request "/divide/8/2")) 4)
+ (check-equal? (site-dispatch math (test-request "/divide/8/4")) 2))
+
+ (test-case "site-dispatch : add-numbers"
+ (check-equal? (site-dispatch math (test-request "/add/1/2")) 3))
+
+ (test-case "site-dispatch : controller undefined"
+ (check-pred response/full? (site-dispatch math (test-request "/subtract/1/2")))
+ (parameterize ([default-controller-undefined-responder
+ (lambda (controller request . args)
+ (cons (controller-id controller) args))])
+ (check-equal? (site-dispatch math (test-request "/subtract/1/2"))
+ '(subtract-numbers 1 2))))
+
+ (test-case "site-dispatch : access denied"
+ (check-pred response/full? (site-dispatch math (test-request "/divide/8/0")))
+ (parameterize ([default-access-denied-responder
+ (lambda (controller request . args)
+ (cons (controller-id controller) args))])
+ (check-equal? (site-dispatch math (test-request "/divide/8/0"))
+ '(divide-numbers 8 0))))
+
+ (test-case "site-dispatch : controller not found"
+ ; We can't use check-exn because exn:dispatcher isn't actually an exn:
+ (check-true (with-handlers ([exn:dispatcher? (lambda _ #t)])
+ (site-dispatch math (test-request "/undefined"))
+ #f)))
+
+ (test-case "site-dispatch : anchor / query string / url-params"
+ (check-equal? (site-dispatch math (test-request "/divide/8/2#anchor")) 4)
+ (check-equal? (site-dispatch math (test-request "/divide/8/4;((a . b))")) 2)
+ (check-equal? (site-dispatch math (test-request "/divide/8/8?a=b&c=d")) 1))
+
+ (test-case "controller-url : divide-numbers"
+ (check-equal? (controller-url divide-numbers 8 2) "/divide/8/2")
+ (check-equal? (controller-url divide-numbers 8 4) "/divide/8/4"))
+
+ (test-case "controller-url : add-numbers"
+ (check-equal? (controller-url add-numbers 1 2) "/add/1/2"))
+
+ (test-case "controller-access? : divide-numbers"
+ (check-true (controller-access? divide-numbers (test-request "foo") 8 2))
+ (check-false (controller-access? divide-numbers (test-request "foo") 8 0)))
+
+ (test-case "controller-link : no arguments"
+ (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 4)]
+ [mirrors (link-ref)]
+ [sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
+ [sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
+ (check-pred xml? mirrors)
+ (check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\">/divide/8/4</a>")
+ (check-equal? sexp '(a ([href "/divide/8/4"]) "/divide/8/4"))
+ (check-equal? sexps '((a ([href "/divide/8/4"]) "/divide/8/4")))))
+
+ (test-case "controller-link : all arguments"
+ (let* ([link-ref (lambda (body)
+ (controller-link
+ divide-numbers
+ (test-request "foo") 8 4
+ #:id 'id
+ #:class 'class
+ #:title "title"
+ #:body body))]
+ [mirrors (link-ref "body")]
+ [sexp (parameterize ([default-link-format 'sexp]) (link-ref "body"))]
+ [sexps (parameterize ([default-link-format 'sexps]) (link-ref '("body")))])
+ (check-pred xml? mirrors)
+ (check-equal? (xml->string mirrors) "<a href=\"/divide/8/4\" id=\"id\" class=\"class\" title=\"title\">body</a>")
+ (check-equal? sexp '(a ([href "/divide/8/4"] [id "id"] [class "class"] [title "title"]) "body"))
+ (check-equal? sexps '((a ([href "/divide/8/4"] [id "id"] [class "class"] [title "title"]) "body")))))
+
+ (test-case "controller-link : no access : hide"
+ (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'hide)]
+ [mirrors (link-ref)]
+ [sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
+ [sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
+ (check-pred xml? mirrors)
+ (check-pred xml-empty? mirrors)
+ (check-equal? sexp '(span))
+ (check-equal? sexps null)))
+
+ (test-case "controller-link : no access : span"
+ (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'span #:id 'id #:class 'class #:title "title")]
+ [mirrors (link-ref)]
+ [sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
+ [sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
+ (check-pred xml? mirrors)
+ (check-equal? (xml->string mirrors) "<span id=\"id\" class=\"no-access-link class\" title=\"title\">/divide/8/0</span>")
+ (check-equal? sexp '(span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0"))
+ (check-equal? sexps '((span ([id "id"] [class "no-access-link class"] [title "title"]) "/divide/8/0")))))
+
+ (test-case "controller-link : no access : body"
+ (let* ([link-ref (cut controller-link divide-numbers (test-request "foo") 8 0 #:else 'body)]
+ [mirrors (link-ref)]
+ [sexp (parameterize ([default-link-format 'sexp]) (link-ref))]
+ [sexps (parameterize ([default-link-format 'sexps]) (link-ref))])
+ (check-pred xml? mirrors)
+ (check-equal? (xml->string mirrors) "/divide/8/0")
+ (check-equal? sexp "/divide/8/0")
+ (check-equal? sexps '("/divide/8/0"))))
+
+ (test-case "default-controller-wrapper"
+ (parameterize ([default-controller-wrapper
+ (lambda (controller request . args)
+ (add1 (apply (controller-body-proc controller) request args)))])
+ (check-equal? (site-dispatch math (test-request "/divide/8/2")) 5))))
Oops, something went wrong.

0 comments on commit 0f53731

Please sign in to comment.