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

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