Commit 6bb1036a authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.26.22: Add new, sensible, :if-feature feature.

Remove last traces of previous non-sensical :feature features.
parent 45a36620
......@@ -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 ()
((:file "asdf")))
;; -*- 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 <>.
......@@ -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.
(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
(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))))
(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))))
#| 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))
(latest-stamp-f stamp (funcall fun op kid))
(missing-dependency (condition)
(when (eq (module-if-component-dep-fails module)
(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)
(not at-least-one))
(error error))
(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)
......@@ -2,9 +2,5 @@
(asdf:defsystem test3
:properties ((:prop1 . "value"))
((:module "deps"
:if-component-dep-fails :try-next
:pathname ""
((:file "file1" :in-order-to ((compile-op (feature :f1))))
(:file "file2" :in-order-to ((compile-op (feature :f2))))))))
((:file "file1" :if-feature :asdf)
(:file "file2" :if-feature (:not :asdf))))
;;; -*- 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)
(let* ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp")))
......@@ -15,21 +8,12 @@
(ns2 (native-namestring fasl2)))
(asdf:run-shell-command "rm -f ~A ~A" ns1 ns2)
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(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)
(DBG "should load file1 but not file2")
(asdf:load-system :test3)
(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)))))
(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"))))
;;; -*- Lisp -*-
;;; -*- Lisp -*-
(load "script-support.lisp")
(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")))
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