Commit b2a8f0e1 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.32.7: Tweak UIOP. Fix some package exports.

Always define dump-image and create-image, even if to throw an error.
Add prepend-kernel argument to dump-image on CCL.
Preserve keyword arguments and more in deferred warnings on CCL.
Reindent split-string.
parent bf954c46
......@@ -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.
......
;;; -*- 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>.
......
......@@ -139,8 +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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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?"
......
......@@ -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)))
......
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