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