From c417fd282faa6c70e507651420100670ae98960a Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Mon, 12 Apr 2010 14:27:44 -0400 Subject: [PATCH] 1.674: Fix long-form of source-registry parsing. Add tests for configuration files. Also export enable-asdf-binary-locations-compatibility. --- asdf.lisp | 5 ++- doc/asdf.texinfo | 4 +- doc/index.html | 8 ++-- test/script-support.lisp | 19 ++++---- test/test-configuration.script | 78 ++++++++++++++++++++++++++++++++ test/test-module-depend.script | 2 +- test/test-source-registry.s | 82 ---------------------------------- test/test-utilities.script | 15 ------- 8 files changed, 99 insertions(+), 114 deletions(-) create mode 100644 test/test-configuration.script delete mode 100644 test/test-source-registry.s diff --git a/asdf.lisp b/asdf.lisp index d3d96c419..3b295df32 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -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 diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index aafb56274..c6e9061cd 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -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 diff --git a/doc/index.html b/doc/index.html index 6a14b0441..1e0098aeb 100644 --- a/doc/index.html +++ b/doc/index.html @@ -95,14 +95,14 @@ <dd>François-René 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> diff --git a/test/script-support.lisp b/test/script-support.lisp index 8358e5aa9..edecd3be3 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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 () diff --git a/test/test-configuration.script b/test/test-configuration.script new file mode 100644 index 000000000..9b6406cf3 --- /dev/null +++ b/test/test-configuration.script @@ -0,0 +1,78 @@ +;;; -*- 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"))) +) diff --git a/test/test-module-depend.script b/test/test-module-depend.script index 5bd7efa2b..ff6296a6b 100644 --- a/test/test-module-depend.script +++ b/test/test-module-depend.script @@ -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? diff --git a/test/test-source-registry.s b/test/test-source-registry.s deleted file mode 100644 index 51b348217..000000000 --- a/test/test-source-registry.s +++ /dev/null @@ -1,82 +0,0 @@ -(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 diff --git a/test/test-utilities.script b/test/test-utilities.script index e252a313d..5be682f6f 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -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))) ) -- GitLab