Commit 5f6aabab authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.116: Avoid stepping on symbols used by ASDF 2.26 and earlier

unless we're backward compatible.
parent 6f520a1e
......@@ -34,6 +34,7 @@ tmp/
......@@ -57,6 +57,9 @@ bump: bump-version
bump-version: build/asdf.lisp
./bin/asdf-builder bump-version
@echo $(driver_lisp)
archive: build/asdf.lisp
#${SBCL} --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \
# --eval "(rewrite-license)" --eval "(quit)"
......@@ -14,7 +14,7 @@ that you can't portably construct a complete program without using them."
:defsystem-depends-on (#+(and (not asdf2.27) (or clisp xcl)) :asdf)
:around-compile call-without-redefinition-warnings
((:file "header")
((:static-file "version.lisp-expr")
(:file "package")
(:file "compatibility" :depends-on ("package"))
(:file "utility" :depends-on ("compatibility"))
......@@ -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.115" ;; to be automatically updated by bin/bump-revision
:version "2.26.116" ;; 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))))
......@@ -37,6 +37,7 @@
:description "All the components needed to build asdf.lisp"
:description "Generate asdf.lisp based on this and monolithic-concatenate-source-op"
:defsystem-depends-on (:asdf)
:version (:read-file-form "version.lisp-expr")
:class :bundle-system
:build-operation monolithic-concatenate-source-op
:bundle-pathname "build/asdf"
......@@ -12,7 +12,8 @@
(defun build-asdf ()
;; Make sure asdf.lisp is built.
(build-system :asdf/generate)
(load-system :asdf))
(load-system :asdf)
;;; ASDF directory
......@@ -66,7 +67,8 @@
(defun run-program* (x)
(format t "~A~%" x)
(run-program/ x))
(run-program/ x)
(defun make-tarball-under-build (name base files)
(check-type name string)
......@@ -106,7 +108,8 @@
/base/ /files/ /destination/))
(run-program* (format nil "tar zcfC ~S ~S ~S/"
/tarball/ /build-dir/ name))
(run-program* `("rm" "-rf" ,/destination/))))
(run-program* `("rm" "-rf" ,/destination/)))
(defun driver-files ()
(list* "asdf-driver.asd" "version.lisp-expr"
......@@ -125,15 +128,32 @@
(make-tarball-under-build (asdf-system-name) *asdf-dir* (asdf-system-files)))
(defun asdf-git-name ()
(format nil "asdf-~A" *version*))
(defun make-git-tarball ()
(run-program* (format nil "cd ~S && tar zcf build/asdf-~A.tar.gz build/asdf.lisp $(git ls-files)"
/asdf-dir/ *version*)))
(run-program* (format nil "cd ~S && tar zcf build/~A.tar.gz build/asdf.lisp $(git ls-files)"
/asdf-dir/ (asdf-git-name)))
(defun make-tarballs ()
(defun publish-tarballs ()
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-system-name) (asdf-git-name)))))
(run-program* (format nil "cd ~S && rsync ~{~S ~}clnet:/project/asdf/public_html/archives/"
/build-dir/ tarballs)))
(format t "~&To download the tarballs, point your browser at:~%
(defun make-and-publish-tarballs ()
(defparameter *versioned-files*
'(("version.lisp-expr" "\"" "\"")
......@@ -177,13 +177,13 @@
(operation-original-initargs instance)
(setf (operation-original-initargs instance)
(remove-keys '(:lisp-files :epilogue-code :prologue-code) original-initargs)
(remove-plist-keys '(:lisp-files :epilogue-code :prologue-code) original-initargs)
(monolithic-op-prologue-code instance) prologue-code
(monolithic-op-epilogue-code instance) epilogue-code)
#-ecl (assert (null (or lisp-files epilogue-code prologue-code)))
#+ecl (setf (bundle-op-lisp-files instance) lisp-files)))
(setf (bundle-op-build-args instance)
(remove-keys '(:type :monolithic :name-suffix)
(remove-plist-keys '(:type :monolithic :name-suffix)
(operation-original-initargs instance))))
(defmethod bundle-op-build-args :around ((o lib-op))
......@@ -332,7 +332,7 @@
(merge-pathnames "./asdf-output/")))
(operation (apply #'operate operation-name
(remove-keys '(:monolithic :type :move-here) args)))
(remove-plist-keys '(:monolithic :type :move-here) args)))
(system (find-system system))
(files (and system (output-files operation system))))
(if (or move-here (and (null move-here-p)
......@@ -239,15 +239,16 @@ directive.")
(when directory (setf ensure-directory t)) ;; :directory backward compatibility, until 2014-01-16.
(if (atom x)
(resolve-absolute-location-component x :ensure-directory ensure-directory :wilden wilden)
(loop :with path = (resolve-absolute-location-component
(car x) :ensure-directory (and (or ensure-directory (cdr x)) t)
:wilden (and wilden (null (cdr x))))
:for (component . morep) :on (cdr x)
(loop :with (first . rest) = x
:with path = (resolve-absolute-location-component
first :ensure-directory (and (or ensure-directory rest) t)
:wilden (and wilden (null rest)))
:for (element . morep) :on rest
:for dir = (and (or morep ensure-directory) t)
:for wild = (and wilden (not morep))
:do (setf path (merge-pathnames*
component :ensure-directory dir :wilden wild)
element :ensure-directory dir :wilden wild)
:finally (return path))))
......@@ -101,7 +101,7 @@
(type name &rest rest &key
;; the following list of keywords is reproduced below in the
;; remove-keys form. important to keep them in sync
;; remove-plist-keys form. important to keep them in sync
components pathname perform explain output-files operation-done-p
weakly-depends-on depends-on serial
do-first if-component-dep-fails (version nil versionp)
......@@ -119,7 +119,7 @@
(let* ((args `(:name ,(coerce-name name)
:pathname ,pathname
,@(when parent `(:parent ,parent))
'(:components :pathname :if-component-dep-fails :version
:perform :explain :output-files :operation-done-p
:weakly-depends-on :depends-on :serial)
......@@ -178,7 +178,7 @@
(make-instance 'system :name name :source-file source-file))))
(system (reset-system (cdr registered!)
:name name :source-file source-file))
(component-options (remove-key :class options)))
(component-options (remove-plist-key :class options)))
(apply 'load-systems defsystem-depends-on)
;; We change-class AFTER we loaded the defsystem-depends-on
;; since the class might be defined as part of those.
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.115: Another System Definition Facility.
;;; This is ASDF 2.26.116: Another System Definition Facility.
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <>.
......@@ -275,7 +275,7 @@ If WARNINGS-FILE is defined, deferred warnings are saved to that file.
On ECL or MKCL, it creates both the linkable object and loadable fasl files.
On implementations that erroneously do not recognize standard keyword arguments,
it will filter them appropriately."
(let* ((keywords (remove-keys
(let* ((keywords (remove-plist-keys
`(:compile-check :warnings-file
#+gcl<2.7 ,@'(:external-format :print :verbose)) keys))
(output-file (apply 'compile-file-pathname* input-file :output-file output-file keywords))
......@@ -324,7 +324,7 @@ it will filter them appropriately."
(defun* compile-file-pathname* (input-file &rest keys &key output-file &allow-other-keys)
(let* ((keys
(remove-keys `(#+(and allegro (not (version>= 8 2))) :external-format
(remove-plist-keys `(#+(and allegro (not (version>= 8 2))) :external-format
,@(unless output-file '(:output-file))) keys)))
(if (absolute-pathname-p output-file)
;; what cfp should be doing, w/ mp* instead of mp
......@@ -339,7 +339,7 @@ it will filter them appropriately."
(etypecase x
((or pathname string #-(or gcl<2.7 clozure allegro) stream)
(apply 'load x
#-gcl<2.7 keys #+gcl<2.7 (remove-key :external-format keys)))
#-gcl<2.7 keys #+gcl<2.7 (remove-plist-key :external-format keys)))
#-(or gcl<2.7 clozure allegro)
;; GCL 2.6 can't load from a string-input-stream
;; ClozureCL 1.6 can only load from file input stream
......@@ -57,7 +57,8 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(let* ((system (etypecase system
(system system)
((or string symbol) (find-system system))))
;; I'd like to remove-keys :force :force-not :verbose, but swank.asd relies on :force (!).
;; I'd like to remove-plist-keys :force :force-not :verbose,
;; but swank.asd relies on :force (!).
(op (apply 'make-operation operation-class args))
(systems-being-operated *systems-being-operated*)
(*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal))))
......@@ -620,7 +620,7 @@ to throw an error if the pathname is absolute"
:directory (unless file-only (cons relative path))
:name name :type type
:defaults (or defaults (nil-pathname)))
(remove-keys '(:type :dot-dot :defaults) keys))))))
(remove-plist-keys '(:type :dot-dot :defaults) keys))))))
(defun* unix-namestring (pathname)
"Given a non-wild PATHNAME, return a Unix-style namestring for it.
......@@ -769,11 +769,11 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
(loop :with directory = (normalize-pathname-directory-component
(pathname-directory p))
:for component :in (cdr directory)
:for dir :in (cdr directory)
:for rest :on (cdr directory)
:for more = (probe-file*
(make-pathname* :directory `(:relative ,component))
(make-pathname* :directory `(:relative ,dir))
sofar)) :do
(if more
(setf sofar more)
......@@ -321,7 +321,7 @@ processed in order by OPERATE."))
(defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
(let ((plan (apply 'make-instance
(or plan-class *default-plan-class*)
:system (component-system c) (remove-key :plan-class keys))))
:system (component-system c) (remove-plist-key :plan-class keys))))
(traverse-action plan o c t)
(plan-actions plan)))
......@@ -245,7 +245,7 @@ and read its contents as per SLURP-STREAM-FORMS with given COUNT.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(apply 'call-with-input-file file
#'(lambda (input) (slurp-stream-forms input :count count))
(remove-key :count keys)))
(remove-plist-key :count keys)))
(defun* read-file-form (file &rest keys &key (path 0) &allow-other-keys)
"Open input FILE with option KEYS (except path),
......@@ -253,14 +253,14 @@ and read its contents as per SLURP-STREAM-FORM with given PATH.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(apply 'call-with-input-file file
#'(lambda (input) (slurp-stream-form input :path path))
(remove-key :path keys)))
(remove-plist-key :path keys)))
(defun* safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys)
"Reads the specified form from the top of a file using a safe standardized syntax.
Extracts the form using READ-FILE-FORM,
within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
(with-safe-io-syntax (:package package)
(apply 'read-file-form pathname (remove-key :package keys))))
(apply 'read-file-form pathname (remove-plist-key :package keys))))
(defun* eval-input (input)
"Portably read and evaluate forms from INPUT, return the last values."
......@@ -10,6 +10,7 @@
(assert (absolute-pathname-p exe))
(unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
......@@ -45,7 +45,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.115")
(asdf-version "2.26.116")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
......@@ -10,7 +10,7 @@
#:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility*
#:undefine-function #:undefine-functions #:defun* #:defgeneric* ;; (un)defining functions
#:if-let ;; basic flow control
#:while-collecting #:appendf #:length=n-p #:remove-keys #:remove-key ;; lists and plists
#:while-collecting #:appendf #:length=n-p #:remove-plist-keys #:remove-plist-key ;; lists and plists
#:emptyp ;; sequences
#:first-char #:last-char #:split-string ;; strings
#:string-prefix-p #:string-enclosed-p #:string-suffix-p
......@@ -132,13 +132,13 @@ Returns two values: \(A B C\) and \(1 2 3\)."
((not (consp l)) (return nil)))))
;;; remove a key from a plist, i.e. for keyword argument cleanup
(defun* remove-key (key plist)
(defun* remove-plist-key (key plist)
"Remove a single key from a plist"
(loop :for (k v) :on plist :by #'cddr
:unless (eq k key)
:append (list k v)))
(defun* remove-keys (keys plist)
(defun* remove-plist-keys (keys plist)
"Remove a list of keys from a plist"
(loop :for (k v) :on plist :by #'cddr
:unless (member k keys)
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