From 5f6aabab77a867ceb8119e97481a93aefb993f26 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 18 Jan 2013 08:40:51 -0500 Subject: [PATCH] 2.26.116: Avoid stepping on symbols used by ASDF 2.26 and earlier unless we're backward compatible. --- .gitignore | 1 + Makefile | 3 +++ asdf-driver.asd | 2 +- asdf.asd | 3 ++- bin/asdf-builder | 32 ++++++++++++++++++++++++++------ bundle.lisp | 6 +++--- configuration.lisp | 11 ++++++----- defsystem.lisp | 6 +++--- header.lisp | 2 +- lisp-build.lisp | 6 +++--- operate.lisp | 3 ++- pathname.lisp | 6 +++--- plan.lisp | 2 +- stream.lisp | 6 +++--- test/test-program.script | 1 + upgrade.lisp | 2 +- utility.lisp | 6 +++--- version.lisp-expr | 2 +- 18 files changed, 64 insertions(+), 36 deletions(-) diff --git a/.gitignore b/.gitignore index 04420abd..400128c7 100644 --- a/.gitignore +++ b/.gitignore @@ -34,6 +34,7 @@ tmp/ *.ufasl *.vbin *.~*~ +*.sse2f test/try-reloading-dependency.asd test/fileMissing.lisp test/hello-world-example diff --git a/Makefile b/Makefile index d5060d37..8b55b957 100644 --- a/Makefile +++ b/Makefile @@ -57,6 +57,9 @@ bump: bump-version bump-version: build/asdf.lisp ./bin/asdf-builder bump-version +driver-files: + @echo $(driver_lisp) + archive: build/asdf.lisp #${SBCL} --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \ # --eval "(rewrite-license)" --eval "(quit)" diff --git a/asdf-driver.asd b/asdf-driver.asd index 3aa9c129..b5928d3e 100644 --- a/asdf-driver.asd +++ b/asdf-driver.asd @@ -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 :components - ((:file "header") + ((:static-file "version.lisp-expr") (:file "package") (:file "compatibility" :depends-on ("package")) (:file "utility" :depends-on ("compatibility")) diff --git a/asdf.asd b/asdf.asd index e408d9f2..05d64669 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.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" diff --git a/bin/asdf-builder b/bin/asdf-builder index a10fd092..1454d405 100755 --- a/bin/asdf-builder +++ b/bin/asdf-builder @@ -12,7 +12,8 @@ (defun build-asdf () ;; Make sure asdf.lisp is built. (build-system :asdf/generate) - (load-system :asdf)) + (load-system :asdf) + (values)) ;;; ASDF directory @@ -66,7 +67,8 @@ (defun run-program* (x) (format t "~A~%" x) - (run-program/ x)) + (run-program/ x) + (values)) (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/))) + (values)) (defun driver-files () (list* "asdf-driver.asd" "version.lisp-expr" @@ -125,15 +128,32 @@ (build-asdf) (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 () (build-asdf) - (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))) + (values)) (defun make-tarballs () (make-driver-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* '(("version.lisp-expr" "\"" "\"") diff --git a/bundle.lisp b/bundle.lisp index 615ddc49..e3661b4a 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -177,13 +177,13 @@ &allow-other-keys) (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 system - (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) diff --git a/configuration.lisp b/configuration.lisp index a3bc109a..c42e4930 100644 --- a/configuration.lisp +++ b/configuration.lisp @@ -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* (resolve-relative-location-component - component :ensure-directory dir :wilden wild) + element :ensure-directory dir :wilden wild) path)) :finally (return path)))) diff --git a/defsystem.lisp b/defsystem.lisp index 2b00b4a0..d9efc53c 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -101,7 +101,7 @@ (destructuring-bind (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)) - ,@(remove-keys + ,@(remove-plist-keys '(: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. diff --git a/header.lisp b/header.lisp index b11c6b69..d06feab8 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.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 <asdf-devel@common-lisp.net>. diff --git a/lisp-build.lisp b/lisp-build.lisp index 8e664de3..a5f77989 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -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 diff --git a/operate.lisp b/operate.lisp index 1ca31be9..f044f3fc 100644 --- a/operate.lisp +++ b/operate.lisp @@ -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)))) diff --git a/pathname.lisp b/pathname.lisp index b65f37de..1a92f000 100644 --- a/pathname.lisp +++ b/pathname.lisp @@ -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." sofar))) (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* (merge-pathnames* - (make-pathname* :directory `(:relative ,component)) + (make-pathname* :directory `(:relative ,dir)) sofar)) :do (if more (setf sofar more) diff --git a/plan.lisp b/plan.lisp index 0cc484f1..2ea3f2f5 100644 --- a/plan.lisp +++ b/plan.lisp @@ -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))) diff --git a/stream.lisp b/stream.lisp index 288559f5..73f77217 100644 --- a/stream.lisp +++ b/stream.lisp @@ -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." diff --git a/test/test-program.script b/test/test-program.script index 28aa9f10..c6d1ab76 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -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 " ")) "2.48")) diff --git a/upgrade.lisp b/upgrade.lisp index a744d1d7..5b997e38 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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))) diff --git a/utility.lisp b/utility.lisp index 4b104404..fd91ea1c 100644 --- a/utility.lisp +++ b/utility.lisp @@ -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) diff --git a/version.lisp-expr b/version.lisp-expr index 86dcaf2c..a43243cf 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.115" +"2.26.116" -- GitLab