Commit 86243bfd authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.629: play nicer with upgrade on CLISP.

parent a381162b
Loading
Loading
Loading
Loading
+4 −4
Original line number Diff line number Diff line
@@ -247,7 +247,7 @@
  ;; This parameter isn't actually user-visible
  ;; -- please use the exported function ASDF:ASDF-VERSION below.
  ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
  (subseq "VERSION:1.628" (1+ (length "VERSION"))))
  (subseq "VERSION:1.629" (1+ (length "VERSION"))))

(defun asdf-version ()
  "Exported interface to the version of ASDF currently installed. A string.
@@ -1125,7 +1125,7 @@ to `~a` which is not a directory.~@:>"
(defmethod source-file-type ((c html-file) (s module)) "html")
(defmethod source-file-type ((c static-file) (s module)) nil)

(defun merge-component-relative-pathname (name &key type defaults)
(defun merge-component-name-type (name &key type defaults)
  ;; The defaults are required notably because they provide the default host
  ;; to the below make-pathname, which may crucially matter to
  ;; e.g. people somehow using logical-pathnames.
@@ -1133,7 +1133,7 @@ to `~a` which is not a directory.~@:>"
    (pathname
     name)
    (symbol
     (merge-component-relative-pathname (string-downcase name) :type type :defaults defaults))
     (merge-component-name-type (string-downcase name) :type type :defaults defaults))
    (string
     (multiple-value-bind (relative path filename)
         (component-name-to-pathname-components name (eq type :directory))
@@ -1153,7 +1153,7 @@ to `~a` which is not a directory.~@:>"
                          :host host :device device)))))))

(defmethod component-relative-pathname ((component component))
  (merge-component-relative-pathname
  (merge-component-name-type
   (or (slot-value component 'relative-pathname)
       (component-name component))
   :type (source-file-type component (component-system component))
+2 −0
Original line number Diff line number Diff line
@@ -45,8 +45,10 @@ is bound, write a message and exit on an error. If
                  ((ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST"))
                   (break))
                  (t
                   (format *error-output* "ABORTING:~% ~S~%" c)
                   #+sbcl (sb-debug:backtrace 69)
                   #+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
                   (format *error-output* "ABORTING:~% ~S~%" c)
                   (leave-lisp "~&Script failed~%" 1))))))
    (funcall thunk)
    (leave-lisp "~&Script succeeded~%" 0)))
+1 −5
Original line number Diff line number Diff line
@@ -4,12 +4,8 @@

(quit-on-error
 (setf asdf:*central-registry* '(*default-pathname-defaults*))
 (format t "blah ~S~%" asdf:*central-registry*)
 (describe (asdf:find-system 'test1))
 (trace asdf:operate asdf:perform asdf::merge-component-relative-pathname
        asdf:component-name asdf:component-pathname)
 ;;(trace ASDF::MERGE-COMPONENT-RELATIVE-PATHNAME ASDF::COMPONENT-RELATIVE-PATHNAME)
 (asdf:operate 'asdf:load-op 'test1)
 (format t "blah~%")
 ;; test that it compiled
 (let* ((file1 (asdf:compile-file-pathname* "file1"))
        (file2 (asdf:compile-file-pathname* "file2"))