From 61e7074c9b83f010d970fd2c384c29b0315155bd Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Fri, 20 Dec 2013 01:53:56 -0500
Subject: [PATCH] Make upgrade more robust on CLISP.

---
 header.lisp       |  2 +-
 system.lisp       |  2 +-
 test/run-tests.sh |  9 +++++----
 uiop/utility.lisp | 10 +++++-----
 4 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/header.lisp b/header.lisp
index b674df47..2cb21b75 100644
--- a/header.lisp
+++ b/header.lisp
@@ -54,7 +54,7 @@
   (declaim (optimize (speed 1) (safety 3) (debug 3)))
   (setf ext:*gc-verbose* nil))
 
-#+(or abcl clisp clozure cmu ecl xcl) ;; punt on hard package upgrade on those implementations
+#+(or abcl clozure cmu ecl xcl) ;; punt on hard package upgrade on those implementations
 (eval-when (:load-toplevel :compile-toplevel :execute)
   (unless (member :asdf3 *features*)
     (let* ((existing-version
diff --git a/system.lisp b/system.lisp
index ba2dfcd9..40a8324f 100644
--- a/system.lisp
+++ b/system.lisp
@@ -23,7 +23,7 @@
 
 (with-upgradability ()
   (defgeneric* (find-system) (system &optional error-p))
-  (defgeneric* (system-source-file) (system)
+  (defgeneric* (system-source-file :supersede #-clisp t #+clisp nil) (system)
     (:documentation "Return the source file in which system is defined."))
   (defgeneric component-build-pathname (component))
 
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 29ded0d0..430ef946 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -381,12 +381,13 @@ valid_upgrade_test_p () {
         allegromodern:1.*) : ;;
         # ccl fasl numbering broke loading of old asdf 2.0
         ccl:2.0[01]*) : ;;
-        # my old ubuntu clisp 2.44.1 is wired in
+        # My old ubuntu 10.04LTS clisp 2.44.1 came wired in
         # with an antique ASDF 1.374 from CLC that can't be downgraded.
-        # 2.00[0-7] use UID, which fails on that CLISP and was removed afterwards.
+        # More recent CLISPs work.
+        # 2.00[0-7] use UID, which fails on some old CLISPs.
         # Note that for the longest time, CLISP has included 2.011 in its distribution.
-        # Since we punt on the upgrade, let's only do the test once, for 2.26.
-        clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;;
+        # We don't punt on upgrade anymore, so we can go at it!
+        ### clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;;
         # Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade.
         # Weird unidentified problems before 2.018, so we punt equally for everything before,
         # and only need to test it once: above, for 2.017.
diff --git a/uiop/utility.lisp b/uiop/utility.lisp
index 3cc30397..bd645498 100644
--- a/uiop/utility.lisp
+++ b/uiop/utility.lisp
@@ -46,6 +46,9 @@
   (defun undefine-function (function-spec)
     (cond
       ((symbolp function-spec)
+       ;; undefining the previous function is the portable way
+       ;; of overriding any incompatible previous gf,
+       ;; but CLISP needs extra help with getting rid of previous methods.
        #+clisp
        (let ((f (and (fboundp function-spec) (fdefinition function-spec))))
          (when (typep f 'clos:standard-generic-function)
@@ -67,12 +70,9 @@
                     name)
               (declare (ignorable supersede))
               `(progn
-                 ;; undefining the previous function is the portable way
-                 ;; of overriding any incompatible previous gf, except on CLISP.
                  ;; We usually try to do it only for the functions that need it,
-                 ;; which happens in asdf/upgrade - however, for ECL, we need this hammer
-                 ;; (which causes issues in clisp)
-                 ,@(when (or #-clisp supersede #+ecl t)
+                 ;; which happens in asdf/upgrade - however, for ECL, we need this hammer.
+                 ,@(when (or supersede #+ecl t)
                      `((undefine-function ',name)))
                  ,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
                      `((declaim (notinline ,name))))
-- 
GitLab