[armedbear-cvs] r13795 - trunk/abcl/contrib/asdf-jar
mevenson at common-lisp.net
mevenson at common-lisp.net
Sun Jan 22 08:47:02 UTC 2012
Author: mevenson
Date: Sun Jan 22 00:47:02 2012
New Revision: 13795
Log:
Yong patches asdf-jar for MSFT.
See http://article.gmane.org/gmane.lisp.armedbear.devel/2190
Modified:
trunk/abcl/contrib/asdf-jar/asdf-jar.lisp
Modified: trunk/abcl/contrib/asdf-jar/asdf-jar.lisp
==============================================================================
--- trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Sat Jan 21 23:52:54 2012 (r13794)
+++ trunk/abcl/contrib/asdf-jar/asdf-jar.lisp Sun Jan 22 00:47:02 2012 (r13795)
@@ -35,9 +35,11 @@
(handler-case (slot-value system 'asdf:version)
(unbound-slot () "unknown")))
(package-jar-name
- (format nil "~A~A-~A.jar" name (if recursive "-all" "") version))
+ (format nil "~A~A-~A" name (if recursive "-all" "") version))
(package-jar
- (make-pathname :directory (pathname-directory out) :defaults package-jar-name))
+ (make-pathname :name package-jar-name
+ :type "jar"
+ :defaults out))
(mapping (make-hash-table :test 'equal))
(dependencies (dependent-systems system)))
(when verbose
@@ -55,10 +57,10 @@
(let ((base (slot-value system 'asdf::absolute-pathname))
(name (slot-value system 'asdf::name))
(asdf (slot-value system 'asdf::source-file)))
- (setf (gethash asdf mapping) (relative-path base name asdf))
+ (setf (gethash asdf mapping) (archive-relative-path base name asdf))
(loop :for component :in (all-files system)
:for source = (slot-value component 'asdf::absolute-pathname)
- :for source-entry = (relative-path base name source)
+ :for source-entry = (archive-relative-path base name source)
:do (setf (gethash source mapping)
source-entry)
:do (when *debug*
@@ -96,11 +98,12 @@
:when sub :append sub)))
(remove-duplicates `(, at dependencies , at sub-depends))))
-(defun relative-path (base dir file)
+(defun archive-relative-path (base dir file)
(let* ((relative
(nthcdr (length (pathname-directory base)) (pathname-directory file)))
- (entry-dir `(:relative ,dir ,@(when relative relative))))
- (make-pathname :directory entry-dir
+ (entry-dir `(:relative ,dir , at relative)))
+ (make-pathname :device nil
+ :directory entry-dir
:defaults file)))
(defun tmpdir (name)
@@ -117,7 +120,7 @@
The parameter passed to :USE-JAR-FASLS determines whether to instruct
asdf to use the fasls packaged in the jar. If this is nil, the fasls
-will be compiled with respect to the ususual asdf output translation
+will be compiled with respect to the usual asdf output translation
conventions."
(when (not (typep jar 'pathname))
(setf jar (pathname jar)))
More information about the armedbear-cvs
mailing list