suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Abstracting dispatcher in tests

Browse Source 
svn: r6297
This commit is contained in:
Jay McCarthy 2007-05-25 16:04:40 +00:00
parent f7ca8895b6
commit fb5d0a0592
4 changed files with 40 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/web-server/prototype-web-server/tests/certify-tests.ss
View File

@ -3,6 +3,11 @@
"language-tester.ss")
(provide certify-suite)
(define the-dispatch
`(lambda (k*v)
(lambda (k*v)
((car k*v) k*v))))
(define certify-suite
(make-test-suite
"Test the certification process"
@ -18,7 +23,7 @@
(provide start)
(define (start initial)
`(,@(list 1 2 initial)))))])
(go)
(go the-dispatch)
(assert equal? (list 1 2 3) (test-m01.1 '(dispatch-start 3)))
(assert equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start 'foo)))))
@ -30,7 +35,7 @@
(provide start)
(define (start initial)
`(foo ,@(list 1 2 3)))))])
(go)
(go the-dispatch)
(assert-true #t)))
(make-test-case
@ -41,7 +46,7 @@
(provide start)
(define (start n)
`(n ,@(list 1 2 3)))))])
(go)
(go the-dispatch)
(assert-true #t)))
(make-test-case
@ -54,5 +59,5 @@
(define (bar n)
`(n ,@(list 1 2 3)))
(bar 7))))])
(go)
(go the-dispatch)
(assert-true #t)))))))

35
collects/web-server/prototype-web-server/tests/lang-tests.ss
View File

@ -14,6 +14,11 @@
(raise the-exn)))])
(and (thunk) #f)))
(define the-dispatch
`(lambda (k*v)
(lambda (k*v)
((car k*v) k*v))))
(define lang-suite
(make-test-suite
"Test the Web language"
@ -33,7 +38,7 @@
(define (start initial)
(let ([f (let ([m 7]) m)])
(+ f initial)))))])
(go)
(go the-dispatch)
(assert = 8 (test-m00.4 '(dispatch-start 1)))))
(make-test-case
@ -45,7 +50,7 @@
(provide start)
(define (start initial)
(foo initial))))])
(go)
(go the-dispatch)
(assert eqv? 'foo (test-m00.3 '(dispatch-start 7)))))
(make-test-case
@ -57,7 +62,7 @@
(provide start)
(define (start initial)
(id initial))))])
(go)
(go the-dispatch)
(assert = 7 (test-m00 '(dispatch-start 7)))
(assert eqv? 'foo (test-m00 '(dispatch-start 'foo)))))
@ -69,7 +74,7 @@
(provide start)
(define (start initial)
(+ 1 initial))))])
(go)
(go the-dispatch)
(assert = 2 (test-m00.1 '(dispatch-start 1)))))
(make-test-case
@ -80,7 +85,7 @@
(provide start)
(define (start initial)
(+ (+ 1 1) initial))))])
(go)
(go the-dispatch)
(assert = 14 (test-m00.2 '(dispatch-start 12)))
(assert = 20 (test-m00.2 '(dispatch-start 18)))))
@ -92,7 +97,7 @@
(provide start)
(define (start initial)
(+ (* 1 2) (* 3 4) initial))))])
(go)
(go the-dispatch)
(assert = 14 (test-m01 '(dispatch-start 0)))
(assert = 20 (test-m01 '(dispatch-start 6)))))
@ -130,7 +135,7 @@
(define (start x)
(let/cc k
(+ 2 4 (k 3) 6 8)))))])
(go)
(go the-dispatch)
(assert = 3 (test-m03 '(dispatch-start 'foo)))
(assert = 3 (test-m03 '(dispatch-start 7)))))
@ -151,7 +156,7 @@
[else
(* (car ln)
(start (cdr ln)))])))))])
(go)
(go the-dispatch)
(assert = 0 (test-m04 '(dispatch-start (list 1 2 3 4 5 6 7 0 8 9))))
(assert = 120 (test-m04 '(dispatch-start (list 1 2 3 4 5))))))
@ -177,7 +182,7 @@
[else
(* (car ln)
(mult/escape escape (cdr ln)))]))))])
(go)
(go the-dispatch)
(assert = 0 (test-m05 '(dispatch-start (list 1 2 3 0 4 5 6))))
(assert = 120 (test-m05 '(dispatch-start (list 1 2 3 4 5)))))))
@ -248,7 +253,7 @@
(let ([result (+ (gn "first") (gn "second"))])
(let ([ignore (printf "The answer is: ~s~n" result)])
result)))))])
(go)
(go the-dispatch)
(let* ([first-key (test-m06.1 '(dispatch-start 'foo))]
[second-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) 1)))]
[third-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) -7)))])
@ -279,7 +284,7 @@
(and (not (zero? n))
(even? (sub1 n))))])
(even? initial)))))])
(go)
(go the-dispatch)
(assert-true (test-m07 '(dispatch-start 0)))
(assert-true (test-m07 '(dispatch-start 16)))
(assert-false (test-m07 '(dispatch-start 1)))
@ -306,7 +311,7 @@
(let ([result (g (gn "third"))])
(let ([ignore (printf "The answer is: ~s~n" result)])
result))))))])
(go)
(go the-dispatch)
(let* ([k0 (test-m08 '(serialize (dispatch-start 'foo)))]
[k1 (test-m08 `(serialize (dispatch (list (deserialize ',k0) 1))))]
[k2 (test-m08 `(serialize (dispatch (list (deserialize ',k1) 2))))])
@ -360,7 +365,7 @@
result))
(define (start ignore)
(nta (lambda (x) (let/cc k (k x))) 7))))])
(go)
(go the-dispatch)
(assert = 7 (m10-eval '(dispatch-start 'foo)))))
(make-test-case
@ -374,7 +379,7 @@
(map
(lambda (x) (let/cc k k))
(list 1 2 3)))))])
(go)
(go the-dispatch)
(assert-true (catch-unsafe-context-exn
(lambda () (m11-eval '(dispatch-start 'foo)))))))
@ -417,7 +422,7 @@
(let ([ignore (printf "n = ~s~n" n)])
k))))
(list 1 2 3)))))])
(go)
(go the-dispatch)
(assert-true (catch-unsafe-context-exn
(lambda () (m13-eval '(dispatch-start 'foo)))))))

