formlets tests
svn: r13508
This commit is contained in:
Jay McCarthy
parent
561885d2d6
commit
79ef2483f3
198
collects/tests/web-server/formlets-test.ss
Normal file
198
collects/tests/web-server/formlets-test.ss
Normal file
|
|
@ -0,0 +1,198 @@
|
|||
#lang scheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
net/url
|
||||
web-server/http
|
||||
web-server/formlets
|
||||
web-server/formlets/lib)
|
||||
(provide all-formlets-tests)
|
||||
|
||||
(define (run-formlet f i)
|
||||
(define-values (r proc post-i) (f i))
|
||||
(list r proc post-i))
|
||||
|
||||
(define all-formlets-tests
|
||||
(test-suite
|
||||
"Formlets"
|
||||
|
||||
(test-suite
|
||||
"lib"
|
||||
|
||||
(test-case "pure (render)" (check-equal? (first (run-formlet (pure 0) 0)) empty))
|
||||
(test-case "pure (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? ((second (run-formlet (pure x) 0)) empty)
|
||||
x)))
|
||||
(test-case "pure (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (pure 0) x))
|
||||
x)))
|
||||
|
||||
(test-case "xml-forest (render)" (check-equal? (formlet-display (xml-forest (list))) empty))
|
||||
(test-case "xml-forest (render)" (check-equal? (formlet-display (xml-forest (list '(html (body "Hey")))))
|
||||
(list '(html (body "Hey")))))
|
||||
(test-case "xml-forest (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (xml-forest (list)) 0)) empty) x)
|
||||
x)))
|
||||
(test-case "xml-forest (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (xml-forest (list)) 0)) (list (make-binding:form #"name" #"value"))) x)
|
||||
x)))
|
||||
(test-case "xml-forest (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (xml-forest (list)) x))
|
||||
x)))
|
||||
|
||||
(test-case "xml (render)" (check-equal? (formlet-display (xml '(html (body "Hey"))))
|
||||
(list '(html (body "Hey")))))
|
||||
(test-case "xml (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (xml '(html (body "Hey"))) 0)) empty) x)
|
||||
x)))
|
||||
(test-case "xml (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (xml '(html (body "Hey"))) 0)) (list (make-binding:form #"name" #"value"))) x)
|
||||
x)))
|
||||
(test-case "xml (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (xml '(html (body "Hey"))) x))
|
||||
x)))
|
||||
|
||||
(test-case "text (render)" (check-equal? (formlet-display (text "Hey"))
|
||||
(list "Hey")))
|
||||
(test-case "text (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (text "Hey") 0)) empty) x)
|
||||
x)))
|
||||
(test-case "text (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (text "Hey") 0)) (list (make-binding:form #"name" #"value"))) x)
|
||||
x)))
|
||||
(test-case "text (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (text "Hey") x))
|
||||
x)))
|
||||
|
||||
(test-case "tag-xexpr (render)" (check-equal? (formlet-display (tag-xexpr 'p (list (list 'id "p")) (text "Hey")))
|
||||
'((p ([id "p"]) "Hey"))))
|
||||
(test-case "tag-xexpr (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (tag-xexpr 'p (list (list 'id "p")) (text "Hey")) 0)) empty) x)
|
||||
x)))
|
||||
(test-case "tag-xexpr (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (tag-xexpr 'p (list (list 'id "p")) (text "Hey")) 0))
|
||||
(list (make-binding:form #"name" #"value"))) x)
|
||||
x)))
|
||||
(test-case "tag-xexpr (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (tag-xexpr 'p (list (list 'id "p")) (text "Hey")) x))
|
||||
x)))
|
||||
|
||||
(test-case "cross (render)"
|
||||
(check-equal? (formlet-display (cross (text "One") (text "Two")))
|
||||
(list "One" "Two")))
|
||||
(test-case "cross (proc)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (((second (run-formlet (cross (text "One") (text "Two")) 0)) empty) x)
|
||||
x)))
|
||||
(test-case "cross (proc)"
|
||||
(check-equal? ((second (run-formlet (cross (pure string->number)
|
||||
(pure "100"))
|
||||
0)) empty)
|
||||
100))
|
||||
(test-case "cross (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (cross (text "One") (text "Two")) x))
|
||||
x)))
|
||||
|
||||
(test-case "cross* (render)"
|
||||
(check-equal? (formlet-display (cross* (text "One") (text "Two")))
|
||||
(list "One" "Two")))
|
||||
(test-case "cross* (proc)"
|
||||
(check-equal? ((second (run-formlet (cross* (pure (lambda xs (apply string->number xs)))
|
||||
(pure "100"))
|
||||
0)) empty)
|
||||
100))
|
||||
(test-case "cross* (post-i)"
|
||||
(let ([x (random 1000)])
|
||||
(check-equal? (third (run-formlet (cross* (text "One") (text "Two")) x))
|
||||
x))))
|
||||
|
||||
(local [(define-struct date (month day) #:transparent)
|
||||
(define (date->xml d)
|
||||
(format "~a/~a"
|
||||
(date-month d)
|
||||
(date-day d)))
|
||||
(define (submit t)
|
||||
`(input ([type "submit"]) ,t))
|
||||
(define date-formlet
|
||||
(formlet
|
||||
(div
|
||||
"Month:" ,{input-int . => . month}
|
||||
"Day:" ,{input-int . => . day})
|
||||
(make-date month day)))
|
||||
|
||||
(define travel-formlet
|
||||
(formlet
|
||||
(div
|
||||
"Name:" ,{input-string . => . name}
|
||||
(div
|
||||
"Arrive:" ,{date-formlet . => . arrive}
|
||||
"Depart:" ,{date-formlet . => . depart})
|
||||
,@(list "1" "2" "3")
|
||||
,(submit "Submit"))
|
||||
(list name arrive depart)))
|
||||
|
||||
(define display-itinernary
|
||||
(match-lambda
|
||||
[(list name arrive depart)
|
||||
`(html
|
||||
(head (title "Itinerary"))
|
||||
(body
|
||||
"Itinerary for: " ,name
|
||||
"Arriving:" ,(date->xml arrive)
|
||||
"Departing:" ,(date->xml depart)))]))]
|
||||
(test-suite
|
||||
"Date"
|
||||
|
||||
(test-case "date->xml"
|
||||
(check-equal? (date->xml (make-date 1 2))
|
||||
"1/2"))
|
||||
(test-case "date-formlet"
|
||||
(check-equal? (formlet-display date-formlet)
|
||||
'((div () "Month:" (input ((name "input_0") (type "text"))) "Day:" (input ((name "input_1") (type "text")))))))
|
||||
(test-case "travel-formlet"
|
||||
(check-equal? (formlet-display travel-formlet)
|
||||
'((div
|
||||
()
|
||||
"Name:"
|
||||
(input ((name "input_0") (type "text")))
|
||||
(div
|
||||
()
|
||||
"Arrive:"
|
||||
(div () "Month:" (input ((name "input_1") (type "text"))) "Day:" (input ((name "input_2") (type "text"))))
|
||||
"Depart:"
|
||||
(div () "Month:" (input ((name "input_3") (type "text"))) "Day:" (input ((name "input_4") (type "text")))))
|
||||
"1"
|
||||
"2"
|
||||
"3"
|
||||
(input ((type "submit")) "Submit")))))
|
||||
(test-case "travel-formlet (proc)"
|
||||
(check-equal? (formlet-process travel-formlet
|
||||
(make-request #"GET" (string->url "http://test.com")
|
||||
empty
|
||||
(list (make-binding:form #"input_0" #"Jay")
|
||||
(make-binding:form #"input_1" #"10")
|
||||
(make-binding:form #"input_2" #"6")
|
||||
(make-binding:form #"input_3" #"10")
|
||||
(make-binding:form #"input_4" #"8"))
|
||||
#f "127.0.0.1" 80 "127.0.0.1"))
|
||||
(list "Jay" (make-date 10 6) (make-date 10 8))))))
|
||||
|
||||
))
|
||||
|
||||
#|
|
||||
(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)))
|
||||
(test/graphical-ui all-formlets-tests)
|
||||
|#
|
||||
|
|
@ -1,61 +0,0 @@
|
|||
#lang scheme
|
||||
(require web-server/formlets)
|
||||
|
||||
(define-struct date (month day))
|
||||
(define (date->xml d)
|
||||
(format "~a/~a"
|
||||
(date-month d)
|
||||
(date-day d)))
|
||||
|
||||
(define (submit t)
|
||||
`(input ([type "submit"]) ,t))
|
||||
|
||||
(define date-formlet
|
||||
(formlet
|
||||
(div
|
||||
"Month:" ,{input-int . => . month}
|
||||
"Day:" ,{input-int . => . day})
|
||||
(make-date month day)))
|
||||
|
||||
(formlet-display date-formlet)
|
||||
|
||||
(define travel-formlet
|
||||
(formlet
|
||||
(div
|
||||
"Name:" ,{input-string . => . name}
|
||||
(div
|
||||
"Arrive:" ,{date-formlet . => . arrive}
|
||||
"Depart:" ,{date-formlet . => . depart})
|
||||
,@(list "1" "2" "3")
|
||||
,(submit "Submit"))
|
||||
(list name arrive depart)))
|
||||
|
||||
(formlet-display travel-formlet)
|
||||
|
||||
(define display-itinernary
|
||||
(match-lambda
|
||||
[(list name arrive depart)
|
||||
`(html
|
||||
(head (title "Itinerary"))
|
||||
(body
|
||||
"Itinerary for: " ,name
|
||||
"Arriving:" ,(date->xml arrive)
|
||||
"Departing:" ,(date->xml depart)))]))
|
||||
|
||||
(require net/url
|
||||
web-server/servlet)
|
||||
(formlet-process travel-formlet
|
||||
(make-request #"GET" (string->url "http://test.com")
|
||||
empty
|
||||
(list (make-binding:form #"input_0" #"Jay")
|
||||
(make-binding:form #"input_1" #"10")
|
||||
(make-binding:form #"input_2" #"6")
|
||||
(make-binding:form #"input_3" #"10")
|
||||
(make-binding:form #"input_4" #"8"))
|
||||
#f "127.0.0.1" 80 "127.0.0.1"))
|
||||
|
||||
(define (start request)
|
||||
(display-itinernary
|
||||
(send/formlet
|
||||
travel-formlet)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user