From e258cad51ae8eb02f0a385ce1e2b50cf12020cf2 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sat, 24 Apr 2010 20:02:55 -0400 Subject: [PATCH] 1.706: Report errors while searching for systems (fix for bug 569109, by Juanjo). Fix lisp-version-string for ECL (1.705 bug - oops). Trivial cleanups and small documentation updates. --- asdf.lisp | 30 ++++++++++++++++++------------ doc/asdf.texinfo | 2 +- doc/index.html | 3 ++- test/test1.script | 2 +- 4 files changed, 22 insertions(+), 15 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index cb033e14..93378060 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -63,7 +63,7 @@ (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) (let* ((asdf-version ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace - (subseq "VERSION:1.705" (1+ (length "VERSION")))) + (subseq "VERSION:1.706" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf @@ -683,7 +683,7 @@ actually-existing directory." (defun get-uid () (let ((uid-string (with-output-to-string (*verbose-out*) - (asdf:run-shell-command "id -ur")))) + (run-shell-command "id -ur")))) (with-input-from-string (stream uid-string) (read-line stream) (handler-case (parse-integer (read-line stream)) @@ -1066,7 +1066,7 @@ to `~a` which is not a directory.~@:>" (defun make-temporary-package () (flet ((try (counter) (ignore-errors - (make-package (format nil "~a~D" 'asdf counter) + (make-package (format nil "~A~D" :asdf counter) :use '(:cl :asdf))))) (do* ((counter 0 (+ counter 1)) (package (try counter) (try counter))) @@ -1901,7 +1901,7 @@ details." ;; we recur when trying to find an existing system of the same name ;; to reuse options (e.g. pathname) from ,@(loop :for system :in defsystem-depends-on - :collect `(asdf:load-system ,system)) + :collect `(load-system ,system)) (let ((s (system-registered-p ',name))) (cond ((and s (eq (type-of (cdr s)) ',class)) (setf (car s) (get-universal-time))) @@ -2236,7 +2236,7 @@ located." #+cmu (substitute #\- #\/ s) #+digitool (subseq s 8) #+ecl (format nil "~A~@[-~A~]" s - (let ((vcs-id (funcall (ext:lisp-implementation-vcs-id)))) + (let ((vcs-id (ext:lisp-implementation-vcs-id))) (when (>= (length vcs-id) 8) (subseq vcs-id 0 8)))) #+lispworks (format nil "~A~@[~A~]" s @@ -2332,7 +2332,8 @@ located." (list #p"/etc/")))) (defun in-first-directory (dirs x) (loop :for dir :in dirs - :thereis (and dir (ignore-errors (truename (merge-pathnames* x (ensure-directory-pathname dir))))))) + :thereis (and dir (ignore-errors + (truename (merge-pathnames* x (ensure-directory-pathname dir))))))) (defun in-user-configuration-directory (x) (in-first-directory (user-configuration-directories) x)) (defun in-system-configuration-directory (x) @@ -3035,10 +3036,15 @@ with a different configuration, so the configuration would be re-read then." (defun register-asd-directory (directory &key recurse exclude collect) (if (not recurse) (funcall collect directory) - (let* ((files (ignore-errors - (directory (merge-pathnames* *wild-asd* directory) - #+sbcl #+sbcl :resolve-symlinks nil - #+clisp #+clisp :circle t))) + (let* ((files + (handler-case + (directory (merge-pathnames* *wild-asd* directory) + #+sbcl #+sbcl :resolve-symlinks nil + #+clisp #+clisp :circle t) + (error (c) + (warn "Error while scanning system definitions under directory ~S:~%~A" + directory c) + nil))) (dirs (remove-duplicates (mapcar #'pathname-directory-pathname files) :test #'equal :from-end t))) (loop @@ -3199,9 +3205,9 @@ with a different configuration, so the configuration would be re-read then." (format *error-output* "ASDF could not load ~A because ~A.~%" name e)))) (let* ((*verbose-out* (make-broadcast-stream)) - (system (asdf:find-system name nil))) + (system (find-system name nil))) (when system - (asdf:operate 'asdf:load-op name) + (load-system name) t)))) (pushnew 'module-provide-asdf #+sbcl sb-ext:*module-provider-functions* diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 7d7689ae..390384a0 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -535,7 +535,7 @@ other ASDF add-ons offered the same functionality, each in subtly different and incompatible ways: ASDF-Binary-Locations, cl-launch, common-lisp-controller. ASDF-Binary-Locations is now not needed anymore and should not be used. -cl-launch 3.0 and common-lisp-controller 7.1 have been updated +cl-launch 2.900 and common-lisp-controller 7.1 have been updated to just delegate this functionality to ASDF. @node Using ASDF, Defining systems with defsystem, Configuring ASDF, Top diff --git a/doc/index.html b/doc/index.html index a4de63ca..d8d14a96 100644 --- a/doc/index.html +++ b/doc/index.html @@ -92,7 +92,8 @@ <dl> <dt>December 2009 to April 2010</dt> <dd>François-René Rideau is de facto maintainer, - with notable contributions from Robert P. Goldman. + with notable contributions from Robert P. Goldman, + Juanjo Garcia-Ripoll and James Anderson. Push towards an ASDF 2 release with many clean-ups, better configurability and updated documentation. diff --git a/test/test1.script b/test/test1.script index fe6955f8..c3713f3d 100644 --- a/test/test1.script +++ b/test/test1.script @@ -22,7 +22,7 @@ ;; recompiled (sleep 1) ; mtime has 1-second granularity, so pause here for fast machines - (trace asdf::operation-done-p asdf::traverse) + ;;(trace asdf::operation-done-p asdf::traverse) (asdf::run-shell-command "rm -f ~A" (namestring file2)) (asdf:operate 'asdf:load-op 'test1) (assert (= file1-date (file-write-date file1))) -- GitLab