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

1.674: Fix long-form of source-registry parsing.

Add tests for configuration files.
Also export enable-asdf-binary-locations-compatibility.
parent 347e43c8
Loading
Loading
Loading
Loading
+3 −2
Original line number Diff line number Diff line
@@ -60,7 +60,7 @@
(eval-when (:load-toplevel :compile-toplevel :execute)
  (let* ((asdf-version
          ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
          (subseq "VERSION:1.673" (1+ (length "VERSION"))))
          (subseq "VERSION:1.674" (1+ (length "VERSION"))))
         #+allegro (excl::*autoload-package-name-alist* nil)
         (existing-asdf (find-package :asdf))
         (versym '#:*asdf-version*)
@@ -257,6 +257,7 @@
           #:ensure-output-translations
           #:apply-output-translations
           #:compile-file-pathname*
           #:enable-asdf-binary-locations-compatibility

           #:*default-source-registries*
           #:initialize-source-registry
@@ -2883,7 +2884,7 @@ with a different configuration, so the configuration would be re-read then."
     '(:source-registry :inherit-configuration))
    ((not (stringp string))
     (error "environment string isn't: ~S" string))
    ((eql (char string 0) "\"(")
    ((find (char string 0) "\"(")
     (validate-source-registry-form (read-from-string string)))
    (t
     (loop
+2 −2
Original line number Diff line number Diff line
@@ -2904,7 +2904,7 @@ Here is an old list of things to do,
in addition to the bugs that are now tracked on launchpad:
@url{https://launchpad.net/asdf}.

* Outstanding spec questions, things to add
@section Outstanding spec questions, things to add

** packaging systems

@@ -2956,7 +2956,7 @@ A ``dry run'' of an operation can be made with the following form:
This uses unexported symbols.
What would be a nice interface for this functionality?

* Missing bits in implementation
@section Missing bits in implementation

** all of the above

+4 −4
Original line number Diff line number Diff line
@@ -95,14 +95,14 @@
          <dd>Fran&ccedil;ois-Ren&eacute; Rideau is de facto maintainer,
            with notable contributions from Robert P. Goldman.
            Push towards an ASDF 2 release
            which many clean-ups, simplified configuration
            with many clean-ups, better configurability
            and updated documentation.
          </dd>
          <dt>May 2006 to November 2009</dt>
          <dd>Gary King is de facto maintainer,
            with notable contributions from
            Robert P. Goldman, Nikodemus Siivola, Christophe Rhodes, D Herring.
            Many small features and fixing bugs,
            Many small features and bug fixes,
            trying to make the project more usable,
            moving to using git and common-lisp.net.
          </dd>
@@ -110,9 +110,9 @@
          <dd>Christophe Rhodes is de facto maintainer,
            with notable contributions from
            Nikodemus Siivola, Peter Van Eynde, Edi Weitz, Kevin Rosenberg.
            Make the system more robust, a few more features.
            The system made more robust, a few more features.
          <dt>August 2001 to May 2004</dt>
          <dd>Maintained by Daniel Barlow, with notable contributions from
          <dd>Developed by Daniel Barlow, with notable contributions from
            Christophe Rhodes, Kevin Rosenberg, Edi Weitz, Rahul Jain.
          <dt>August 2001</dt>
          <dd>Created by Daniel Barlow</dd>
+11 −8
Original line number Diff line number Diff line
@@ -2,13 +2,16 @@

;; We can't use asdf:merge-pathnames* because ASDF isn't loaded yet.
;; We still want to work despite and host/device funkiness.
(defvar *asdf-lisp*
  (truename
(defparameter *test-directory*
  (make-pathname :name nil :type nil :version nil
                 :defaults (or *load-truename* *compile-file-truename*)))
(defparameter *asdf-directory*
  (merge-pathnames
    (make-pathname :directory '(:relative :up) :name "asdf" :type "lisp"
                   :defaults *load-truename*)
    *load-truename*)))
(defvar *asdf-fasl*
   (make-pathname :directory '(:relative :back) :defaults *test-directory*)
   *test-directory*))
(defparameter *asdf-lisp*
  (make-pathname :name "asdf" :type "lisp" :defaults *asdf-directory*))
(defparameter *asdf-fasl*
  (compile-file-pathname
   (let ((impl (string-downcase
                (or #+allegro
@@ -28,7 +31,7 @@
                    #+scl scl))))
     (merge-pathnames
      (make-pathname :directory `(:relative "tmp" "fasls" ,impl)
                     :defaults *asdf-lisp*)
                     :defaults *asdf-directory*)
      *asdf-lisp*))))

(defun load-asdf ()
+78 −0
Original line number Diff line number Diff line
;;; -*- Lisp -*-
(load "script-support")
(load-asdf)
(in-package :asdf)

(defparameter *test-directory*
  (merge-pathnames*
    (make-pathname :directory '(:relative "tmp"))
    cl-user::*asdf-directory*))

(defun under-test-directory (designator &optional (defaults *test-directory*))
  (namestring (merge-pathnames* (merge-component-name-type designator) defaults)))

(defun create-conf-files (&optional (path *test-directory*))
  (let ((v `(("conf.d/conf1.conf"
              ((:directory ,(under-test-directory "dir1/"))))
             ("conf.d/conf2.conf"
              ((:tree ,(under-test-directory "dir2/")))))))
    (loop
      :for (file contents) :in v
      :for name = (under-test-directory file path)
      :do
      (ensure-directories-exist name)
      (with-open-file (out name
                           :direction :output
                           :if-exists :supersede)
        (with-standard-io-syntax
          (format out "~{~S~}" contents))))))

(defparameter *test-asd-directories*
  (loop
    :for dir
    :in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
    :collect (under-test-directory dir)))

(defun create-asd-files ()
  (loop
    :for d :in *test-asd-directories*
    :for i :from 0 :do
    (ensure-directories-exist d)
    (with-open-file (s (merge-pathnames* (format nil "foo~D.asd" i) d)
                       :direction :output
                       :if-exists :rename-and-delete
                       :if-does-not-exist :create)
      (format s "(asdf:defsystem :foo~D)~%" i))))

(cl-user::quit-on-error

(assert
 (equal (parse-output-translations-string "/foo:/bar::/baz:/quux")
        '(:output-translations
          ("/foo" "/bar")
          :inherit-configuration
          ("/baz" "/quux"))))
(assert
 (equal (parse-output-translations-string "/:")
        '(:output-translations ("/" nil) :ignore-inherited-configuration)))
(assert
 (equal (parse-output-translations-string "/::")
        '(:output-translations ("/" nil) :inherit-configuration)))
(assert
 (equal (parse-output-translations-string "/:/")
        '(:output-translations ("/" "/") :ignore-inherited-configuration)))

(assert
 (equal (parse-output-translations-string
         "(:output-translations (\"/\" \"/\") :ignore-inherited-configuration)")
        '(:output-translations ("/" "/") :ignore-inherited-configuration)))

(create-asd-files)
(create-conf-files)
(initialize-source-registry
 `(:source-registry (:include ,(under-test-directory "conf.d/"))
                    :ignore-inherited-configuration))
(assert
 (equal (namestring (system-relative-pathname :foo3 "bar/baz.lisp"))
        (under-test-directory "dir2/bar/baz.lisp")))
)
Loading