From 8b6734db3383ac4e6eb734fbbf3f020ccb68e81a Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Fri, 7 May 2010 12:29:27 -0400
Subject: [PATCH] 1.720: integrate feedback from Clozure, Franz. * minor
 stylistic cleanups for CCL * refactor use of *load-truename* for more
 consistency.

---
 asdf.lisp        | 46 ++++++++++++++++++++++------------------------
 doc/asdf.texinfo | 19 +++----------------
 2 files changed, 25 insertions(+), 40 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index 8c436796..30695c26 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -49,8 +49,8 @@
 
 (cl:in-package :cl-user)
 
-(declaim (optimize (speed 2) (debug 2) (safety 3))
-         #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
+#|(declaim (optimize (speed 2) (debug 2) (safety 3))
+#+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))|#
 
 #+ecl (require :cmp)
 
@@ -70,7 +70,7 @@
                 :test 'equalp :key 'car))
   (let* ((asdf-version
           ;; the 1+ helps the version bumping script discriminate
-          (subseq "VERSION:1.719" (1+ (length "VERSION"))))
+          (subseq "VERSION:1.720" (1+ (length "VERSION"))))
          (existing-asdf (find-package :asdf))
          (vername '#:*asdf-version*)
          (versym (and existing-asdf
@@ -626,7 +626,7 @@ pathnames."
   #+sbcl
   (sb-ext:posix-getenv x)
   #+clozure
-  (ccl::getenv x)
+  (ccl:getenv x)
   #+clisp
   (ext:getenv x)
   #+cmu
@@ -1947,24 +1947,21 @@ details."
 ;;;; -------------------------------------------------------------------------
 ;;;; Defsystem
 
+(defun load-pathname ()
+  (let ((pn (or *load-pathname* *compile-file-pathname*)))
+    (if *resolve-symlinks*
+        (and pn (resolve-symlinks pn))
+        pn)))
+
 (defun determine-system-pathname (pathname pathname-supplied-p)
-  ;; called from the defsystem macro.
-  ;; the pathname of a system is either
+  ;; The defsystem macro calls us to determine
+  ;; the pathname of a system as follows:
   ;; 1. the one supplied,
-  ;; 2. derived from the *load-truename* (see below), or
-  ;; 3. taken from *default-pathname-defaults*
-  ;;
-  ;; if using *load-truename*, then we also deal with whether or not
-  ;; to resolve symbolic links. If not resolving symlinks, then we use
-  ;; *load-pathname* instead of *load-truename* since in some
-  ;; implementations, the latter has *already resolved it.
-  (let ((file-pathname
-         (when (or *load-pathname* *compile-file-pathname*)
-           (pathname-directory-pathname
-            (if *resolve-symlinks*
-                (resolve-symlinks (or *load-truename* *compile-file-truename*))
-                *load-pathname*)))))
-    (or (and pathname-supplied-p (merge-pathnames* pathname file-pathname))
+  ;; 2. derived from *load-pathname* via load-pathname
+  ;; 3. taken from the *default-pathname-defaults* via current-directory
+  (let* ((file-pathname (load-pathname))
+         (directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
+    (or (and pathname-supplied-p (merge-pathnames* pathname directory-pathname))
         file-pathname
         (current-directory))))
 
@@ -1987,7 +1984,7 @@ details."
                  (t
                   (register-system (quote ,name)
                                    (make-instance ',class :name ',name))))
-           (%set-system-source-file *load-truename*
+           (%set-system-source-file (load-pathname)
                                     (cdr (system-registered-p ',name))))
          (parse-component-form
           nil (list*
@@ -2563,6 +2560,7 @@ with a different configuration, so the configuration would be re-read then."
                (relativize-pathname-directory (current-directory)))
               ((eql :implementation) (implementation-identifier))
               ((eql :implementation-type) (string-downcase (implementation-type)))
+              #-(and (or win32 windows mswindows mingw32) (not cygwin))
               ((eql :uid) (princ-to-string (get-uid)))))
          (d (if (pathnamep x) r (ensure-directory-pathname r)))
          (s (if (and wildenp (not (pathnamep x)))
@@ -2677,8 +2675,8 @@ with a different configuration, so the configuration would be re-read then."
     ;; Some implementations have precompiled ASDF systems,
     ;; so we must disable translations for implementation paths.
     #+sbcl (,(getenv "SBCL_HOME") ())
-    #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; only needed if LPNs are resolved manually.
-    #+clozure (,(wilden (ccl::ccl-directory)) ()) ; not needed: no precompiled ASDF system
+    #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; not needed: no precompiled ASDF system
+    #+clozure (,(wilden (truename #p"ccl:")) ()) ; not needed: no precompiled ASDF system
     ;; All-import, here is where we want user stuff to be:
     :inherit-configuration
     ;; These are for convenience, and can be overridden by the user:
@@ -3283,7 +3281,7 @@ with a different configuration, so the configuration would be re-read then."
           t))))
   (pushnew 'module-provide-asdf
            #+abcl sys::*module-provider-functions*
-           #+clozure ccl::*module-provider-functions*
+           #+clozure ccl:*module-provider-functions*
            #+cmu ext:*module-provider-functions*
            #+ecl si:*module-provider-functions*
            #+sbcl sb-ext:*module-provider-functions*))
diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo
index eaf5e5a5..a5d74c0c 100644
--- a/doc/asdf.texinfo
+++ b/doc/asdf.texinfo
@@ -2635,11 +2635,12 @@ Windows support was notably quirky because of such non-portability.
 @item
 The internal test suite used to massively fail on many implementations.
 While still incomplete, it now fully passes
-on all implementations supported by the test suite.
+on all implementations supported by the test suite,
+except for GCL (due to GCL bugs).
 
 @item
 Support was lacking for some implementations.
-ABCL was notably wholly broken.
+ABCL and GCL were notably wholly broken.
 ECL extensions were not integrated in the ASDF release.
 
 @item
@@ -3089,12 +3090,8 @@ What would be a nice interface for this functionality?
 
 @section Missing bits in implementation
 
-** all of the above
-
 ** reuse the same scratch package whenever a system is reloaded from disk
 
-** rules for system pathname defaulting are not yet implemented properly
-
 ** proclamations probably aren't
 
 ** when a system is reloaded with fewer components than it previously had, odd things happen
@@ -3103,16 +3100,6 @@ We should do something inventive when processing a @code{defsystem} form,
 like take the list of kids and @code{setf} the slot to @code{nil},
 then transfer children from old to new list as they're found.
 
-**  traverse may become a normal function
-
-If you're defining methods on @code{traverse}, speak up.
-
-
-** a lot of load-op methods can be rewritten to use input-files
-
-so should be.
-
-
 ** (stuff that might happen later)
 
 *** Propagation of the @code{:force} option.
-- 
GitLab