Skip to content
Snippets Groups Projects
Commit 30bb39c6 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.715: support gcl 2.7.0

parent 95c5ffb8
No related branches found
Tags 1.715
No related merge requests found
...@@ -35,3 +35,4 @@ tmp/ ...@@ -35,3 +35,4 @@ tmp/
*.a *.a
*.*fsl *.*fsl
*.bak *.bak
*.data
...@@ -49,7 +49,8 @@ ...@@ -49,7 +49,8 @@
(cl:in-package :cl-user) (cl:in-package :cl-user)
(declaim (optimize (speed 2) (debug 2) (safety 3))) (declaim (optimize (speed 2) (debug 2) (safety 3))
#+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))
#+ecl (require :cmp) #+ecl (require :cmp)
...@@ -57,228 +58,248 @@ ...@@ -57,228 +58,248 @@
;;;; See https://bugs.launchpad.net/asdf/+bug/485687 ;;;; See https://bugs.launchpad.net/asdf/+bug/485687
;;;; See more at the end of the file. ;;;; See more at the end of the file.
#+gcl
(eval-when (:compile-toplevel :load-toplevel)
(defpackage :asdf-utilities (:use :cl))
(defpackage :asdf (:use :cl :asdf-utilities)))
(eval-when (:load-toplevel :compile-toplevel :execute) (eval-when (:load-toplevel :compile-toplevel :execute)
#+allegro #+allegro
(setf excl::*autoload-package-name-alist* (setf excl::*autoload-package-name-alist*
(remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car)) (remove "asdf" excl::*autoload-package-name-alist*
:test 'equalp :key 'car))
(let* ((asdf-version (let* ((asdf-version
;; the 1+ hair is to ensure that we don't do an inadvertent find and replace ;; the 1+ helps the version bumping script discriminate
(subseq "VERSION:1.714" (1+ (length "VERSION")))) (subseq "VERSION:1.715" (1+ (length "VERSION"))))
(existing-asdf (find-package :asdf)) (existing-asdf (find-package :asdf))
(versym '#:*asdf-version*) (vername '#:*asdf-version*)
(existing-version (and existing-asdf (versym (and existing-asdf
(symbol-value (find-symbol (string vername) existing-asdf)))
(find-symbol (string versym) existing-asdf)))) (existing-version (and versym (boundp versym) (symbol-value versym)))
(redefined-functions
'(#:perform #:explain #:output-files #:operation-done-p
#:perform-with-restarts #:component-relative-pathname
#:system-source-file #:operate #:find-component))
(already-there (equal asdf-version existing-version))) (already-there (equal asdf-version existing-version)))
(unless (and existing-asdf already-there) (unless (and existing-asdf already-there)
#-gcl
(when existing-asdf (when existing-asdf
(format *error-output* (format *error-output*
"~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%" "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%"
existing-version asdf-version)) existing-version asdf-version))
(labels ((rename-away (package) (labels
(loop :with name = (package-name package) ((rename-away (package)
:for i :from 1 :for new = (format nil "~A.~D" name i) (loop :with name = (package-name package)
:unless (find-package new) :do :for i :from 1 :for new = (format nil "~A.~D" name i)
(rename-package-name package name new))) :unless (find-package new) :do
(rename-package-name (package old new) (rename-package-name package name new)))
(let* ((old-names (cons (package-name package) (package-nicknames package))) (rename-package-name (package old new)
(new-names (subst new old old-names :test 'equal)) (let* ((old-names (cons (package-name package)
(new-name (car new-names)) (package-nicknames package)))
(new-nicknames (cdr new-names))) (new-names (subst new old old-names :test 'equal))
(rename-package package new-name new-nicknames))) (new-name (car new-names))
(ensure-exists (name nicknames use) (new-nicknames (cdr new-names)))
(let* ((previous (rename-package package new-name new-nicknames)))
(remove-duplicates (ensure-exists (name nicknames use)
(remove-if (let* ((previous
#'null (remove-duplicates
(mapcar #'find-package (cons name nicknames))) (remove-if
:from-end t))) #'null
(cond (mapcar #'find-package (cons name nicknames)))
(previous :from-end t)))
(map () #'rename-away (cdr previous)) ;; packages with conflicting (nick)names (cond
(let ((p (car previous))) ;; previous package with same name (previous
(rename-package p name nicknames) ;; do away with packages with conflicting (nick)names
(ensure-use p use) (map () #'rename-away (cdr previous))
p)) ;; reuse previous package with same name
(t (let ((p (car previous)))
(make-package name :nicknames nicknames :use use))))) (rename-package p name nicknames)
(find-sym (symbol package) (ensure-use p use)
(find-symbol (string symbol) package)) p))
(intern* (symbol package) (t
(intern (string symbol) package)) (make-package name :nicknames nicknames :use use)))))
(remove-symbol (symbol package) (find-sym (symbol package)
(let ((sym (find-sym symbol package))) (find-symbol (string symbol) package))
(when sym (intern* (symbol package)
(unexport sym package) (intern (string symbol) package))
(unintern sym package)))) (remove-symbol (symbol package)
(ensure-unintern (package symbols) (let ((sym (find-sym symbol package)))
(dolist (sym symbols) (remove-symbol sym package))) (when sym
(ensure-shadow (package symbols) (unexport sym package)
(shadow symbols package)) (unintern sym package))))
(ensure-use (package use) (ensure-unintern (package symbols)
(dolist (used (reverse use)) (dolist (sym symbols) (remove-symbol sym package)))
(do-external-symbols (sym used) (ensure-shadow (package symbols)
(unless (eq sym (find-sym sym package)) (shadow symbols package))
(remove-symbol sym package))) (ensure-use (package use)
(use-package used package))) (dolist (used (reverse use))
(ensure-fmakunbound (package symbols) (do-external-symbols (sym used)
(loop :for name :in symbols (unless (eq sym (find-sym sym package))
:for sym = (find-sym name package) (remove-symbol sym package)))
:when sym :do (fmakunbound sym))) (use-package used package)))
(ensure-export (package export) (ensure-fmakunbound (package symbols)
(let ((syms (loop :for x :in export :collect (loop :for name :in symbols
(intern* x package)))) :for sym = (find-sym name package)
(do-external-symbols (sym package) :when sym :do (fmakunbound sym)))
(unless (member sym syms) (ensure-export (package export)
(remove-symbol sym package))) (let ((syms (loop :for x :in export :collect
(dolist (sym syms) (intern* x package))))
(export sym package)))) (do-external-symbols (sym package)
(ensure-package (name &key nicknames use unintern fmakunbound shadow export) (unless (member sym syms)
(let ((p (ensure-exists name nicknames use))) (remove-symbol sym package)))
(ensure-unintern p unintern) (dolist (sym syms)
(ensure-shadow p shadow) (export sym package))))
(ensure-export p export) (ensure-package (name &key nicknames use unintern fmakunbound shadow export)
(ensure-fmakunbound p fmakunbound) (let ((p (ensure-exists name nicknames use)))
p))) (ensure-unintern p unintern)
(ensure-package (ensure-shadow p shadow)
':asdf-utilities (ensure-export p export)
:nicknames '(#:asdf-extensions) (ensure-fmakunbound p fmakunbound)
:use '(#:common-lisp) p)))
:unintern '(#:split #:make-collector) (macrolet
:export ((pkgdcl (name &key nicknames use export
'(#:absolute-pathname-p redefined-functions unintern fmakunbound shadow)
#:aif `(ensure-package
#:appendf ',name :nicknames ',nicknames :use ',use :export ',export
#:asdf-message :shadow ',shadow
#:coerce-name :unintern ',(append #-(or gcl ecl) redefined-functions
#:directory-pathname-p unintern)
#:ends-with :fmakunbound ',(append #+(or gcl ecl) redefined-functions
#:ensure-directory-pathname fmakunbound))))
#:getenv (pkgdcl
#:get-uid :asdf-utilities
#:length=n-p :nicknames (#:asdf-extensions)
#:merge-pathnames* :use (#:common-lisp)
#:pathname-directory-pathname :unintern (#:split #:make-collector)
#:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname :export
#:read-file-forms (#:absolute-pathname-p
#:remove-keys #:aif
#:remove-keyword #:appendf
#:resolve-symlinks #:asdf-message
#:split-string #:coerce-name
#:component-name-to-pathname-components #:directory-pathname-p
#:split-name-type #:ends-with
#:system-registered-p #:ensure-directory-pathname
#:truenamize #:getenv
#:while-collecting)) #:get-uid
(ensure-package #:length=n-p
':asdf #:merge-pathnames*
:use '(:common-lisp :asdf-utilities) #:pathname-directory-pathname
:unintern `(#-(or gcl ecl) ,@redefined-functions #:read-file-forms
#:*asdf-revision* #:around #:asdf-method-combination #:remove-keys
#:split #:make-collector) #:remove-keyword
:fmakunbound `(#+(or gcl ecl) ,@redefined-functions #:resolve-symlinks
#:system-source-file #:split-string
#:component-relative-pathname #:system-relative-pathname #:component-name-to-pathname-components
#:process-source-registry #:split-name-type
#:inherit-source-registry #:process-source-registry-directive) #:system-registered-p
:export #:truenamize
'(#:defsystem #:oos #:operate #:find-system #:run-shell-command #:while-collecting))
#:system-definition-pathname #:find-component ; miscellaneous (pkgdcl
#:compile-system #:load-system #:test-system :asdf
#:compile-op #:load-op #:load-source-op :use (:common-lisp :asdf-utilities)
#:test-op :redefined-functions
#:operation ; operations (#:perform #:explain #:output-files #:operation-done-p
#:feature ; sort-of operation #:perform-with-restarts #:component-relative-pathname
#:version ; metaphorically sort-of an operation #:system-source-file #:operate #:find-component)
#:version-satisfies :unintern
(#:*asdf-revision* #:around #:asdf-method-combination
#:input-files #:output-files #:perform ; operation methods #:split #:make-collector)
#:operation-done-p #:explain :fmakunbound
(#:system-source-file
#:component #:source-file #:component-relative-pathname #:system-relative-pathname
#:c-source-file #:cl-source-file #:java-source-file #:process-source-registry
#:static-file #:inherit-source-registry #:process-source-registry-directive)
#:doc-file :export
#:html-file (#:defsystem #:oos #:operate #:find-system #:run-shell-command
#:text-file #:system-definition-pathname #:find-component ; miscellaneous
#:source-file-type #:compile-system #:load-system #:test-system
#:module ; components #:compile-op #:load-op #:load-source-op
#:system #:test-op
#:unix-dso #:operation ; operations
#:feature ; sort-of operation
#:module-components ; component accessors #:version ; metaphorically sort-of an operation
#:module-components-by-name ; component accessors #:version-satisfies
#:component-pathname
#:component-relative-pathname #:input-files #:output-files #:perform ; operation methods
#:component-name #:operation-done-p #:explain
#:component-version
#:component-parent #:component #:source-file
#:component-property #:c-source-file #:cl-source-file #:java-source-file
#:component-system #:static-file
#:doc-file
#:component-depends-on #:html-file
#:text-file
#:system-description #:source-file-type
#:system-long-description #:module ; components
#:system-author #:system
#:system-maintainer #:unix-dso
#:system-license
#:system-licence #:module-components ; component accessors
#:system-source-file #:module-components-by-name ; component accessors
#:system-source-directory #:component-pathname
#:system-relative-pathname #:component-relative-pathname
#:map-systems #:component-name
#:component-version
#:operation-on-warnings #:component-parent
#:operation-on-failure #:component-property
;#:*component-parent-pathname* #:component-system
#:*system-definition-search-functions*
#:*central-registry* ; variables #:component-depends-on
#:*compile-file-warnings-behaviour*
#:*compile-file-failure-behaviour* #:system-description
#:*resolve-symlinks* #:system-long-description
#:*asdf-verbose* #:system-author
#:system-maintainer
#:asdf-version #:system-license
#:system-licence
#:operation-error #:compile-failed #:compile-warned #:compile-error #:system-source-file
#:error-name #:system-source-directory
#:error-pathname #:system-relative-pathname
#:load-system-definition-error #:map-systems
#:error-component #:error-operation
#:system-definition-error #:operation-on-warnings
#:missing-component #:operation-on-failure
#:missing-component-of-version ;;#:*component-parent-pathname*
#:missing-dependency #:*system-definition-search-functions*
#:missing-dependency-of-version #:*central-registry* ; variables
#:circular-dependency ; errors #:*compile-file-warnings-behaviour*
#:duplicate-names #:*compile-file-failure-behaviour*
#:*resolve-symlinks*
#:try-recompiling #:*asdf-verbose*
#:retry
#:accept ; restarts #:asdf-version
#:coerce-entry-to-directory
#:remove-entry-from-registry #:operation-error #:compile-failed #:compile-warned #:compile-error
#:error-name
#:initialize-output-translations #:error-pathname
#:disable-output-translations #:load-system-definition-error
#:clear-output-translations #:error-component #:error-operation
#:ensure-output-translations #:system-definition-error
#:apply-output-translations #:missing-component
#:compile-file-pathname* #:missing-component-of-version
#:enable-asdf-binary-locations-compatibility #:missing-dependency
#:missing-dependency-of-version
#:*default-source-registries* #:circular-dependency ; errors
#:initialize-source-registry #:duplicate-names
#:compute-source-registry
#:clear-source-registry #:try-recompiling
#:ensure-source-registry #:retry
#:process-source-registry)) #:accept ; restarts
(let* ((version (intern* versym :asdf)) #:coerce-entry-to-directory
#:remove-entry-from-registry
#:initialize-output-translations
#:disable-output-translations
#:clear-output-translations
#:ensure-output-translations
#:apply-output-translations
#:compile-file-pathname*
#:enable-asdf-binary-locations-compatibility
#:*default-source-registries*
#:initialize-source-registry
#:compute-source-registry
#:clear-source-registry
#:ensure-source-registry
#:process-source-registry)))
(let* ((version (intern* vername :asdf))
(upvar (intern* '#:*upgraded-p* :asdf)) (upvar (intern* '#:*upgraded-p* :asdf))
(upval0 (and (boundp upvar) (symbol-value upvar))) (upval0 (and (boundp upvar) (symbol-value upvar)))
(upval1 (if existing-version (cons existing-version upval0) upval0))) (upval1 (if existing-version (cons existing-version upval0) upval0)))
...@@ -289,6 +310,10 @@ ...@@ -289,6 +310,10 @@
(in-package :asdf) (in-package :asdf)
;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687 ;; More cleanups in case of hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
#+gcl
(eval-when (:compile-toplevel :load-toplevel)
(defvar *asdf-version* nil)
(defvar *upgraded-p* nil))
(when *upgraded-p* (when *upgraded-p*
#+ecl #+ecl
(defmethod update-instance-for-redefined-class :after (defmethod update-instance-for-redefined-class :after
...@@ -449,14 +474,6 @@ processed in order by `operate`.")) ...@@ -449,14 +474,6 @@ processed in order by `operate`."))
(defmacro aif (test then &optional else) (defmacro aif (test then &optional else)
`(let ((it ,test)) (if it ,then ,else))) `(let ((it ,test)) (if it ,then ,else)))
(defun pathname-sans-name+type (pathname)
"Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
and NIL NAME and TYPE components.
Issue: doesn't override the VERSION component.
Deprecated. Use PATHNAME-DIRECTORY-PATHNAME instead."
(make-pathname :name nil :type nil :defaults pathname))
(defun pathname-directory-pathname (pathname) (defun pathname-directory-pathname (pathname)
"Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
and NIL NAME, TYPE and VERSION components" and NIL NAME, TYPE and VERSION components"
...@@ -498,6 +515,13 @@ Also, if either argument is NIL, then the other argument is returned unmodified. ...@@ -498,6 +515,13 @@ Also, if either argument is NIL, then the other argument is returned unmodified.
(values (pathname-host defaults) (values (pathname-host defaults)
(pathname-device defaults) (pathname-device defaults)
(append (pathname-directory defaults) (cdr directory)) (append (pathname-directory defaults) (cdr directory))
(unspecific-handler defaults)))
#+gcl
(t
(assert (stringp (first directory)))
(values (pathname-host defaults)
(pathname-device defaults)
(append (pathname-directory defaults) directory)
(unspecific-handler defaults)))) (unspecific-handler defaults))))
(make-pathname :host host :device device :directory directory (make-pathname :host host :device device :directory directory
:name (funcall unspecific-handler name) :name (funcall unspecific-handler name)
...@@ -539,7 +563,7 @@ starting the separation from the end, e.g. when called with arguments ...@@ -539,7 +563,7 @@ starting the separation from the end, e.g. when called with arguments
;; Giving :unspecific as argument to make-pathname is not portable. ;; Giving :unspecific as argument to make-pathname is not portable.
;; See CLHS make-pathname and 19.2.2.2.3. ;; See CLHS make-pathname and 19.2.2.2.3.
;; We only use it on implementations that support it. ;; We only use it on implementations that support it.
(or #+(or sbcl ccl ecl lispworks) :unspecific))) (or #+(or ccl ecl gcl lispworks sbcl) :unspecific)))
(destructuring-bind (name &optional (type unspecific)) (destructuring-bind (name &optional (type unspecific))
(split-string filename :max 2 :separator ".") (split-string filename :max 2 :separator ".")
(if (equal name "") (if (equal name "")
...@@ -711,28 +735,27 @@ actually-existing directory." ...@@ -711,28 +735,27 @@ actually-existing directory."
(return p)) (return p))
(let ((sofar (ignore-errors (truename (pathname-root p))))) (let ((sofar (ignore-errors (truename (pathname-root p)))))
(unless sofar (return p)) (unless sofar (return p))
(loop :for component :in (cdr directory) (flet ((solution (directory)
:for rest :on (cdr directory) (merge-pathnames*
:for more = (ignore-errors (make-pathname :host nil :device nil
(truename :directory directory
(merge-pathnames* :name (pathname-name p)
(make-pathname :directory `(:relative ,component)) :type (pathname-type p)
sofar))) :do :version (pathname-version p)
(if more :defaults "/" :case :local)
(setf sofar more) sofar)))
(return (loop :for component :in (cdr directory)
(merge-pathnames* :for rest :on (cdr directory)
(make-pathname :host nil :device nil :for more = (ignore-errors
:directory `(:relative ,@rest) (truename
:defaults p) (merge-pathnames*
sofar))) (make-pathname :directory `(:relative ,component))
:finally sofar))) :do
(return (if more
(merge-pathnames* (setf sofar more)
(make-pathname :host nil :device nil (return (solution `(:relative ,@rest))))
:directory nil :finally
:defaults p) (return (solution nil))))))))
sofar)))))))
(defun lispize-pathname (input-file) (defun lispize-pathname (input-file)
(make-pathname :type "lisp" :defaults input-file)) (make-pathname :type "lisp" :defaults input-file))
...@@ -2021,7 +2044,7 @@ Returns the new tree (which probably shares structure with the old one)" ...@@ -2021,7 +2044,7 @@ Returns the new tree (which probably shares structure with the old one)"
(defun sysdef-error-component (msg type name value) (defun sysdef-error-component (msg type name value)
(sysdef-error (concatenate 'string msg (sysdef-error (concatenate 'string msg
"~&The value specified for ~(~A~) ~A is ~W") "~&The value specified for ~(~A~) ~A is ~S")
type name value)) type name value))
(defun check-component-input (type name weakly-depends-on (defun check-component-input (type name weakly-depends-on
...@@ -2157,20 +2180,9 @@ synchronously execute the result using a Bourne-compatible shell, with ...@@ -2157,20 +2180,9 @@ synchronously execute the result using a Bourne-compatible shell, with
output to `*verbose-out*`. Returns the shell's exit code." output to `*verbose-out*`. Returns the shell's exit code."
(let ((command (apply #'format nil control-string args))) (let ((command (apply #'format nil control-string args)))
(asdf-message "; $ ~A~%" command) (asdf-message "; $ ~A~%" command)
#+sbcl
(sb-ext:process-exit-code
(apply #'sb-ext:run-program
#+win32 "sh" #-win32 "/bin/sh"
(list "-c" command)
:input nil :output *verbose-out*
#+win32 '(:search t) #-win32 nil))
#+(or cmu scl) #+abcl
(ext:process-exit-code (ext:run-shell-command command :output *verbose-out*)
(ext:run-program
"/bin/sh"
(list "-c" command)
:input nil :output *verbose-out*))
#+allegro #+allegro
;; will this fail if command has embedded quotes - it seems to work ;; will this fail if command has embedded quotes - it seems to work
...@@ -2184,18 +2196,10 @@ output to `*verbose-out*`. Returns the shell's exit code." ...@@ -2184,18 +2196,10 @@ output to `*verbose-out*`. Returns the shell's exit code."
(format *verbose-out* "~{~&; ~a~%~}~%" stdout) (format *verbose-out* "~{~&; ~a~%~}~%" stdout)
exit-code) exit-code)
#+lispworks
(system:call-system-showing-output
command
:shell-type "/bin/sh"
:show-cmd nil
:prefix ""
:output-stream *verbose-out*)
#+clisp ;XXX not exactly *verbose-out*, I know #+clisp ;XXX not exactly *verbose-out*, I know
(ext:run-shell-command command :output :terminal :wait t) (ext:run-shell-command command :output :terminal :wait t)
#+openmcl #+clozure
(nth-value 1 (nth-value 1
(ccl:external-process-status (ccl:external-process-status
(ccl:run-program "/bin/sh" (list "-c" command) (ccl:run-program "/bin/sh" (list "-c" command)
...@@ -2205,12 +2209,34 @@ output to `*verbose-out*`. Returns the shell's exit code." ...@@ -2205,12 +2209,34 @@ output to `*verbose-out*`. Returns the shell's exit code."
#+ecl ;; courtesy of Juan Jose Garcia Ripoll #+ecl ;; courtesy of Juan Jose Garcia Ripoll
(si:system command) (si:system command)
#+abcl #+gcl
(ext:run-shell-command command :output *verbose-out*) (lisp:system command)
#+lispworks
(system:call-system-showing-output
command
:shell-type "/bin/sh"
:show-cmd nil
:prefix ""
:output-stream *verbose-out*)
#+sbcl
(sb-ext:process-exit-code
(apply #'sb-ext:run-program
#+win32 "sh" #-win32 "/bin/sh"
(list "-c" command)
:input nil :output *verbose-out*
#+win32 '(:search t) #-win32 nil))
#-(or openmcl clisp lispworks allegro scl cmu sbcl ecl abcl) #+(or cmu scl)
(error "RUN-SHELL-COMMAND not implemented for this Lisp") (ext:process-exit-code
)) (ext:run-program
"/bin/sh"
(list "-c" command)
:input nil :output *verbose-out*))
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl)
(error "RUN-SHELL-COMMAND not implemented for this Lisp")))
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; system-relative-pathname ;;;; system-relative-pathname
...@@ -2229,9 +2255,13 @@ located." ...@@ -2229,9 +2255,13 @@ located."
:defaults (system-source-file system-designator))) :defaults (system-source-file system-designator)))
(defun relativize-directory (directory) (defun relativize-directory (directory)
(if (eq (car directory) :absolute) (cond
(cons :relative (cdr directory)) ((stringp directory)
directory)) (list :relative directory))
((eq (car directory) :absolute)
(cons :relative (cdr directory)))
(t
directory)))
(defun relativize-pathname-directory (pathspec) (defun relativize-pathname-directory (pathspec)
(let ((p (pathname pathspec))) (let ((p (pathname pathspec)))
......
...@@ -185,11 +185,11 @@ ...@@ -185,11 +185,11 @@
(handler-bind (handler-bind
((error (lambda (c) ((error (lambda (c)
(incf system-failures) (incf system-failures)
(format *error-output* "~&error! ~a~%sysdef:~% ~W~%" c system-definition) (format *error-output* "~&error! ~a~%sysdef:~% ~S~%" c system-definition)
#+sbcl (sb-debug:backtrace 69) #+sbcl (sb-debug:backtrace 69)
#+clozure (ccl:print-call-history :count 69 :start-frame-number 1) #+clozure (ccl:print-call-history :count 69 :start-frame-number 1)
#+clisp (system::print-backtrace) #+clisp (system::print-backtrace)
(format result-stream "~&~%***~%error: ~a~%~:w" (format result-stream "~&~%***~%error: ~a~%~s"
c system-definition) c system-definition)
(return-from :test-system)))) (return-from :test-system))))
(unless (and (or (typep system-pathname 'logical-pathname) (unless (and (or (typep system-pathname 'logical-pathname)
...@@ -241,9 +241,9 @@ ...@@ -241,9 +241,9 @@
:missing))) :missing)))
test-files)) test-files))
(format result-stream "~&~%~% translations: ~a: ~:w" "ASDFTEST" (logical-pathname-translations "ASDFTEST")) (format result-stream "~&~%~% translations: ~a: ~s" "ASDFTEST" (logical-pathname-translations "ASDFTEST"))
(format result-stream "~&~%~% variations:~% systems: ~:w~% modules: ~:w~% files: ~:w" (format result-stream "~&~%~% variations:~% systems: ~s~% modules: ~s~% files: ~s"
systems modules files) systems modules files)
(let ((homogeneous-failures 0) (*print-length* nil)) (let ((homogeneous-failures 0) (*print-length* nil))
......
;;; -*- Lisp -*-
(asdf:defsystem try-reloading-dependency
:components ((:file "file3")))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment