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

Cleaning up cwd access for DrDr

Browse Source 
svn: r16373
This commit is contained in:
Jay McCarthy 2009-10-19 21:28:17 +00:00
parent 0bd8b828e9
commit fba54e27af
2 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/schemeunit/check-test.ss
View File

@ -29,6 +29,7 @@
#lang scheme/base #lang scheme/base
(require (require
scheme/runtime-path
(lib "list.ss" "srfi" "1") (lib "list.ss" "srfi" "1")
(file "check.ss") (file "check.ss")
(file "result.ss") (file "result.ss")
@ -50,6 +51,8 @@
(define-check (bad) (define-check (bad)
(fail-check)) (fail-check))
(define-runtime-path check-file "check.ss")
(define check-tests (define check-tests
(test-suite (test-suite
"Check tests" "Check tests"
@ -288,7 +291,7 @@
(cns (current-namespace))) (cns (current-namespace)))
(parameterize ((current-namespace destns)) (parameterize ((current-namespace destns))
(namespace-require '(for-syntax scheme/base)) (namespace-require '(for-syntax scheme/base))
(namespace-require '(file "check.ss")) (namespace-require `(file ,(path->string check-file)))
;; First check that the right check macro got ;; First check that the right check macro got
;; used: ie that it didn't just compile the thing ;; used: ie that it didn't just compile the thing
;; as an application. ;; as an application.
@ -303,7 +306,7 @@
;; is writable ;; is writable
(let ((stx-string "(check = 1 2)")) (let ((stx-string "(check = 1 2)"))
(write (compile (read-syntax (write (compile (read-syntax
(string->path "file") check-file
(open-input-string stx-string))) (open-input-string stx-string)))
(open-output-string)))))) (open-output-string))))))

7
collects/schemeunit/test-test.ss
View File

@ -2,7 +2,8 @@
(require (for-syntax scheme/base)) (require (for-syntax scheme/base))
(require srfi/1 (require scheme/runtime-path
srfi/1
srfi/13) srfi/13)
(require (file "test.ss") (require (file "test.ss")
@ -24,6 +25,8 @@
"Example 3" "Example 3"
#t))) #t)))
(define-runtime-path test-file "test.ss")
(define-check (check-test-results test successes failures errors) (define-check (check-test-results test successes failures errors)
(let ((results (run-test test))) (let ((results (run-test test)))
(check = (length results) (+ successes failures errors)) (check = (length results) (+ successes failures errors))
@ -44,7 +47,7 @@
(let ((destns (make-base-namespace)) (let ((destns (make-base-namespace))
(cns (current-namespace))) (cns (current-namespace)))
(parameterize ((current-namespace destns)) (parameterize ((current-namespace destns))
(namespace-require '(file "test.ss")) (namespace-require `(file ,(path->string test-file)))
(check-exn (lambda (e) (check-exn (lambda (e)
(check-pred exn:fail:syntax? e) (check-pred exn:fail:syntax? e)
(check string-contains (exn-message e) msg)) (check string-contains (exn-message e) msg))