Proposed ASDF modification

Since we can require particular versions of software, it seemed to me
that we should also be able to say stuff like:

(asdf:oos 'asdf:load-op :shop2 :version "1.3.0")

Unfortunately, this does not work --- the version argument is not
used to constrain the finding of the system :shop2.

[Actually, worse, the :version is quietly dropped on the floor, so that
the user is left believing that something is happening with it, but
nothing is.]

I believe that the attached patch to asdf.lisp will make version
selection work.

Note that the patch also pulls the version comparison function (now
called bigger-version) out of version-satisfies.  This is done so that
one can test the version comparision function without having to build
a faux component; now one need only compare lists of integers.

I apologize if I got the diffing wrong --- I was wrestling with
on-again off-again CVS access.

R


--- asdf.lisp.1.93	2006-05-09 11:15:37.000000000 -0500
+++ asdf.lisp	2006-05-09 11:24:34.000000000 -0500
@@ -312,6 +312,16 @@ (defmethod version-satisfies ((c compone
 		   (split (component-version c) nil '(#\.))))
 	(y (mapcar #'parse-integer
 		   (split version nil '(#\.)))))
+    (bigger-version x y)))
+
+;;; pulled this function out so that it could be tested outside the
+;;; context of version-satisfies (i.e., w/o the need to make a
+;;; component).  Possibly since this is >= instead of >, this should
+;;; be renamed.  Also, possibly (1 3) should be BIGGER-VERSION to (1 3
+;;; 0): currently it is not.  [2006/05/09:rpg]
+(defun bigger-version (x y)
+  "X and Y are lists of integers, indicating version numbers.
+Returns T if X is a version greater than *OR EQUAL TO* Y."
     (labels ((bigger (x y)
 	       (cond ((not y) t)
 		     ((not x) nil)
@@ -319,7 +329,8 @@ (defmethod version-satisfies ((c compone
 		     ((= (car x) (car y))
 		      (bigger (cdr x) (cdr y))))))
       (and (= (car x) (car y))
-	   (or (not (cdr y)) (bigger (cdr x) (cdr y)))))))
+	 (or (not (cdr y)) (bigger (cdr x) (cdr y))))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; finding systems
@@ -811,15 +822,20 @@ (defmethod perform ((operation test-op) 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; invoking operations
 
-(defun operate (operation-class system &rest args)
+(defun operate (operation-class system &rest args &key 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)))
+	 (system (if (typep system 'component) system (find-system system))))
+    (cond ((null system)
+	   (error (make-condition 'missing-component :requires system)))
+	  ((and system version)
+	   (unless (version-satisfies system version)
+	     (error (make-condition 'missing-component :requires system :version version)))))
+    (let ((steps (traverse op system)))
     (with-compilation-unit ()
       (loop for (op . component) in steps do
 	    (loop
@@ -841,7 +857,7 @@ (defun operate (operation-class system &
 		 (setf (gethash (type-of op)
 				(component-operation-times component))
 		       (get-universal-time))
-		 (return))))))))
+		     (return)))))))))
 
 (defun oos (&rest args)
   "Alias of OPERATE function"


-------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642