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&ccedil;ois-Ren&eacute; 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