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

info.rkt: allow regexps in compile-omit-paths

Browse Source 
Closes #1400
This commit is contained in:
Matthew Flatt 2021-05-03 13:30:37 -06:00
parent c663d13fab
commit 9c60382461
13 changed files with 170 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pkgs/racket-doc/scribblings/raco/api.scrbl
View File

@ -105,19 +105,30 @@ collection. The following fields are used:
@item{@indexed-racket[name] : The name of the collection as a string, used
only for status and error reporting.}
@item{@indexed-racket[compile-omit-paths] : A list of immediate file
and directory paths that should not be compiled. Alternatively,
this field's value is @racket['all], which is equivalent to
specifying all files and directories in the collection (to
effectively ignore the collection for
@item{@indexed-racket[compile-omit-paths] : Either a list of paths
and @tech[#:doc reference-doc]{regexp values} or @racket['all].
In a list, a path is treated as a file that should not be
compiled or a directory whose files should not be compiled and
whose @filepath{info.rkt} files should be ignored by @exec{raco
setup}; the paths are relative to the collection (i.e.,
directory containing the @filepath{info.rkt} file) and can
refer to files and directories in subcollections that are that
are represented by subdirectories. A regexp in the list is
matched against file and directory paths relative to the
collection (so, for example, start a regexp with @litchar{^} to
match only paths in the immediate collection and not in
subcollections) to exclude those files and directories from
compilation and @exec{raco setup}. The value @racket['all] is
equivalent to specifying all files and directories in the
collection (to effectively ignore the collection for
compilation). Automatically omitted files and directories are
@filepath{compiled}, @filepath{doc}, and those whose names
start with @litchar{.}.
Files that are required by other files, however, are always
compiled in the process of compiling the requiring file---even
when the required file is listed with this field or when the
field's value is @racket['all].}
Files that are required by other files are always compiled in
the process of compiling the requiring file---even when the
required file is listed with this field or when the field's
value is @racket['all].}
@item{@indexed-racket[compile-omit-files] : A list of filenames (without
directory paths) that are not compiled, in addition to the
@ -141,7 +152,8 @@ collection. The following fields are used:
]
@history[#:changed "6.3" @elem{Added support for @racket[compile-include-files].}
#:changed "7.8.0.8" @elem{Changed ``starts with'' for @racket[skip-path] to include an exact match.}]}
#:changed "7.8.0.8" @elem{Changed ``starts with'' for @racket[skip-path] to include an exact match.}
#:changed "8.1.0.5" @elem{Added support for regexps in @racket[compile-omit-paths].}]}
@defproc[(compile-directory-zos [path path-string?]

3
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/info.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang info
(define compile-omit-paths '("not-me" #rx"either"))

1
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/1 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/a.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/info.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang info
(define scribblings '(("a.scrbl")))
(define racket-launcher-names '("x"))
(define racket-launcher-libraries '("x.rkt"))
(define copy-shared-files '("1"))

1
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/x.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

1
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/1 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/a.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/info.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang info
(define scribblings '(("a.scrbl")))
(define racket-launcher-names '("x"))
(define racket-launcher-libraries '("x.rkt"))
(define copy-shared-files '("1"))

1
pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/x.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

6
pkgs/racket-test/tests/pkg/tests-conflicts.rkt
View File

@ -127,6 +127,12 @@
(with-fake-root
(shelly-begin
$ (~a "raco pkg install --copy test-pkgs/pkg-add-base " c) =exit> 0))))
(shelly-case
"no doc conflict with excluded subcollections"
(for ([c '("test-pkgs/pkg-add-excl")])
(with-fake-root
(shelly-begin
$ (~a "raco pkg install --copy --strict-doc-conflicts test-pkgs/pkg-add-base " c) =exit> 0))))
(putenv "PLT_PKG_NOSETUP" "")
(with-fake-root
(shelly-case

76
racket/collects/pkg/private/addl-installs.rkt
View File

@ -25,34 +25,56 @@
#:system-library-subpath [sys-lib-subpath #f])
(define single-collect
(pkg-single-collection dir #:name pkg-name #:namespace metadata-ns))
(let loop ([s (set)] [f dir] [top? #t] [omits (set)])
;; In this loop `omits` is a set of paths built on `dir`, and `prefix+rxes`
;; is a set of regular expressions to continue using as we recur down;
;; each regular expression is matched relative to the directory where it was
;; introduced, so we have to build up a prefix to use with each regexp
(let loop ([s (set)] [f-rel dir] [wrt #f] [top? #t] [omits (set)] [prefix+rxs '()])
(define f (if wrt (build-path wrt f-rel) f-rel))
(cond
[(and (directory-exists? f)
(not (set-member? omits (simplify-path f))))
(define i (get-pkg-info f metadata-ns))
(define omit-paths (if i
(i 'compile-omit-paths (lambda () null))
null))
(cond
[(eq? omit-paths 'all)
s]
[else
(define omit-files (if i
(i 'compile-omit-files (lambda () null))
null))
(define new-s
(if (and i (or single-collect (not top?)))
(set-union (extract-additional-installs i sys-type sys-lib-subpath)
s)
s))
(define new-omits
(set-union
omits
(for/set ([i (in-list (append omit-paths omit-files))])
(simplify-path (build-path f i)))))
(for/fold ([s new-s]) ([f (directory-list f #:build? #t)])
(loop s f #f new-omits))])]
[else s])))
[(and (directory-exists? f)
(let ([sf (simplify-path f)])
(and (not (set-member? omits sf))
(not (for/or ([prefix+rx (in-list prefix+rxs)])
(define prefix (car prefix+rx))
(regexp-match? (cdr prefix+rx) (if (eq? prefix 'same)
f-rel
(build-path prefix f-rel))))))))
(define i (get-pkg-info f metadata-ns))
(define omit-paths (if i
(i 'compile-omit-paths (lambda () null))
null))
(cond
[(eq? omit-paths 'all)
s]
[else
(define omit-files (if i
(i 'compile-omit-files (lambda () null))
null))
(define new-s
(if (and i (or single-collect (not top?)))
(set-union (extract-additional-installs i sys-type sys-lib-subpath)
s)
s))
(define new-omits
(set-union omits
(for/set ([i (in-list (append omit-paths omit-files))]
#:unless (regexp? i))
(simplify-path (build-path f i)))))
(define new-prefix+rxs
(append (for/list ([i (in-list (append omit-paths omit-files))]
#:when (regexp? i))
(cons 'same i))
;; add to prefix for rxs accumulated so far
(for/list ([prefix+rx (in-list prefix+rxs)])
(define prefix (car prefix+rx))
(cons (if (eq? prefix 'same)
f-rel
(build-path prefix f-rel))
(cdr prefix+rx)))))
(for/fold ([s new-s]) ([sub-f (directory-list f)])
(loop s sub-f f #f new-omits new-prefix+rxs))])]
[else s])))
(define (extract-additional-installs i sys-type sys-lib-subpath)
(define (extract-documents i)

86
racket/collects/setup/private/omitted-paths.rkt
View File

@ -44,44 +44,84 @@
(and omit-doc? (equal? "doc" str))
(regexp-match? #rx"^[.]" str))))
;; accumulated omissions is a list of
;; exploded paths plus a list of (cons prefix-path regexp)
(struct omits (exploded-paths prefix+rxs))
;; returns 'all or an `omits`
(define (compute-omitted dir accumulated implicit-omit? get-info/full)
(define info (or (get-info/full dir) (lambda _ '())))
(define explicit
(let ([omit (info 'compile-omit-paths (lambda () '()))])
(if (eq? 'all omit)
'all
(map (lambda (e) (explode-path (simplify-path e #f)))
;; for backward compatibility
(append omit (info 'compile-omit-files (lambda () '())))))))
'all
(map (lambda (e) (if (regexp? e)
e
(explode-path (simplify-path e #f))))
;; for backward compatibility
(append omit (info 'compile-omit-files (lambda () '())))))))
(cond
[(or (eq? 'all explicit) (memq 'same explicit)) 'all]
[(findf (lambda (e)
(or (null? e) (not (path? (car e))) (absolute-path? (car e))))
(and (not (regexp? e))
(or (null? e) (not (path? (car e))) (absolute-path? (car e)))))
explicit)
=> (lambda (bad)
(error 'compile-omit-paths
"bad entry value in info file: ~e" (apply build-path bad)))]
[else (append explicit
(map list (filter implicit-omit? (directory-list dir)))
accumulated)]))
[else
(define explicit-paths (filter pair? explicit))
(define rxes (filter regexp? explicit))
(omits
(append explicit-paths
(map list (filter (lambda (p)
(or (implicit-omit? p)
(for/or ([rx (in-list rxes)])
(regexp-match? rx p))
(for/or ([prefix+rx (in-list (omits-prefix+rxs accumulated))])
(regexp-match? (cdr prefix+rx)
(build-path (car prefix+rx) p)))))
(directory-list dir)))
(omits-exploded-paths accumulated))
(append (map (lambda (rx) (cons 'same rx)) rxes)
(omits-prefix+rxs accumulated)))]))
(define (accumulate-omitted get-info/full rsubs root t omit-doc?)
(define dir (apply build-path root))
(define implicit? (implicit-omit? omit-doc?))
(let loop ([rsubs rsubs])
(if (null? rsubs)
(compute-omitted dir '() implicit? get-info/full)
(compute-omitted dir (omits '() '()) implicit? get-info/full)
(with-memo t rsubs
(let ([acc (loop (cdr rsubs))])
(if (or (eq? 'all acc) (member (list (car rsubs)) acc))
'all
(compute-omitted (apply build-path dir (reverse rsubs))
(for/list ([up acc]
#:when (equal? (car up) (car rsubs)))
;; must have non-null cdr: see `member' check
(cdr up))
implicit?
get-info/full)))))))
(let ([acc (loop (cdr rsubs))]
[rsub (car rsubs)])
(cond
[(or (eq? 'all acc)
;; if the nest subdirectory is omitted, it's 'all from
;; the perspective of the subdirectory or any even more
;; nested directory:
(member (list rsub) (omits-exploded-paths acc)))
'all]
[else
;; keep paths from enclosing directory that apply to
;; nested directory, and strip off the nested directory element
(define acc-exploded-paths (for/list ([up (omits-exploded-paths acc)]
#:when (equal? (car up) (car rsubs)))
;; must have non-null cdr: see `member' check
(cdr up)))
;; extend prefix of each prefix+rx accumulated from the
;; enclosing directory
(define acc-prefix+rxes (map (lambda (prefix+rx)
(define prefix (car prefix+rx))
(cons (if (eq? prefix 'same)
rsub
(build-path prefix rsub))
(cdr prefix+rx)))
(omits-prefix+rxs acc)))
(compute-omitted (apply build-path dir (reverse rsubs))
(omits acc-exploded-paths acc-prefix+rxes)
implicit?
get-info/full)]))))))
(define (omitted-paths* dir get-info/full root-dir)
(unless (and (path-string? dir) (complete-path? dir) (directory-exists? dir))
@ -97,13 +137,15 @@
#t))
(force roots)))]
[r (and r (apply accumulate-omitted get-info/full r))])
(unless r
(error 'omitted-paths
"given directory path is not in any collection root: ~e" dir))
(if (eq? 'all r)
r
(filter-map (lambda (x) (and (null? (cdr x)) (car x))) r))))
r
;; get paths for the immediate directory only; that is, drop
;; any exploded path that has more than one element:
(filter-map (lambda (x) (and (null? (cdr x)) (car x)))
(omits-exploded-paths r)))))
(define omitted-paths-memo (make-hash))