Commit 9b3ac744 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.017.17: robustification and cleanup of Robert's previous CLISP checkin.

parent 89dd3a7a
...@@ -14,7 +14,7 @@ ...@@ -14,7 +14,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.017.16" ;; to be automatically updated by bin/bump-revision :version "2.017.17" ;; to be automatically updated by bin/bump-revision
:depends-on () :depends-on ()
:components :components
((:file "asdf") ((:file "asdf")
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.017.16: Another System Definition Facility. ;;; This is ASDF 2.017.17: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
...@@ -115,7 +115,7 @@ ...@@ -115,7 +115,7 @@
;; "2.345.6" would be a development version in the official upstream ;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(asdf-version "2.017.16") (asdf-version "2.017.17")
(existing-asdf (find-class 'component nil)) (existing-asdf (find-class 'component nil))
(existing-version *asdf-version*) (existing-version *asdf-version*)
(already-there (equal asdf-version existing-version))) (already-there (equal asdf-version existing-version)))
...@@ -2825,12 +2825,11 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -2825,12 +2825,11 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(asdf-message "~{~&~a~%~}~%" stdout) (asdf-message "~{~&~a~%~}~%" stdout)
exit-code) exit-code)
#+clisp ;XXX not exactly *verbose-out*, I know #+clisp
;; CLISP returns NIL for exit status zero. ;; CLISP returns NIL for exit status zero.
(if *verbose-out* (if *verbose-out*
(let* ((new-command (concatenate 'string (let* ((new-command (format nil "( ~A ) ; r=$? ; echo ; echo ASDF-EXIT-STATUS $r"
command command))
"; echo \"ASDF-EXIT-STATUS $?\""))
(outstream (ext:run-shell-command new-command :output :stream :wait t))) (outstream (ext:run-shell-command new-command :output :stream :wait t)))
(multiple-value-bind (retval out-lines) (multiple-value-bind (retval out-lines)
(unwind-protect (unwind-protect
...@@ -2839,9 +2838,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -2839,9 +2838,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
(asdf-message "~{~&~a~%~}~%" out-lines) (asdf-message "~{~&~a~%~}~%" out-lines)
retval)) retval))
;; there will be no output, just grab up the exit status ;; there will be no output, just grab up the exit status
(let ((retval (ext:run-shell-command command :output nil :wait t))) (or (ext:run-shell-command command :output nil :wait t) 0))
(if (null retval) 0
retval)))
#+clozure #+clozure
(nth-value 1 (nth-value 1
...@@ -2891,25 +2888,24 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." ...@@ -2891,25 +2888,24 @@ output to *VERBOSE-OUT*. Returns the shell's exit code."
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl sbcl scl xcl) #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mcl sbcl scl xcl)
(error "RUN-SHELL-COMMAND not implemented for this Lisp"))) (error "RUN-SHELL-COMMAND not implemented for this Lisp")))
#+clisp
(defconstant +clisp-status-prefix-length+ (length "ASDF-EXIT-STATUS "))
#+clisp
(defconstant +clisp-status-prefix+ "ASDF-EXIT-STATUS ")
#+clisp #+clisp
(defun* parse-clisp-shell-output (stream) (defun* parse-clisp-shell-output (stream)
"Helper function for running shell commands under clisp. Parses a specially- "Helper function for running shell commands under clisp. Parses a specially-
crafted output string to recover the exit status of the shell command and a crafted output string to recover the exit status of the shell command and a
list of lines of output." list of lines of output."
(loop for line = (read-line stream nil nil) (loop :with status-prefix = "ASDF-EXIT-STATUS "
with exit-status :with prefix-length = (length status-prefix)
while line :with exit-status = -1 :with lines = ()
if (equal (subseq line 0 +clisp-status-prefix-length+) :for line = (read-line stream nil nil)
+clisp-status-prefix+) :while line :do (push line lines) :finally
do (setf exit-status (parse-integer line :start +clisp-status-prefix-length+ (let* ((last (car lines))
:junk-allowed t)) (status (and last (>= (length last) prefix-length)
else collect line into output-lines (string-equal last status-prefix :end1 prefix-length)
finally (return (values exit-status output-lines)))) (parse-integer last :start prefix-length :junk-allowed t))))
(when status
(setf exit-status status)
(pop lines) (when (equal "" (car lines)) (pop lines)))
(return (values exit-status (reverse lines))))))
;;;; --------------------------------------------------------------------------- ;;;; ---------------------------------------------------------------------------
;;;; system-relative-pathname ;;;; system-relative-pathname
......
...@@ -3,5 +3,4 @@ ...@@ -3,5 +3,4 @@
# This script simply writes some text to STDERR, to check and # This script simply writes some text to STDERR, to check and
# make sure that ASDF:RUN-SHELL-COMMAND handles it properly. # make sure that ASDF:RUN-SHELL-COMMAND handles it properly.
echo "Writing to standard error." > /dev/stderr echo "Writing to standard error." >& 2
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment