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

fix tests to avoid writing to the current or installation directory

Browse Source
This commit is contained in:
Matthew Flatt 2016-03-10 16:54:28 -07:00
parent cbba4e75f9
commit 33acbaeaf1
10 changed files with 216 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -5,6 +5,10 @@
(define testing.rktl (build-path (current-load-relative-directory) "testing.rktl")) (define testing.rktl (build-path (current-load-relative-directory) "testing.rktl"))
(define original-dir (current-directory))
(define work-dir (make-temporary-file "path~a" 'directory))
(current-directory work-dir)
(test #t input-port? (current-input-port)) (test #t input-port? (current-input-port))
(test #t output-port? (current-output-port)) (test #t output-port? (current-output-port))
(test #t output-port? (current-error-port)) (test #t output-port? (current-error-port))
@ -1615,6 +1619,9 @@
;; Cleanup files created above ;; Cleanup files created above
(for ([f '("tmp1" "tmp2" "tmp3")] #:when (file-exists? f)) (delete-file f)) (for ([f '("tmp1" "tmp2" "tmp3")] #:when (file-exists? f)) (delete-file f))
(current-directory original-dir)
(delete-directory work-dir)
;; Network - - - - - - - - - - - - - - - - - - - - - - ;; Network - - - - - - - - - - - - - - - - - - - - - -
(define (net-reject? who host port what) (define (net-reject? who host port what)

116
pkgs/racket-test-core/tests/racket/filelib.rktl
View File

@ -7,7 +7,8 @@
racket/system racket/system
racket/list) racket/list)
(define tmp-name "tmp0-filelib") (define tmp-dir (make-temporary-file "filelib~a" 'directory))
(define tmp-name (build-path tmp-dir "tmp0-filelib"))
(when (file-exists? tmp-name) (delete-file tmp-name)) (when (file-exists? tmp-name) (delete-file tmp-name))
(display-lines-to-file '("a" "b" "c") tmp-name #:separator #"\r\n" #:mode 'binary) (display-lines-to-file '("a" "b" "c") tmp-name #:separator #"\r\n" #:mode 'binary)
(test '(a b c) file->list tmp-name) (test '(a b c) file->list tmp-name)
@ -28,6 +29,7 @@
(test #"\"\316\273\"" file->bytes tmp-name) (test #"\"\316\273\"" file->bytes tmp-name)
(test "\u03BB" file->value tmp-name) (test "\u03BB" file->value tmp-name)
(when (file-exists? tmp-name) (delete-file tmp-name)) (when (file-exists? tmp-name) (delete-file tmp-name))
(delete-directory tmp-dir)
(define-syntax-rule (err/rt-chk-test (op arg ...)) (define-syntax-rule (err/rt-chk-test (op arg ...))
(err/rt-test (op arg ...) (check-msg 'op))) (err/rt-test (op arg ...) (check-msg 'op)))
@ -87,57 +89,79 @@
(test #t equal? (sort rel) (sort rel2)) (test #t equal? (sort rel) (sort rel2))
(unless (eq? (system-type) 'windows) (unless (eq? (system-type) 'windows)
(make-file-or-directory-link "filelib.rktl" "filelib-link") (define tmp-dir (make-temporary-file "filelib~a" 'directory))
(make-file-or-directory-link "." "loop-link") (define (touch . elems)
(call-with-output-file
(apply build-path elems)
void))
(copy-file "filelib.rktl" (build-path tmp-dir "filelib.rktl"))
(make-directory (build-path tmp-dir "sub"))
(touch tmp-dir "a")
(touch tmp-dir "b")
(touch tmp-dir "sub" "x")
(parameterize ([current-directory tmp-dir])
(define rel2 (fold-files (lambda (name kind accum)
(test kind name (if (file-exists? name)
'file
'dir))
(cons name accum))
null))
(make-file-or-directory-link "filelib.rktl" "filelib-link")
(make-file-or-directory-link "." "loop-link")
(test (+ 2 (length rel2)) (test (+ 2 (length rel2))
fold-files fold-files
(lambda (name kind accum) (lambda (name kind accum)
(test kind values (cond (test kind values (cond
[(link-exists? name) 'link] [(link-exists? name) 'link]
[(file-exists? name) 'file] [(file-exists? name) 'file]
[(directory-exists? name) 'dir] [(directory-exists? name) 'dir]
[else '???])) [else '???]))
(when (member name '("filelib-link" "loop-link")) (when (member name '("filelib-link" "loop-link"))
(test kind name 'link)) (test kind name 'link))
(add1 accum)) (add1 accum))
0 0
#f #f
#f) #f)
(test (+ 2 (length rel2)) (test (+ 2 (length rel2))
fold-files fold-files
(lambda (name kind accum) (lambda (name kind accum)
(test kind values (cond (test kind values (cond
[(link-exists? name) 'link] [(link-exists? name) 'link]
[(file-exists? name) 'file] [(file-exists? name) 'file]
[(directory-exists? name) 'dir] [(directory-exists? name) 'dir]
[else '???])) [else '???]))
(when (member name '("filelib-link" "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)
(delete-file "loop-link") (delete-file "loop-link")
(test (+ 1 (length rel2)) (test (+ 1 (length rel2))
fold-files fold-files
(lambda (name kind accum) (lambda (name kind accum)
(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")) (when (member name '("filelib-link"))
(test kind name 'file)) (test kind name 'file))
(add1 accum)) (add1 accum))
0 0
#f #f
#t) #t)
(delete-file "filelib-link") (delete-file "filelib-link")
'done)
(delete-directory/files tmp-dir)))))
'done))))
;; ---------------------------------------- ;; ----------------------------------------
;;---------------------------------------------------------------------- ;;----------------------------------------------------------------------

57
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -7,7 +7,8 @@
ffi/unsafe/cvector ffi/unsafe/cvector
ffi/vector ffi/vector
racket/extflonum racket/extflonum
racket/place) racket/place
racket/file)
(define test-async? (and (place-enabled?) (not (eq? 'windows (system-type))))) (define test-async? (and (place-enabled?) (not (eq? 'windows (system-type)))))
@ -97,34 +98,38 @@
(require dynext/compile dynext/link racket/runtime-path) (require dynext/compile dynext/link racket/runtime-path)
(define-runtime-path here ".") (define-runtime-path here ".")
(define test-tmp-dir
(make-temporary-file "foreign~a" 'directory))
(copy-file (build-path here "foreign-test.c")
(build-path test-tmp-dir "foreign-test.c"))
(define delete-test-files (define delete-test-files
(let ([c (build-path here "foreign-test.c")] (parameterize ([current-directory test-tmp-dir])
[o (build-path (current-directory) (let ([c (build-path (current-directory) "foreign-test.c")]
(if (eq? 'windows (system-type)) [o (build-path (current-directory)
"foreign-test.obj" "foreign-test.o"))] (if (eq? 'windows (system-type))
[so (build-path (current-directory) "foreign-test.obj" "foreign-test.o"))]
(bytes->path (bytes-append #"foreign-test" [so (build-path (current-directory)
(system-type 'so-suffix))))]) (bytes->path (bytes-append #"foreign-test"
(when (file-exists? o) (delete-file o)) (system-type 'so-suffix))))])
(when (file-exists? so) (delete-file so))
(parameterize ([current-standard-link-libraries '()]
[current-extension-compiler-flags
(if test-async?
(append '("-pthread" "-DUSE_THREAD_TEST") (current-extension-compiler-flags))
(current-extension-compiler-flags))]
[current-extension-linker-flags
(if test-async?
(append '("-pthread") (current-extension-linker-flags))
(current-extension-linker-flags))])
(compile-extension #t c o '())
(link-extension #t (list o) so))
(lambda ()
(when (file-exists? o) (delete-file o)) (when (file-exists? o) (delete-file o))
(when (file-exists? so) (when (file-exists? so) (delete-file so))
(parameterize ([current-standard-link-libraries '()]
[current-extension-compiler-flags
(if test-async?
(append '("-pthread" "-DUSE_THREAD_TEST") (current-extension-compiler-flags))
(current-extension-compiler-flags))]
[current-extension-linker-flags
(if test-async?
(append '("-pthread") (current-extension-linker-flags))
(current-extension-linker-flags))])
(compile-extension #t c o '())
(link-extension #t (list o) so))
(lambda ()
(with-handlers ([exn:fail:filesystem? (with-handlers ([exn:fail:filesystem?
(lambda (e) (lambda (e)
(eprintf "warning: could not delete ~e\n" so))]) (eprintf "warning: could not delete ~e\n" test-tmp-dir))])
(delete-file so)))))) (delete-directory/files test-tmp-dir))))))
;; Test arrays ;; Test arrays
(define _c7_list (_array/list _byte 7)) (define _c7_list (_array/list _byte 7))
@ -179,7 +184,7 @@
(define _borl (_union _byte _long)) (define _borl (_union _byte _long))
(define _ic7iorl (_union _ic7i _long)) (define _ic7iorl (_union _ic7i _long))
(define test-lib (ffi-lib "./foreign-test")) (define test-lib (ffi-lib (build-path test-tmp-dir "foreign-test")))
(for ([n (in-range 5)]) (for ([n (in-range 5)])
(define (ffi name type) (get-ffi-obj name test-lib type)) (define (ffi name type) (get-ffi-obj name test-lib type))

13
pkgs/racket-test-core/tests/racket/path.rktl
View File

@ -71,6 +71,10 @@
(arity-test complete-path? 1 1) (arity-test complete-path? 1 1)
(err/rt-test (complete-path? 'a)) (err/rt-test (complete-path? 'a))
(define original-dir (current-directory))
(define work-dir (make-temporary-file "path~a" 'directory))
(current-directory work-dir)
(call-with-output-file "tmp6" void #:exists 'replace) (call-with-output-file "tmp6" void #:exists 'replace)
(define existant "tmp6") (define existant "tmp6")
@ -220,6 +224,9 @@
(test #t delete-directory/tf "down") (test #t delete-directory/tf "down")
(test #f delete-directory/tf "down") (test #f delete-directory/tf "down")
(current-directory original-dir)
(delete-directory work-dir)
; Redefine these per-platform ; Redefine these per-platform
(define drives null) (define drives null)
(define nondrive-roots (list "/")) (define nondrive-roots (list "/"))
@ -875,12 +882,12 @@
(test (bytes->path #"/home/mflatt/././~") build-path (bytes->path #"/home/mflatt") (bytes->path #"././~")) (test (bytes->path #"/home/mflatt/././~") build-path (bytes->path #"/home/mflatt") (bytes->path #"././~"))
(test (bytes->path #"./~") build-path (bytes->path #"./~")) (test (bytes->path #"./~") build-path (bytes->path #"./~"))
(when use-fs? (when use-fs?
(let ([dir "tmp79"]) (let ([dir (make-temporary-file "tmp79~a" 'directory)])
(unless (directory-exists? dir) (unless (directory-exists? dir)
(make-directory dir)) (make-directory dir))
(close-output-port (open-output-file "tmp79/~me" #:exists 'replace)) (close-output-port (open-output-file (build-path dir "~me") #:exists 'replace))
(test (list (bytes->path #"~me")) directory-list dir) (test (list (bytes->path #"~me")) directory-list dir)
(delete-file (build-path "tmp79" (bytes->path #"~me"))) (delete-file (build-path dir (bytes->path #"~me")))
(delete-directory dir))) (delete-directory dir)))
(void))) (void)))

42
pkgs/racket-test-core/tests/racket/port.rktl
View File

@ -3,6 +3,15 @@
(Section 'port) (Section 'port)
(define (call-in-temporary-directory thunk)
(define dir (make-temporary-file "tmp~a" 'directory))
(dynamic-wind
void
(lambda ()
(parameterize ([current-directory dir])
(thunk)))
(lambda () (delete-directory dir))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests for progress events and commits ;; Tests for progress events and commits
@ -57,12 +66,15 @@
(test-pipe #t)) (test-pipe #t))
(let ([test-file (let ([test-file
(lambda (commit-eof?) (lambda (commit-eof?)
(with-output-to-file "tmp8" #:exists 'truncate/replace (call-in-temporary-directory
(lambda () (write-string "hello"))) (lambda ()
(define p (open-input-file "tmp8")) (with-output-to-file "tmp8"
(test-hello-port p commit-eof?) #:exists 'truncate/replace
(close-input-port p) (lambda () (write-string "hello")))
(delete-file "tmp8"))]) (define p (open-input-file "tmp8"))
(test-hello-port p commit-eof?)
(close-input-port p)
(delete-file "tmp8"))))])
(test-file #f) (test-file #f)
(test-file #t)) (test-file #t))
@ -777,14 +789,16 @@
(count-lines! in) (count-lines! in)
(check in)) (check in))
(let () (let ()
(with-output-to-file "tmp8" (call-in-temporary-directory
#:exists 'truncate/replace (lambda ()
(lambda () (display "12345"))) (with-output-to-file "tmp8"
(define in (open-input-file "tmp8")) #:exists 'truncate/replace
(count-lines! in) (lambda () (display "12345")))
(check in) (define in (open-input-file "tmp8"))
(close-input-port in) (count-lines! in)
(delete-file "tmp8"))) (check in)
(close-input-port in)
(delete-file "tmp8")))))
(check-all void) (check-all void)
(check-all port-count-lines!)) (check-all port-count-lines!))

58
pkgs/racket-test/tests/pkg/tests-install.rkt
View File

@ -119,17 +119,18 @@
"local directory fails when not there" "local directory fails when not there"
$ "raco pkg install --copy test-pkgs/pkg-test1-not-there/" =exit> 1) $ "raco pkg install --copy test-pkgs/pkg-test1-not-there/" =exit> 1)
(shelly-case (parameterize ([current-directory test-source-directory])
"directory fails due to path overlap" (shelly-case
$ "raco pkg install test-pkgs/pkg-test1" "directory fails due to path overlap"
=exit> 1 $ "raco pkg install test-pkgs/pkg-test1"
=stderr> #rx"overlap" =exit> 1
$ (~a "raco pkg install " (find-collects-dir)) =stderr> #rx"overlap"
=exit> 1 $ (~a "raco pkg install " (find-collects-dir))
=stderr> #rx"overlap.*collection" =exit> 1
$ (~a "raco pkg install " (collection-path "tests")) =stderr> #rx"overlap.*collection"
=exit> 1 $ (~a "raco pkg install " (collection-path "tests"))
=stderr> #rx"overlap.*package") =exit> 1
=stderr> #rx"overlap.*package"))
(define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory))) (define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory)))
$ (~a "cp -r test-pkgs/pkg-test1 "tmp-dir"pkg-test1") $ (~a "cp -r test-pkgs/pkg-test1 "tmp-dir"pkg-test1")
@ -165,23 +166,24 @@
$ (~a "cp -r "tmp-dir"pkg-test1 "tmp-dir"pkg-test1-linking") $ (~a "cp -r "tmp-dir"pkg-test1 "tmp-dir"pkg-test1-linking")
$ (~a "cp -r test-pkgs/pkg-test1-staging "tmp-dir"pkg-test1-staging") $ (~a "cp -r test-pkgs/pkg-test1-staging "tmp-dir"pkg-test1-staging")
(with-fake-root (parameterize ([current-directory test-source-directory])
(shelly-case (with-fake-root
"linking local directory" (shelly-case
$ "racket -e '(require pkg-test1)'" =exit> 1 "linking local directory"
$ (~a "raco pkg install --link "tmp-dir"pkg-test1-linking") $ "racket -e '(require pkg-test1)'" =exit> 1
$ "racket -e '(require pkg-test1)'" $ (~a "raco pkg install --link "tmp-dir"pkg-test1-linking")
$ "racket -e '(require pkg-test1/a)'" =exit> 1 $ "racket -e '(require pkg-test1)'"
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking\")'") =stdout> "\"pkg-test1-linking\"\n" $ "racket -e '(require pkg-test1/a)'" =exit> 1
$ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking/README\")'") =stdout> "\"pkg-test1-linking\"\n" $ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking\")'") =stdout> "\"pkg-test1-linking\"\n"
$ "racket -e '(require pkg/lib)' -e '(path->pkg \"test-pkgs\")'" =stdout> "\"racket-test\"\n" $ (~a "racket -e '(require pkg/lib)' -e '(path->pkg \""tmp-dir"pkg-test1-linking/README\")'") =stdout> "\"pkg-test1-linking\"\n"
$ "racket -e '(require pkg/lib)' -e '(path->pkg (collection-file-path \"main.rkt\" \"racket\"))'" =stdout> "#f\n" $ "racket -e '(require pkg/lib)' -e '(path->pkg \"test-pkgs\")'" =stdout> "\"racket-test\"\n"
$ (~a "cp "tmp-dir"pkg-test1-staging/a.rkt "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt") $ "racket -e '(require pkg/lib)' -e '(path->pkg (collection-file-path \"main.rkt\" \"racket\"))'" =stdout> "#f\n"
$ "racket -e '(require pkg-test1/a)'" $ (~a "cp "tmp-dir"pkg-test1-staging/a.rkt "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
$ (~a "rm -f "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt") $ "racket -e '(require pkg-test1/a)'"
$ "racket -e '(require pkg-test1/a)'" =exit> 1 $ (~a "rm -f "tmp-dir"pkg-test1-linking/pkg-test1/a.rkt")
$ "raco pkg remove pkg-test1-linking" $ "racket -e '(require pkg-test1/a)'" =exit> 1
$ "racket -e '(require pkg-test1)'" =exit> 1)) $ "raco pkg remove pkg-test1-linking"
$ "racket -e '(require pkg-test1)'" =exit> 1)))
$ (~a "cp -r "tmp-dir"pkg-test3 "tmp-dir"pkg-test3-linking") $ (~a "cp -r "tmp-dir"pkg-test3 "tmp-dir"pkg-test3-linking")

12
pkgs/racket-test/tests/pkg/tests-promote.rkt
View File

@ -15,11 +15,11 @@
"promote" "promote"
$ "raco pkg config --set catalogs http://localhost:9990" $ "raco pkg config --set catalogs http://localhost:9990"
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0 $ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg install test-pkgs/pkg-test2.zip" =exit> 1 =stderr> #rx"already installed" $ "raco pkg install test-pkgs/pkg-test2.zip" =exit> 1 =stderr> #rx"already installed"
$ "raco pkg install test-pkgs/pkg-test1.zip" =exit> 1 =stderr> #rx"already installed from a different source" $ "raco pkg install test-pkgs/pkg-test1.zip" =exit> 1 =stderr> #rx"already installed from a different source"
$ "raco pkg install pkg-test1" ; promote $ "raco pkg install pkg-test1" ; promote
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg install pkg-test1" =exit> 1 =stderr> #rx"already installed" ; redundant promote fails $ "raco pkg install pkg-test1" =exit> 1 =stderr> #rx"already installed" ; redundant promote fails
$ "racket -e '(require pkg-test1)'" =exit> 0 $ "racket -e '(require pkg-test1)'" =exit> 0
$ "racket -e '(require pkg-test2)'" =exit> 0 $ "racket -e '(require pkg-test2)'" =exit> 0
@ -32,9 +32,9 @@
"demote" "demote"
$ "raco pkg config --set catalogs http://localhost:9990" $ "raco pkg config --set catalogs http://localhost:9990"
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0 $ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg remove --demote pkg-test2" $ "raco pkg remove --demote pkg-test2"
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2\\* +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2\\* +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "racket -e '(require pkg-test1)'" =exit> 0 $ "racket -e '(require pkg-test1)'" =exit> 0
$ "racket -e '(require pkg-test2)'" =exit> 0 $ "racket -e '(require pkg-test2)'" =exit> 0
$ "raco pkg remove --auto" $ "raco pkg remove --auto"
@ -44,8 +44,8 @@
"demote+auto" "demote+auto"
$ "raco pkg config --set catalogs http://localhost:9990" $ "raco pkg config --set catalogs http://localhost:9990"
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0 $ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg remove --demote --auto pkg-test1" =exit> 0 ; should have no effect $ "raco pkg remove --demote --auto pkg-test1" =exit> 0 ; should have no effect
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg remove --demote --auto pkg-test2" $ "raco pkg remove --demote --auto pkg-test2"
$ "raco pkg show -l -u -a" =stdout> " [none]\n")))) $ "raco pkg show -l -u -a" =stdout> " [none]\n"))))

8
pkgs/racket-test/tests/pkg/tests-remove.rkt
View File

@ -35,12 +35,12 @@
"pkg-test1 pkg-test1") "pkg-test1 pkg-test1")
(shelly-install "remove of dep fails" (shelly-install "remove of dep fails"
"test-pkgs/pkg-test1.zip" "test-pkgs/pkg-test1.zip"
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\n"
$ "raco pkg install test-pkgs/pkg-test2.zip" $ "raco pkg install test-pkgs/pkg-test2.zip"
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "raco pkg remove pkg-test1" =exit> 1 =stderr> #rx"pkg-test1 \\(required by: \\(pkg-test2\\)\\)" $ "raco pkg remove pkg-test1" =exit> 1 =stderr> #rx"pkg-test1 \\(required by: \\(pkg-test2\\)\\)"
$ "raco pkg remove pkg-test2" $ "raco pkg remove pkg-test2"
$ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test1.zip\"\\)\n") $ "raco pkg show -l -u -a" =stdout> #rx"Package +Checksum +Source\npkg-test1 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test1.zip\"\\)\n")
(shelly-install "remove of dep can be forced" (shelly-install "remove of dep can be forced"
"test-pkgs/pkg-test1.zip" "test-pkgs/pkg-test1.zip"
$ "raco pkg install test-pkgs/pkg-test2.zip" $ "raco pkg install test-pkgs/pkg-test2.zip"
@ -68,7 +68,7 @@
$ "racket -e '(require pkg-test1)'" =exit> 1 $ "racket -e '(require pkg-test1)'" =exit> 1
$ "racket -e '(require pkg-test2)'" =exit> 1 $ "racket -e '(require pkg-test2)'" =exit> 1
$ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0 $ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0
$ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+tests/pkg/test-pkgs/pkg-test2.zip\"\\)\n" $ "raco pkg show -l -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-test1\\* +[a-f0-9.]+ +\\(catalog \"pkg-test1\"\\)\npkg-test2 +[a-f0-9.]+ +\\(file .+/test-pkgs/pkg-test2.zip\"\\)\n"
$ "racket -e '(require pkg-test1)'" =exit> 0 $ "racket -e '(require pkg-test1)'" =exit> 0
$ "racket -e '(require pkg-test2)'" =exit> 0 $ "racket -e '(require pkg-test2)'" =exit> 0
$ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0 $ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0

19
pkgs/racket-test/tests/pkg/util.rkt
View File

@ -13,7 +13,23 @@
setup/dirs setup/dirs
"shelly.rkt") "shelly.rkt")
(define-runtime-path test-directory ".") (define-runtime-path test-source-directory ".")
;; Use a consistent directory, so that individual tests can be
;; run after "tests-create.rkt":
(define-runtime-path test-directory (build-path (find-system-path 'temp-dir)
"pkg-test-work"))
(define (sync-test-directory)
(printf "Syncing test directory\n")
(make-directory* test-directory)
(parameterize ([current-directory test-source-directory])
(for ([f (in-directory)])
(define src f)
(define dest (build-path test-directory f))
(cond
[(directory-exists? src) (make-directory* dest)]
[else (copy-file src dest #t)]))))
(define-syntax-rule (this-test-is-run-by-the-main-test) (define-syntax-rule (this-test-is-run-by-the-main-test)
(module test racket/base)) (module test racket/base))
@ -186,6 +202,7 @@
(shelly-case "setup info cache" $ "raco setup -nDKxiI --no-foreign-libs") (shelly-case "setup info cache" $ "raco setup -nDKxiI --no-foreign-libs")
(with-fake-root (with-fake-root
(parameterize ([current-directory test-directory]) (parameterize ([current-directory test-directory])
(sync-test-directory)
(t))))))) (t)))))))
(define-syntax-rule (shelly-install** message pkg rm-pkg (pre ...) (more ...)) (define-syntax-rule (shelly-install** message pkg rm-pkg (pre ...) (more ...))

15
pkgs/racket-test/tests/racket/old-make-zo.rkt
View File

@ -1,7 +1,14 @@
#lang racket #lang racket/base
(require setup/dirs) (require setup/dirs
racket/path
racket/file
racket/system)
(define src (collection-file-path "old-make-zo.rkt" "tests" "racket")) (define orig-src (collection-file-path "old-make-zo.rkt" "tests" "racket"))
(define tmp-dir (make-temporary-file "old-zo~a" 'directory))
(define src (build-path tmp-dir (file-name-from-path orig-src)))
(copy-file orig-src src)
(define (exe s) (define (exe s)
(if (eq? (system-type) 'windows) (if (eq? (system-type) 'windows)
@ -28,3 +35,5 @@
"make" "make"
"--no-deps" "--no-deps"
(path->string src))) (path->string src)))
(delete-directory/files tmp-dir)