fix test problems

svn: r18221
This commit is contained in:
Matthew Flatt 2010-02-20 12:23:01 +00:00
parent 190af1efe9
commit d2bdc2eca8
4 changed files with 16 additions and 14 deletions

View File

@ -1,4 +1,4 @@
(load-relative "loadtest.ss") (load-relative "../mzscheme/loadtest.ss")
(Section 'future) (Section 'future)
(require scheme/future) (require scheme/future)

View File

@ -186,8 +186,9 @@ Errors/exceptions and other kinds of control?
(define-namespace-anchor ns-here) (define-namespace-anchor ns-here)
(let loop ([n 100]) (let loop ([n 100])
(printf ".") (flush-output) (unless (zero? n)
(let ([p (gen-prog)]) (printf ".") (flush-output)
(pretty-print p) (let ([p (gen-prog)])
(eval p (namespace-anchor->namespace ns-here))) (pretty-print p)
(loop (- n 1))) (eval p (namespace-anchor->namespace ns-here)))
(loop (- n 1))))

View File

@ -8,6 +8,7 @@
'("2htdp" '("2htdp"
"aligned-pasteboard" "aligned-pasteboard"
"deinprogramm" "deinprogramm"
"future"
"honu" "honu"
"match" "match"
"macro-debugger" "macro-debugger"

View File

@ -80,9 +80,9 @@
(bytes<? (path->bytes a) (path->bytes b)))))]) (bytes<? (path->bytes a) (path->bytes b)))))])
(test #t equal? (sort rel) (sort rel2)) (test #t equal? (sort rel) (sort rel2))
(when (eq? (system-type) 'unix) (unless (eq? (system-type) 'windows)
(system "ln -s filelib.ss filelib-link.ss") (make-file-or-directory-link "filelib.ss" "filelib-link")
(system "ln -s . loop-link") (make-file-or-directory-link "." "loop-link")
(test (+ 2 (length rel2)) (test (+ 2 (length rel2))
fold-files fold-files
@ -92,7 +92,7 @@
[(file-exists? name) 'file] [(file-exists? name) 'file]
[(directory-exists? name) 'dir] [(directory-exists? name) 'dir]
[else '???])) [else '???]))
(when (member name '("filelib-link.ss" "loop-link")) (when (member name '("filelib-link" "loop-link"))
(test kind name 'link)) (test kind name 'link))
(add1 accum)) (add1 accum))
0 0
@ -107,14 +107,14 @@
[(file-exists? name) 'file] [(file-exists? name) 'file]
[(directory-exists? name) 'dir] [(directory-exists? name) 'dir]
[else '???])) [else '???]))
(when (member name '("filelib-link.ss" "loop-link")) (when (member name '("filelib-link" "loop-link"))
(test kind name 'link)) (test kind name 'link))
(values (add1 accum) #t)) (values (add1 accum) #t))
0 0
#f #f
#f) #f)
(system "rm loop-link") (delete-file "loop-link")
(test (+ 1 (length rel2)) (test (+ 1 (length rel2))
fold-files fold-files
@ -122,14 +122,14 @@
(test kind values (cond (test kind values (cond
[(file-exists? name) 'file] [(file-exists? name) 'file]
[else 'dir])) [else 'dir]))
(when (member name '("filelib-link.ss")) (when (member name '("filelib-link"))
(test kind name 'file)) (test kind name 'file))
(add1 accum)) (add1 accum))
0 0
#f #f
#t) #t)
(system "rm filelib-link.ss") (delete-file "filelib-link")
'done)))) 'done))))