diff --git a/action.lisp b/action.lisp index 485979a1acbb04de5f20524ce0acee9609070cd8..247569753dee08a25a895b6249cf3104c84fd20a 100644 --- a/action.lisp +++ b/action.lisp @@ -115,7 +115,7 @@ You can put together sentences using this phrase.")) (multiple-value-bind (files fixedp) (call-next-method) (if fixedp files - (mapcar *output-translation-hook* files))) + (mapcar *output-translation-function* files))) t)) (defmethod output-files ((o operation) (c component)) (declare (ignorable o c)) diff --git a/asdf-driver.asd b/asdf-driver.asd index 29ed2a5fb991055f548cd5fdff19080de611000b..425dfe004c0244d52c6da09eb2504863bdf12dbe 100644 --- a/asdf-driver.asd +++ b/asdf-driver.asd @@ -5,6 +5,7 @@ :description "Basic general-purpose utilities used by ASDF" :long-description "Basic general-purpose utilities that is in such a need that you can't portably construct a complete program without using them." + #+asdf2.27 :version #+asdf2.27 (:read-file-form "version.lisp-expr") :components ((:file "header") (:file "package") @@ -12,9 +13,9 @@ that you can't portably construct a complete program without using them." (:file "utility" :depends-on ("compatibility")) (:file "pathname" :depends-on ("utility")) (:file "stream" :depends-on ("pathname")) - (:file "os" :depends-on ("pathname" "stream")) + (:file "os" :depends-on ("stream")) (:file "image" :depends-on ("os")) (:file "run-program" :depends-on ("os")) (:file "lisp-build" :depends-on ("image")) - (:file "configuration" :depends-on ("os")) + (:file "configuration" :depends-on ("image")) (:file "driver" :depends-on ("lisp-build" "run-program" "configuration")))) diff --git a/asdf.asd b/asdf.asd index 750d258c8f70245ba9956318504bae5293127c8f..3de1d4a4cd01eb6d0800cb6cc0a18daf9ef27341 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.85" ;; to be automatically updated by bin/bump-revision + :version "2.26.86" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:module "build" :components ((:file "asdf")))) :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf)))) diff --git a/bin/bump-version b/bin/bump-version index cc1a578dde06258ffa23d4ebdfcfe97411549bf1..d03238d09e43ab628b71548313006a9348b47c81 100755 --- a/bin/bump-version +++ b/bin/bump-version @@ -1,25 +1,68 @@ #!/bin/sh -# Takes one optional argument: the new version number. -# If not provided, increment previous patch number, -# e.g. 3.45.6 ==> 3.45.7, or 3.56 ==> 3.56.1 -NEWVER="${1}" -PROG="$0" -ASDFDIR="$(cd $(dirname $PROG)/.. ; /bin/pwd)" ## readlink -f doesn't work on BSD - -if [ -z "$NEWVER" ] ; then - OLDVER="$(grep ' (asdf-version "' ${ASDFDIR}/upgrade.lisp | cut -d\" -f2)" - NEWVER="$(echo $OLDVER | perl -npe 's/([0-9].[0-9]+)(\.([0-9]+))?/"${1}.".($3+1)/e')" -fi -echo "Setting ASDF version to $NEWVER" -for i in ${ASDFDIR}/header.lisp ${ASDFDIR}/upgrade.lisp ; do - perl -i.bak -npe 's/^( \(asdf-version "|;;; This is ASDF )[0-9.]+("\)|:)/${1}'"$NEWVER"'${2}/' $i -done -for i in ${ASDFDIR}/asdf.asd ; do # ${ASDFDIR}/generate-asdf.asd - perl -i.bak -npe 's/^( :version ")[0-9.]+(")/${1}'"$NEWVER"'${2}/' $i -done - -cat<") - version name parent))) (when do-first (error "DO-FIRST is not supported anymore since ASDF 2.27")) (let* ((args `(:name ,(coerce-name name) :pathname ,pathname @@ -120,6 +124,10 @@ (apply 'reinitialize-instance ret args) (setf ret (apply 'make-instance (class-for-type parent type) args))) (component-pathname ret) ; eagerly compute the absolute pathname + (when versionp + (unless (parse-version (normalize-version version (component-pathname ret)) nil) + (warn (compatfmt "~@") + version name parent))) (when (typep ret 'parent-component) (setf (component-children ret) (loop diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 6460eceb7c059f691ec4d43d828d11fa69065940..ab74beda5a455f52a89fe79be3e080d9dcd33d06 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -847,7 +847,13 @@ are parsed as period-separated lists of integers. I.e., in the example, In particular, version @code{0.2.1} is interpreted the same as @code{0.0002.1} and is strictly version-less-than version @code{0.20.1}, even though the two are the same when interpreted as decimal fractions. -@cindex version specifiers +Instead of a string representing the version, +the @code{:version} argument can be an expression that is resolved to +such a string using the following trivial domain-specific language: +in addition to being a literal string, it can be an expression of the form +@code{(:read-file-form )}, which will be resolved +by reading the first form in the specified pathname or string +(merged against the pathname of the current component if relative). @cindex :version @end itemize diff --git a/driver.lisp b/driver.lisp index eb0fdfef4aa2bd9b2a7724cfbe199fdda7870e68..c4f6e7b2c35ed6521f7f0a5ef0d98329453bafb8 100644 --- a/driver.lisp +++ b/driver.lisp @@ -2,6 +2,7 @@ ;;;; Re-export all the functionality in asdf/driver (asdf/package:define-package :asdf/driver + (:nicknames :d) (:use :common-lisp :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os :asdf/image diff --git a/generate-asdf.asd b/generate-asdf.asd index 8654adc1ee44b7a98e481ee77139c53bb9e6fdb4..48d47fa2214fda3f6e92a0a8461607ebfe80c66e 100644 --- a/generate-asdf.asd +++ b/generate-asdf.asd @@ -9,6 +9,7 @@ ;; :include-dependencies t :translate-output-p nil :concatenated-source-file "build/asdf.lisp" + :version (:read-file-form "version.lisp-expr") :serial t :depends-on (:asdf-driver) :components diff --git a/header.lisp b/header.lisp index 8dfb510651ad5d16382f7c65dae458e6812fc8c6..0a62a800045bfcb20d89979bd046b2dc3e03a2a3 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.85: Another System Definition Facility. +;;; This is ASDF 2.26.86: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . diff --git a/image.lisp b/image.lisp index 0326e4807f0e885090601e32b8160c0200e7f9fa..cd51a6f2f20ebaebd98e215ad9b9e6be71a9dea2 100644 --- a/image.lisp +++ b/image.lisp @@ -5,7 +5,8 @@ (:recycle :asdf/image :xcvb-driver) (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream :asdf/os) (:export - #:*arguments* #:*dumped* #:raw-command-line-arguments #:*command-line-arguments* + #:*dumped* #:raw-command-line-arguments #:*command-line-arguments* + #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:*debugging* #:*post-image-restart* #:*entry-point* #:quit #:die #:raw-print-backtrace #:print-backtrace #:print-condition-backtrace #:bork #:with-coded-exit #:shell-boolean @@ -19,7 +20,7 @@ (defvar *debugging* nil "Shall we print extra debugging information?") -(defvar *arguments* nil +(defvar *command-line-arguments* nil "Command-line arguments") (defvar *dumped* nil @@ -158,11 +159,11 @@ This is designed to abstract away the implementation specific quit forms." ;;; Using hooks -(defun* register-image-resume-hook (hook) - (pushnew hook *image-resume-hook*)) +(defun* register-image-resume-hook (hook &optional (now t)) + (register-hook-function '*image-resume-hook* hook now)) -(defun* register-image-dump-hook (hook) - (pushnew hook *image-dump-hook*)) +(defun* register-image-dump-hook (hook &optional (now nil)) + (register-hook-function '*image-dump-hook* hook now)) (defun* call-image-resume-hook () (call-functions (reverse *image-resume-hook*))) @@ -171,15 +172,6 @@ This is designed to abstract away the implementation specific quit forms." (call-functions *image-dump-hook*)) -;;; Build initialization - -(defun* initialize-asdf-utilities () - "Setup the XCVB environment with respect to debugging, profiling, performance" - (setf *temporary-directory* (default-temporary-directory) - *stderr* #-clozure *error-output* #+clozure ccl::*stderr*) - (values)) - - ;;; Proper command-line arguments (defun* raw-command-line-arguments () @@ -210,20 +202,24 @@ if we are not called from a directly executable image dumped by XCVB." (member "--" arguments :test 'string-equal)))) (rest arguments))) -(defun* do-resume (&key (post-image-restart *post-image-restart*) (entry-point *entry-point*)) - (with-safe-io-syntax (:package :asdf) +(defun setup-command-line-arguments () + (setf *command-line-arguments* (command-line-arguments))) + +(defun* resume-program (&key (post-image-restart *post-image-restart*) (entry-point *entry-point*)) + (call-image-resume-hook) + (with-safe-io-syntax () (let ((*read-eval* t)) (when post-image-restart (eval-input post-image-restart)))) - (with-coded-exit () - (when entry-point - (let ((ret (apply entry-point *arguments*))) - (if (typep ret 'integer) - (quit ret) - (quit 99)))))) + (when entry-point + (apply entry-point *command-line-arguments*))) (defun* resume () - (setf *arguments* (command-line-arguments)) - (do-resume)) + (with-coded-exit () + (let ((ret (resume-program))) + (if (typep ret 'integer) + (quit ret) + (quit 99))))) + ;;; Dumping an image @@ -284,3 +280,9 @@ if we are not called from a directly executable image dumped by XCVB." (when executable (list :toplevel #'resume :save-runtime-options t)))) ;--- only save runtime-options for standalone executables #-(or allegro clisp clozure cmu gcl lispworks sbcl scl) (die 98 "Can't dump ~S: asdf doesn't support image dumping with this Lisp implementation.~%" filename)) + + +;;; Initial environmental hooks +(pushnew 'setup-temporary-directory *image-resume-hook*) +(pushnew 'setup-stderr *image-resume-hook*) +(pushnew 'setup-command-line-arguments *image-resume-hook*) diff --git a/lisp-build.lisp b/lisp-build.lisp index 667eb0272e475b06fb1cf462210ece72e18c75a0..e5aaf3f6e5699dcd0a10f43e778d41809d675fdd 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -7,7 +7,7 @@ (:export ;; Variables #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* - #:*compile-file-function* #:*output-translation-hook* + #:*compile-file-function* #:*output-translation-function* #:*optimization-settings* #:*previous-optimization-settings* #:*uninteresting-conditions* #:*uninteresting-compiler-conditions* #:*uninteresting-loader-conditions* @@ -259,7 +259,7 @@ for processing later (possibly in a different process)." (defaults (make-pathname :type type :defaults (merge-pathnames* input-file)))) (merge-pathnames* output-file defaults)) - (funcall *output-translation-hook* + (funcall *output-translation-function* (apply 'compile-file-pathname input-file keys))))) (defun* load* (x &rest keys &key &allow-other-keys) diff --git a/os.lisp b/os.lisp index 8f6abe1f9a2ea025a2ab961e0bea048fb383b0a3..253e17d0b980b3bd078caa9e5cc57b07c2804110 100644 --- a/os.lisp +++ b/os.lisp @@ -15,24 +15,19 @@ #:hostname #:user-homedir #:lisp-implementation-directory #:getcwd #:chdir #:call-with-current-directory #:with-current-directory #:*temporary-directory* #:temporary-directory #:default-temporary-directory + #:setup-temporary-directory #:call-with-temporary-file #:with-temporary-file)) (in-package :asdf/os) ;;; Features (eval-when (:compile-toplevel :load-toplevel :execute) - (defun* featurep (x &optional (features *features*)) + (defun* featurep (x &optional (*features* *features*)) (cond - ((atom x) - (and (member x features) t)) - ((eq :not (car x)) - (assert (null (cddr x))) - (not (featurep (cadr x) features))) - ((eq :or (car x)) - (some #'(lambda (x) (featurep x features)) (cdr x))) - ((eq :and (car x)) - (every #'(lambda (x) (featurep x features)) (cdr x))) - (t - (error "Malformed feature specification ~S" x)))) + ((atom x) (and (member x *features*) t)) + ((eq :not (car x)) (assert (null (cddr x))) (not (featurep (cadr x)))) + ((eq :or (car x)) (some #'featurep (cdr x))) + ((eq :and (car x)) (every #'featurep (cdr x))) + (t (error "Malformed feature specification ~S" x)))) (defun* os-unix-p () (featurep '(:or :unix :cygwin :darwin))) @@ -109,16 +104,21 @@ then returning the non-empty string value of the variable" ;; Initially stolen from SLIME's SWANK, completely rewritten since. ;; We're back to runtime checking, for the sake of e.g. ABCL. -(defun* first-feature (features) - (dolist (x features) - (multiple-value-bind (val feature) - (if (consp x) (values (first x) (cons :or (rest x))) (values x x)) - (when (featurep feature) (return val))))) +(defun* first-feature (feature-sets) + (dolist (x feature-sets) + (multiple-value-bind (short long feature-expr) + (if (consp x) + (values (first x) (second x) (cons :or (rest x))) + (values x x x)) + (when (featurep feature-expr) + (return (values short long)))))) (defun* implementation-type () (first-feature - '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) :cmu - :ecl :gcl (:lw :lispworks) :mcl :mkcl :sbcl :scl :symbolics :xcl))) + '(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp) + (:cmu :cmucl :cmu) :ecl :gcl + (:lwpe :lispworks-personal-edition) (:lw :lispworks) + :mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl))) (defun* operating-system () (first-feature @@ -130,7 +130,7 @@ then returning the non-empty string value of the variable" (defun* architecture () (first-feature - '((:x64 :amd64 :x86-64 :x86_64 :x8664-target (:and :word-size=64 :pc386)) + '((:x64 :x86-64 :x86_64 :x8664-target :amd64 (:and :word-size=64 :pc386)) (:x86 :x86 :i386 :i486 :i586 :i686 :pentium3 :pentium4 :pc386 :iapx386 :x8632-target) (:ppc64 :ppc64 :ppc64-target) (:ppc32 :ppc32 :ppc32-target :ppc :powerpc) :hppa64 :hppa :sparc64 (:sparc32 :sparc32 :sparc) @@ -278,6 +278,9 @@ then returning the non-empty string value of the variable" (defun* temporary-directory () (or *temporary-directory* (default-temporary-directory))) +(defun setup-temporary-directory () + (setf *temporary-directory* (default-temporary-directory))) + (defun* call-with-temporary-file (thunk &key prefix keep (direction :io) diff --git a/output-translations.lisp b/output-translations.lisp index 49478e62d861d9a2744bc92494c7c11ad32ef635..89dd41f47a8b9337ddb48ab5727a5a58cea9e6ac 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -20,6 +20,8 @@ )) (in-package :asdf/output-translations) +(when-upgrade () (undefine-function '(setf output-translations))) + (define-condition invalid-output-translation (invalid-configuration warning) ((format :initform (compatfmt "~@")))) @@ -305,5 +307,5 @@ effectively disabling the output translation facility." (merge-pathnames* relative-source target-root))) (normalize-device (apply-output-translations target))))) -(setf *output-translation-hook* 'apply-output-translations) +(setf *output-translation-function* 'apply-output-translations) (pushnew 'clear-output-translations *clear-configuration-hook*) diff --git a/package.lisp b/package.lisp index 3653c448fe3c6f8a945167c806136a429e8bd560..aeef01151023584d3197d905b65f12bddb9f6f24 100644 --- a/package.lisp +++ b/package.lisp @@ -73,7 +73,9 @@ or when loading the package is optional." (let* ((symbol-name (aref vector 0)) (package-name (aref vector 1))) (if package-name (intern symbol-name package-name) - (make-symbol symbol-name))))) + (make-symbol symbol-name)))) + (defun home-package-p (symbol package) + (eq (symbol-package symbol) (find-package* package)))) (eval-when (:load-toplevel :compile-toplevel :execute) #+(or clisp clozure) @@ -225,7 +227,7 @@ or when loading the package is optional." (imported (not (eq home package))) (shadowing (symbol-shadowing-p sym package))) (cond - ((and shadowing import) + ((and shadowing imported) (push name (gethash home-name shadowing-import))) (shadowing (push name shadow)) @@ -290,9 +292,8 @@ or when loading the package is optional." (macrolet ((fishy (&rest info) `(when fishyp (push (list ,@info) fishy)))) (labels - ((ensure-shadowing-import (sym p) - (let ((name (string sym)) - (import (find-symbol* name p))) + ((ensure-shadowing-import (name p) + (let ((import (find-symbol* name p))) (multiple-value-bind (existing status) (find-symbol name package) (cond ((gethash name shadowed) @@ -303,10 +304,10 @@ or when loading the package is optional." (setf (gethash name imported) t) (unless (or (null status) (and (member status '(:internal :external)) - (eq existing sym) + (eq existing import) (symbol-shadowing-p existing package))) (fishy :shadowing-import - name (package-name p) (symbol-package-name sym) + name (package-name p) (symbol-package-name import) (and status (symbol-package-name existing)) status)) (shadowing-import import package)))))) (ensure-import (sym p) @@ -328,29 +329,38 @@ or when loading the package is optional." (fishy :import name (package-name p) (symbol-package-name import) (and status (symbol-package-name existing)) status)) (import import package))))))) - (ensure-mix (sym p) - (let* ((name (symbol-name sym)) - (sp (symbol-package sym))) - (unless (or (gethash name shadowed) (gethash name imported)) - (let ((ip (gethash name inherited))) + (ensure-mix (name symbol p) + (unless (gethash name shadowed) + (multiple-value-bind (existing status) (find-symbol name package) + (let* ((sp (symbol-package symbol)) + (im (gethash name imported)) + (in (gethash name inherited))) (cond - ((and ip (eq sp (first ip)))) - (ip + ((or (null status) + (and status (eq symbol existing)) + (and in (eq sp (first in)))) + (ensure-inherited name symbol p t)) + (in (remhash name inherited) - (ensure-shadowing-import name (second ip))) + (ensure-shadowing-import name (second in))) + (im + (error "Imported symbol ~S conflicts with inherited symbol ~S in ~S" + existing symbol (package-name package))) (t - (ensure-inherited name sym p))))))) - (ensure-inherited (name symbol p) + (ensure-inherited name symbol p t))))))) + (ensure-inherited (name symbol p mix) (multiple-value-bind (existing status) (find-symbol name package) (let* ((sp (symbol-package symbol)) - (ip (gethash name inherited)) + (in (gethash name inherited)) (xp (and status (symbol-package existing)))) (cond ((gethash name shadowed)) - (ip - (unless (equal sp (first ip)) - (error "Can't inherit ~S from ~S, it is inherited from ~S" - name (package-name sp) (package-name (first ip))))) + (in + (unless (equal sp (first in)) + (if mix + (ensure-shadowing-import name (second in)) + (error "Can't inherit ~S from ~S, it is inherited from ~S" + name (package-name sp) (package-name (first in)))))) ((gethash name imported) (unless (eq symbol existing) (error "Can't inherit ~S from ~S, it is imported from ~S" @@ -358,11 +368,11 @@ or when loading the package is optional." (t (setf (gethash name inherited) (list sp p)) (when status - (unintern* existing package) - (fishy :inherited name (package-name p) (package-name sp) - (package-name xp)))))))) - (home-package-p (symbol package) - (eq (symbol-package symbol) (find-package* package))) + (let ((shadowing (symbol-shadowing-p existing package))) + (fishy :inherited name (package-name p) (package-name sp) + (package-name xp)) + (if shadowing (ensure-shadowing-import name p) + (unintern* existing package))))))))) (recycle-symbol (name) (let (recycled foundp) (dolist (r recycle (values recycled foundp)) @@ -466,14 +476,15 @@ or when loading the package is optional." (shadowing-import dummy package) (import dummy package))))))) (shadow name package)) - (loop :for (p . syms) :in shadowing-import-from :do - (dolist (sym syms) (ensure-shadowing-import sym p))) + (loop :for (p . syms) :in shadowing-import-from + :for pp = (find-package* p) :do + (dolist (sym syms) (ensure-shadowing-import (string sym) pp))) (dolist (p mix) - (do-external-symbols (sym p) (ensure-mix sym p))) + (do-external-symbols (sym p) (ensure-mix (symbol-name sym) sym p))) (loop :for (p . syms) :in import-from :do (dolist (sym syms) (ensure-import sym p))) (dolist (p (append use mix)) - (do-external-symbols (sym p) (ensure-inherited (string sym) sym p)) + (do-external-symbols (sym p) (ensure-inherited (string sym) sym p nil)) (use-package p package)) (loop :for name :being :the :hash-keys :of exported :do (ensure-symbol (string name) t) diff --git a/pathname.lisp b/pathname.lisp index 5a7d2250d81e3192604be2114d1bb892dc69444d..98535a0479ae560b3bee01d0decb5246b72e5c2c 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -53,7 +53,7 @@ #:read-null-terminated-string #:read-little-endian #:parse-file-location-info #:parse-windows-shortcut ;; Output translations - #:*output-translation-hook*)) + #:*output-translation-function*)) (in-package :asdf/pathname) @@ -835,4 +835,4 @@ For the latter case, we ought pick random suffix and atomically open it." nil))))) ;;; Hook for output translations -(defvar *output-translation-hook* 'identity) +(defvar *output-translation-function* 'identity) diff --git a/run-program.lisp b/run-program.lisp index f262cf2de574de8f63b8c67b09549ddaa8690a64..4f8d7d1a607f60267f26d6b494bc329af2f22856 100644 --- a/run-program.lisp +++ b/run-program.lisp @@ -10,10 +10,12 @@ #:escape-windows-token #:escape-windows-command #:escape-token #:escape-command - ;;; run-program/foo + ;;; run-program/ + #:slurp-input-stream #:run-program/ #:subprocess-error - #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process)) + #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process + )) (in-package :asdf/run-program) ;;;; ----- Escaping strings for the shell ----- @@ -339,6 +341,7 @@ Use ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT process (format nil (if (os-unix-p) "exec > ~*~A ; ~2:*~A" "~A > ~A") (system-command command) (native-namestring out))) (system (command &key interactive) + (declare (ignorable interactive)) #+(or abcl xcl) (ext:run-shell-command command) #+allegro (excl:run-shell-command command :input interactive :output interactive :wait t) diff --git a/stream.lisp b/stream.lisp index 675d6cc0b9f9538232c0c2f865e75898c74e185a..41e43f550d7e92b2710ffa1038172ad7106995e2 100644 --- a/stream.lisp +++ b/stream.lisp @@ -5,7 +5,7 @@ (:recycle :asdf/stream) (:use :cl :asdf/package :asdf/compatibility :asdf/utility :asdf/pathname) (:export - #:*default-stream-element-type* #:*stderr* + #:*default-stream-element-type* #:*stderr* #:setup-stderr #:with-safe-io-syntax #:call-with-safe-io-syntax #:with-output #:output-string #:with-input #:with-input-file #:call-with-input-file @@ -14,8 +14,9 @@ #:copy-stream-to-stream #:concatenate-files #:copy-stream-to-stream-line-by-line #:slurp-stream-string #:slurp-stream-lines - #:slurp-stream-forms #:slurp-file-string - #:read-file-lines #:read-file-forms #:eval-input + #:slurp-stream-forms #:read-file-string + #:read-file-lines #:read-file-forms + #:safe-read-first-file-form #:eval-input #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format #:*default-encoding* #:*utf-8-external-format*)) @@ -27,9 +28,14 @@ (defvar *stderr* #-clozure *error-output* #+clozure ccl::*stderr* "the original error output stream at startup") +(defun setup-stderr () + (setf *stderr* #-clozure *error-output* #+clozure ccl::*stderr*)) + ;;; Safe syntax +(defvar *standard-readtable* (copy-readtable nil)) + (defmacro with-safe-io-syntax ((&key (package :cl)) &body body) "Establish safe CL reader options around the evaluation of BODY" `(call-with-safe-io-syntax #'(lambda () (let ((*package* (find-package ,package))) ,@body)))) @@ -37,6 +43,8 @@ (defun* call-with-safe-io-syntax (thunk &key (package :cl)) (with-standard-io-syntax () (let ((*package* (find-package package)) + (*readtable* *standard-readtable*) + (*read-default-float-format* 'double-float) (*print-readably* nil) (*read-eval* nil)) (funcall thunk)))) @@ -207,9 +215,11 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" "Reads the first form from the top of a file. BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof" (with-input-file (in pathname) - (read in eof-error-p eof-value))) + (read-preserving-whitespace in eof-error-p eof-value))) -(defun* safe-read-first-file-form (pathname &key (package :cl) eof-error-p eof-value) +(defun* safe-read-first-file-form (pathname &key + (package :cl) + eof-error-p eof-value) "Reads the first form from the top of a file using a safe standardized syntax" (with-safe-io-syntax (:package package) (read-first-file-form pathname :eof-error-p eof-error-p :eof-value eof-value))) diff --git a/system.lisp b/system.lisp index f3d9560776ba262b1811b67e104d8d3a60b6a62b..c8d15b251efd4cb0e7ecd135c732a211e678ddef 100644 --- a/system.lisp +++ b/system.lisp @@ -2,7 +2,7 @@ ;;;; Systems (asdf/package:define-package :asdf/system - (:recycle :asdf/system :asdf) + (:recycle :asdf :asdf/system) (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/upgrade :asdf/component) (:intern #:children #:children-by-name #:default-component-class diff --git a/upgrade.lisp b/upgrade.lisp index 1650ccde4bccd0795b22b0f21e667b10b2d9d940..738f71b38f04a4dd867b2150c977bd0b40da13f2 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -32,7 +32,7 @@ ;; "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.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.85") + (asdf-version "2.26.86") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -94,7 +94,7 @@ You can compare this string with e.g.: (defun* upgrade-asdf () "Try to upgrade of ASDF. If a different version was used, return T. - We need do that before we operate on anything that depends on ASDF." + We need do that before we operate on anything that may possibly depend on ASDF." (unless *asdf-upgrade-already-attempted* (setf *asdf-upgrade-already-attempted* t) (let ((version (asdf-version))) diff --git a/utility.lisp b/utility.lisp index 71058f848d7b47cf28d056b44a943e58129d5d7f..d88eaca8a1f54c23bc34ff279f8203a2002175e8 100644 --- a/utility.lisp +++ b/utility.lisp @@ -20,9 +20,9 @@ #:stamp< #:stamp<= #:earlier-stamp #:stamps-earliest #:earliest-stamp ;; stamps #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f #:list-to-hash-set ;; hash-table - #:ensure-function #:call-function #:call-functions ;; functions + #:ensure-function #:call-function #:call-functions #:register-hook-function ;; functions #:eval-string #:load-string #:load-stream - #:parse-version #:version-compatible-p)) ;; version + #:parse-version #:unparse-version #:version-compatible-p)) ;; version (in-package :asdf/utility) ;;;; Defining functions in a way compatible with hot-upgrade: @@ -238,6 +238,10 @@ starting the separation from the end, e.g. when called with arguments (defun* call-functions (function-specs) (map () 'call-function function-specs)) +(defun* register-hook-function (variable hook &optional (now t)) + (pushnew hook (symbol-value variable)) + (when now (call-function hook))) + ;;; Version handling (defun* parse-version (string &optional on-error) @@ -260,6 +264,9 @@ NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3" 'parse-version string)) nil) (mapcar #'parse-integer (split-string string :separator ".")))) +(defun* unparse-version (version-list) + (format nil "~{~D~^.~}" version-list)) + (defun* version-compatible-p (provided-version required-version) "Is the provided version a compatible substitution for the required-version? If major versions differ, it's not compatible. diff --git a/version.lisp-expr b/version.lisp-expr new file mode 100644 index 0000000000000000000000000000000000000000..aa65cbbb9c91c96e194d3260e161b4d1e04c2d4a --- /dev/null +++ b/version.lisp-expr @@ -0,0 +1 @@ +"2.26.86"