diff --git a/TODO b/TODO index 1d175e0fa9f0d22251863095c492300c7d5a8937..4b9540fd3a3fedad8bd7462b6628c1b69937b23d 100644 --- a/TODO +++ b/TODO @@ -1,3 +1,4 @@ +* have a mode to explain WHY a module needs to be recompiled. * have a better defsystem form verifier - see lp#1007335 * have a function verify-strict-asd that can verify a asd is pure lp#541562 Then if it passes, use load-strict-asd. diff --git a/asdf.asd b/asdf.asd index 58649f47b164e14d2bfc62e13e77f62a34543e5c..934ffb275ef73f0c2ef9aabb4e4df9ebc57ded01 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.31" ;; to be automatically updated by make bump-version + :version "2.31.1" ;; 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/cache.lisp b/cache.lisp index 592b76a7e4b9da2a17e5a75b164efb5948ebe666..1d8a7936b6dce579f7494fcabb2f603c313c9b6b 100644 --- a/cache.lisp +++ b/cache.lisp @@ -22,13 +22,13 @@ (setf (gethash key *asdf-cache*) value-list) value-list))) - (defun consult-asdf-cache (key thunk) + (defun consult-asdf-cache (key &optional thunk) (if *asdf-cache* (multiple-value-bind (results foundp) (gethash key *asdf-cache*) (if foundp (apply 'values results) - (set-asdf-cache-entry key (multiple-value-list (funcall thunk))))) - (funcall thunk))) + (set-asdf-cache-entry key (multiple-value-list (call-function thunk))))) + (call-function thunk))) (defmacro do-asdf-cache (key &body body) `(consult-asdf-cache ,key #'(lambda () ,@body))) diff --git a/header.lisp b/header.lisp index 1f3866d845457714b8d4c3dce1e72b27350f614f..e5bba9f1824f0f8928ea9147de984509c336d807 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.31: Another System Definition Facility. +;;; This is ASDF 2.31.1: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/operate.lisp b/operate.lisp index 0195a60cf94e816fd1f023c836990cd8e77e544a..6fcd4f244ecc0fc2d2c758b531e842f3797321f7 100644 --- a/operate.lisp +++ b/operate.lisp @@ -140,18 +140,48 @@ for how to load or compile stuff") (defun require-system (s &rest keys &key &allow-other-keys) (apply 'load-system s :force-not (already-loaded-systems) keys)) + (defvar *modules-being-required* nil) + + (defclass require-system (system) + ((module :initarg :module :initform nil :accessor required-module))) + + (defmethod perform ((o compile-op) (c require-system)) + (declare (ignorable o c)) + nil) + + (defmethod perform ((o load-op) (s require-system)) + (declare (ignorable o)) + (let* ((module (or (required-module s) (coerce-name s))) + (*modules-being-required* (cons module *modules-being-required*))) + (assert (null (component-children s))) + (require module))) + + (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) + (declare (ignorable component combinator)) + (unless (length=n-p arguments 1) + (error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>") + (cons combinator arguments) component combinator)) + (let* ((module (car arguments)) + (name (string-downcase module))) + (assert module) + (make-instance 'require-system :name name))) + (defun module-provide-asdf (name) - (handler-bind - ((style-warning #'muffle-warning) - (missing-component (constantly nil)) - (error #'(lambda (e) - (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%") - name e)))) - (let ((*verbose-out* (make-broadcast-stream)) - (system (find-system (string-downcase name) nil))) - (when system - (require-system system :verbose nil) - t))))) + (let ((module (string-downcase name))) + (unless (member module *modules-being-required* :test 'equal) + (let ((*modules-being-required* (cons module *modules-being-required*)) + #+sbcl (sb-impl::*requiring* (remove module sb-impl::*requiring* :test 'equal))) + (handler-bind + ((style-warning #'muffle-warning) + (missing-component (constantly nil)) + (error #'(lambda (e) + (format *error-output* (compatfmt "~@<ASDF could not load ~(~A~) because ~A.~@:>~%") + name e)))) + (let ((*verbose-out* (make-broadcast-stream))) + (let ((system (find-system module nil))) + (when system + (require-system system :verbose nil) + t))))))))) ;;;; Some upgrade magic diff --git a/output-translations.lisp b/output-translations.lisp index c105b8acdde409cc2afc2f4195b248f8627e3d6a..583bfe09623e41c87f36f3cdefd8f07c65e4295b 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -263,27 +263,27 @@ effectively disabling the output translation facility." (initialize-output-translations))) (defun* (apply-output-translations) (path) - #+cormanlisp (resolve-symlinks* path) #-cormanlisp - (etypecase path - (logical-pathname - path) - ((or pathname string) - (ensure-output-translations) - (loop* :with p = (resolve-symlinks* path) - :for (source destination) :in (car *output-translations*) - :for root = (when (or (eq source t) - (and (pathnamep source) - (not (absolute-pathname-p source)))) - (pathname-root p)) - :for absolute-source = (cond - ((eq source t) (wilden root)) - (root (merge-pathnames* source root)) - (t source)) - :when (or (eq source t) (pathname-match-p p absolute-source)) - :return (translate-pathname* p absolute-source destination root source) - :finally (return p))))) + (etypecase path + (logical-pathname + path) + ((or pathname string) + (ensure-output-translations) + (loop* :with p = (resolve-symlinks* path) + :for (source destination) :in (car *output-translations*) + :for root = (when (or (eq source t) + (and (pathnamep source) + (not (absolute-pathname-p source)))) + (pathname-root p)) + :for absolute-source = (cond + ((eq source t) (wilden root)) + (root (merge-pathnames* source root)) + (t source)) + :when (or (eq source t) (pathname-match-p p absolute-source)) + :return (translate-pathname* p absolute-source destination root source) + :finally (return p))))) ;; Hook into asdf/driver's output-translation mechanism + #-cormanlisp (setf *output-translation-function* 'apply-output-translations) #+abcl diff --git a/plan.lisp b/plan.lisp index cbf93d7d1ec454d33b509e372936860cf61df1d8..e72451e28ec540c50448b0db4cbe07fcbc15b417 100644 --- a/plan.lisp +++ b/plan.lisp @@ -176,7 +176,8 @@ the action of OPERATION on COMPONENT in the PLAN")) :do (loop :with dep-o = (find-operation operation dep-o-spec) :for dep-c-spec :in dep-c-specs :for dep-c = (resolve-dependency-spec component dep-c-spec) - :do (funcall fun dep-o dep-c)))) + :when (and dep-o dep-c) + :do (funcall fun dep-o dep-c)))) (defun reduce-direct-dependencies (operation component combinator seed) (map-direct-dependencies diff --git a/test/test-asdf.asd b/test/test-asdf.asd index edfdf3cc7418b211e8c0c591b68dd395a532d2ef..0d230437492315ae4958465a01faabebdc355b0d 100644 --- a/test/test-asdf.asd +++ b/test/test-asdf.asd @@ -30,6 +30,7 @@ :depends-on ((:version :test-asdf/test9-2 "2.0"))) (defsystem :test-asdf/test-module-depend + :depends-on (#+sbcl (:require :sb-posix)) :components ((:file "file1") (:module "quux" diff --git a/test/test-encodings.script b/test/test-encodings.script index 81e1fb3c8118c3713690314f4661e69cee505690..13e0badaa5555901312bd6d8dc438dbfef056d99 100644 --- a/test/test-encodings.script +++ b/test/test-encodings.script @@ -40,8 +40,10 @@ (leave-test "No Unicode support to test on this lisp implementation" 0) #+abcl -(when (version< (lisp-implementation-version) "1.1.2") - (leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)) +(let ((version (lisp-implementation-version)) + (version-nums (subseq version 0 (position-if-not (lambda (x) (find x "0123456789.")) version)))) + (when (version< version-nums "1.1.2") + (leave-test "Your old ABCL is known to fail this test script, so skipping it." 0))) (with-encoding-test (:utf-8) (def-test-system :test-encoding-explicit-u8 diff --git a/upgrade.lisp b/upgrade.lisp index cefa9329e3aaa65370e6b1d29d99605cc2ebce48..64abe040d81604e596f1f84021890588c8ab55de 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.31") + (asdf-version "2.31.1") (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 55c69c20433352e37018befba550dd1f1ac192c7..666b3e95c5403338d1b120b44bdcf888c4a8301e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.31" +"2.31.1"