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

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

Add tests for configuration files.
Also export enable-asdf-binary-locations-compatibility.
parent 347e43c8
......@@ -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
......
......@@ -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
......
......@@ -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>
......
......@@ -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
(merge-pathnames
(make-pathname :directory '(:relative :up) :name "asdf" :type "lisp"
:defaults *load-truename*)
*load-truename*)))
(defvar *asdf-fasl*
(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 :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 ()
......
;;; -*- 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")))
)
......@@ -19,8 +19,8 @@
;; dependency bug is fixed.
(let ((before (file-write-date (asdf:compile-file-pathname* "file2"))))
(asdf::run-shell-command "touch file1.lisp")
(sleep 1)
(asdf::run-shell-command "touch file1.lisp")
(asdf:operate 'asdf:load-op 'test-module-depend)
(assert (> (file-write-date (asdf:compile-file-pathname* "file2")) before))
;; does this properly go to the second level?
......
(load "script-support")
(load "../asdf")
(defvar *test-directory*
(ensure-directory-pathname
(getenv "PWD")))
(defvar *test-conf-directory*
(merge-pathnames "conf.d/" (getenv "PWD")))
(defun under-test-directory (path &optional (defaults *test-directory*))
(merge-pathnames path defaults))
(defun ensure-recursive-directory (path)
(concatenate
'string
(namestring
(ensure-directory-pathname path))
"/"))
(defun create-conf-files (&optional (path *test-conf-directory*))
(let ((v `(("conf1.conf"
((:directory ,(namestring (under-test-directory "dir1/")))))
("conf2.conf"
((:tree ,(namestring (under-test-directory "dir2/"))))))))
(loop
:for (file contents) :in v :do
(with-open-file (out (merge-pathnames file path)
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(format out "~{~S~}" contents))))))
(defvar *test-config-1*
`(:source-registry
(:tree ,(getenv "PWD"))
(:ignore-inherited-configuration)))
(defvar *test-expect-1*
(append
(loop
:for dir
:in '("dir1/" "dir2/dir3/" "dir2/dir4/" "dir2/")
:collect (merge-pathnames dir *test-directory*))
(list *test-directory*)))
(defvar *test-source-registries*
'(test-environment-source-registry
test-environment-source-registry-recursive
test-something-3))
(defun test-environment-source-registry ()
(process-source-registry (getenv "CL_SOURCE_REGISTRY")
:inherit *test-source-registries*))
(defun test-environment-source-registry-recursive ()
(process-source-registry
(ensure-recursive-directory
(getenv "CL_SOURCE_REGISTRY"))
:inherit *test-source-registries*))
(defun test-directory-source-registry
(&optional (directory *test-conf-directory*))
(process-source-registry
(validate-source-registry-directory directory)))
(defun test-something-3 () nil)
(cl-user::quit-on-error
(create-conf-files)
(assert (every #'pathname (test-environment-source-registry)))
(assert (every #'pathname (test-environment-source-registry-recursive)))
(assert (equal (test-directory-source-registry) *test-expect-1*))
;; FIXME:
;; (assert (equal (process-source-registry
;; *test-config-1*)
;; *test-expect-1*))
;; FIXME: add more tests
;; (assert (equal ...))
)
\ No newline at end of file
......@@ -43,19 +43,4 @@
(assert
(not (asdf::version-satisfies (asdf:asdf-version) "666")))
(assert
(equal (asdf::parse-output-translations-string "/foo:/bar::/baz:/quux")
'(:output-translations
("/foo" "/bar")
:inherit-configuration
("/baz" "/quux"))))
(assert
(equal (asdf::parse-output-translations-string "/:")
'(:output-translations ("/" nil) :ignore-inherited-configuration)))
(assert
(equal (asdf::parse-output-translations-string "/::")
'(:output-translations ("/" nil) :inherit-configuration)))
(assert
(equal (asdf::parse-output-translations-string "/:/")
'(:output-translations ("/" "/") :ignore-inherited-configuration)))
)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment