fix test problems
svn: r18221
This commit is contained in:
parent
190af1efe9
commit
d2bdc2eca8
|
@ -1,4 +1,4 @@
|
||||||
(load-relative "loadtest.ss")
|
(load-relative "../mzscheme/loadtest.ss")
|
||||||
|
|
||||||
(Section 'future)
|
(Section 'future)
|
||||||
(require scheme/future)
|
(require scheme/future)
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
'("2htdp"
|
'("2htdp"
|
||||||
"aligned-pasteboard"
|
"aligned-pasteboard"
|
||||||
"deinprogramm"
|
"deinprogramm"
|
||||||
|
"future"
|
||||||
"honu"
|
"honu"
|
||||||
"match"
|
"match"
|
||||||
"macro-debugger"
|
"macro-debugger"
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user