diff --git a/asdf.asd b/asdf.asd index c92fc6d74d9df1d06b1f95378d11d2ef4622db55..dd2778722793d812b07bdfb5f468fdd6a7bcc4ed 100644 --- a/asdf.asd +++ b/asdf.asd @@ -74,7 +74,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.32.6" ;; to be automatically updated by make bump-version + :version "2.32.7" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 ;; For most purposes, asdf itself specially counts as a builtin system. diff --git a/header.lisp b/header.lisp index fbc1e78532c7798589ce7d0f8e8e86439b39dc24..201b9109a5a39bdacc820866613cede67355d6e2 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.32.6: Another System Definition Facility. +;;; This is ASDF 2.32.7: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/test/make-hello-world.lisp b/test/make-hello-world.lisp index 4d8618c536426881363a8fc57d2981abf6d76e6a..068265dd97b7217de09efa1d0c1a05fb8894a3c1 100644 --- a/test/make-hello-world.lisp +++ b/test/make-hello-world.lisp @@ -2,6 +2,7 @@ #+lispworks (lispworks:load-all-patches) (load (make-pathname :name "script-support" :defaults *load-pathname*)) (load-asdf) +(asdf-test::frob-packages) #+ecl (require :cmp) (with-test () diff --git a/test/run-tests.sh b/test/run-tests.sh index 557bb5ebb38d7fc1f9436614362afb860081a4d6..043bce2d5f1f2335c7f6603c6f2a6e56d105e1ad 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -1,6 +1,6 @@ #!/bin/sh -# do_tests {lisp invocation} {scripts-regex} +# run-tests {lisp invocation} {scripts-regex} # - read lisp forms one at a time from standard input # - quit with exit status 0 on getting eof # - quit with exit status >0 if an unhandled error occurs @@ -77,7 +77,7 @@ kwote () { ( set +x ) } DO () { kwote "$@" ; "$@" ; } -do_tests() { +do_tests () { if [ -z "$*" ]; then scripts="*.script" else @@ -105,7 +105,7 @@ do_tests() { echo "Testing: $i" >&2 test_count=`expr "$test_count" + 1` rm -f ~/.cache/common-lisp/"`pwd`"/* || true - if DO $cmd $debugp $eval "(load \"script-support.lisp\")" $eval "(asdf-test::load-asdf)" $eval "(asdf-test::with-test () (load \"$i\"))" ; then + if DO $cmd $debugp $eval "(load \"script-support.lisp\")" $eval "(progn (asdf-test::load-asdf) (asdf-test::frob-packages) (asdf-test::with-test () (load \"$i\")))" ; then echo "Using $command, $i passed" >&2 test_pass=`expr "$test_pass" + 1` else diff --git a/test/script-support.lisp b/test/script-support.lisp index 0ad0721905b30529a8a46359bf6e34c248ffade0..089178d7c0928a18eeb3e835386e330b6380f72a 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -510,6 +510,9 @@ is bound, write a message and exit on an error. If (pathname-components *test-directory*) (pathname-components x))) (setf *test-directory* x))) + t) + +(defun frob-packages () (format t "Frob packages~%") (use-package :asdf :asdf-test) (when (find-package :asdf/driver) (use-package :asdf/driver :asdf-test)) @@ -517,6 +520,7 @@ is bound, write a message and exit on an error. If (setf *package* (find-package :asdf-test)) t) + (defun load-asdf-lisp-and-test-uiop (&optional tag) (load-asdf-lisp tag) (configure-asdf) diff --git a/test/test-utilities.script b/test/test-utilities.script index 00741ca13d9c51dbc20734f9b36b46b25c89d072..d1e6cffde835bf0e6de2c5a1d86102860daa26b9 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -139,9 +139,6 @@ asdf/bundle:bundle-system asdf/bundle:register-pre-built-system asdf/bundle:static-library - asdf/image:create-image - asdf/image:dump-image - asdf/lisp-build:reify-undefined-warning asdf/os:parse-file-location-info asdf/os:parse-windows-shortcut asdf/os:read-little-endian @@ -175,3 +172,5 @@ :from-end t)) (assert-equal nil (fishy-asdf-exported-symbols)) + +(delete-package* :asdf-test-package-1) diff --git a/uiop/image.lisp b/uiop/image.lisp index 3f2b2a4797d7492dadbf99ac1ace71e3d5bfc066..88259d8d8d48459e7eb0e218a2043af8ad0a92cc 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -252,10 +252,10 @@ if we are not called from a directly executable image." ;;; Dumping an image (with-upgradability () - #-(or ecl mkcl) (defun dump-image (filename &key output-name executable ((:postlude *image-postlude*) *image-postlude*) - ((:dump-hook *image-dump-hook*) *image-dump-hook*)) + ((:dump-hook *image-dump-hook*) *image-dump-hook*) + #+clozure (prepend-kernel t)) (declare (ignorable filename output-name executable)) (setf *image-dumped-p* (if executable :executable t)) (setf *image-restored-p* :in-regress) @@ -280,7 +280,7 @@ if we are not called from a directly executable image." ;; :parse-options nil ;--- requires a non-standard patch to clisp. :norc t :script nil :init-function #'restore-image))) #+clozure - (ccl:save-application filename :prepend-kernel t + (ccl:save-application filename :prepend-kernel prepend-kernel :toplevel-function (when executable #'restore-image)) #+(or cmu scl) (progn @@ -305,33 +305,36 @@ if we are not called from a directly executable image." :executable t ;--- always include the runtime that goes with the core (when executable (list :toplevel #'restore-image :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 ~A.~%" - filename (nth-value 1 (implementation-type)))) + (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%" + 'dump-image filename (nth-value 1 (implementation-type)))) - - #+ecl (defun create-image (destination object-files &key kind output-name prologue-code epilogue-code - (prelude () preludep) (entry-point () entry-point-p) build-args) + (prelude () preludep) (postlude () postludep) + (entry-point () entry-point-p) build-args) + (declare (ignorable destination object-files kind output-name prologue-code epilogue-code + prelude preludep postlude postludep entry-point entry-point-p build-args)) ;; Is it meaningful to run these in the current environment? ;; only if we also track the object files that constitute the "current" image, ;; and otherwise simulate dump-image, including quitting at the end. - ;; (standard-eval-thunk *image-postlude*) (call-image-dump-hook) - (check-type kind (member :binary :dll :lib :static-library :program :object :fasl :program)) - (apply 'c::builder - kind (pathname destination) - :lisp-files object-files - :init-name (c::compute-init-name (or output-name destination) :kind kind) - :prologue-code prologue-code - :epilogue-code - `(progn - ,epilogue-code - ,@(when (eq kind :program) - `((setf *image-dumped-p* :executable) - (restore-image ;; default behavior would be (si::top-level) - ,@(when preludep `(:prelude ',prelude)) - ,@(when entry-point-p `(:entry-point ',entry-point)))))) - build-args))) + #-ecl (error "~S not implemented for your implementation (yet)" 'create-image) + #+ecl + (progn + (check-type kind (member :binary :dll :lib :static-library :program :object :fasl :program)) + (apply 'c::builder + kind (pathname destination) + :lisp-files object-files + :init-name (c::compute-init-name (or output-name destination) :kind kind) + :prologue-code prologue-code + :epilogue-code + `(progn + ,epilogue-code + ,@(when (eq kind :program) + `((setf *image-dumped-p* :executable) + (restore-image ;; default behavior would be (si::top-level) + ,@(when preludep `(:prelude ',prelude)) + ,@(when entry-point-p `(:entry-point ',entry-point)))))) + build-args)))) ;;; Some universal image restore hooks diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp index 03bf43b7db47d29a5640302ce304058b1f66f566..04ccce09234d4987b69b9ec5196938a344edf277 100644 --- a/uiop/lisp-build.lisp +++ b/uiop/lisp-build.lisp @@ -20,7 +20,7 @@ #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions #:call-with-muffled-loader-conditions #:with-muffled-loader-conditions #:reify-simple-sexp #:unreify-simple-sexp - #:reify-deferred-warnings #:reify-undefined-warning #:unreify-deferred-warnings + #:reify-deferred-warnings #:unreify-deferred-warnings #:reset-deferred-warnings #:save-deferred-warnings #:check-deferred-warnings #:with-saved-deferred-warnings #:warnings-file-p #:warnings-file-type #:*warnings-file-type* #:enable-deferred-warnings-check #:disable-deferred-warnings-check @@ -241,7 +241,9 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when :args (destructuring-bind (fun formals env) args (declare (ignorable env)) (list (unsymbolify-function-name fun) - (mapcar (constantly nil) formals) + (loop :for arg :in formals :collect + (typecase arg ;; notably preserve constant keyword arguments + ((or symbol number character string pathname) arg))) nil))))) (defun unreify-deferred-warning (reified-deferred-warning) (destructuring-bind (&key warning-type function-name source-note args) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index b38b89ed586201f628ce12d584539e19fc45ade0..8ed2306a8edffaef931fe57b2ecf87d144944c5d 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -396,7 +396,7 @@ If a string, repeatedly read and evaluate from it, returning the last values." #+gcl2.6 (declare (ignorable external-format)) (check-type direction (member :output :io)) (loop - :with prefix = (or prefix (format nil "~Atmp" (native-namestring (temporary-directory)))) + :with prefix = (namestring (ensure-absolute-pathname (or prefix "tmp") #'temporary-directory)) :for counter :from (random (ash 1 32)) :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do ;; TODO: on Unix, do something about umask diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 5248c8c26b5adc201d472edccad59bf4cf754a83..b91136572b818b77af95bc397abbdb4a1ac24e97 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -202,12 +202,11 @@ starting the separation from the end, e.g. when called with arguments (loop :for start = (if (and max (>= words (1- max))) (done) - (position-if #'separatorp string :end end :from-end t)) :do - (when (null start) - (done)) - (push (subseq string (1+ start) end) list) - (incf words) - (setf end start)))))) + (position-if #'separatorp string :end end :from-end t)) + :do (when (null start) (done)) + (push (subseq string (1+ start) end) list) + (incf words) + (setf end start)))))) (defun string-prefix-p (prefix string) "Does STRING begin with PREFIX?" diff --git a/upgrade.lisp b/upgrade.lisp index a9511756559fdf3d1e426587bd28c197b4901c59..a884918bdf949d679437b388a8e96997159927aa 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "2.32.6") + (asdf-version "2.32.7") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index 1835bc78b5045e00a23f03331a4c87803c56e3b7..531748491490658bb0961d6d77c0d1dbbd3d1889 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.32.6" +"2.32.7"