Changeset 14590 for trunk/abcl/contrib/abcl-asdf/asdf-jar.lisp

Timestamp:

12/05/13 22:09:20 (9 years ago)

Author:

Mark Evenson

Message:

Extend ABCL-ASDF:JAR-FILE pathname normalization to ASDF:COMPILE-OP.

Fixes loading of the lsw2 util system by normalizing
ABCL-ASDF:JAR-FILE components whose pathname NAME component ends in
".jar".

File:

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

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

@@ -69 +69 @@
 ;;; in ".jar" without a TYPE.  If we encounter such a definition, we
 ;;; clean it up.
-(defmethod perform :before ((operation load-op) (c jar-file))
-  (when (#"endsWith" (slot-value c 'name) ".jar")
-    (with-slots (name absolute-pathname) c
+(defun normalize-jar-name (component)
+  (when (#"endsWith" (slot-value component 'name) ".jar")
+    (with-slots (name absolute-pathname) component
       (let* ((new-name 
               (subseq name 0 (- (length name) 4)))
@@ -78 +78 @@
         (setf name new-name
               absolute-pathname new-absolute-pathname)))))
+  
+(defmethod perform :before ((operation compile-op) (c jar-file))
+  (normalize-jar-name c))
+  
+(defmethod perform :before ((operation load-op) (c jar-file))
+  (normalize-jar-name c))
 
 (defmethod operation-done-p :before ((operation load-op) (c jar-file))
-  (when (#"endsWith" (slot-value c 'name) ".jar")
-    (with-slots (name absolute-pathname) c
-      (let* ((new-name 
-              (subseq name 0 (- (length name) 4)))
-             (new-absolute-pathname 
-              (make-pathname :defaults absolute-pathname :name new-name)))
-        (setf name new-name
-              absolute-pathname new-absolute-pathname)))))
+  (normalize-jar-name c))
 
 (defmethod operation-done-p ((operation load-op) (c jar-file))