Commit f3c8215d authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.140: Make subdirectories actually work with ABCL, Allegro, CMUCL, CormanLisp, Scieneer

Also, save defsystem-depends-on information for the sake of introspection by e.g. quicklisp.
Some documentation clarifications.
parent 450ee853
Loading
Loading
Loading
Loading
+37 −18
Original line number Diff line number Diff line
@@ -72,7 +72,7 @@
  (defvar *asdf-version* nil)
  (defvar *upgraded-p* nil)
  (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
          (subseq "VERSION:2.139" (1+ (length "VERSION"))))
          (subseq "VERSION:2.140" (1+ (length "VERSION"))))
         (existing-asdf (fboundp 'find-system))
         (existing-version *asdf-version*)
         (already-there (equal asdf-version existing-version)))
@@ -305,6 +305,7 @@
            #:split-string
            #:component-name-to-pathname-components
            #:split-name-type
            #:subdirectories
            #:truenamize
            #:while-collecting)))
        (setf *asdf-version* asdf-version
@@ -695,11 +696,14 @@ ways that the filename components can be missing are for it to be NIL,

Note that this does _not_ check to see that PATHNAME points to an
actually-existing directory."
  (when pathname
    (let ((pathname (pathname pathname)))
      (flet ((check-one (x)
               (member x '(nil :unspecific "") :test 'equal)))
    (and (check-one (pathname-name pathname))
        (and (not (wild-pathname-p pathname))
             (check-one (pathname-name pathname))
             (check-one (pathname-type pathname))
         t)))
             t)))))

(defun* ensure-directory-pathname (pathspec)
  "Converts the non-wild pathname designator PATHSPEC to directory form."
@@ -1069,7 +1073,8 @@ with given pathname and if it exists return its truename."
   (licence :accessor system-licence :initarg :licence
            :accessor system-license :initarg :license)
   (source-file :reader system-source-file :initarg :source-file
                :writer %set-system-source-file)))
                :writer %set-system-source-file)
   (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on)))

;;;; -------------------------------------------------------------------------
;;;; version-satisfies
@@ -2156,7 +2161,7 @@ details."
  (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system)
                            defsystem-depends-on &allow-other-keys)
      options
    (let ((component-options (remove-keys '(:defsystem-depends-on :class) options)))
    (let ((component-options (remove-keys '(:class) options)))
      `(progn
         ;; system must be registered before we parse the body, otherwise
         ;; we recur when trying to find an existing system of the same name
@@ -3247,17 +3252,31 @@ with a different configuration, so the configuration would be re-read then."
                    #+clisp #+clisp :circle t))
       t))

(defparameter *wild-subdir*
  (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil))

(defun subdirectories (directory)
  (let* ((directory (ensure-directory-pathname directory))
         #-cormanlisp
         (wild (merge-pathnames*
                #-(or abcl allegro scl)
                (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil)
                #+(or abcl allegro scl) "*.*"
                directory))
         (dirs
          #-cormanlisp
          (ignore-errors
    (directory (merge-pathnames* *wild-subdir* directory)
               #+sbcl #+sbcl :resolve-symlinks nil
               #+ccl #+ccl :follow-links nil
               #+ccl #+ccl :directories t
               #+ccl #+ccl :files nil
               #+clisp #+clisp :circle t)))
            (directory wild .
              #.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil)
                    #+ccl '(:follow-links nil :directories t :files nil)
                    #+clisp '(:circle t :if-does-not-exist :ignore)
                    #+(or cmu scl) '(:follow-links nil :truenamep nil)
                    #+digitool '(:directories t)
                    #+sbcl '(:resolve-symlinks nil))))
          #+cormanlisp (cl::directory-subdirs directory))
         #+(or abcl allegro scl)
         (dirs (remove-if-not #+abcl #'extensions:probe-directory
                              #+allegro #'excl:probe-directory
                              #+scl #'directory-pathname-p
                              dirs)))
    dirs))

(defun collect-subdirs (directory collectp recursep collector)
  (when (funcall collectp directory)
+5 −1
Original line number Diff line number Diff line
@@ -1717,6 +1717,9 @@ to be found, for systems to be found the current directory
(at the time that the configuration is initialized) as well as
@code{:directory} entries for @file{$XDG_DATA_DIRS/common-lisp/systems/} and
@code{:tree} entries for @file{$XDG_DATA_DIRS/common-lisp/source/}.
For instance, SBCL will include directories for its contribs
when it can find them; it will look for them where SBCL was installed,
or at the location specified by the @code{SBCL_HOME} environment variable.

@end enumerate

@@ -1796,6 +1799,8 @@ DIRECTIVE :=
    (:exclude PATTERN ...) |
    ;; augment the defaults for exclusion patterns
    (:also-exclude PATTERN ...) |
    ;; Note that the scope of a an exclude pattern specification is
    ;; the rest of the current configuration expression or file.

    ;; splice the parsed contents of another config file
    (:include REGULAR-FILE-PATHNAME-DESIGNATOR) |
@@ -1840,7 +1845,6 @@ once contained:
  :inherit-configuration)
@end example


@section Configuration Directories

Configuration directories consist in files each contains
+9 −0
Original line number Diff line number Diff line
@@ -46,6 +46,8 @@

(cl-user::quit-on-error

(format t "~&subdirectories of dir2/: ~S~%" (subdirectories (under-test-directory "dir2/")))
(assert (= 2 (length (subdirectories (under-test-directory "dir2/")))))
(assert
 (equal (parse-output-translations-string "/foo:/bar::/baz:/quux")
        '(:output-translations
@@ -74,6 +76,13 @@
 `(:source-registry (:include ,(under-test-directory "conf.d/"))
                    :ignore-inherited-configuration))

(format t "~&Source Registry: ~S~%"
        asdf::*source-registry*)
(assert (find-system :foo0 nil))
(assert (find-system :foo1 nil))
(assert (find-system :foo2 nil))
(assert (find-system :foo3 nil))

(assert
 (equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
        (under-test-directory "dir2/bar/baz.lisp")))