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

Allow concurrent testing

Browse Source 
svn: r16506
This commit is contained in:
Kevin Tew 2009-11-02 23:24:08 +00:00
parent ca5a7e604b
commit 9611f21611
3 changed files with 30 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/tests/mzscheme/module.ss
View File

@ -305,23 +305,26 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ([f1 "tmp1.ss"]
[f2 "tmp2.ss"]
(let ([f1 (make-temporary-file)]
[f2 (make-temporary-file)]
[exn:fail-cycle? (lambda (exn)
(and (exn:fail? exn)
(regexp-match? #rx"cycle" (exn-message exn))))])
(let-values ([(b1 tmp1 mbd1?) (split-path f1)]
[(b2 tmp2 mbd2?) (split-path f2)])
(with-output-to-file f1
#:exists 'truncate/replace
(lambda ()
(write `(module tmp1 mzscheme (require ,f2)))))
(write `(module ,(string->symbol (path->string tmp1)) mzscheme (require (file ,(path->string f2)))))))
(with-output-to-file f2
#:exists 'truncate/replace
(lambda ()
(write `(module tmp2 mzscheme (require ,f1)))))
(err/rt-test (dynamic-require (build-path (current-directory) f1) #f) exn:fail-cycle?)
(err/rt-test (dynamic-require (build-path (current-directory) f2) #f) exn:fail-cycle?)
(write `(module ,(string->symbol (path->string tmp2)) mzscheme (require (file ,(path->string f1)))))))
(err/rt-test (dynamic-require f1 #f) exn:fail-cycle?)
(err/rt-test (dynamic-require f2 #f) exn:fail-cycle?)
(delete-file f1)
(delete-file f2))
(delete-file f2)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

22
collects/tests/mzscheme/stx.ss
View File

@ -1340,12 +1340,17 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Test namespace-attach with phase-levels -2 and 2
(when (file-exists? "tmp10")
(delete-file "tmp10"))
(module tn scheme/base
(require scheme/file)
(define tmp10 (make-temporary-file))
(provide tmp10)
)
(module @!a scheme/base
(require 'tn)
(provide x)
(with-output-to-file "tmp10"
(with-output-to-file tmp10
#:exists 'append
(lambda ()
(printf "a\n")))
@ -1357,6 +1362,7 @@
(define (get-x) #'x))
(module @!c scheme/base
(require 'tn)
(require (for-meta 2 '@!b)
(for-syntax scheme/base
(for-syntax scheme/base)))
@ -1365,13 +1371,15 @@
#`(quote-syntax #,(get-x)))])
(ref-x)))
(with-output-to-file "tmp10"
(with-output-to-file tmp10
#:exists 'append
(lambda ()
(printf "~s\n" (foo)))))
(require 'tn)
(define (check-tmp10 s)
(test s with-input-from-file "tmp10" (lambda () (read-string 1000))))
(test s with-input-from-file tmp10 (lambda () (read-string 1000))))
(require '@!c)
(check-tmp10 "a\n5\n")
@ -1388,8 +1396,8 @@
(eval 'x)))
(check-tmp10 "a\n5\n"))
(when (file-exists? "tmp10")
(delete-file "tmp10"))
(when (file-exists? tmp10)
(delete-file tmp10))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure post-ex renames aren't simplied away too soon:

9
collects/tests/mzscheme/syntax.ss
View File

@ -1113,17 +1113,18 @@
(let ([p (open-input-bytes (get-output-bytes s))])
(read p)
(read p))))
(let ([tmp-file "tmp1"])
(let ([tmp-file (make-temporary-file)])
(let-values ([(base tmp1 mbd?) (split-path tmp-file)])
(with-output-to-file tmp-file (lambda () (display '(+ 1 2))) #:exists 'truncate/replace)
(test '(+ 1 2) 'repl-top
(parameterize ([current-namespace ns])
(load tmp-file)))
(with-output-to-file tmp-file (lambda () (display '(module tmp1 mzscheme (provide x) (define x 12))))
(with-output-to-file tmp-file (lambda () (display `(module ,tmp1 mzscheme (provide x) (define x 12))))
#:exists 'truncate/replace)
(test 12 'module
(parameterize ([current-namespace ns])
(dynamic-require (build-path (current-directory) tmp-file) 'x)))
(delete-file tmp-file)))
(dynamic-require tmp-file 'x)))
(delete-file tmp-file))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;