From 1cf58c2fdfe43333ff58ccc6f058be56cfe04dcd Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 14 May 2006 16:03:16 +0000
Subject: [PATCH] OOS :VERSION support. Thanks to Robert P. Goldman.

---
 asdf.lisp                | 64 ++++++++++++++++++++--------------------
 test/test-version.script | 30 +++++++++++++++++++
 test/wild-module.asd     |  5 ++--
 3 files changed, 64 insertions(+), 35 deletions(-)
 create mode 100644 test/test-version.script

diff --git a/asdf.lisp b/asdf.lisp
index 1a38b2d6..7143e660 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  $Revision: 1.96 $
+;;; This is asdf: Another System Definition Facility.  $Revision: 1.97 $
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -109,7 +109,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "$Revision: 1.96 $")
+(defvar *asdf-revision* (let* ((v "$Revision: 1.97 $")
 			       (colon (or (position #\: v) -1))
 			       (dot (position #\. v)))
 			  (and v colon dot 
@@ -828,37 +828,37 @@ system."))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; invoking operations
 
-(defun operate (operation-class system &rest args)
+(defun operate (operation-class system &rest args &key (verbose t) version)
   (let* ((op (apply #'make-instance operation-class
-		    :original-initargs args args))
-	 (*verbose-out*
-	  (if (getf args :verbose t)
-	      *trace-output*
-	      (make-broadcast-stream)))
-	 (system (if (typep system 'component) system (find-system system)))
-	 (steps (traverse op system)))
-    (with-compilation-unit ()
-      (loop for (op . component) in steps do
-	    (loop
-	     (restart-case 
-		 (progn (perform op component)
-			(return))
-	       (retry ()
-		 :report
-		 (lambda (s)
-		   (format s "~@<Retry performing ~S on ~S.~@:>"
-			   op component)))
-	       (accept ()
-		 :report
-		 (lambda (s)
-		   (format s
-			   "~@<Continue, treating ~S on ~S as ~
-                            having been successful.~@:>"
-			   op component))
-		 (setf (gethash (type-of op)
-				(component-operation-times component))
-		       (get-universal-time))
-		 (return))))))))
+		    :original-initargs args
+		    args))
+	 (*verbose-out* (if verbose *trace-output* (make-broadcast-stream)))
+	 (system (if (typep system 'component) system (find-system system))))
+    (unless (version-satisfies system version)
+      (error 'missing-component :requires system :version version))
+    (let ((steps (traverse op system)))
+      (with-compilation-unit ()
+	(loop for (op . component) in steps do
+	     (loop
+		(restart-case 
+		    (progn (perform op component)
+			   (return))
+		  (retry ()
+		    :report
+		    (lambda (s)
+		      (format s "~@<Retry performing ~S on ~S.~@:>"
+			      op component)))
+		  (accept ()
+		    :report
+		    (lambda (s)
+		      (format s
+			      "~@<Continue, treating ~S on ~S as ~
+                               having been successful.~@:>"
+			      op component))
+		    (setf (gethash (type-of op)
+				   (component-operation-times component))
+			  (get-universal-time))
+		    (return)))))))))
 
 (defun oos (&rest args)
   "Alias of OPERATE function"
diff --git a/test/test-version.script b/test/test-version.script
new file mode 100644
index 00000000..16465ca3
--- /dev/null
+++ b/test/test-version.script
@@ -0,0 +1,30 @@
+;; -*- lisp -*-
+
+(load "../asdf")
+(setf asdf:*central-registry* '(*default-pathname-defaults*))
+
+(defpackage :test-version-system
+  (:use :cl :asdf))
+
+(in-package :test-version-system)
+
+(defsystem :versioned-system-1
+  :pathname #.*default-pathname-defaults*
+  :version "1.0")
+
+(defsystem :versioned-system-2
+  :pathname #.*default-pathname-defaults*
+  :version "1.1")
+
+(defsystem :versioned-system-3
+  :pathname #.*default-pathname-defaults*
+  :version "1.2")
+
+(flet ((test (name v &optional (true t))
+	 (or (eq true (asdf::version-satisfies (find-system name) v))
+	     (error "no satisfaction: ~S version ~A not ~A" name v true))))
+  (test :versioned-system-1 "1.0")
+  (test :versioned-system-2 "1.0")
+  (test :versioned-system-3 "2.0" nil))
+
+      
\ No newline at end of file
diff --git a/test/wild-module.asd b/test/wild-module.asd
index 8c090084..b12f351c 100644
--- a/test/wild-module.asd
+++ b/test/wild-module.asd
@@ -1,6 +1,5 @@
 ;;; -*- Lisp -*-
 
-(asdf:defsystem wild-module
+(asdf:defsystem :wild-module
   :version "0.0"
-  :components ((:wild-module "systems"
-                             :pathname "*.asd")))
+  :components ((:wild-module "systems" :pathname "*.asd")))
-- 
GitLab