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

Tests could not be run from any directory

Browse Source 
svn: r6327
This commit is contained in:
Jay McCarthy 2007-05-26 00:17:38 +00:00
parent 26c00bcb39
commit 04d52a5c2a
5 changed files with 46 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19,7 +19,7 @@
"quasi-quote with splicing: need to recertify context for qq-append"
(let-values ([(go test-m01.1)
(make-module-eval
(module m01.1 "../lang.ss"
(module m01.1 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
`(,@(list 1 2 initial)))))])
@ -31,7 +31,7 @@
"recertify context test (1)"
(let-values ([(go test-m01.2)
(make-module-eval
(module m01.1 "../lang.ss"
(module m01.1 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
`(foo ,@(list 1 2 3)))))])
@ -42,7 +42,7 @@
"recertify context test (2)"
(let-values ([(go test-m01.3)
(make-module-eval
(module m01.3 "../lang.ss"
(module m01.3 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start n)
`(n ,@(list 1 2 3)))))])
@ -53,7 +53,7 @@
"recertify context test (3)"
(let-values ([(go test-m01.4)
(make-module-eval
(module m1 "../lang.ss"
(module m1 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(define (bar n)

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

@ -33,7 +33,7 @@
"Function application with single argument in tail position"
(let-values ([(go test-m00.4)
(make-module-eval
(module m00.4 "../lang.ss"
(module m00.4 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(let ([f (let ([m 7]) m)])
@ -45,7 +45,7 @@
"start-interaction in argument position of a function call"
(let-values ([(go test-m00.3)
(make-module-eval
(module m00.3 "../lang.ss"
(module m00.3 (lib "lang.ss" "web-server" "prototype-web-server")
(define (foo x) 'foo)
(provide start)
(define (start initial)
@ -57,7 +57,7 @@
"identity interaction, dispatch-start called multiple times"
(let-values ([(go test-m00)
(make-module-eval
(module m00 "../lang.ss"
(module m00 (lib "lang.ss" "web-server" "prototype-web-server")
(define (id x) x)
(provide start)
(define (start initial)
@ -70,7 +70,7 @@
"start-interaction in argument position of a primitive"
(let-values ([(go test-m00.1)
(make-module-eval
(module m00.1 "../lang.ss"
(module m00.1 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(+ 1 initial))))])
@ -81,7 +81,7 @@
"dispatch-start called multiple times for s-i in non-trivial context"
(let-values ([(go test-m00.2)
(make-module-eval
(module m00.2 "../lang.ss"
(module m00.2 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(+ (+ 1 1) initial))))])
@ -93,7 +93,7 @@
"start-interaction in third position"
(let-values ([(go test-m01)
(make-module-eval
(module m01 "../lang.ss"
(module m01 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(+ (* 1 2) (* 3 4) initial))))])
@ -109,7 +109,7 @@
"start-interaction called twice, dispatch-start will invoke different continuations"
(let ([test-m02
(make-module-eval
(module m02 "../lang.ss"
(module m02 (lib "lang.ss" "web-server" "prototype-web-server")
(define (id x) x)
(+ (start-interaction id)
(start-interaction id))))])
@ -130,7 +130,7 @@
"continuation invoked in non-trivial context from within proc"
(let-values ([(go test-m03)
(make-module-eval
(module m03 "../lang.ss"
(module m03 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start x)
(let/cc k
@ -146,7 +146,7 @@
"non-tail-recursive 'escaping' continuation"
(let-values ([(go test-m04)
(make-module-eval
(module m04 "../lang.ss"
(module m04 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start ln)
(let/cc k
@ -168,7 +168,7 @@
"tail-recursive escaping continuation"
(let-values ([(go test-m05)
(make-module-eval
(module m05 "../lang.ss"
(module m05 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start ln)
@ -210,7 +210,7 @@
(define (lookup-k key-pair)
(hash-table-get the-table (car key-pair) (lambda () #f)))))])
(table-01-eval
'(module m06 "../lang.ss"
'(module m06 (lib "lang.ss" "web-server" "prototype-web-server")
(require table01)
(provide start)
@ -273,7 +273,7 @@
"mutually recursive even? and odd?"
(let-values ([(go test-m07)
(make-module-eval
(module m07 "../lang.ss"
(module m07 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(letrec ([even? (lambda (n)
@ -293,7 +293,7 @@
"send/suspend on rhs of letrec binding forms"
(let-values ([(go test-m08)
(make-module-eval
(module m08 "../lang.ss"
(module m08 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (gn which)
(cadr
@ -340,7 +340,7 @@
(let ([result (apply f args)])
(printf "result = ~s~n" result)
result))))])
(nta-eval '(module m09 "../lang.ss"
(nta-eval '(module m09 (lib "lang.ss" "web-server" "prototype-web-server")
(require nta)
(provide start)
(define (start ignore)
@ -356,7 +356,7 @@
(let-values ([(go m10-eval)
(make-module-eval
(module m10 "../lang.ss"
(module m10 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (nta f arg)
(let ([result (f arg)])
@ -372,7 +372,7 @@
(let-values ([(go m11-eval)
(make-module-eval
(module m11 "../lang.ss"
(module m11 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start ignore)
(map
@ -396,7 +396,7 @@
(define (tail-apply f . args)
(apply f args))))])
(ta-eval '(module m12 "../lang.ss"
(ta-eval '(module m12 (lib "lang.ss" "web-server" "prototype-web-server")
(require ta)
(provide start)
(define (start initial)
@ -412,7 +412,7 @@
(let-values ([(go m13-eval)
(make-module-eval
(module m11 "../lang.ss"
(module m11 (lib "lang.ss" "web-server" "prototype-web-server")
(provide start)
(define (start initial)
(map
@ -437,7 +437,7 @@
(define (tail-apply f . args)
(apply f args))))])
(ta-eval '(module m14 "../lang.ss"
(ta-eval '(module m14 (lib "lang.ss" "web-server" "prototype-web-server")
(require ta)
(provide start)
(define (start ignore)

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

@ -5,6 +5,7 @@
(lib "url.ss" "net")
(lib "dirs.ss" "setup")
(lib "file.ss")
(lib "etc.ss")
"util.ss")
(require/expose (lib "stuff-url.ss" "web-server" "prototype-web-server" "private")
@ -31,6 +32,9 @@
(lambda (k*v)
((car k*v) k*v))))
(define m00 '(lib "mm00.ss" "web-server" "prototype-web-server" "tests" "modules"))
(define m01 '(lib "mm01.ss" "web-server" "prototype-web-server" "tests" "modules"))
(define stuff-url-suite
(test-suite
"Tests for stuff-url.ss"
@ -43,7 +47,7 @@
'(lib "abort-resume.ss" "web-server" "prototype-web-server" "private")))
(check-true
(same-module? `(file ,(path->string (build-absolute-path (current-directory) "../private/abort-resume.ss")))
(same-module? `(file ,(path->string (build-absolute-path (this-expression-source-directory) "../private/abort-resume.ss")))
'(lib "abort-resume.ss" "web-server" "prototype-web-server" "private")))
(check-true
@ -53,32 +57,32 @@
(test-case
"compose url-parts and recover-serial (1)"
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
(let-values ([(go ev) (make-eval/mod-path m00)])
(go the-dispatch)
(let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm00.ss"))]
m00)]
[k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
`(file "modules/mm00.ss"))]
m00)]
[k2 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
`(file "modules/mm00.ss"))])
m00)])
(check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))
(test-case
"compose url-parts and recover-serial (2)"
(let-values ([(go ev) (make-eval/mod-path "modules/mm01.ss")])
(let-values ([(go ev) (make-eval/mod-path m01)])
(go the-dispatch)
(let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm01.ss"))])
m01)])
(check-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7))))))))
(test-case
(test-case
"compose stuff-url and unstuff-url and recover the serial"
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
(let-values ([(go ev) (make-eval/mod-path m00)])
(go the-dispatch)
(let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo)))
uri0 `(file "modules/mm00.ss"))]
uri0 m00)]
[k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
uri0 `(file "modules/mm00.ss"))]
uri0 m00)]
[k2 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
uri0 `(file "modules/mm00.ss"))])
uri0 m00)])
(check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))))))

12
collects/web-server/prototype-web-server/tests/suite.ss
View File

@ -13,10 +13,10 @@
(test/graphical-ui
(test-suite
"Main Tests for Prototype Web Server"
persistent-close-suite
#;persistent-close-suite
stuff-url-suite
anormal-tests
closure-tests-suite
labels-tests-suite
lang-suite
certify-suite)))
#;anormal-tests
#;closure-tests-suite
#;labels-tests-suite
#;lang-suite
#;certify-suite)))

2
collects/web-server/prototype-web-server/tests/util.ss
View File

@ -34,7 +34,7 @@
(parameterize ([current-namespace ns])
(eval `(require (lib "abort-resume.ss" "web-server" "prototype-web-server" "private")
(lib "serialize.ss")
(file ,pth))))
,pth)))
(values (go ns)
(lambda (expr)
(parameterize ([current-namespace ns])