284 lines
12 KiB
Racket
284 lines
12 KiB
Racket
#lang racket/base
|
|
(require "shelly.rkt"
|
|
"util.rkt"
|
|
racket/file
|
|
file/unzip)
|
|
|
|
(this-test-is-run-by-the-main-test)
|
|
|
|
(pkg-tests
|
|
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-x/" =exit> 1
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-y/" =exit> 1
|
|
$ "raco pkg install --deps fail --copt test-pkgs/pkg-x/ test-pkgs/pkg-z/" =exit> 1
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-y/ test-pkgs/pkg-z/" =exit> 1
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-x/ test-pkgs/pkg-y/" =exit> 1
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-y/ test-pkgs/pkg-x/" =exit> 1
|
|
|
|
$ "raco pkg install --deps fail --copy test-pkgs/pkg-z/" =exit> 0
|
|
|
|
(putenv "PLT_PKG_NOSETUP" "")
|
|
$ "raco pkg install --copy test-pkgs/pkg-x/ test-pkgs/pkg-y/"
|
|
(putenv "PLT_PKG_NOSETUP" "1")
|
|
|
|
$ "racket -l racket/base -l x -e '(x)'" =stdout> "'x\n"
|
|
$ "racket -l racket/base -l y -e '(y)'" =stdout> "'y\n"
|
|
$ "racket -l racket/base -l y/sub/s -e '(s)'" =stdout> "'s\n"
|
|
|
|
$ "racket -l racket/base -e '(require (submod x test))'"
|
|
$ "racket -l racket/base -e '(require (submod y/other doc))'"
|
|
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-x #t)'" =stderr> ""
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" =stderr> ""
|
|
|
|
(make-directory* "test-pkgs/src-pkgs")
|
|
(make-directory* "test-pkgs/built-pkgs")
|
|
(make-directory* "test-pkgs/binary-lib-pkgs")
|
|
$ "raco pkg create --from-install --source --dest test-pkgs/src-pkgs pkg-x"
|
|
$ "raco pkg create --from-install --source --dest test-pkgs/src-pkgs pkg-y"
|
|
$ "raco pkg create --from-install --source --dest test-pkgs/src-pkgs pkg-z"
|
|
|
|
$ "raco pkg create --from-install --binary --dest test-pkgs pkg-x"
|
|
$ "raco pkg create --from-install --binary --dest test-pkgs pkg-y"
|
|
$ "raco pkg create --from-install --binary --dest test-pkgs pkg-z"
|
|
|
|
$ "raco pkg create --from-install --binary-lib --dest test-pkgs/binary-lib-pkgs pkg-x"
|
|
$ "raco pkg create --from-install --binary-lib --dest test-pkgs/binary-lib-pkgs pkg-y"
|
|
$ "raco pkg create --from-install --binary-lib --dest test-pkgs/binary-lib-pkgs pkg-z"
|
|
|
|
$ "raco pkg create --from-install --built --dest test-pkgs/built-pkgs pkg-x"
|
|
$ "raco pkg create --from-install --built --dest test-pkgs/built-pkgs pkg-y"
|
|
$ "raco pkg create --from-install --built --dest test-pkgs/built-pkgs pkg-z"
|
|
|
|
(putenv "PLT_PKG_NOSETUP" "")
|
|
$ "raco pkg remove pkg-x pkg-y pkg-z"
|
|
(putenv "PLT_PKG_NOSETUP" "1")
|
|
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-x #f)'" =stderr> ""
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #f)'" =stderr> ""
|
|
|
|
(define tmp-dir (make-temporary-file "unpack-~a" 'directory))
|
|
|
|
(shelly-case
|
|
"check content of source package"
|
|
(make-directory* tmp-dir)
|
|
(define (unpack name)
|
|
(define orig-d (current-directory))
|
|
(let ([z (path->complete-path (format "test-pkgs/src-pkgs/pkg-~a.zip" name))])
|
|
(define d (build-path tmp-dir name))
|
|
(make-directory* d)
|
|
(parameterize ([current-directory d])
|
|
(unzip z)
|
|
(for ([f (in-directory)])
|
|
(define orig-f (build-path orig-d (format "test-pkgs/pkg-~a" name) f))
|
|
(unless (if (file-exists? f)
|
|
(file-exists? orig-f)
|
|
(directory-exists? orig-f))
|
|
(error 'diff "extra ~s" f))
|
|
(when (file-exists? f)
|
|
(unless (equal? (file->bytes f)
|
|
(file->bytes orig-f))
|
|
(error 'diff "file differs ~s" f)))))
|
|
(parameterize ([current-directory (format "test-pkgs/pkg-~a" name)])
|
|
(for ([f (in-directory)])
|
|
(define new-f (build-path d f))
|
|
(unless (if (file-exists? f)
|
|
(file-exists? new-f)
|
|
(directory-exists? new-f))
|
|
(unless (or (regexp-match? #rx#"nosrc" f)
|
|
(and (regexp-match? #rx#"keep2" f)
|
|
(regexp-match? #rx#"doc" f)))
|
|
(error 'diff "missing ~s" new-f)))))))
|
|
(unpack "x")
|
|
(unpack "y")
|
|
(unpack "z")
|
|
(delete-directory/files tmp-dir))
|
|
|
|
(shelly-case
|
|
"check content of binary package"
|
|
(make-directory* tmp-dir)
|
|
(define (unpack-bin name lib?)
|
|
(let ([z (path->complete-path (format "test-pkgs/~apkg-~a.zip"
|
|
(if lib? "binary-lib-pkgs/" "")
|
|
name))])
|
|
(define d (build-path tmp-dir name))
|
|
(delete-directory/files d #:must-exist? #f)
|
|
(make-directory* d)
|
|
(parameterize ([current-directory d])
|
|
(unzip z)
|
|
(for ([f (in-directory)])
|
|
(when (or (and (regexp-match? #rx#"(?:[.](?:rkt|scrbl|dep)|_scrbl[.]zo)$" f)
|
|
(not (regexp-match? #rx#"(?:info_rkt[.]dep)$" f)))
|
|
(and (regexp-match? #rx#"nobin" f)
|
|
(or lib?
|
|
(not (regexp-match? #rx#"nobinlib" f)))))
|
|
(unless (regexp-match? #rx#"(?:info[.]rkt|keep.scrbl)$" f)
|
|
(error (if lib? 'binary-lib 'binary) "extra ~s" f)))
|
|
(when lib?
|
|
(when (and (regexp-match? #rx#"doc$" f)
|
|
(not (regexp-match? #rx#"keep2" f)))
|
|
(error 'binary-lib "extra ~s" f)))
|
|
(when (regexp-match? #rx#"(?:info[.]rkt|info_rkt.zo)$" f)
|
|
(parameterize ([current-namespace (make-base-namespace)])
|
|
(define i (dynamic-require f '#%info-lookup))
|
|
(for ([key '(implies update-implies)])
|
|
(define implies (i key (lambda () null)))
|
|
(define deps (map (lambda (p) (if (pair? p) (car p) p))
|
|
(i 'deps (lambda () null))))
|
|
(for ([s (in-list implies)])
|
|
(unless (member s deps)
|
|
(error 'binary "bad `~a'" key))))))))))
|
|
(unpack-bin "x" #f)
|
|
(unpack-bin "y" #f)
|
|
(unpack-bin "z" #f)
|
|
(unpack-bin "x" #t)
|
|
(unpack-bin "y" #t)
|
|
(unpack-bin "z" #t)
|
|
(delete-directory/files tmp-dir))
|
|
|
|
(shelly-case
|
|
"check content of built package"
|
|
(make-directory* tmp-dir)
|
|
(define (unpack-built name)
|
|
(let ([src (path->complete-path (format "test-pkgs/src-pkgs/pkg-~a.zip" name))]
|
|
[bin (path->complete-path (format "test-pkgs/pkg-~a.zip" name))]
|
|
[blt (path->complete-path (format "test-pkgs/built-pkgs/pkg-~a.zip" name))])
|
|
(define compiled-dir (let ([l (use-compiled-file-paths)])
|
|
(if (null? l)
|
|
(string->path-element "compiled")
|
|
(car l))))
|
|
(define sd (build-path tmp-dir name "src"))
|
|
(define bd (build-path tmp-dir name "bin"))
|
|
(define td (build-path tmp-dir name "blt"))
|
|
(make-directory* sd)
|
|
(make-directory* bd)
|
|
(make-directory* td)
|
|
(parameterize ([current-directory sd])
|
|
(unzip src))
|
|
(parameterize ([current-directory bd])
|
|
(unzip bin))
|
|
(parameterize ([current-directory td])
|
|
(unzip blt)
|
|
(for ([f (in-directory)])
|
|
(when (file-exists? f)
|
|
(unless (or (file-exists? (build-path sd f))
|
|
(file-exists? (build-path bd f)))
|
|
(unless (regexp-match? #rx#"(?:[.](?:dep)|_scrbl[.]zo)$" f)
|
|
(error 'built "extra ~s" f))))
|
|
(when (regexp-match? #rx#"[.]zo$" f)
|
|
(unless (file-exists? (path-replace-suffix f #".dep"))
|
|
(error 'build "dep missing for ~s" f)))
|
|
(when (regexp-match? #rx#"[.](rkt|scrbl|ss)$" f)
|
|
(let-values ([(base name dir?) (split-path f)])
|
|
(unless (file-exists? (build-path (if (eq? base 'relative) 'same base)
|
|
compiled-dir
|
|
(path-add-suffix name #".zo")))
|
|
(unless (regexp-match? #rx#"^(?:info.rkt|x/keep.scrbl)$" f)
|
|
(error 'build "compiled file missing for ~s" f)))))))
|
|
(parameterize ([current-directory sd])
|
|
(for ([f (in-directory)])
|
|
(when (file-exists? f)
|
|
(unless (file-exists? (build-path td f))
|
|
(error 'built "missing source ~s" f)))))
|
|
(parameterize ([current-directory bd])
|
|
(define (extra-info? p)
|
|
;; A binary package can have extra "info.rkt" files in collections
|
|
;; to set `assume-virtual-sources` to #t.
|
|
(let-values ([(base name dir?) (split-path p)])
|
|
(define s (path->string name))
|
|
(and (or (equal? "info.rkt" s)
|
|
(equal? "info_rkt.zo" s)
|
|
(equal? "info_rkt.dep" s))
|
|
(or (eq? base 'relative)
|
|
(and (path? base)
|
|
(let-values ([(base name dir?) (split-path base)])
|
|
(or (eq? base 'relative)
|
|
(let loop ([elems (explode-path compiled-dir)] [name name] [base base])
|
|
(and (path? name)
|
|
(cond
|
|
[(eq? base 'relative) #t]
|
|
[(null? elems) #f]
|
|
[(equal? (path->string name) (path->string compiled-dir))
|
|
(let-values ([(base name dir?) (split-path base)])
|
|
(loop (cdr elems) name base))]))))))))))
|
|
(for ([f (in-directory)])
|
|
(when (file-exists? f)
|
|
(unless (file-exists? (build-path td f))
|
|
(unless (extra-info? f)
|
|
(error 'built "missing binary ~s" f))))))))
|
|
(unpack-built "x")
|
|
(unpack-built "y")
|
|
(unpack-built "z")
|
|
(delete-directory/files tmp-dir))
|
|
|
|
(shelly-case
|
|
"source-package dependencies like original"
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-x.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-y.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-x.zip test-pkgs/src-pkgs/pkg-z.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-y.zip test-pkgs/src-pkgs/pkg-z.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-x.zip test-pkgs/src-pkgs/pkg-y.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/src-pkgs/pkg-y.zip test-pkgs/src-pkgs/pkg-x.zip" =exit> 1)
|
|
|
|
(shelly-case
|
|
"binary-package dependencies are less"
|
|
$ "raco pkg install --deps fail test-pkgs/pkg-x.zip" =exit> 1
|
|
|
|
$ "raco pkg install --deps fail test-pkgs/pkg-x.zip test-pkgs/pkg-z.zip"
|
|
$ "raco pkg remove pkg-x pkg-z"
|
|
$ "raco pkg install --deps fail test-pkgs/pkg-y.zip"
|
|
$ "raco pkg remove pkg-y")
|
|
|
|
(putenv "PLT_PKG_NOSETUP" "")
|
|
$ "raco pkg install --deps fail test-pkgs/pkg-y.zip"
|
|
(putenv "PLT_PKG_NOSETUP" "1")
|
|
|
|
$ "racket -l racket/base -l y -e '(y)'" =stdout> "'y\n"
|
|
$ "racket -l racket/base -l y/sub/s -e '(s)'" =stdout> "'s\n"
|
|
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-x #f)'" =stderr> ""
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" =stderr> ""
|
|
|
|
$ "racket -l racket/base -e '(require (submod x test))'" =exit> 1
|
|
$ "racket -l racket/base -e '(require (submod y/other doc))'" =exit> 1
|
|
|
|
(shelly-case
|
|
"check that cleaning doesn't destroy a binary install"
|
|
$ "racket -l y"
|
|
$ "raco setup -c -l y"
|
|
$ "racket -l y")
|
|
|
|
(putenv "PLT_PKG_NOSETUP" "")
|
|
$ "raco pkg remove pkg-y"
|
|
(putenv "PLT_PKG_NOSETUP" "1")
|
|
|
|
$ "raco pkg install --deps fail test-pkgs/built-pkgs/pkg-x.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/built-pkgs/pkg-y.zip" =exit> 1
|
|
$ "raco pkg install --deps fail test-pkgs/built-pkgs/pkg-x.zip test-pkgs/built-pkgs/pkg-z.zip" =exit> 1
|
|
|
|
(putenv "PLT_PKG_NOSETUP" "")
|
|
$ "raco pkg install --deps fail test-pkgs/built-pkgs/pkg-x.zip test-pkgs/built-pkgs/pkg-y.zip test-pkgs/built-pkgs/pkg-z.zip"
|
|
=stdout> #rx"syncing: [^\n]*x\n[^\n]*syncing: [^\n]*y"
|
|
(putenv "PLT_PKG_NOSETUP" "1")
|
|
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-x #t)'" =stderr> ""
|
|
$ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" =stderr> ""
|
|
$ "racket -l racket/base -l x -e '(x)'" =stdout> "'x\n"
|
|
$ "racket -l racket/base -l y -e '(y)'" =stdout> "'y\n"
|
|
$ "racket -l racket/base -l y/sub/s -e '(s)'" =stdout> "'s\n"
|
|
|
|
$ "raco pkg remove pkg-x pkg-y pkg-z"
|
|
|
|
(shelly-case
|
|
"incompatible conversion request rejected"
|
|
$ "raco pkg install --binary test-pkgs/src-pkgs/pkg-z.zip"
|
|
=exit> 1 =stderr> #rx"not compatible"
|
|
$ "raco pkg install --binary-lib test-pkgs/src-pkgs/pkg-z.zip"
|
|
=exit> 1 =stderr> #rx"not compatible"
|
|
$ "raco pkg install --source test-pkgs/pkg-z.zip"
|
|
=exit> 1 =stderr> #rx"not compatible"
|
|
$ "raco pkg install --source test-pkgs/binary-lib-pkgs/pkg-z.zip"
|
|
=exit> 1 =stderr> #rx"not compatible")
|
|
|
|
)
|