Loading .gitignore +1 −0 Original line number Diff line number Diff line Loading @@ -35,3 +35,4 @@ tmp/ *.a *.*fsl *.bak *.data asdf.lisp +304 −274 Original line number Diff line number Diff line Loading @@ -49,7 +49,8 @@ (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) Loading @@ -57,35 +58,40 @@ ;;;; See https://bugs.launchpad.net/asdf/+bug/485687 ;;;; 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) #+allegro (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 ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.714" (1+ (length "VERSION")))) ;; the 1+ helps the version bumping script discriminate (subseq "VERSION:1.715" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf (symbol-value (find-symbol (string versym) existing-asdf)))) (redefined-functions '(#:perform #:explain #:output-files #:operation-done-p #:perform-with-restarts #:component-relative-pathname #:system-source-file #:operate #:find-component)) (vername '#:*asdf-version*) (versym (and existing-asdf (find-symbol (string vername) existing-asdf))) (existing-version (and versym (boundp versym) (symbol-value versym))) (already-there (equal asdf-version existing-version))) (unless (and existing-asdf already-there) #-gcl (when existing-asdf (format *error-output* "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%" existing-version asdf-version)) (labels ((rename-away (package) (labels ((rename-away (package) (loop :with name = (package-name package) :for i :from 1 :for new = (format nil "~A.~D" name i) :unless (find-package new) :do (rename-package-name package name new))) (rename-package-name (package old new) (let* ((old-names (cons (package-name package) (package-nicknames package))) (let* ((old-names (cons (package-name package) (package-nicknames package))) (new-names (subst new old old-names :test 'equal)) (new-name (car new-names)) (new-nicknames (cdr new-names))) Loading @@ -99,8 +105,10 @@ :from-end t))) (cond (previous (map () #'rename-away (cdr previous)) ;; packages with conflicting (nick)names (let ((p (car previous))) ;; previous package with same name ;; do away with packages with conflicting (nick)names (map () #'rename-away (cdr previous)) ;; reuse previous package with same name (let ((p (car previous))) (rename-package p name nicknames) (ensure-use p use) p)) Loading Loading @@ -144,13 +152,23 @@ (ensure-export p export) (ensure-fmakunbound p fmakunbound) p))) (ensure-package ':asdf-utilities :nicknames '(#:asdf-extensions) :use '(#:common-lisp) :unintern '(#:split #:make-collector) (macrolet ((pkgdcl (name &key nicknames use export redefined-functions unintern fmakunbound shadow) `(ensure-package ',name :nicknames ',nicknames :use ',use :export ',export :shadow ',shadow :unintern ',(append #-(or gcl ecl) redefined-functions unintern) :fmakunbound ',(append #+(or gcl ecl) redefined-functions fmakunbound)))) (pkgdcl :asdf-utilities :nicknames (#:asdf-extensions) :use (#:common-lisp) :unintern (#:split #:make-collector) :export '(#:absolute-pathname-p (#:absolute-pathname-p #:aif #:appendf #:asdf-message Loading @@ -163,7 +181,6 @@ #:length=n-p #:merge-pathnames* #:pathname-directory-pathname #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname #:read-file-forms #:remove-keys #:remove-keyword Loading @@ -174,19 +191,23 @@ #:system-registered-p #:truenamize #:while-collecting)) (ensure-package ':asdf :use '(:common-lisp :asdf-utilities) :unintern `(#-(or gcl ecl) ,@redefined-functions #:*asdf-revision* #:around #:asdf-method-combination (pkgdcl :asdf :use (:common-lisp :asdf-utilities) :redefined-functions (#:perform #:explain #:output-files #:operation-done-p #:perform-with-restarts #:component-relative-pathname #:system-source-file #:operate #:find-component) :unintern (#:*asdf-revision* #:around #:asdf-method-combination #:split #:make-collector) :fmakunbound `(#+(or gcl ecl) ,@redefined-functions #:system-source-file :fmakunbound (#:system-source-file #:component-relative-pathname #:system-relative-pathname #:process-source-registry #:inherit-source-registry #:process-source-registry-directive) :export '(#:defsystem #:oos #:operate #:find-system #:run-shell-command (#:defsystem #:oos #:operate #:find-system #:run-shell-command #:system-definition-pathname #:find-component ; miscellaneous #:compile-system #:load-system #:test-system #:compile-op #:load-op #:load-source-op Loading Loading @@ -235,7 +256,7 @@ #:operation-on-warnings #:operation-on-failure ;#:*component-parent-pathname* ;;#:*component-parent-pathname* #:*system-definition-search-functions* #:*central-registry* ; variables #:*compile-file-warnings-behaviour* Loading Loading @@ -277,8 +298,8 @@ #:compute-source-registry #:clear-source-registry #:ensure-source-registry #:process-source-registry)) (let* ((version (intern* versym :asdf)) #:process-source-registry))) (let* ((version (intern* vername :asdf)) (upvar (intern* '#:*upgraded-p* :asdf)) (upval0 (and (boundp upvar) (symbol-value upvar))) (upval1 (if existing-version (cons existing-version upval0) upval0))) Loading @@ -289,6 +310,10 @@ (in-package :asdf) ;; 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* #+ecl (defmethod update-instance-for-redefined-class :after Loading Loading @@ -449,14 +474,6 @@ processed in order by `operate`.")) (defmacro aif (test then &optional 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) "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, and NIL NAME, TYPE and VERSION components" Loading Loading @@ -498,6 +515,13 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (values (pathname-host defaults) (pathname-device defaults) (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)))) (make-pathname :host host :device device :directory directory :name (funcall unspecific-handler name) Loading Loading @@ -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. ;; See CLHS make-pathname and 19.2.2.2.3. ;; 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)) (split-string filename :max 2 :separator ".") (if (equal name "") Loading Loading @@ -711,6 +735,15 @@ actually-existing directory." (return p)) (let ((sofar (ignore-errors (truename (pathname-root p))))) (unless sofar (return p)) (flet ((solution (directory) (merge-pathnames* (make-pathname :host nil :device nil :directory directory :name (pathname-name p) :type (pathname-type p) :version (pathname-version p) :defaults "/" :case :local) sofar))) (loop :for component :in (cdr directory) :for rest :on (cdr directory) :for more = (ignore-errors Loading @@ -720,19 +753,9 @@ actually-existing directory." sofar))) :do (if more (setf sofar more) (return (merge-pathnames* (make-pathname :host nil :device nil :directory `(:relative ,@rest) :defaults p) sofar))) (return (solution `(:relative ,@rest)))) :finally (return (merge-pathnames* (make-pathname :host nil :device nil :directory nil :defaults p) sofar))))))) (return (solution nil)))))))) (defun lispize-pathname (input-file) (make-pathname :type "lisp" :defaults input-file)) Loading Loading @@ -2021,7 +2044,7 @@ Returns the new tree (which probably shares structure with the old one)" (defun sysdef-error-component (msg type name value) (sysdef-error (concatenate 'string msg "~&The value specified for ~(~A~) ~A is ~W") "~&The value specified for ~(~A~) ~A is ~S") type name value)) (defun check-component-input (type name weakly-depends-on Loading Loading @@ -2157,20 +2180,9 @@ synchronously execute the result using a Bourne-compatible shell, with output to `*verbose-out*`. Returns the shell's exit code." (let ((command (apply #'format nil control-string args))) (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) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :input nil :output *verbose-out*)) #+abcl (ext:run-shell-command command :output *verbose-out*) #+allegro ;; will this fail if command has embedded quotes - it seems to work Loading @@ -2184,18 +2196,10 @@ output to `*verbose-out*`. Returns the shell's exit code." (format *verbose-out* "~{~&; ~a~%~}~%" stdout) 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 (ext:run-shell-command command :output :terminal :wait t) #+openmcl #+clozure (nth-value 1 (ccl:external-process-status (ccl:run-program "/bin/sh" (list "-c" command) Loading @@ -2205,12 +2209,34 @@ output to `*verbose-out*`. Returns the shell's exit code." #+ecl ;; courtesy of Juan Jose Garcia Ripoll (si:system command) #+abcl (ext:run-shell-command command :output *verbose-out*) #+gcl (lisp:system command) #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl abcl) (error "RUN-SHELL-COMMAND not implemented for this Lisp") )) #+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 cmu scl) (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 Loading @@ -2229,9 +2255,13 @@ located." :defaults (system-source-file system-designator))) (defun relativize-directory (directory) (if (eq (car directory) :absolute) (cons :relative (cdr directory)) directory)) (cond ((stringp directory) (list :relative directory)) ((eq (car directory) :absolute) (cons :relative (cdr directory))) (t directory))) (defun relativize-pathname-directory (pathspec) (let ((p (pathname pathspec))) Loading test/asdf-pathname-test.script +4 −4 Original line number Diff line number Diff line Loading @@ -185,11 +185,11 @@ (handler-bind ((error (lambda (c) (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) #+clozure (ccl:print-call-history :count 69 :start-frame-number 1) #+clisp (system::print-backtrace) (format result-stream "~&~%***~%error: ~a~%~:w" (format result-stream "~&~%***~%error: ~a~%~s" c system-definition) (return-from :test-system)))) (unless (and (or (typep system-pathname 'logical-pathname) Loading Loading @@ -241,9 +241,9 @@ :missing))) 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) (let ((homogeneous-failures 0) (*print-length* nil)) Loading test/try-reloading-dependency.asddeleted 100644 → 0 +0 −5 Original line number Diff line number Diff line ;;; -*- Lisp -*- (asdf:defsystem try-reloading-dependency :components ((:file "file3"))) Loading
.gitignore +1 −0 Original line number Diff line number Diff line Loading @@ -35,3 +35,4 @@ tmp/ *.a *.*fsl *.bak *.data
asdf.lisp +304 −274 Original line number Diff line number Diff line Loading @@ -49,7 +49,8 @@ (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) Loading @@ -57,35 +58,40 @@ ;;;; See https://bugs.launchpad.net/asdf/+bug/485687 ;;;; 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) #+allegro (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 ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace (subseq "VERSION:1.714" (1+ (length "VERSION")))) ;; the 1+ helps the version bumping script discriminate (subseq "VERSION:1.715" (1+ (length "VERSION")))) (existing-asdf (find-package :asdf)) (versym '#:*asdf-version*) (existing-version (and existing-asdf (symbol-value (find-symbol (string versym) existing-asdf)))) (redefined-functions '(#:perform #:explain #:output-files #:operation-done-p #:perform-with-restarts #:component-relative-pathname #:system-source-file #:operate #:find-component)) (vername '#:*asdf-version*) (versym (and existing-asdf (find-symbol (string vername) existing-asdf))) (existing-version (and versym (boundp versym) (symbol-value versym))) (already-there (equal asdf-version existing-version))) (unless (and existing-asdf already-there) #-gcl (when existing-asdf (format *error-output* "~&Upgrading ASDF package ~@[from version ~A ~]to version ~A~%" existing-version asdf-version)) (labels ((rename-away (package) (labels ((rename-away (package) (loop :with name = (package-name package) :for i :from 1 :for new = (format nil "~A.~D" name i) :unless (find-package new) :do (rename-package-name package name new))) (rename-package-name (package old new) (let* ((old-names (cons (package-name package) (package-nicknames package))) (let* ((old-names (cons (package-name package) (package-nicknames package))) (new-names (subst new old old-names :test 'equal)) (new-name (car new-names)) (new-nicknames (cdr new-names))) Loading @@ -99,8 +105,10 @@ :from-end t))) (cond (previous (map () #'rename-away (cdr previous)) ;; packages with conflicting (nick)names (let ((p (car previous))) ;; previous package with same name ;; do away with packages with conflicting (nick)names (map () #'rename-away (cdr previous)) ;; reuse previous package with same name (let ((p (car previous))) (rename-package p name nicknames) (ensure-use p use) p)) Loading Loading @@ -144,13 +152,23 @@ (ensure-export p export) (ensure-fmakunbound p fmakunbound) p))) (ensure-package ':asdf-utilities :nicknames '(#:asdf-extensions) :use '(#:common-lisp) :unintern '(#:split #:make-collector) (macrolet ((pkgdcl (name &key nicknames use export redefined-functions unintern fmakunbound shadow) `(ensure-package ',name :nicknames ',nicknames :use ',use :export ',export :shadow ',shadow :unintern ',(append #-(or gcl ecl) redefined-functions unintern) :fmakunbound ',(append #+(or gcl ecl) redefined-functions fmakunbound)))) (pkgdcl :asdf-utilities :nicknames (#:asdf-extensions) :use (#:common-lisp) :unintern (#:split #:make-collector) :export '(#:absolute-pathname-p (#:absolute-pathname-p #:aif #:appendf #:asdf-message Loading @@ -163,7 +181,6 @@ #:length=n-p #:merge-pathnames* #:pathname-directory-pathname #:pathname-sans-name+type ;; deprecated. Use pathname-directory-pathname #:read-file-forms #:remove-keys #:remove-keyword Loading @@ -174,19 +191,23 @@ #:system-registered-p #:truenamize #:while-collecting)) (ensure-package ':asdf :use '(:common-lisp :asdf-utilities) :unintern `(#-(or gcl ecl) ,@redefined-functions #:*asdf-revision* #:around #:asdf-method-combination (pkgdcl :asdf :use (:common-lisp :asdf-utilities) :redefined-functions (#:perform #:explain #:output-files #:operation-done-p #:perform-with-restarts #:component-relative-pathname #:system-source-file #:operate #:find-component) :unintern (#:*asdf-revision* #:around #:asdf-method-combination #:split #:make-collector) :fmakunbound `(#+(or gcl ecl) ,@redefined-functions #:system-source-file :fmakunbound (#:system-source-file #:component-relative-pathname #:system-relative-pathname #:process-source-registry #:inherit-source-registry #:process-source-registry-directive) :export '(#:defsystem #:oos #:operate #:find-system #:run-shell-command (#:defsystem #:oos #:operate #:find-system #:run-shell-command #:system-definition-pathname #:find-component ; miscellaneous #:compile-system #:load-system #:test-system #:compile-op #:load-op #:load-source-op Loading Loading @@ -235,7 +256,7 @@ #:operation-on-warnings #:operation-on-failure ;#:*component-parent-pathname* ;;#:*component-parent-pathname* #:*system-definition-search-functions* #:*central-registry* ; variables #:*compile-file-warnings-behaviour* Loading Loading @@ -277,8 +298,8 @@ #:compute-source-registry #:clear-source-registry #:ensure-source-registry #:process-source-registry)) (let* ((version (intern* versym :asdf)) #:process-source-registry))) (let* ((version (intern* vername :asdf)) (upvar (intern* '#:*upgraded-p* :asdf)) (upval0 (and (boundp upvar) (symbol-value upvar))) (upval1 (if existing-version (cons existing-version upval0) upval0))) Loading @@ -289,6 +310,10 @@ (in-package :asdf) ;; 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* #+ecl (defmethod update-instance-for-redefined-class :after Loading Loading @@ -449,14 +474,6 @@ processed in order by `operate`.")) (defmacro aif (test then &optional 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) "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME, and NIL NAME, TYPE and VERSION components" Loading Loading @@ -498,6 +515,13 @@ Also, if either argument is NIL, then the other argument is returned unmodified. (values (pathname-host defaults) (pathname-device defaults) (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)))) (make-pathname :host host :device device :directory directory :name (funcall unspecific-handler name) Loading Loading @@ -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. ;; See CLHS make-pathname and 19.2.2.2.3. ;; 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)) (split-string filename :max 2 :separator ".") (if (equal name "") Loading Loading @@ -711,6 +735,15 @@ actually-existing directory." (return p)) (let ((sofar (ignore-errors (truename (pathname-root p))))) (unless sofar (return p)) (flet ((solution (directory) (merge-pathnames* (make-pathname :host nil :device nil :directory directory :name (pathname-name p) :type (pathname-type p) :version (pathname-version p) :defaults "/" :case :local) sofar))) (loop :for component :in (cdr directory) :for rest :on (cdr directory) :for more = (ignore-errors Loading @@ -720,19 +753,9 @@ actually-existing directory." sofar))) :do (if more (setf sofar more) (return (merge-pathnames* (make-pathname :host nil :device nil :directory `(:relative ,@rest) :defaults p) sofar))) (return (solution `(:relative ,@rest)))) :finally (return (merge-pathnames* (make-pathname :host nil :device nil :directory nil :defaults p) sofar))))))) (return (solution nil)))))))) (defun lispize-pathname (input-file) (make-pathname :type "lisp" :defaults input-file)) Loading Loading @@ -2021,7 +2044,7 @@ Returns the new tree (which probably shares structure with the old one)" (defun sysdef-error-component (msg type name value) (sysdef-error (concatenate 'string msg "~&The value specified for ~(~A~) ~A is ~W") "~&The value specified for ~(~A~) ~A is ~S") type name value)) (defun check-component-input (type name weakly-depends-on Loading Loading @@ -2157,20 +2180,9 @@ synchronously execute the result using a Bourne-compatible shell, with output to `*verbose-out*`. Returns the shell's exit code." (let ((command (apply #'format nil control-string args))) (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) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :input nil :output *verbose-out*)) #+abcl (ext:run-shell-command command :output *verbose-out*) #+allegro ;; will this fail if command has embedded quotes - it seems to work Loading @@ -2184,18 +2196,10 @@ output to `*verbose-out*`. Returns the shell's exit code." (format *verbose-out* "~{~&; ~a~%~}~%" stdout) 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 (ext:run-shell-command command :output :terminal :wait t) #+openmcl #+clozure (nth-value 1 (ccl:external-process-status (ccl:run-program "/bin/sh" (list "-c" command) Loading @@ -2205,12 +2209,34 @@ output to `*verbose-out*`. Returns the shell's exit code." #+ecl ;; courtesy of Juan Jose Garcia Ripoll (si:system command) #+abcl (ext:run-shell-command command :output *verbose-out*) #+gcl (lisp:system command) #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl abcl) (error "RUN-SHELL-COMMAND not implemented for this Lisp") )) #+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 cmu scl) (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 Loading @@ -2229,9 +2255,13 @@ located." :defaults (system-source-file system-designator))) (defun relativize-directory (directory) (if (eq (car directory) :absolute) (cons :relative (cdr directory)) directory)) (cond ((stringp directory) (list :relative directory)) ((eq (car directory) :absolute) (cons :relative (cdr directory))) (t directory))) (defun relativize-pathname-directory (pathspec) (let ((p (pathname pathspec))) Loading
test/asdf-pathname-test.script +4 −4 Original line number Diff line number Diff line Loading @@ -185,11 +185,11 @@ (handler-bind ((error (lambda (c) (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) #+clozure (ccl:print-call-history :count 69 :start-frame-number 1) #+clisp (system::print-backtrace) (format result-stream "~&~%***~%error: ~a~%~:w" (format result-stream "~&~%***~%error: ~a~%~s" c system-definition) (return-from :test-system)))) (unless (and (or (typep system-pathname 'logical-pathname) Loading Loading @@ -241,9 +241,9 @@ :missing))) 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) (let ((homogeneous-failures 0) (*print-length* nil)) Loading
test/try-reloading-dependency.asddeleted 100644 → 0 +0 −5 Original line number Diff line number Diff line ;;; -*- Lisp -*- (asdf:defsystem try-reloading-dependency :components ((:file "file3")))