From 70caf5f509f986297e58d372907e7c12605d9510 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 22 May 2013 13:34:43 -0600 Subject: [PATCH] raco pkg create, raco setup: add support for built (source+binary) packages This change removes `rendered-scribblings' as a recognized "info.rkt" definition (which was added for binary packages, but now `scribblings' serves both roles). The `raco setup' changes involve support for moving pre-rendered documentation into place (where "moving" may actually mean leaving it in place but updating the "local-redirect.js" path), but also allowing documentation to be re-rendered. --- collects/pkg/lib.rkt | 13 +- collects/pkg/main.rkt | 2 + collects/pkg/scribblings/pkg.scrbl | 52 ++--- collects/pkg/scribblings/strip.scrbl | 161 ++++++++++++++++ collects/pkg/strip.rkt | 88 +++++---- collects/scribblings/raco/setup.scrbl | 11 +- collects/setup/private/cc-struct.rkt | 2 +- collects/setup/scribble.rkt | 78 ++++---- collects/setup/setup-unit.rkt | 24 ++- collects/tests/pkg/test-pkgs/.gitignore | 3 +- .../tests/pkg/test-pkgs/pkg-y/y/sub/s.rkt | 3 + collects/tests/pkg/tests-binary.rkt | 177 +++++++++++++----- 12 files changed, 440 insertions(+), 174 deletions(-) create mode 100644 collects/pkg/scribblings/strip.scrbl create mode 100644 collects/tests/pkg/test-pkgs/pkg-y/y/sub/s.rkt diff --git a/collects/pkg/lib.rkt b/collects/pkg/lib.rkt index 0162afb779..31d31a10fb 100644 --- a/collects/pkg/lib.rkt +++ b/collects/pkg/lib.rkt @@ -1509,7 +1509,7 @@ (lambda () (define dest-dir (build-path tmp-dir name)) (make-directory dest-dir) - (generate-stripped-directory (eq? mode 'binary) dir dest-dir) + (generate-stripped-directory mode dir dest-dir) (create-as-is create:format name dest-dir dir #:hide-src? #t #:quiet? quiet? @@ -1549,11 +1549,10 @@ [(as-is) (create-as-is create:format pkg-name dir dir #:dest dest-dir #:quiet? quiet?)] - [(source binary) (stripped-create mode pkg-name dir - #:dest dest-dir - #:format create:format - #:quiet? quiet?)])) - + [else (stripped-create mode pkg-name dir + #:dest dest-dir + #:format create:format + #:quiet? quiet?)])) (define (pkg-catalog-copy srcs dest #:from-config? [from-config? #f] @@ -2012,7 +2011,7 @@ (->* ((or/c 'zip 'tgz 'plt 'MANIFEST) path-string?) (#:source (or/c 'dir 'name) - #:mode (or/c 'as-is 'source 'binary) + #:mode (or/c 'as-is 'source 'binary 'built) #:quiet? boolean? #:dest (or/c (and/c path-string? complete-path?) #f)) void?)] diff --git a/collects/pkg/main.rkt b/collects/pkg/main.rkt index 81d7f549cf..685e6ce165 100644 --- a/collects/pkg/main.rkt +++ b/collects/pkg/main.rkt @@ -208,6 +208,7 @@ [#:bool as-is () "Bundle the directory/package as-is (the default)"] [#:bool source () "Bundle sources only"] [#:bool binary () "Bundle bytecode and rendered documentation without sources"] + [#:bool built () "Bundle sources, bytecode and rendered documentation"] #:once-each [(#:str dest-dir #f) dest () "Create output files in "] #:args (directory-or-package) @@ -222,6 +223,7 @@ #:mode (cond [source 'source] [binary 'binary] + [built 'built] [else 'as-is])))] [config "View and modify the package manager's configuration" diff --git a/collects/pkg/scribblings/pkg.scrbl b/collects/pkg/scribblings/pkg.scrbl index bbaa0684d6..2b4c80bc33 100644 --- a/collects/pkg/scribblings/pkg.scrbl +++ b/collects/pkg/scribblings/pkg.scrbl @@ -364,10 +364,10 @@ removing any of the @nonterm{pkg}s. GitHub repository or other non-archive formats. The @exec{create} sub-command can create an archive from a directory (the default) or from an installed package. It can also adjust the archive's content - to include only sources (which is the recommended mode, although not - the default) or as a ``binary'' package (but packages are + to include only sources, only compiled bytecode and rendered documentation, + or both---but packages are normally provided as source and converted to binary form by an - automatic service, instead of by a package author). + automatic service, instead of by a package author. The @exec{create} sub-command accepts the following @nonterm{option}s: @@ -382,34 +382,11 @@ removing any of the @nonterm{pkg}s. @item{@DFlag{manifest} --- Creates a manifest file for a directory, rather than an archive.} @item{@DFlag{as-is} --- Bundle all content of the package directory as is, with no filtering of sources, compiled files, or repository elements.} - @item{@DFlag{source} --- Bundle only sources in the package directory, pruning (by default) - @filepath{compiled} directories (that normally hold compiled - bytecode), @filepath{doc} directories (that normally hold rendered documentation), - directories named @filepath{.svn}, directories and files whose names start with @filepath{.git}, - and files whose name ends with @litchar{~} or starts and ends with @litchar{#}. - Override the default pruning rules with @racket[source-omit-files] and/or - @racket[source-keep-files] definitions in @filepath{info.rkt} files within the - package directory.} + @item{@DFlag{source} --- Bundle only sources in the package directory; see @secref["strip"].} @item{@DFlag{binary} --- Bundle compiled bytecode and rendered - documentation in the package directory. Normally, this option is sensible for - a package that is installed from source in a user-specific scope. Bundling prunes (by default) - @filepath{.rkt} and @filepath{.ss} files for which compiled bytecode is present, files with - a @filepath{.scrbl} suffix and their compiled files, files with a @filepath{.dep} suffix, - @filepath{tests} directories, @filepath{scribblings} - directories, @filepath{.svn} directories, directories and files whose names - start with @filepath{.git}, and files whose name ends with @litchar{~} or starts and ends - with @litchar{#}. For each @filepath{.zo} file, submodules named @racketidfont{test}, - @racketidfont{doc}, or @racketidfont{srcdoc} are removed. For each @filepath{.html} file that - refers to a @filepath{local-redirect.js} script, the path to the script is removed. - In addition, bundling updates any @filepath{info.rkt} as follows: it - adds a @racket[assume-virtual-sources] entry, - converts a @racket[scribblings] entry to a @racket[rendered-scribblings] entry, - changes a @racket[copy-foreign-libs] entry to a @racket[move-foreign-libs] entry, - changes a @racket[copy-man-pages] entry to a @racket[move-man-pages] entry, - and removes any @racket[build-deps] entry. Override - the default pruning rules with @racket[binary-omit-files] - and/or @racket[binary-keep-files] definitions in - @filepath{info.rkt} files within the package directory.} + documentation in the package directory; see @secref["strip"].} + @item{@DFlag{built} --- Bundle compiled sources, bytecode, and rendered + documentation in the package directory, filtering repository elements; see @secref["strip"].} @item{@DFlag{dest} @nonterm{dest-dir} --- Writes generated bundles to @nonterm{dest-dir}.} ] } @@ -751,11 +728,12 @@ The following @filepath{info.rkt} fields are used by the package manager: on the version of the Racket installation.} @item{@racketidfont{build-deps} --- like @racketidfont{deps}, but for - dependencies that can be dropped in a ``binary'' variant of the - package that does not include sources. The - @racketidfont{build-deps} and @racketidfont{deps} lists are appended, - while @command-ref["create"] strips away @racketidfont{build-deps} - when converting a package for @DFlag{binary} mode.} + dependencies that can be dropped in a @tech{binary package}, + which does not include sources; see @secref["strip"]. The + @racketidfont{build-deps} and @racketidfont{deps} lists are + appended, while @command-ref["create"] strips away + @racketidfont{build-deps} when converting a package for + @DFlag{binary} mode.} @item{@racketidfont{setup-collects} --- a list of path strings and/or lists of path strings, which are used as collection names to @@ -769,6 +747,10 @@ The following @filepath{info.rkt} fields are used by the package manager: @; ---------------------------------------- +@include-section["strip.scrbl"] + +@; ---------------------------------------- + @section{@|Planet1| Compatibility} PLT maintains a @tech{package catalog} to serve packages that diff --git a/collects/pkg/scribblings/strip.scrbl b/collects/pkg/scribblings/strip.scrbl new file mode 100644 index 0000000000..bde6987eb7 --- /dev/null +++ b/collects/pkg/scribblings/strip.scrbl @@ -0,0 +1,161 @@ +#lang scribble/manual +@(require "common.rkt" + (for-label pkg/strip)) + +@title[#:tag "strip"]{Source, Binary, and Built Packages} + +A package, especially in a repository format, normally provides module +implementations and documentation in source form. Such @deftech{source +packages} can work with multiple Racket versions, and modules are +compiled to bytecode and documentation is rendered when the package is +installed. + +A @deftech{binary package} provides only compiled bytecode and +rendered documentation, instead of package and documentation +sources. Since compiled bytecode is specific to a version of Racket, a +@tech{binary package} is specific to a version of Racket. The benefit +of a binary package is that it can have less dependencies (e.g., on +Scribble to implement the documentation or on other +packages whose documentation is referenced) and it can install +faster. A drawback of a binary package is that it is version-specific +and the source code may be less immediately accessible to other +programmers. + +A @deftech{built package} combines source and compiled elements. A +@tech{built package} can be installed more quickly than source, as +long as it is installed for a suitable Racket version, but the source +remains available as a back-up for other programmers to consult or to +re-build for a different Racket version. + +A package is not specifically tagged as a @tech{source package}, +@tech{binary package}, or @tech{built package}. The different kinds of +packages are just conventions based on the content of the package. All +forms of packages can be mixed in an installation, and a package can +be updated from any form to any other form. + +Programmers normally supply only @tech{source packages}, while a +package catalog service may convert each source package to a +@tech{binary package} or @tech{built package}. Alternatively, +programmers can create @tech{binary packages} or @tech{built packages} +by using the @command-ref{create} subcommand with @DFlag{binary} or +@DFlag{built}. As a convenience, the @command-ref{create} subcommand +can also create a @tech{source package} from an installed package or +repository checkout, dropping repository elements (such as a +@filepath{.git} directory) and compiled code. Note that +@command-ref{create} by default bundles a package directory as-is, +with no filtering at all. + +Creating a @tech{source package}, @tech{binary package}, or +@tech{built package} from a directory or package installation prunes +the following files and directories: + +@itemlist[ + + @item{directories/files named @filepath{.svn};} + + @item{directories/files whose names start with @filepath{.git};} + + @item{directories/files whose names end with @filepath{~}; and} + + @item{directories/files whose names start and end with @filepath{#}.} + +] + +Any of the above can be suppressed, however, by a +@racket[source-keep-files] (for @tech{source package} and @tech{built +package} bundling) or @racket[binary-keep-files] (for @tech{binary +package} and @tech{built package} bundling) definition in an +@filepath{info.rkt} in the package or any subdirectory. A +@racket[binary-keep-files] or @racket[binary-keep-files] definition +should bind the name to a list of paths relative to the +@filepath{info.rkt} file. + +Creating a @tech{source package} prunes the following additional files +and directories: + +@itemlist[ + + @item{directories/files named @filepath{compiled};} + + @item{directories/files named @filepath{doc};} + + @item{directories/files named @filepath{synced.rktd}, which can appear + as a marker in rendered documentation;} + + @item{directories/files named in an @filepath{info.rkt} file's + @racket[source-omit-files] definition.} + +] + +Any of the above removals can be suppressed through +@racketidfont{source-keep-files}. + +Creating a @tech{binary package} prunes the following addition files +and directories: + +@itemlist[ + + @item{directories/files with names ending in @filepath{.rkt} or + @filepath{.ss} for which a corresponding compiled bytecode file is + present (in a @filepath{compiled} subdirectory);} + + @item{directories/files with names ending in @filepath{.scrbl}, + @filepath{_scrbl.zo}, or @filepath{.dep};} + + @item{directories/files named in an @filepath{info.rkt} file's + @racket[source-omit-files] definition.} + +] + +Any of the above removals can be suppressed through +@racketidfont{binary-keep-files}. + +Creating a @tech{binary package} further adjusts the following files: + +@itemlist[ + + @item{for any file whose name ends in @filepath{.zo}, submodules + named @racketidfont{test}, @racketidfont{doc}, or + @racketidfont{srcdoc} are removed;} + + @item{for each @filepath{.html} file that refers to a + @filepath{local-redirect.js} script, the path to the script is + removed; and} + + @item{each @filepath{info.rkt} is adjusted as follows: an + @racket[assume-virtual-sources] definition is added, any + @racket[copy-foreign-libs] definition is changed to + @racket[move-foreign-libs], any @racket[copy-man-pages] + definition is changed to @racket[move-man-pages] entry, and any + @racket[build-deps] definition is removed.} + +] + +Finally, creating a @tech{built package} removes any file or directory +that would be removed for a @tech{source package} and @tech{binary +package}, and it performs the @filepath{.html} file updating of a +@tech{binary package}. + +@defmodule[pkg/strip]{The @racketmodname[pkg/strip] module provides +support for copying a package-style directory to a given destination +with the same file/directory omissions and updates as +@command-ref{create}.} + +@defproc[(generate-stripped-directory [mode (or/c 'source 'binary 'built)] + [src-dir path-string?] + [dest-dir path-string?]) + void?]{ + +Copies @racket[src-dir] to @racket[dest-dir] with file/directory +omissions and updates corresponding the creation of a @tech{source +package}, @tech{binary package}, or @tech{built package} as indicated +by @racket[mode].} + + +@defproc[(fixup-local-redirect-reference [file path-string?] + [js-path string?]) + void?]{ + +Assuming that @racket[file] is an HTML file for documentation, adjusts +the URL reference to @filepath{local-redirect.js}, if any, to use the +prefix @racket[js-path].} diff --git a/collects/pkg/strip.rkt b/collects/pkg/strip.rkt index b317697214..8bfb0bbccc 100644 --- a/collects/pkg/strip.rkt +++ b/collects/pkg/strip.rkt @@ -4,32 +4,44 @@ syntax/modread racket/match racket/file - racket/list) + racket/list + racket/set) (provide generate-stripped-directory fixup-local-redirect-reference) -(define (generate-stripped-directory binary? dir dest-dir) +(define (generate-stripped-directory mode dir dest-dir) (define drop-keep-ns (make-base-namespace)) (define (add-drop+keeps dir base drops keeps) (define get-info (get-info/full dir #:namespace drop-keep-ns)) - (define drop-tag (if binary? 'binary-omit-files 'source-omit-files)) - (define more-drops (if get-info - (get-info drop-tag (lambda () null)) - null)) - (define keep-tag (if binary? 'binary-keep-files 'source-keep-files)) - (define more-keeps (if get-info - (get-info keep-tag (lambda () null)) - null)) - (define (check tag l) + (define (get-paths tag) + (define l (if get-info + (get-info tag (lambda () null)) + null)) (unless (and (list? l) (andmap (lambda (p) (and (path-string? p) (relative-path? p))) l)) - (error 'strip "bad ~a value from \"info.rkt\": ~e" tag l))) - (check drop-tag more-drops) - (check keep-tag more-keeps) - + (error 'strip "bad ~a value from \"info.rkt\": ~e" tag l)) + l) + (define (intersect l1 l2) + (set->list (set-intersect (list->set l1) (list->set l2)))) + (define (union l1 l2) + (set->list (set-union (list->set l1) (list->set l2)))) + (define more-drops + (case mode + [(source) (get-paths 'source-omit-files)] + [(binary) (get-paths 'binary-omit-files)] + [(built) + (intersect (get-paths 'source-omit-files) + (get-paths 'binary-omit-files))])) + (define more-keeps + (case mode + [(source) (get-paths 'source-keep-files)] + [(binary) (get-paths 'binary-keep-files)] + [(built) + (union (get-paths 'source-keep-files) + (get-paths 'binary-keep-files))])) (define (add ht l) (for/fold ([ht ht]) ([i (in-list l)]) (hash-set ht @@ -44,32 +56,36 @@ (define bstr (path->bytes path)) (or (regexp-match? #rx#"^(?:[.]git.*|[.]svn|.*~|#.*#)$" bstr) - (regexp-match? (if binary? - #rx#"^(?:tests|scribblings|.*(?:[.]scrbl|[.]dep|_scrbl[.]zo))$" - #rx#"^(?:compiled|doc)$") - bstr) - (and binary? - (regexp-match? #rx"[.](?:ss|rkt)$" bstr) - (not (equal? #"info.rkt" bstr)) - (file-exists? (let-values ([(base name dir?) (split-path (get-p))]) - (build-path base "compiled" (path-add-suffix name #".zo"))))) - (and binary? - ;; drop these, because they're recreated on fixup: - (or - (equal? #"info_rkt.zo" bstr) - (equal? #"info_rkt.dep" bstr))))) - + ;; can appear as a marker in rendered documentation: + (equal? #"synced.rktd" bstr) + (case mode + [(source) + (regexp-match? #rx#"^(?:compiled|doc)$" bstr)] + [(binary) + (or (regexp-match? #rx#"^(?:tests|scribblings|.*(?:[.]scrbl|[.]dep|_scrbl[.]zo))$" + bstr) + (and (regexp-match? #rx"[.](?:ss|rkt)$" bstr) + (not (equal? #"info.rkt" bstr)) + (file-exists? (let-values ([(base name dir?) (split-path (get-p))]) + (build-path base "compiled" (path-add-suffix name #".zo"))))) + ;; drop these, because they're recreated on fixup: + (equal? #"info_rkt.zo" bstr) + (equal? #"info_rkt.dep" bstr))] + [(built) + #f]))) + (define (fixup new-p path src-base) - (when binary? + (unless (eq? mode 'source) (define bstr (path->bytes path)) (cond [(regexp-match? #rx"[.]html$" bstr) (fixup-html new-p)] - [(equal? #"info.rkt" bstr) + [(and (eq? mode 'binary) + (equal? #"info.rkt" bstr)) (fixup-info new-p src-base)] - [(regexp-match? #rx"[.]zo$" bstr) - (fixup-zo new-p)] - [else (void)]))) + [(and (eq? mode 'binary) + (regexp-match? #rx"[.]zo$" bstr)) + (fixup-zo new-p)]))) (define (explore base paths drops keeps) (for ([path (in-list paths)]) @@ -201,8 +217,6 @@ (define ((fixup-info-definition get-info) defn) (match defn [`(define build-deps . ,v) #f] - [`(define scribblings . ,v) - `(define rendered-scribblings . ,v)] [`(define copy-foreign-libs . ,v) `(define move-foreign-libs . ,v)] [`(define copy-man-pages . ,v) diff --git a/collects/scribblings/raco/setup.scrbl b/collects/scribblings/raco/setup.scrbl index e55bef452e..01c9ac0016 100644 --- a/collects/scribblings/raco/setup.scrbl +++ b/collects/scribblings/raco/setup.scrbl @@ -261,7 +261,16 @@ Optional @filepath{info.rkt} fields trigger additional actions by A list of documents to build. Each document in the list is itself represented as a list, where each document's list starts with a string that is a collection-relative path to the document's source - file. + file. A directory for pre-rendered documentation is computed from the + source file name by starting with the directory of the @filepath{info.rkt} + file, adding @filepath{doc}, and then using the source file's name without + a suffix; if such a directory exists and does not have a + @filepath{synced.rktd} file, then it is treated as pre-rendered + documentation and moved into place, in which case the documentation source file + need not be present. (Moving documentation into place may require no movement + at all, depending on the way that the enclosing collection is installed, but + movement includes adding a @filepath{synced.rktd} file to represent + the installation.) More precisely a @racketidfont{scribblings} entry must be a value that can be generated from an expression matching the following diff --git a/collects/setup/private/cc-struct.rkt b/collects/setup/private/cc-struct.rkt index 7fd39ee10a..c720a8bc2a 100644 --- a/collects/setup/private/cc-struct.rkt +++ b/collects/setup/private/cc-struct.rkt @@ -3,5 +3,5 @@ (provide (struct-out cc)) (define-struct cc - (collection path name info omit-root info-root info-path info-path-mode shadowing-policy main?) + (collection path name info parent-cc omit-root info-root info-path info-path-mode shadowing-policy main?) #:inspector #f) diff --git a/collects/setup/scribble.rkt b/collects/setup/scribble.rkt index 21034a4600..9a37164065 100644 --- a/collects/setup/scribble.rkt +++ b/collects/setup/scribble.rkt @@ -48,8 +48,7 @@ under-main? pkg? category - out-count - pre-rendered?) + out-count) #:transparent) (define-serializable-struct info (doc ; doc structure above undef ; unresolved requires @@ -147,10 +146,8 @@ (apply validate i))) infos)]) (and (not (memq #f infos)) infos)))) - (define ((get-docs main-dirs pre-rendered?) i rec) - (let* ([pre-s (and i (i (if pre-rendered? - 'rendered-scribblings - 'scribblings)))] + (define ((get-docs main-dirs) i rec) + (let* ([pre-s (and i (i 'scribblings))] [s (validate-scribblings-infos pre-s)] [dir (directory-record-path rec)]) (if s @@ -178,30 +175,23 @@ dest flags under-main? (and (path->pkg src) #t) (caddr d) - (list-ref d 4) - pre-rendered?))) + (list-ref d 4)))) s) (begin (setup-printf "WARNING" - "bad '~ascribblings info: ~e from: ~e" - (if pre-rendered? "rendered-" "") + "bad 'scribblings info: ~e from: ~e" pre-s dir) null)))) (log-setup-info "getting documents") (define docs (let* ([recs (find-relevant-directory-records '(scribblings) 'all-available)] - [r-recs (find-relevant-directory-records '(rendered-scribblings) 'all-available)] [main-dirs (parameterize ([current-library-collection-paths (list (find-collects-dir))]) (for/hash ([k (in-list - (append - (find-relevant-directories '(rendered-scribblings) 'no-planet) - (find-relevant-directories '(scribblings) 'no-planet)))]) + (find-relevant-directories '(scribblings) 'no-planet))]) (values k #t)))] - [infos (map get-info/full (map directory-record-path recs))] - [r-infos (map get-info/full (map directory-record-path r-recs))]) - (filter-user-docs (append (append-map (get-docs main-dirs #f) infos recs) - (append-map (get-docs main-dirs #t) r-infos r-recs)) + [infos (map get-info/full (map directory-record-path recs))]) + (filter-user-docs (append-map (get-docs main-dirs) infos recs) make-user?))) (define-values (main-docs user-docs) (partition doc-under-main? docs)) @@ -759,13 +749,16 @@ only-fast? force-out-of-date? lock) doc) - ;; First, move pre-rendered documentation into place - (when (and (doc-pre-rendered? doc) - (can-build? only-dirs doc) - (or (not (directory-exists? (doc-dest-dir doc))) - force-out-of-date? - (not (file-exists? (build-path (doc-dest-dir doc) "synced.rktd"))))) - (move-documentation-into-place doc setup-printf workerid lock)) + ;; First, move pre-rendered documentation, if any, into place + (let ([rendered-dir (let-values ([(base name dir?) (split-path (doc-src-file doc))]) + (build-path (doc-src-dir doc) "doc" (path-replace-suffix name #"")))]) + (when (and (can-build? only-dirs doc) + (directory-exists? rendered-dir) + (not (file-exists? (build-path rendered-dir "synced.rktd"))) + (or (not (directory-exists? (doc-dest-dir doc))) + force-out-of-date? + (not (file-exists? (build-path (doc-dest-dir doc) "synced.rktd"))))) + (move-documentation-into-place doc rendered-dir setup-printf workerid lock))) (let* ([info-out-files (for/list ([i (add1 (doc-out-count doc))]) (sxref-path latex-dest doc (format "out~a.sxref" i)))] @@ -773,14 +766,17 @@ [db-file (find-db-file doc latex-dest)] [stamp-file (sxref-path latex-dest doc "stamp.sxref")] [out-file (build-path (doc-dest-dir doc) "index.html")] - [src-zo (and - (not (doc-pre-rendered? doc)) - (let-values ([(base name dir?) (split-path (doc-src-file doc))]) - (define path (build-path base "compiled" (path-add-suffix name ".zo"))) - (or (for/or ([root (in-list (current-compiled-file-roots))]) - (define p (reroot-path* path root)) - (and (file-exists? p) p)) - path)))] + [src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))]) + (define path (build-path base "compiled" (path-add-suffix name ".zo"))) + (or (for/or ([root (in-list (current-compiled-file-roots))]) + (define p (reroot-path* path root)) + (and (file-exists? p) p)) + (if (and (not (file-exists? path)) + (file-exists? out-file)) + ;; assume installed as pre-rendered: + #f + ;; need to render, so complain if no source is available: + path)))] [renderer (make-renderer latex-dest doc)] [can-run? (can-build? only-dirs doc)] [stamp-time (file-or-directory-modify-seconds stamp-file #f (lambda () -inf.0))] @@ -815,13 +811,13 @@ [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))] [info-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))] [vers (send renderer get-serialize-version)] - [src-time (and (not (doc-pre-rendered? doc)) + [src-time (and src-zo (file-or-directory-modify-seconds/stamp src-zo stamp-time stamp-data 0 get-compiled-file-sha1))] [up-to-date? - (or (doc-pre-rendered? doc) + (or (not src-zo) (and (not force-out-of-date?) info-out-time info-in-time @@ -832,7 +828,7 @@ ;; this is mostly useful if we interrupt setup-plt after ;; it runs some documents without rendering them: (info-time . >= . src-time))))] - [can-run? (and (not (doc-pre-rendered? doc)) + [can-run? (and src-zo (or (not latex-dest) (not (omit? (doc-category doc)))) (or can-run? @@ -966,9 +962,7 @@ (lambda () #f)) #f)))) -(define (move-documentation-into-place doc setup-printf workerid lock) - (define src-dir (let-values ([(base name dir?) (split-path (doc-src-file doc))]) - (build-path base "doc" (path-replace-suffix name #"")))) +(define (move-documentation-into-place doc src-dir setup-printf workerid lock) (define dest-dir (doc-dest-dir doc)) (define move? (not (equal? (file-or-directory-identity src-dir) (and (directory-exists? dest-dir) @@ -1157,6 +1151,12 @@ (doc-src-file doc) (lambda () (send renderer render (list v) (list dest-dir) ri)) void)) + (unless (or latex-dest (main-doc? doc)) + ;; Since dest dir is the same place as pre-built documentation, + ;; mark it so that it is not treated as needing an install: + (let ([synced (build-path (doc-dest-dir doc) "synced.rktd")]) + (unless (file-exists? synced) + (close-output-port (open-output-file synced))))) (gc-point) (list in-delta? out-delta? undef searches)))) (lambda () #f))) diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt index c93e321c41..41def06433 100644 --- a/collects/setup/setup-unit.rkt +++ b/collects/setup/setup-unit.rkt @@ -192,7 +192,7 @@ ;; Find Collections ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (define (make-cc* collection path omit-root info-root + (define (make-cc* collection parent path omit-root info-root info-path info-path-mode shadowing-policy main?) (define info @@ -218,6 +218,7 @@ (format "~a (~a)" path-name name) path-name) info + parent omit-root info-root info-path info-path-mode shadowing-policy @@ -232,6 +233,7 @@ ;; collection-cc! : listof-path .... -> cc (define (collection-cc! collection-p + #:parent [parent-cc #f] #:path [dir (apply collection-path collection-p)] #:omit-root [omit-root #f] #:info-root [given-info-root #f] @@ -258,6 +260,7 @@ dir)) (define new-cc (make-cc* collection-p + parent-cc dir (if (eq? omit-root 'dir) dir @@ -302,6 +305,7 @@ (error 'planet-cc! "non-path when building package ~e" pkg-file)) (and (directory-exists? path) (make-cc* #f + #f path omit-root #f ; don't need info-root; absolute paths in cache.rktd will be ok @@ -404,6 +408,7 @@ (define (build-collection-tree cc) (define (make-child-cc parent-cc name) (collection-cc! (append (cc-collection parent-cc) (list name)) + #:parent parent-cc #:path (build-path (cc-path parent-cc) name) #:info-root (cc-info-root cc) #:info-path (cc-info-path cc) @@ -440,6 +445,7 @@ (define (make-children-ccs cc children) (map (lambda (child) (collection-cc! (append (cc-collection cc) (list child)) + #:parent cc #:path (build-path (cc-path cc) child) #:info-root (cc-info-root cc) #:info-path (cc-info-path cc) @@ -589,6 +595,12 @@ "encountered ~a, neither a file nor a directory" path)])))) + (define (assume-virtual-sources? cc) + (or ((cc-info cc) 'assume-virtual-sources (lambda () #f)) + (let ([cc (cc-parent-cc cc)]) + (and cc + (assume-virtual-sources? cc))))) + (define (clean-collection cc dependencies) (begin-record-error cc "Cleaning" (define info (cc-info cc)) @@ -597,7 +609,7 @@ info 'clean (lambda () - (if (info 'assume-virtual-sources (lambda () #f)) + (if (assume-virtual-sources? cc) null (list mode-dir (build-path mode-dir "native") @@ -745,9 +757,9 @@ [compile-notify-handler doing-path]) (thunk))))) - (define (clean-cc dir info) + (define (clean-cc cc dir info) ;; Clean up bad .zos: - (unless (info 'assume-virtual-sources (lambda () #f)) + (unless (assume-virtual-sources? cc) (define c (build-path dir "compiled")) (when (directory-exists? c) (define ok-zo-files @@ -807,7 +819,7 @@ (lambda () (define dir (cc-path cc)) (define info (cc-info cc)) - (clean-cc dir info) + (clean-cc cc dir info) (compile-directory-zos dir info #:omit-root (cc-omit-root cc) #:managed-compile-zo caching-managed-compile-zo @@ -853,7 +865,7 @@ (iterate-cct (lambda (cc) (define dir (cc-path cc)) (define info (cc-info cc)) - (clean-cc dir info)) + (clean-cc cc dir info)) cct) (parallel-compile (parallel-workers) setup-fprintf handle-error cct) (for/fold ([gcs 0]) ([cc planet-dirs-to-compile]) diff --git a/collects/tests/pkg/test-pkgs/.gitignore b/collects/tests/pkg/test-pkgs/.gitignore index d5067c840a..5411e23e4a 100644 --- a/collects/tests/pkg/test-pkgs/.gitignore +++ b/collects/tests/pkg/test-pkgs/.gitignore @@ -4,4 +4,5 @@ MANIFEST *plt *CHECKSUM pkg-test1b* -/src-pkg/ +/src-pkgs/ +/built-pkgs/ diff --git a/collects/tests/pkg/test-pkgs/pkg-y/y/sub/s.rkt b/collects/tests/pkg/test-pkgs/pkg-y/y/sub/s.rkt new file mode 100644 index 0000000000..ccaea586d1 --- /dev/null +++ b/collects/tests/pkg/test-pkgs/pkg-y/y/sub/s.rkt @@ -0,0 +1,3 @@ +#lang racket/base +(provide s) +(define (s) 's) diff --git a/collects/tests/pkg/tests-binary.rkt b/collects/tests/pkg/tests-binary.rkt index f344a7a2a1..959665dab1 100644 --- a/collects/tests/pkg/tests-binary.rkt +++ b/collects/tests/pkg/tests-binary.rkt @@ -21,6 +21,7 @@ $ "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))'" @@ -29,6 +30,7 @@ $ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" (make-directory* "test-pkgs/src-pkgs") + (make-directory* "test-pkgs/built-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" @@ -37,6 +39,10 @@ $ "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 --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") @@ -45,54 +51,109 @@ $ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #f)'" (define tmp-dir (make-temporary-file "unpack-~a" 'directory)) - (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 (regexp-match? #rx#"nosrc" (path->bytes f)) - (error 'diff "missing ~s" new-f))))))) - (unpack "x") - (unpack "y") - (unpack "z") - (delete-directory/files tmp-dir) - (make-directory* tmp-dir) - (define (unpack-bin name) - (let ([z (path->complete-path (format "test-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)]) - (when (or (and (regexp-match? #rx#"(?:[.](?:rkt|scrbl|dep)|_scrbl[.]zo)$" (path->bytes f)) - (not (regexp-match? #rx#"(?:info_rkt[.]dep)$" (path->bytes f)))) - (regexp-match? #rx#"nobin" (path->bytes f))) - (unless (regexp-match? #rx#"(?:info[.]rkt|keep.scrbl)$" (path->bytes f)) - (error 'binary "extra ~s" f))))))) - (unpack-bin "x") - (unpack-bin "y") - (unpack-bin "z") - (delete-directory/files tmp-dir) + (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 (regexp-match? #rx#"nosrc" (path->bytes 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) + (let ([z (path->complete-path (format "test-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)]) + (when (or (and (regexp-match? #rx#"(?:[.](?:rkt|scrbl|dep)|_scrbl[.]zo)$" (path->bytes f)) + (not (regexp-match? #rx#"(?:info_rkt[.]dep)$" (path->bytes f)))) + (regexp-match? #rx#"nobin" (path->bytes f))) + (unless (regexp-match? #rx#"(?:info[.]rkt|keep.scrbl)$" (path->bytes f)) + (error 'binary "extra ~s" f))))))) + (unpack-bin "x") + (unpack-bin "y") + (unpack-bin "z") + (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 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)$" (path->bytes f)) + (error 'built "extra ~s" f)))) + (when (regexp-match? #rx#"[.]zo$" (path->bytes f)) + (unless (file-exists? (path-replace-suffix f #".dep")) + (error 'build "dep missing for ~s" f))) + (when (regexp-match? #rx#"[.](rkt|scrbl|ss)$" (path->bytes f)) + (let-values ([(base name dir?) (split-path f)]) + (unless (file-exists? (build-path (if (eq? base 'relative) 'same base) + "compiled" + (path-add-suffix name #".zo"))) + (unless (regexp-match? #rx#"^(?:info.rkt|x/keep.scrbl)$" (path->bytes 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]) + (for ([f (in-directory)]) + (when (file-exists? f) + (unless (file-exists? (build-path td 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" @@ -116,6 +177,9 @@ $ "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)'" $ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" @@ -128,6 +192,25 @@ $ "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)'" + $ "racket -l racket/base -t test-docs.rkt -e '(test-docs-y #t)'" + $ "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" )