From 6bb1036a6c4d05ca05d2d68d55220010b54f59de Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 14 Dec 2012 22:12:16 -0500 Subject: [PATCH] 2.26.22: Add new, sensible, :if-feature feature. Remove last traces of previous non-sensical :feature features. --- asdf.asd | 2 +- asdf.lisp | 54 +++++++++-------------------------------------- test/test3.asd | 12 ++++------- test/test3.script | 38 ++++++++++----------------------- test/test4.script | 11 ---------- 5 files changed, 26 insertions(+), 91 deletions(-) delete mode 100644 test/test4.script diff --git a/asdf.asd b/asdf.asd index e692f407..4a1406d7 100644 --- a/asdf.asd +++ b/asdf.asd @@ -14,7 +14,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.21" ;; to be automatically updated by bin/bump-revision + :version "2.26.22" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:file "asdf"))) diff --git a/asdf.lisp b/asdf.lisp index d9bd643d..8efed19e 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.21: Another System Definition Facility. +;;; This is ASDF 2.26.22: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. @@ -118,7 +118,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.21") + (asdf-version "2.26.22") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -1316,6 +1316,7 @@ Returns two values: (description :accessor component-description :initarg :description) (long-description :accessor component-long-description :initarg :long-description) (sibling-dependencies :accessor component-sibling-dependencies :initform nil) + (if-feature :accessor component-if-feature :initform nil :initarg :if-feature) ;; In the ASDF object model, dependencies exist between *actions* ;; (an action is a pair of operation and component). ;; Dependencies are represented as alists of operations @@ -2039,15 +2040,8 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ;; https://bugs.launchpad.net/asdf/+bug/527788 (resolve-dependency-name component (second dep-spec) (third dep-spec))) ((eq :feature (first dep-spec)) - ;; This particular subform is not documented and - ;; has always been broken in the past. - ;; Therefore no one uses it, and I'm cerroring it out, - ;; after fixing it - ;; See https://bugs.launchpad.net/asdf/+bug/518467 - (cerror "Continue nonetheless." - "Congratulations, you're the first ever user of FEATURE dependencies! Please contact the asdf-devel mailing-list.") - (when (find (second dep-spec) *features* :test 'string-equal) - (resolve-dependency-name component (third dep-spec)))) + (when (featurep (second dep-spec)) + (resolve-dependency-spec component (third dep-spec)))) (t (error (compatfmt "~@<Bad dependency ~s. Dependencies must be (:version <name> <version>), (:feature <feature> <name>), or <name>.~@:>") dep-spec)))) @@ -2225,43 +2219,15 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (latest-stamp-f stamp (funcall fun dep-o dep-c)))) stamp) -#| If we want to support if-component-dep-fails, we have to try harder. -FIX THEM: ironclad, nibbles - -(defun* visit-children (op module fun) - (when (typep module 'parent-component) - (let ((at-least-one nil) - ;; This is set based on the results of the dependencies and - ;; whether we are in the context of a forcing call... - ;; inter-system dependencies DO trigger - ;; building components since ASDF 2.26.8 only. - (error nil) - (stamp nil)) - (dolist (kid (component-children module)) - (handler-case - (latest-stamp-f stamp (funcall fun op kid)) - #-genera - (missing-dependency (condition) - (when (eq (module-if-component-dep-fails module) - :fail) - (error condition)) - (setf error condition)) - (:no-error (c) - (declare (ignore c)) - (setf at-least-one t)))) - (when (and (eq (module-if-component-dep-fails module) - :try-next) - (not at-least-one)) - (error error)) - stamp))) -|# - (defvar *visit-count* 0) ; counter that allows to sort nodes from operation-visited-nodes (defun* visit-action (o c plan recurse fun) - (when (and o c (not (action-override-p o c 'operation-forced-not))) + (when (and o c + (aif (component-if-feature c) (featurep it) t) + (not (action-override-p o c 'operation-forced-not))) + (visit-dependencies o c recurse) (multiple-value-bind (stamp done-p) - (compute-action-stamp o c :plan plan :base-stamp (visit-dependencies o c recurse)) + (compute-action-stamp o c :plan plan #|:base-stamp (visit-dependencies o c recurse)|#) (funcall fun o c done-p stamp) stamp))) diff --git a/test/test3.asd b/test/test3.asd index b655bef8..ba9f03f6 100644 --- a/test/test3.asd +++ b/test/test3.asd @@ -1,10 +1,6 @@ ;;; -*- Lisp -*- (asdf:defsystem test3 - :properties ((:prop1 . "value")) - :components - ((:module "deps" - :if-component-dep-fails :try-next - :pathname "" - :components - ((:file "file1" :in-order-to ((compile-op (feature :f1)))) - (:file "file2" :in-order-to ((compile-op (feature :f2)))))))) + :properties ((:prop1 . "value")) + :components + ((:file "file1" :if-feature :asdf) + (:file "file2" :if-feature (:not :asdf)))) diff --git a/test/test3.script b/test/test3.script index f1ce7673..44c28a71 100644 --- a/test/test3.script +++ b/test/test3.script @@ -1,35 +1,19 @@ ;;; -*- Lisp -*- -#+(or f1 f2) (error "This test cannot run if :f1 or :f2 are on *features*") (load "script-support.lisp") - -;;; This test relies on the removed features :if-component-dep-fails and :feature. -;;; It is disabled. -(asdf-test:leave-lisp "This test was removed, because is stressed a feature that was removed." 0) - - (load-asdf) (quit-on-error (let* ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp"))) (fasl2 (asdf:compile-file-pathname* (truename "file2.lisp"))) (ns1 (native-namestring fasl1)) (ns2 (native-namestring fasl2))) - (asdf:run-shell-command "rm -f ~A ~A" ns1 ns2) - (setf asdf:*central-registry* '(*default-pathname-defaults*)) - #-gcl - (handler-case - (asdf:oos 'asdf:load-op 'test3) - (asdf:missing-dependency (c) - (format t "first test failed as expected: - ~%~A~%" c)) - (:no-error (c) - (declare (ignore c)) - (error "should have failed, oops"))) - (pushnew :f1 *features*) - (asdf:oos 'asdf:load-op 'test3) - (format t "testing for~% FASL1=~S and~% FASL2=~S~%" fasl1 fasl2) - (assert (probe-file fasl1)) - (assert (not (probe-file fasl2))) - (run-shell-command "rm -f ~A" ns1) - (setf *features* (cons :f2 (cdr *features*))) - (asdf:oos 'asdf:load-op 'test3) - (assert (probe-file fasl2)) - (assert (not (probe-file fasl1))))) + (asdf:run-shell-command "rm -f ~A ~A" ns1 ns2) + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (DBG "should load file1 but not file2") + (asdf:load-system :test3) + (assert (probe-file fasl1)) + (assert (not (probe-file fasl2))) + + (assert (not (component-property (find-system 'test3) :foo))) + (assert (equal (component-property (find-system 'test3) :prop1) "value")) + (setf (component-property (find-system 'test3) :foo) "bar") + (assert (equal (component-property (find-system 'test3) :foo) "bar")))) diff --git a/test/test4.script b/test/test4.script deleted file mode 100644 index 9d5c7efe..00000000 --- a/test/test4.script +++ /dev/null @@ -1,11 +0,0 @@ -;;; -*- Lisp -*- -;;; -*- Lisp -*- -(load "script-support.lisp") -(load-asdf) - -(quit-on-error - (setf asdf:*central-registry* '(*default-pathname-defaults*)) - (assert (not (component-property (find-system 'test3) :foo))) - (assert (equal (component-property (find-system 'test3) :prop1) "value")) - (setf (component-property (find-system 'test3) :foo) "bar") - (assert (equal (component-property (find-system 'test3) :foo) "bar"))) -- GitLab