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

meta/pkg-build: check dependency declarations

Browse Source 
Uses `raco setup --check=pkg-deps --pkgs <pkg>`.
This commit is contained in:
Matthew Flatt 2014-07-07 14:44:56 +01:00
parent e62f1cb8d9
commit 6d7edf452d
1 changed files with 73 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
pkgs/plt-services/meta/pkg-build/main.rkt
View File

@ -38,9 +38,15 @@
;; - build without special system libraries (i.e., beyond the ones ;; - build without special system libraries (i.e., beyond the ones
;; needed by `racket/draw`) ;; needed by `racket/draw`)
;; ;;
;; FIXME: ;; A successful build not not require that its declaraed dependencies
;; - check that declared dependencies are right ;; are complete if the needed packages end up installed, anyway, but
;; - run tests ;; the declaraed dependencies are checked.
;;
;; Even when a build is unsuccessful, any documentation that is built
;; along the way is extracted, if possible.
;;
;; To do:
;; - support for running tests
(struct vm (name host user dir init-snapshot installed-snapshot)) (struct vm (name host user dir init-snapshot installed-snapshot))
@ -88,15 +94,18 @@
;; ;;
;; "server/built" --- built packages ;; "server/built" --- built packages
;; For a package P: ;; For a package P:
;; * pkgs/P.orig-CHECKSUM matching archived catalog ;; * "pkgs/P.orig-CHECKSUM" matching archived catalog
;; + pkgs/P.zip ;; + "pkgs/P.zip"
;; + P.zip.CHECKSUM ;; + "P.zip.CHECKSUM"
;; => up-to-date and successful, ;; => up-to-date and successful,
;; docs/P-adds.rktd listing of docs, exes, etc., and ;; "docs/P-adds.rktd" listing of docs, exes, etc., and
;; success/P records success ;; "success/P" records success;
;; "install/P" records installation
;; "deps/P" record dependency-checking failure;
;; * pkgs/P.orig-CHECKSUM matching archived catalog ;; * pkgs/P.orig-CHECKSUM matching archived catalog
;; + fail/P ;; + fail/P
;; => up-to-date and failed ;; => up-to-date and failed;
;; "install/P" may record installation success
;; ;;
;; "dumpster" --- saved builds of failed packages if the ;; "dumpster" --- saved builds of failed packages if the
;; package at least installs; maybe the attempt built ;; package at least installs; maybe the attempt built
@ -158,6 +167,8 @@
(define built-catalog-dir (build-path built-dir "catalog")) (define built-catalog-dir (build-path built-dir "catalog"))
(define fail-dir (build-path built-dir "fail")) (define fail-dir (build-path built-dir "fail"))
(define success-dir (build-path built-dir "success")) (define success-dir (build-path built-dir "success"))
(define install-success-dir (build-path built-dir "install"))
(define deps-fail-dir (build-path built-dir "deps"))
(define dumpster-dir (build-path work-dir "dumpster")) (define dumpster-dir (build-path work-dir "dumpster"))
(define dumpster-pkgs-dir (build-path dumpster-dir "pkgs/")) (define dumpster-pkgs-dir (build-path dumpster-dir "pkgs/"))
@ -219,12 +230,14 @@
(define (ssh vm (define (ssh vm
#:mode [mode 'auto] #:mode [mode 'auto]
#:failure-dest [failure-dest #f] #:failure-dest [failure-dest #f]
#:success-dest [success-dest #f]
. args) . args)
(define cmd (define cmd
(list "/usr/bin/env" (~a "PLTUSERHOME=" (vm-dir vm) "/user") (list "/usr/bin/env" (~a "PLTUSERHOME=" (vm-dir vm) "/user")
"/bin/sh" "-c" (apply ~a args))) "/bin/sh" "-c" (apply ~a args)))
(define saved (and failure-dest (open-output-bytes))) (define saved (and (or failure-dest success-dest)
(open-output-bytes)))
(define (tee o1 o2) (define (tee o1 o2)
(cond (cond
[(not o1) [(not o1)
@ -275,11 +288,12 @@
(kill-thread timeout-thread))))) (kill-thread timeout-thread)))))
(sync-out) (sync-out)
(sync-err) (sync-err)
(when (and failure-dest (not ok?)) (let ([dest (if ok? success-dest failure-dest)])
(call-with-output-file* (when dest
failure-dest (call-with-output-file*
#:exists 'truncate/replace dest
(lambda (o) (write-bytes (get-output-bytes saved) o)))) #:exists 'truncate/replace
(lambda (o) (write-bytes (get-output-bytes saved) o)))))
(case mode (case mode
[(result) ok?] [(result) ok?]
[else [else
@ -635,6 +649,8 @@
(make-directory* (build-path built-dir "adds")) (make-directory* (build-path built-dir "adds"))
(make-directory* fail-dir) (make-directory* fail-dir)
(make-directory* success-dir) (make-directory* success-dir)
(make-directory* install-success-dir)
(make-directory* deps-fail-dir)
(make-directory* dumpster-pkgs-dir) (make-directory* dumpster-pkgs-dir)
(make-directory* dumpster-adds-dir) (make-directory* dumpster-adds-dir)
@ -670,9 +686,14 @@
(show-list pkgs))) (show-list pkgs)))
(define failure-dest (and one-pkg (define failure-dest (and one-pkg
(pkg-failure-dest (if (list? one-pkg) (pkg-failure-dest (car flat-pkgs))))
(car one-pkg) (define install-success-dest (build-path install-success-dir
one-pkg)))) (car flat-pkgs)))
(define (pkg-deps-failure-dest pkg)
(build-path deps-fail-dir pkg))
(define deps-failure-dest (and one-pkg
(pkg-deps-failure-dest (car flat-pkgs))))
(define (save-checksum pkg) (define (save-checksum pkg)
(call-with-output-file* (call-with-output-file*
@ -682,6 +703,10 @@
(define remote-dir (vm-dir vm)) (define remote-dir (vm-dir vm))
(for ([pkg (in-list flat-pkgs)])
(define f (build-path install-success-dir pkg))
(when (file-exists? f) (delete-file f)))
(restore-vbox-snapshot (vm-name vm) (vm-installed-snapshot vm)) (restore-vbox-snapshot (vm-name vm) (vm-installed-snapshot vm))
(start-vbox-vm (vm-name vm) #:max-vms (length vms)) (start-vbox-vm (vm-name vm) #:max-vms (length vms))
(dynamic-wind (dynamic-wind
@ -689,12 +714,19 @@
(lambda () (lambda ()
(define ok? (define ok?
(and (and
;; Try to install:
(ssh vm (cd-racket vm) (ssh vm (cd-racket vm)
" && bin/raco pkg install -u --auto" " && bin/raco pkg install -u --auto"
(if one-pkg "" " --fail-fast") (if one-pkg "" " --fail-fast")
" " pkgs-str " " pkgs-str
#:mode 'result #:mode 'result
#:failure-dest failure-dest) #:failure-dest failure-dest
#:success-dest install-success-dest)
;; Copy success log for other packages in the group:
(for ([pkg (in-list (cdr flat-pkgs))])
(copy-file install-success-dest
(build-path install-success-dir pkg)
#t))
(let () (let ()
;; Make sure that any extra installed packages used were previously ;; Make sure that any extra installed packages used were previously
;; built, since we want built packages to be consistent with a binary ;; built, since we want built packages to be consistent with a binary
@ -712,10 +744,22 @@
(file-exists? (build-path built-catalog-dir "pkg" pkg)) (file-exists? (build-path built-catalog-dir "pkg" pkg))
(complain failure-dest (complain failure-dest
(~a "use of package not previously built: ~s;\n" (~a "use of package not previously built: ~s;\n"
" maybe a dependency is missing, maybe the package\n" " maybe a dependency is missing, or maybe the package\n"
" failed to build on its own, or maybe there's a\n" " failed to build on its own\n")
" dependency cycle that is not currently handled\n")
pkg)))))) pkg))))))
(define deps-ok?
(and ok?
(ssh vm (cd-racket vm)
" && bin/raco setup -nxiID --check-pkg-deps --pkgs "
" " pkgs-str
#:mode 'result
#:failure-dest deps-failure-dest)))
(when (and ok? one-pkg (not deps-ok?))
;; Copy dependency-failure log for other packages in the group:
(for ([pkg (in-list (cdr flat-pkgs))])
(copy-file install-success-dest
(pkg-deps-failure-dest pkg)
#t)))
(define doc-ok? (define doc-ok?
(and (and
;; If we're building a single package (or set of mutually ;; If we're building a single package (or set of mutually
@ -735,23 +779,26 @@
#:mode 'result #:mode 'result
#:failure-dest (and ok? failure-dest))))) #:failure-dest (and ok? failure-dest)))))
(cond (cond
[(and ok? doc-ok?) [(and ok? doc-ok? (or deps-ok? one-pkg))
(for ([pkg (in-list flat-pkgs)]) (for ([pkg (in-list flat-pkgs)])
(when (file-exists? (pkg-failure-dest pkg)) (when (file-exists? (pkg-failure-dest pkg))
(delete-file (pkg-failure-dest pkg))) (delete-file (pkg-failure-dest pkg)))
(when (and deps-ok? (file-exists? (pkg-deps-failure-dest pkg)))
(delete-file (pkg-deps-failure-dest pkg)))
(scp vm (at-vm vm (~a remote-dir "/built/" pkg ".zip")) (scp vm (at-vm vm (~a remote-dir "/built/" pkg ".zip"))
built-pkgs-dir) built-pkgs-dir)
(scp vm (at-vm vm (~a remote-dir "/built/" pkg ".zip.CHECKSUM")) (scp vm (at-vm vm (~a remote-dir "/built/" pkg ".zip.CHECKSUM"))
built-pkgs-dir) built-pkgs-dir)
(scp vm (at-vm vm (~a remote-dir "/pkg-adds.rktd")) (scp vm (at-vm vm (~a remote-dir "/pkg-adds.rktd"))
(build-path built-dir "adds" (format "~a-adds.rktd" pkg))) (build-path built-dir "adds" (format "~a-adds.rktd" pkg)))
(define deps-msg (if deps-ok? "" ", but problems with dependency declarations"))
(call-with-output-file* (call-with-output-file*
(build-path success-dir pkg) (build-path success-dir pkg)
#:exists 'truncate/replace #:exists 'truncate/replace
(lambda (o) (lambda (o)
(if one-pkg (if one-pkg
(fprintf o "success\n") (fprintf o "success~a\n" deps-msg)
(fprintf o "success with ~s\n" pkgs)))) (fprintf o "success with ~s~a\n" pkgs deps-msg))))
(save-checksum pkg)) (save-checksum pkg))
(update-built-catalog flat-pkgs)] (update-built-catalog flat-pkgs)]
[else [else
@ -939,7 +986,7 @@
(cons k v))) (cons k v)))
(cond (cond
[(null? conflicts) [(null? conflicts)
doc-pkgs] (set->list (hash-keys doc-pkgs))]
[else [else
(substatus "Install conflicts:\n") (substatus "Install conflicts:\n")
(for ([v (in-list conflicts)]) (for ([v (in-list conflicts)])