8
collects/web-server/prototype-web-server/tests/language-tester.ss
View File

@ -3,14 +3,12 @@
make-eval/mod-path)
(define (go ns)
(lambda ()
(lambda (dispatch-sexpr)
(parameterize ([current-namespace ns])
(eval '(run-start
(eval `(run-start
(lambda ()
(start-interaction
(lambda (k*v)
(lambda (k*v)
((car k*v) k*v)))))
,dispatch-sexpr))
start)))))
(define-syntax (make-module-eval m-expr)

11
collects/web-server/prototype-web-server/tests/stuff-url-tests.ss
View File

@ -26,6 +26,11 @@
(let ([result-uri (stuff-url svl uri mod-path)])
(unstuff-url result-uri uri mod-path)))
(define the-dispatch
`(lambda (k*v)
(lambda (k*v)
((car k*v) k*v))))
(define stuff-url-suite
(make-test-suite
"Tests for stuff-url.ss"
@ -49,7 +54,7 @@
(make-test-case
"compose url-parts and recover-serial (1)"
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
(go)
(go the-dispatch)
(let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm00.ss"))]
[k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
@ -61,7 +66,7 @@
(make-test-case
"compose url-parts and recover-serial (2)"
(let-values ([(go ev) (make-eval/mod-path "modules/mm01.ss")])
(go)
(go the-dispatch)
(let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm01.ss"))])
(assert-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7))))))))
@ -69,7 +74,7 @@
(make-test-case
"compose stuff-url and unstuff-url and recover the serial"
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
(go)
(go the-dispatch)
(let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo)))
uri0 `(file "modules/mm00.ss"))]
[k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1))))