raco pkg tests: adjust to make tests less dependent on installation

In particular, instead of relying on the default scope as "user"
set up an installation with an indirection that configures the
scope to "user".
This commit is contained in:
Matthew Flatt 2013-09-17 12:49:18 -06:00
parent b2f76bd8cc
commit ad437eee46
2 changed files with 10 additions and 13 deletions

View File

@ -29,14 +29,6 @@
(shelly-case "All tests" (shelly-case "All tests"
(for-each (λ (x) (x)) l))))) (for-each (λ (x) (x)) l)))))
(let ([v (getenv "PLT_PKG_NOSETUP")])
(unless (and v (not (string=? v "")))
(error "Set the PLT_PKG_NOSETUP environment variable before running these tests\n")))
(unless (equal? "user\n" (with-output-to-string
(lambda () (pkg-config-command #:installation #t "default-scope"))))
(error "Run this test suite with `user' default package scope"))
(run-tests (run-tests
"name" "name"
"basic" "create" "install" "permissions" "basic" "create" "install" "permissions"

View File

@ -21,7 +21,7 @@
(and (file-exists? p) (and (file-exists? p)
p)) p))
(define (with-fake-installation* t) (define (with-fake-installation* t #:default-scope [default-scope "installation"])
(define tmp-dir (define tmp-dir
(make-temporary-file ".racket.fake-installation~a" 'directory (make-temporary-file ".racket.fake-installation~a" 'directory
(find-system-path 'temp-dir))) (find-system-path 'temp-dir)))
@ -41,7 +41,7 @@
"test" "test"
'default-scope 'default-scope
"installation" default-scope
;; Find existing links and packages from the ;; Find existing links and packages from the
;; old configuration: ;; old configuration:
@ -150,10 +150,15 @@
(run-pkg-tests* run-pkg-tests)))))])) (run-pkg-tests* run-pkg-tests)))))]))
(define (run-pkg-tests* t) (define (run-pkg-tests* t)
(putenv "PLT_PKG_NOSETUP" "y")
(with-servers (with-servers
(with-fake-installation*
#:default-scope "user"
(lambda ()
(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])
(t))))) (t)))))))
(define-syntax-rule (shelly-install** message pkg rm-pkg (pre ...) (more ...)) (define-syntax-rule (shelly-install** message pkg rm-pkg (pre ...) (more ...))
(with-fake-root (with-fake-root