Changeset 14365

Timestamp:

01/31/13 14:26:25 (11 years ago)

Author:

Mark Evenson

Message:

abcl-asdf: fix bug to use the version of specified MVN components.

Reformat to SLIME whitespace conventions.

File:

• trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp (modified) (5 diffs)

trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp

@@ -18 +18 @@
    (classname :initarg :classname :initform nil)
    (alternate-uri :initarg :alternate-uri :initform nil)
-;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01
-#+nil   (version :initform nil)))
+   ;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01
+   #+nil   (version :initform nil)))
 
 #+nil
@@ -30 +30 @@
   (abcl-asdf:resolve   
    (ensure-parsed-mvn c)))
-     
+
 (defmethod perform ((operation load-op) (c mvn))
   (let ((resolved-path 
@@ -59 +59 @@
 (defun ensure-parsed-mvn (component)
   (with-slots (name group-id artifact-id
-               version schema path repository) 
+                    version schema path repository) 
       component
     (when (null asdf::artifact-id) 
@@ -98 +98 @@
 
 (defgeneric resolve (something)
- (:documentation "Returns a string in JVM CLASSPATH format as entries delimited by classpath separator string."))
+  (:documentation "Returns a string in JVM CLASSPATH format as entries delimited by classpath separator string."))
 
 (defmethod resolve ((mvn-component asdf::mvn))
@@ -107 +107 @@
 denotes that current JVM already has already loaded a given class. Can possibly be a
 single entry denoting a remote binary artifact."
-  (macrolet ((aif (something consequence alternative))
-             `(let ((it ,(something)))
-                (if it
-                    consequence
-                    alternative)))
-    (let ((name (slot-value mvn-component 'asdf::name))
-          (group-id (slot-value mvn-component 'asdf::group-id))
-          (artifact-id (slot-value mvn-component 'asdf::artifact-id))
-          (classname (slot-value mvn-component 'asdf::classname))
-          (alternate-uri (slot-value mvn-component 'asdf::alternate-uri))
-          (version (let ((it (slot-value mvn-component 'asdf::version)))
-                     (cond
-                       ((not it)
-                        it)
-                       (t 
-                        "LATEST")))))
-      (handler-case 
-          (when (and classname 
-                     (jss:find-java-class classname))
-            (warn "Not loading ~A from the network because ~A is present in classpath."
-                  name classname)
-            (return-from resolve t))
-        (java:java-exception (e)
-          (unless (java:jinstance-of-p (java:java-exception-cause e)
-                                  "java.lang.ClassNotFoundException")
-            (error "Unexpected Java exception~&~A.~&" e))))
-      (if (find-mvn)
-          (resolve-dependencies group-id artifact-id version)
-          (if alternate-uri
-              (values (namestring alternate-uri) alternate-uri)
-              (t 
-               (error "Failed to resolve MVN component name ~A." name)))))))
-  
+  (let ((name (slot-value mvn-component 'asdf::name))
+        (group-id (slot-value mvn-component 'asdf::group-id))
+        (artifact-id (slot-value mvn-component 'asdf::artifact-id))
+        (classname (slot-value mvn-component 'asdf::classname))
+        (alternate-uri (slot-value mvn-component 'asdf::alternate-uri))
+        (version (if (slot-value mvn-component 'asdf::version)
+                     (slot-value mvn-component 'asdf::version)
+                     "LATEST")))
+    (handler-case 
+        (when (and classname 
+                   (jss:find-java-class classname))
+          (warn "Not loading ~A from the network because ~A is present in classpath."
+                name classname)
+          (return-from resolve t))
+      (java:java-exception (e)
+        (unless (java:jinstance-of-p (java:java-exception-cause e)
+                                     "java.lang.ClassNotFoundException")
+          (error "Unexpected Java exception~&~A.~&" e))))
+    (if (find-mvn)
+        (resolve-dependencies group-id artifact-id version)
+        (if alternate-uri
+            (values (namestring alternate-uri) alternate-uri)
+            (t 
+             (error "Failed to resolve MVN component name ~A." name))))))
+
 (defun as-classpath (classpath)
   "Break apart the JVM CLASSPATH string into a list of its consituents."