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

Closes #1400

pkgs/racket-doc/scribblings/raco/api.scrbl

@@ -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
+ @item{@indexed-racket[compile-omit-paths] : Either a list of paths
-       and directory paths that should not be compiled. Alternatively,
+       and @tech[#:doc reference-doc]{regexp values} or @racket['all].
-       this field's value is @racket['all], which is equivalent to
+       In a list, a path is treated as a file that should not be
-       specifying all files and directories in the collection (to
+       compiled or a directory whose files should not be compiled and
-       effectively ignore the collection for
+       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
+       Files that are required by other files are always compiled in
-       compiled in the process of compiling the requiring file---even
+       the process of compiling the requiring file---even when the
-       when the required file is listed with this field or when the
+       required file is listed with this field or when the field's
-       field's value is @racket['all].}
+       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?]

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/info.rkt

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

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/1

@@ -0,0 +1 @@
+one

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/a.scrbl

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

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/info.rkt

@@ -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"))

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/neither/x.rkt

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

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/1

@@ -0,0 +1 @@
+one

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/a.scrbl

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

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/info.rkt

@@ -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"))

pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-excl/not-me/x.rkt

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

pkgs/racket-test/tests/pkg/tests-conflicts.rkt

@@ -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

racket/collects/pkg/private/addl-installs.rkt

@@ -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)
+      [(and (directory-exists? f)
-           (not (set-member? omits (simplify-path f))))
+            (let ([sf (simplify-path f)])
-      (define i (get-pkg-info f metadata-ns))
+              (and (not (set-member? omits sf))
-      (define omit-paths (if i
+                   (not (for/or ([prefix+rx (in-list prefix+rxs)])
-                             (i 'compile-omit-paths (lambda () null))
+                          (define prefix (car prefix+rx))
-                             null))
+                          (regexp-match? (cdr prefix+rx) (if (eq? prefix 'same)
-      (cond
+                                                             f-rel
-       [(eq? omit-paths 'all)
+                                                             (build-path prefix f-rel))))))))
-        s]
+       (define i (get-pkg-info f metadata-ns))
-       [else
+       (define omit-paths (if i
-        (define omit-files (if i
+                              (i 'compile-omit-paths (lambda () null))
-                               (i 'compile-omit-files (lambda () null))
+                              null))
-                               null))
+       (cond
-        (define new-s
+         [(eq? omit-paths 'all)
-          (if (and i (or single-collect (not top?)))
+          s]
-              (set-union (extract-additional-installs i sys-type sys-lib-subpath)
+         [else
-                         s)
+          (define omit-files (if i
-              s))
+                                 (i 'compile-omit-files (lambda () null))
-        (define new-omits
+                                 null))
-          (set-union
+          (define new-s
-           omits
+            (if (and i (or single-collect (not top?)))
-           (for/set ([i (in-list (append omit-paths omit-files))])
+                (set-union (extract-additional-installs i sys-type sys-lib-subpath)
-             (simplify-path (build-path f i)))))
+                           s)
-        (for/fold ([s new-s]) ([f (directory-list f #:build? #t)])
+                s))
-          (loop s f #f new-omits))])]
+          (define new-omits
-     [else s])))
+            (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)

racket/collects/setup/private/omitted-paths.rkt

@@ -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
+          'all
-        (map (lambda (e) (explode-path (simplify-path e #f)))
+          (map (lambda (e) (if (regexp? e)
-             ;; for backward compatibility
+                               e
-             (append omit (info 'compile-omit-files (lambda () '())))))))
+                               (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
+    [else
-                  (map list (filter implicit-omit? (directory-list dir)))
+     (define explicit-paths (filter pair? explicit))
-                  accumulated)]))
+     (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))])
+        (let ([acc (loop (cdr rsubs))]
-          (if (or (eq? 'all acc) (member (list (car rsubs)) acc))
+              [rsub (car rsubs)])
-            'all
+          (cond
-            (compute-omitted (apply build-path dir (reverse rsubs))
+            [(or (eq? 'all acc)
-                             (for/list ([up acc]
+                 ;; if the nest subdirectory is omitted, it's 'all from
-                                        #:when (equal? (car up) (car rsubs)))
+                 ;; the perspective of the subdirectory or any even more
-                               ;; must have non-null cdr: see `member' check
+                 ;; nested directory:
-                               (cdr up))
+                 (member (list rsub) (omits-exploded-paths acc)))
-                             implicit?
+             'all]
-                             get-info/full)))))))
+            [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
+        r
-      (filter-map (lambda (x) (and (null? (cdr x)) (car x))) 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))