[armedbear-cvs] r13033 - in branches/0.23.x/abcl: . src/org/armedbear/lisp test/lisp/abcl
Mark Evenson
mevenson at common-lisp.net
Sat Nov 20 14:37:02 UTC 2010
Author: mevenson
Date: Sat Nov 20 09:36:57 2010
New Revision: 13033
Log:
[ticket #110][backport r13024,r13026] Fix #\+ in JAR pathnames.
Modified:
branches/0.23.x/abcl/CHANGES
branches/0.23.x/abcl/src/org/armedbear/lisp/Pathname.java
branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp
branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp
Modified: branches/0.23.x/abcl/CHANGES
==============================================================================
--- branches/0.23.x/abcl/CHANGES (original)
+++ branches/0.23.x/abcl/CHANGES Sat Nov 20 09:36:57 2010
@@ -16,6 +16,8 @@
Fixes
-----
+* [ticket #110][svn r13024,r13026] Fix #\+ in JAR pathnames does not work
+
* [svn r12995-12997] Changes to generated byte code to prevent JRockit JVM
from crashing when optimizing it
Modified: branches/0.23.x/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- branches/0.23.x/abcl/src/org/armedbear/lisp/Pathname.java (original)
+++ branches/0.23.x/abcl/src/org/armedbear/lisp/Pathname.java Sat Nov 20 09:36:57 2010
@@ -196,26 +196,18 @@
public Pathname(URL url) {
if ("file".equals(url.getProtocol())) {
- String s;
- try {
- s = URLDecoder.decode(url.getPath(), "UTF-8");
- } catch (java.io.UnsupportedEncodingException uee) {
- // Can't happen: every Java is supposed to support
- // at least UTF-8 encoding
- Debug.assertTrue(false);
- s = null;
- }
+ String s = url.getPath();
if (s != null) {
- if (Utilities.isPlatformWindows) {
- // Workaround for Java's idea of URLs
- // new (URL"file:///c:/a/b").getPath() --> "/c:/a/b"
+ if (Utilities.isPlatformWindows) {
+ // Workaround for Java's idea of URLs
+ // new (URL"file:///c:/a/b").getPath() --> "/c:/a/b"
// whereas we need "c" to be the DEVICE.
- if (s.length() > 2
- && s.charAt(0) == '/'
- && s.charAt(2) == ':') {
- s = s.substring(1);
- }
- }
+ if (s.length() > 2
+ && s.charAt(0) == '/'
+ && s.charAt(2) == ':') {
+ s = s.substring(1);
+ }
+ }
init(s);
return;
}
@@ -651,13 +643,13 @@
sb.append('.');
if (type instanceof AbstractString) {
String t = type.getStringValue();
- // Allow Windows shortcuts to include TYPE
- if (!(t.endsWith(".lnk") && Utilities.isPlatformWindows)) {
- if (t.indexOf('.') >= 0) {
- Debug.assertTrue(namestring == null);
- return null;
- }
- }
+ // Allow Windows shortcuts to include TYPE
+ if (!(t.endsWith(".lnk") && Utilities.isPlatformWindows)) {
+ if (t.indexOf('.') >= 0) {
+ Debug.assertTrue(namestring == null);
+ return null;
+ }
+ }
sb.append(t);
} else if (type == Keyword.WILD) {
sb.append('*');
@@ -2093,12 +2085,12 @@
result = Utilities.getEntryAsInputStream(zipInputStream, entryPath);
} else {
ZipEntry entry = jarFile.getEntry(entryPath);
- if (entry == null) {
- Debug.trace("Failed to get InputStream for "
- + "'" + getNamestring() + "'");
+ if (entry == null) {
+ Debug.trace("Failed to get InputStream for "
+ + "'" + getNamestring() + "'");
// XXX should this be fatal?
- Debug.assertTrue(false);
- }
+ Debug.assertTrue(false);
+ }
try {
result = jarFile.getInputStream(entry);
} catch (IOException e) {
@@ -2267,7 +2259,7 @@
final File destination = new File(newNamestring);
if (Utilities.isPlatformWindows) {
if (destination.isFile()) {
- ZipCache.remove(destination);
+ ZipCache.remove(destination);
destination.delete();
}
}
@@ -2327,19 +2319,19 @@
}
public URL toURL() throws MalformedURLException {
- if(isURL()) {
- return new URL(getNamestring());
- } else {
- return toFile().toURL();
- }
+ if(isURL()) {
+ return new URL(getNamestring());
+ } else {
+ return toFile().toURL();
+ }
}
public File toFile() {
- if(!isURL()) {
- return new File(getNamestring());
- } else {
- throw new RuntimeException(this + " does not represent a file");
- }
+ if(!isURL()) {
+ return new File(getNamestring());
+ } else {
+ throw new RuntimeException(this + " does not represent a file");
+ }
}
static {
Modified: branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp
==============================================================================
--- branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp (original)
+++ branches/0.23.x/abcl/test/lisp/abcl/jar-pathname.lisp Sat Nov 20 09:36:57 2010
@@ -39,29 +39,32 @@
(compile-file "foo.lisp")
(compile-file "bar.lisp")
(compile-file "eek.lisp")
- (let* ((dir (merge-pathnames "tmp/" *abcl-test-directory*))
- (sub (merge-pathnames "a/b/" dir)))
- (when (probe-directory dir)
- (delete-directory-and-files dir))
- (ensure-directories-exist sub)
- (sys:unzip (merge-pathnames "foo.abcl")
- dir)
- (sys:unzip (merge-pathnames "foo.abcl")
- sub)
+ (let* ((tmpdir (merge-pathnames "tmp/" *abcl-test-directory*))
+ (subdirs
+ (mapcar (lambda (p) (merge-pathnames p tmpdir))
+ '("a/b/" "d/e+f/")))
+ (sub1 (first subdirs))
+ (sub2 (second subdirs)))
+ (when (probe-directory tmpdir)
+ (delete-directory-and-files tmpdir))
+ (mapcar (lambda (p) (ensure-directories-exist p)) subdirs)
+ (sys:unzip (merge-pathnames "foo.abcl") tmpdir)
+ (sys:unzip (merge-pathnames "foo.abcl") sub1)
(cl-fad-copy-file (merge-pathnames "bar.abcl")
- (merge-pathnames "bar.abcl" dir))
+ (merge-pathnames "bar.abcl" tmpdir))
(cl-fad-copy-file (merge-pathnames "bar.abcl")
- (merge-pathnames "bar.abcl" sub))
+ (merge-pathnames "bar.abcl" sub1))
+ (cl-fad-copy-file (merge-pathnames "bar.abcl")
+ (merge-pathnames "bar.abcl" sub2))
(cl-fad-copy-file (merge-pathnames "eek.lisp")
- (merge-pathnames "eek.lisp" dir))
+ (merge-pathnames "eek.lisp" tmpdir))
(cl-fad-copy-file (merge-pathnames "eek.lisp")
- (merge-pathnames "eek.lisp" sub))
+ (merge-pathnames "eek.lisp" sub1))
(sys:zip (merge-pathnames "baz.jar")
- (append
- (directory (merge-pathnames "*" dir))
- (directory (merge-pathnames "*" sub)))
- dir)
- (delete-directory-and-files dir)))
+ (loop :for p :in (list tmpdir sub1 sub2)
+ :appending (directory (merge-pathnames "*" p)))
+ tmpdir)
+ #+nil (delete-directory-and-files dir)))
(setf *jar-file-init* t))
(defmacro with-jar-file-init (&rest body)
@@ -121,6 +124,11 @@
(load "jar:file:baz.jar!/a/b/eek.lisp"))
t)
+(deftest jar-pathname.load.11
+ (with-jar-file-init
+ (load "jar:file:baz.jar!/d/e+f/bar.abcl"))
+ t)
+
;;; wrapped in PROGN for easy disabling without a network connection
;;; XXX come up with a better abstraction
@@ -131,43 +139,43 @@
`(load (format nil "~A~A" *url-jar-pathname-base* ,path)))
(progn
- (deftest jar-pathname.load.11
+ (deftest jar-pathname.load.http.1
(load-url-relative "foo")
t)
- (deftest jar-pathname.load.12
+ (deftest jar-pathname.load.http.2
(load-url-relative "bar")
t)
- (deftest jar-pathname.load.13
+ (deftest jar-pathname.load.http.3
(load-url-relative "bar.abcl")
t)
- (deftest jar-pathname.load.14
+ (deftest jar-pathname.load.http.4
(load-url-relative "eek")
t)
- (deftest jar-pathname.load.15
+ (deftest jar-pathname.load.http.5
(load-url-relative "eek.lisp")
t)
- (deftest jar-pathname.load.16
+ (deftest jar-pathname.load.http.6
(load-url-relative "a/b/foo")
t)
- (deftest jar-pathname.load.17
+ (deftest jar-pathname.load.http.7
(load-url-relative "a/b/bar")
t)
- (deftest jar-pathname.load.18
+ (deftest jar-pathname.load.http.8
(load-url-relative "a/b/bar.abcl")
t)
- (deftest jar-pathname.load.19
+ (deftest jar-pathname.load.http.9
(load-url-relative "a/b/eek")
t)
- (deftest jar-pathname.load.20
+ (deftest jar-pathname.load.http.10
(load-url-relative "a/b/eek.lisp")
t))
@@ -192,7 +200,8 @@
(deftest jar-pathname.probe-file.4
(with-jar-file-init
(probe-file "jar:file:baz.jar!/a/b"))
- nil)
+ #p#.(format nil "jar:file:~Abaz.jar!/a/b/"
+ (namestring *abcl-test-directory*)))
(deftest jar-pathname.probe-file.5
(with-jar-file-init
@@ -200,6 +209,12 @@
#p#.(format nil "jar:file:~Abaz.jar!/a/b/"
(namestring *abcl-test-directory*)))
+(deftest jar-pathname.probe-file.6
+ (with-jar-file-init
+ (probe-file "jar:file:baz.jar!/d/e+f/bar.abcl"))
+ #p#.(format nil "jar:file:~Abaz.jar!/d/e+f/bar.abcl"
+ (namestring *abcl-test-directory*)))
+
(deftest jar-pathname.merge-pathnames.1
(merge-pathnames
"/bar.abcl" #p"jar:file:baz.jar!/foo")
@@ -326,6 +341,19 @@
(:relative "a" "b") "foo" "jar"
(:absolute "c" "d") "foo" "lisp")
+(deftest jar-pathname.10
+ (let ((s "jar:file:/foo/bar/a space/that!/this"))
+ (equal s
+ (namestring (pathname s))))
+ t)
+
+(deftest jar-pathname.11
+ (let ((s "jar:file:/foo/bar/a+space/that!/this"))
+ (equal s
+ (namestring (pathname s))))
+ t)
+
+
(deftest jar-pathname.match-p.1
(pathname-match-p "jar:file:/a/b/some.jar!/a/system/def.asd"
"jar:file:/**/*.jar!/**/*.asd")
Modified: branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp
==============================================================================
--- branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp (original)
+++ branches/0.23.x/abcl/test/lisp/abcl/pathname-tests.lisp Sat Nov 20 09:36:57 2010
@@ -438,6 +438,21 @@
(equal #p"c:\\foo.bar" #p"C:\\FOO.BAR")
t)
+#+windows
+(deftest pathname.windows.6
+ (equal (pathname-device #p"z:/foo/bar") "z")
+ t)
+
+#+windows
+(deftest pathname.windows.7
+ (equal (pathname-device #p"file:z:/foo/bar") "z")
+ t)
+
+#+windows
+(deftest pathname.windows.8
+ (equal (pathname-device #p"zoo:/foo/bar") nil)
+ t)
+
(deftest wild.1
(check-physical-pathname #p"foo.*" nil "foo" :wild)
t)
More information about the armedbear-cvs
mailing list