From 9259a065590233a0e3eaa8c7ac71b3ee6e220cd6 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Fri, 29 Oct 2010 06:11:01 -0700
Subject: [PATCH] 2.147: improve things somewhat for gcl. Merge two u-i-f-r-c
 methods for smaller output.

---
 asdf.lisp                      | 31 ++++++++++++++-----------------
 test/asdf-pathname-test.script |  9 ++++-----
 2 files changed, 18 insertions(+), 22 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index 43757f6f..2ffaeeb3 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -49,6 +49,8 @@
 
 (cl:in-package :cl-user)
 
+#+gcl (defpackage :asdf (:use :cl)) ;; GCL treats defpackage magically and needs this
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   ;;; make package if it doesn't exist yet.
   ;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
@@ -71,7 +73,7 @@
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (defvar *asdf-version* nil)
   (defvar *upgraded-p* nil)
-  (let* ((asdf-version "2.146") ;; bump this version when you modify this file.
+  (let* ((asdf-version "2.147") ;; bump this version when you modify this file.
          (existing-asdf (fboundp 'find-system))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -323,19 +325,14 @@
          (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))
    (when (find-class 'module nil)
      (eval
-      '(progn
-         (defmethod update-instance-for-redefined-class :after
-             ((m module) added deleted plist &key)
-           (declare (ignorable deleted plist))
-           (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m))
-           (when (member 'components-by-name added)
-             (compute-module-components-by-name m)))
-         (defmethod update-instance-for-redefined-class :after
-             ((s system) added deleted plist &key)
-           (declare (ignorable deleted plist))
-           (when *asdf-verbose* (format *trace-output* "Updating ~A~%" s))
-           (when (member 'source-file added)
-             (%set-system-source-file (probe-asd (component-name s) (component-pathname s)) s)))))))
+      '(defmethod update-instance-for-redefined-class :after
+           ((m module) added deleted plist &key)
+         (declare (ignorable deleted plist))
+         (when *asdf-verbose* (format *trace-output* "Updating ~A~%" m))
+         (when (member 'components-by-name added)
+           (compute-module-components-by-name m))
+         (when (and (typep m 'system) (member 'source-file added))
+           (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m))))))
 
 ;;;; -------------------------------------------------------------------------
 ;;;; User-visible parameters
@@ -535,11 +532,11 @@ Also, if either argument is NIL, then the other argument is returned unmodified.
          (directory (pathname-directory specified))
          (directory
           (cond
-            #-(or sbcl cmu)
+            #-(or sbcl cmu scl)
             ((stringp directory) `(:absolute ,directory) directory)
             #+gcl
-            ((and (consp directory) (stringp (first directory)))
-             `(:absolute ,@directory))
+            ((and (consp directory) (not (member (first directory) '(:absolute :relative))))
+             `(:relative ,@directory))
             ((or (null directory)
                  (and (consp directory) (member (first directory) '(:absolute :relative))))
              directory)
diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script
index 0e2a0f52..50dd95ad 100644
--- a/test/asdf-pathname-test.script
+++ b/test/asdf-pathname-test.script
@@ -64,7 +64,6 @@
                   ("**;*.*.*"
                    ,(make-pathname :directory (src-dir :wild-inferiors)
                                    :name :wild :type :wild))))
-
           (let ((failures nil)
                 (systems `(,(make-pathname :directory (src-dir "system1") :name nil :type nil)
                            ,(make-pathname :host "ASDFTEST" :directory '(:absolute "system1"))
@@ -209,13 +208,12 @@
                                          pathname))
                                      (test-module (module)
                                        (incf directory-count)
-                                       (unless #-clisp (probe-file (asdf:component-pathname module))
-                                               #+clisp (ext:probe-directory (asdf:component-pathname module))
+                                       (unless (asdf::probe-file* (asdf:component-pathname module))
                                          (incf directory-failures)
                                          (push (list (type-of module) (asdf:component-name module)
                                                      (translate-if-needed (asdf:component-pathname module))
                                                      configuration
-                                                     (list (when (asdf:component-parent module) (asdf:component-pathname  (asdf:component-parent module)))))
+                                                     (list (when (asdf:component-parent module) (asdf:component-pathname (asdf:component-parent module)))))
                                                failures)))
                                      (test-file (file)
                                        (incf file-count)
@@ -280,7 +278,8 @@
  (asdf:initialize-output-translations)
  (format t "output translations: ~S~%" (asdf::output-translations))
 
- #-(or clisp ecl) ; clisp has problem with the first one having :version :newest
+ #+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
+
  (progn ; 1- we're testing with unix, are we not?
    (assert (equal (asdf::resolve-location '(:home)) (truename (user-homedir-pathname))))
    (assert (equal (asdf::resolve-location '("/foo" "bar" "baz")) #p"/foo/bar/baz"))
-- 
GitLab