[cmucl-cvs] CMUCL commit: src/contrib/asdf (asdf.lisp)

[Raymond Toy]

    Date: Friday, September 17, 2010 @ 19:25:58
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/contrib/asdf

Modified: asdf.lisp

Update to upstream asdf 2.008.


-----------+
 asdf.lisp |   48 ++++++++++++++++++++++++++++--------------------
 1 file changed, 28 insertions(+), 20 deletions(-)


Index: src/contrib/asdf/asdf.lisp
diff -u src/contrib/asdf/asdf.lisp:1.7 src/contrib/asdf/asdf.lisp:1.8
--- src/contrib/asdf/asdf.lisp:1.7	Thu Aug 26 09:09:22 2010
+++ src/contrib/asdf/asdf.lisp	Fri Sep 17 19:25:58 2010
@@ -72,7 +72,7 @@
   (defvar *asdf-version* nil)
   (defvar *upgraded-p* nil)
   (let* ((asdf-version ;; the 1+ helps the version bumping script discriminate
-          (subseq "VERSION:2.007" (1+ (length "VERSION")))) ; same as 2.124
+          (subseq "VERSION:2.008" (1+ (length "VERSION")))) ; same as 2.128
          (existing-asdf (fboundp 'find-system))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -176,6 +176,9 @@
                    :shadow ',shadow
                    :unintern ',(append #-(or gcl ecl) redefined-functions unintern)
                    :fmakunbound ',(append fmakunbound))))
+          (let ((u (find-package :asdf-utilities)))
+            (when u
+              (ensure-unintern u (loop :for s :being :each :present-symbol :in u :collect s))))
           (pkgdcl
            :asdf
            :use (:common-lisp)
@@ -287,29 +290,29 @@
             #:clear-source-registry
             #:ensure-source-registry
             #:process-source-registry
+            #:system-registered-p
+            #:asdf-message
 
             ;; Utilities
             #:absolute-pathname-p
-            #:aif
-            #:appendf
-            #:asdf-message
+	    ;; #:aif #:it
+            ;; #:appendf
             #:coerce-name
             #:directory-pathname-p
-            #:ends-with
+            ;; #:ends-with
             #:ensure-directory-pathname
             #:getenv
-            #:get-uid
-            #:length=n-p
+            ;; #:get-uid
+            ;; #:length=n-p
             #:merge-pathnames*
             #:pathname-directory-pathname
             #:read-file-forms
-            #:remove-keys
-            #:remove-keyword
+	    ;; #:remove-keys
+	    ;; #:remove-keyword
             #:resolve-symlinks
             #:split-string
             #:component-name-to-pathname-components
             #:split-name-type
-            #:system-registered-p
             #:truenamize
             #:while-collecting)))
         (setf *asdf-version* asdf-version
@@ -531,7 +534,7 @@
   (let* ((specified (pathname specified))
          (defaults (pathname defaults))
          (directory (pathname-directory specified))
-         #-sbcl (directory (if (stringp directory) `(:absolute ,directory) directory))
+         #-(or sbcl cmu) (directory (if (stringp directory) `(:absolute ,directory) directory))
          (name (or (pathname-name specified) (pathname-name defaults)))
          (type (or (pathname-type specified) (pathname-type defaults)))
          (version (or (pathname-version specified) (pathname-version defaults))))
@@ -740,7 +743,9 @@
                   '(ffi:clines "#include <sys/types.h>" "#include <unistd.h>"))
   (defun* get-uid ()
     #+allegro (excl.osi:getuid)
-    #+clisp (posix:uid)
+    #+clisp (loop :for s :in '("posix:uid" "LINUX:getuid")
+	          :for f = (ignore-errors (read-from-string s))
+                  :when f :return (funcall f))
     #+(or cmu scl) (unix:unix-getuid)
     #+ecl #.(cl:if (cl:< ext:+ecl-version-number+ 100601)
                    '(ffi:c-inline () () :int "getuid()" :one-liner t)
@@ -764,11 +769,13 @@
 (defun* probe-file* (p)
   "when given a pathname P, probes the filesystem for a file or directory
 with given pathname and if it exists return its truename."
-  (and (pathnamep p) (not (wild-pathname-p p))
-       #+(or allegro clozure cmu ecl sbcl scl) (probe-file p)
-       #+clisp (ext:probe-pathname p)
-       #-(or allegro clisp clozure cmu ecl sbcl scl)
-       (ignore-errors (truename p))))
+  (etypecase p
+   (null nil)
+   (string (probe-file* (parse-namestring p)))
+   (pathname (unless (wild-pathname-p p)
+               #.(or #+(or allegro clozure cmu ecl sbcl scl) '(probe-file p)
+               #+clisp (aif (find-symbol (string :probe-pathname) :ext) `(,it p))
+	       '(ignore-errors (truename p)))))))
 
 (defun* truenamize (p)
   "Resolve as much of a pathname as possible"
@@ -779,7 +786,7 @@
       (when (typep p 'logical-pathname) (return p))
       (let ((found (probe-file* p)))
         (when found (return found)))
-      #-sbcl (when (stringp directory) (return p))
+      #-(or sbcl cmu) (when (stringp directory) (return p))
       (when (not (eq :absolute (car directory))) (return p))
       (let ((sofar (probe-file* (pathname-root p))))
         (unless sofar (return p))
@@ -857,7 +864,8 @@
                 error-name error-pathname error-condition
                 duplicate-names-name
                 error-component error-operation
-                module-components module-components-by-name)
+                module-components module-components-by-name
+                circular-dependency-components)
          (ftype (function (t t) t) (setf module-components-by-name)))
 
 
@@ -1353,7 +1361,7 @@
   ;; NOTE that the host and device slots will be taken from the defaults,
   ;; but that should only matter if you either (a) use absolute pathnames, or
   ;; (b) later merge relative pathnames with CL:MERGE-PATHNAMES instead of
-  ;; ASDF-UTILITIES:MERGE-PATHNAMES*
+  ;; ASDF:MERGE-PATHNAMES*
   (etypecase name
     (pathname
      name)