diff -r 311de2e729d1 abcl.asd --- a/abcl.asd Sat Jan 23 14:40:34 2010 +0100 +++ b/abcl.asd Sun Jan 24 15:28:01 2010 +0100 @@ -10,7 +10,6 @@ (defsystem :abcl :version "0.5.0") (defmethod perform :after ((o load-op) (c (eql (find-system :abcl)))) - (operate 'load-op :abcl-tests :force t) (operate 'load-op :abcl-test-lisp :force t) (operate 'load-op :cl-bench :force t) (operate 'load-op :ansi-compiled :force t) @@ -20,38 +19,28 @@ (defmethod perform ((o test-op) (c (eql (find-system :abcl)))) (operate 'test-op :abcl-tests :force t)) -;;; A collection of test suites for ABCL. -(defsystem :abcl-tests - :version "2.0" - :depends-on (:abcl-test-lisp - :ansi-compiled :ansi-interpreted - :cl-bench)) - -(defmethod perfom :before ((o test-op (c (eql find-system :abcl-tests)))) - (operate 'load-op :abcl-test-lisp) - (operate 'load-op :ansi-compiled) - (operate 'load-op :cl-bench)) - -;;; Run via (asdf:operate 'asdf:test-op :abcl-tests :force t) -(defmethod perform ((o test-op) (c (eql (find-system :abcl-tests)))) - ;; Additional test suite invocations would go here. - (operate 'test-op :abcl-test-lisp) - (operate 'test-op :ansi-compiled) - (operate 'test-op :cl-bench)) - ;;; Test ABCL with the Lisp unit tests collected in "test/lisp/abcl" (defsystem :abcl-test-lisp :version "1.1" :components - ((:module abcl-rt :pathname "test/lisp/abcl/" :serial t :components - ((:file "rt-package") (:file "rt"))) + ((:module abcl-rt + :pathname "test/lisp/abcl/" :serial t :components + ((:file "rt-package") (:file "rt") + (:file "test-utilities"))) (:module package :depends-on (abcl-rt) :pathname "test/lisp/abcl/" :components - ((:file "package"))))) -(defmethod perform :before ((o test-op) (c (eql (find-system - :abcl-test-lisp)))) - (operate 'load-op :abcl-test-lisp :force t)) + ((:file "package"))) + (:module test :depends-on (package) + :pathname "test/lisp/abcl/" :components + ((:file "compiler-tests") + (:file "condition-tests") + (:file "file-system-tests") + (:file "jar-file") + (:file "math-tests") + (:file "misc-tests") + (:file "pathname-tests"))))) + (defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp)))) "Invoke tests with (asdf:oos 'asdf:test-op :abcl-test-lisp)." - (funcall (intern (symbol-name 'run) :abcl-test))) + (funcall (intern (symbol-name 'run) :abcl.test.lisp))) ;;; Test ABCL with the interpreted ANSI tests (defsystem :ansi-interpreted :version "1.0.1" diff -r 311de2e729d1 build.properties.in --- a/build.properties.in Sat Jan 23 14:40:34 2010 +0100 +++ b/build.properties.in Sun Jan 24 15:28:01 2010 +0100 @@ -1,2 +1,11 @@ # build.properties # $Id: build.properties,v 1.23 2007-03-03 19:19:11 piso Exp $ + +# Contents show up in JAR Manifest in the Implementation-Source attribute +#version.src=[abcl] + +# If set, ABCL attempts to perform incremental compilation +#abcl.build.incremental=true + +# Skip the compilation of Lisp sources (for debugging) +#abcl.compile.lisp.skip=true diff -r 311de2e729d1 build.xml --- a/build.xml Sat Jan 23 14:40:34 2010 +0100 +++ b/build.xml Sun Jan 24 15:28:01 2010 +0100 @@ -76,6 +76,7 @@ + @@ -269,7 +270,7 @@ value="${src.dir}/org/armedbear/lisp/"/> - + - + - + + - + @@ -623,18 +625,19 @@ - + - + + depends="abcl.test.pre-compile"> + + diff -r 311de2e729d1 src/org/armedbear/lisp/AutoloadedFunctionProxy.java --- a/src/org/armedbear/lisp/AutoloadedFunctionProxy.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/AutoloadedFunctionProxy.java Sun Jan 24 15:28:01 2010 +0100 @@ -52,7 +52,7 @@ AUTOLOADING_CACHE, // allow loading local preloaded functions Load._FASL_ANONYMOUS_PACKAGE_, // package for uninterned symbols Symbol._PACKAGE_, // current package - Symbol.LOAD_TRUENAME // LOAD-TIME-VALUE depends on this + Symbol.LOAD_TRUENAME // LOAD-TIME-VALUE depends on this }; final private Symbol symbol; @@ -304,7 +304,8 @@ Hashtable cache = (Hashtable)AUTOLOADING_CACHE.symbolValue(thread).javaInstance(); - byte[] bytes = readFunctionBytes(namestring); + Pathname pathname = new Pathname(namestring); + byte[] bytes = readFunctionBytes(pathname); cache.put(namestring, bytes); return T; diff -r 311de2e729d1 src/org/armedbear/lisp/Interpreter.java --- a/src/org/armedbear/lisp/Interpreter.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Interpreter.java Sun Jan 24 15:28:01 2010 +0100 @@ -285,8 +285,8 @@ if (i + 1 < args.length) { if (arg.equals("--load")) Load.load(new Pathname(args[i + 1]), - args[i + 1], false, false, true); + else Load.loadSystemFile(args[i + 1]); ++i; diff -r 311de2e729d1 src/org/armedbear/lisp/Lisp.java --- a/src/org/armedbear/lisp/Lisp.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Lisp.java Sun Jan 24 15:28:01 2010 +0100 @@ -1201,134 +1201,55 @@ LispThread.currentThread()); } + @Deprecated public static final LispObject loadCompiledFunction(final String namestring) { - byte[] bytes = readFunctionBytes(namestring); + Pathname name = new Pathname(namestring); + byte[] bytes = readFunctionBytes(name); if (bytes != null) return loadClassBytes(bytes); return null; } - public static final byte[] readFunctionBytes(final String namestring) - { + public static final byte[] readFunctionBytes(final Pathname name) { final LispThread thread = LispThread.currentThread(); - final boolean absolute = Utilities.isFilenameAbsolute(namestring); - LispObject device = NIL; - final Pathname defaultPathname; - if (absolute) - { - defaultPathname = - coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread)); - } - else - { - LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread); - if (loadTruename instanceof Pathname) - { - defaultPathname = (Pathname) loadTruename; - // We're loading a file. - device = ((Pathname)loadTruename).getDevice(); - } - else - { - defaultPathname = - coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue(thread)); - } - } - if (device instanceof Pathname) { //Loading from a jar - URL url = null; - String jar = ((Pathname)device).getNamestring(); - if(jar.startsWith("jar:")) { - try { - url = new URL(jar + "!/" + namestring); - } catch (MalformedURLException ex) { - Debug.trace(ex); - } - } else { - url = Lisp.class.getResource(namestring); - } - if (url != null) { - try { - InputStream input = null; - java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream(); - try { - input = url.openStream(); - byte[] bytes = new byte[4096]; - int n = 0; - while (n >= 0) { - n = input.read(bytes, 0, 4096); - if(n >= 0) { - baos.write(bytes, 0, n); - } - } - bytes = baos.toByteArray(); - return bytes; - } finally { - baos.close(); - if(input != null) { - input.close(); - } - } - } catch (IOException e) { - Debug.trace(e); - } - } - error(new LispError("Unable to load " + namestring)); - return null; // not reached + Pathname load = null; + LispObject truenameFasl = Symbol.LOAD_TRUENAME_FASL.symbolValue(thread); + LispObject truename = Symbol.LOAD_TRUENAME.symbolValue(thread); + Pathname fasl = null; + if (truenameFasl instanceof Pathname) { + load = Pathname.mergePathnames(name, (Pathname)truenameFasl, Keyword.NEWEST); + } else if (truename instanceof Pathname) { + load = Pathname.mergePathnames(name, (Pathname) truename, Keyword.NEWEST); + } else { + load = name; } - Pathname pathname = new Pathname(namestring); - final File file = Utilities.getFile(pathname, defaultPathname); - if (file != null && file.isFile()) - { - // The .cls file exists. - try - { - byte[] bytes = readFunctionBytes(new FileInputStream(file), - (int) file.length()); - // FIXME close stream! - if (bytes != null) - return bytes; - } - catch (FileNotFoundException fnf) { - error(new LispError("Unable to load " + pathname.writeToString() - + ": " + fnf.getMessage())); - return null; // not reached + InputStream input = load.getInputStream(); + if (input == null) { + Debug.trace("Pathname: " + name); + Debug.trace("LOAD_TRUENAME_FASL: " + truenameFasl); + Debug.trace("LOAD_TRUENAME: " + truename); + Debug.assertTrue(input != null); + } + byte[] bytes = new byte[4096]; + int n = 0; + java.io.ByteArrayOutputStream baos = new java.io.ByteArrayOutputStream(); + try { + while (n >= 0) { + n = input.read(bytes, 0, 4096); + if(n >= 0) { + baos.write(bytes, 0, n); + } } - return null; // not reached - } - try - { - LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValue(thread); - String zipFileName = ((Pathname)loadTruename).getNamestring(); - ZipFile zipFile = ZipCache.getZip(zipFileName); - try - { - ZipEntry entry = zipFile.getEntry(namestring); - if (entry != null) - { - byte[] bytes = readFunctionBytes(zipFile.getInputStream(entry), - (int) entry.getSize()); - if (bytes != null) - return bytes; - Debug.trace("Unable to load " + namestring); - error(new LispError("Unable to load " + namestring)); - return null; // not reached - } - } - finally - { - ZipCache.removeZip(zipFile.getName()); - } - } - catch (IOException t) - { - Debug.trace(t); - } - error(new FileError("File not found: " + namestring, - new Pathname(namestring))); - return null; // not reached + } catch (IOException e) { + Debug.trace("Failed to read bytes from " + + "'" + name.getNamestring() + "'"); + return null; + } + bytes = baos.toByteArray(); + return bytes; } public static final Function makeCompiledFunctionFromClass(Class c) { @@ -2395,6 +2316,7 @@ Symbol.LOAD_PRINT.initializeSpecial(NIL); Symbol.LOAD_PATHNAME.initializeSpecial(NIL); Symbol.LOAD_TRUENAME.initializeSpecial(NIL); + Symbol.LOAD_TRUENAME_FASL.initializeSpecial(NIL); Symbol.COMPILE_VERBOSE.initializeSpecial(T); Symbol.COMPILE_PRINT.initializeSpecial(T); Symbol._COMPILE_FILE_PATHNAME_.initializeSpecial(NIL); @@ -2784,3 +2706,6 @@ } } +// Local Variables: +// c-basic-offset: 4 +// End: diff -r 311de2e729d1 src/org/armedbear/lisp/Load.java --- a/src/org/armedbear/lisp/Load.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Load.java Sun Jan 24 15:28:01 2010 +0100 @@ -70,200 +70,133 @@ public final class Load { public static final LispObject load(String filename) - { final LispThread thread = LispThread.currentThread(); return load(new Pathname(filename), - filename, Symbol.LOAD_VERBOSE.symbolValue(thread) != NIL, Symbol.LOAD_PRINT.symbolValue(thread) != NIL, true); } - - private static final File findLoadableFile(final String filename, - final String dir) - { - File file = new File(dir, filename); - if (!file.isFile()) { - String extension = getExtension(filename); - if (extension == null) { - // No extension specified. Try appending ".lisp" or ".abcl". - File lispFile = new File(dir, filename.concat(".lisp")); - File abclFile = new File(dir, filename.concat(".abcl")); - if (lispFile.isFile() && abclFile.isFile()) { - if (abclFile.lastModified() > lispFile.lastModified()) { - return abclFile; - } else { - return lispFile; - } - } else if (abclFile.isFile()) { - return abclFile; - } else if (lispFile.isFile()) { - return lispFile; + + /** @return Pathname of loadable fasl based on NAME, or null if + * none can be determined. */ + private static final Pathname findLoadableFile(Pathname name) { + LispObject truename = Pathname.truename(name, false); + if (truename instanceof Pathname) { + Pathname t = (Pathname)truename; + if (t.name != NIL + && t.name != null) { + return t; + } + } + if (name.type == NIL + && (name.name != NIL || name.name != null)) { + Pathname lispPathname = new Pathname(name.getNamestring()); + lispPathname.type = new SimpleString("lisp"); + LispObject lisp = Pathname.truename(lispPathname, false); + Pathname abclPathname = new Pathname(name.getNamestring()); + abclPathname.type = new SimpleString("abcl"); + LispObject abcl = Pathname.truename(abclPathname, false); + if (lisp instanceof Pathname && abcl instanceof Pathname) { + long lispLastModified = Pathname.getLastModified((Pathname)lisp); + long abclLastModified = Pathname.getLastModified((Pathname)abcl); + if (abclLastModified > lispLastModified) { + return (Pathname) lisp; + } else { + return (Pathname) abcl; + } + } else if (abcl instanceof Pathname) { + return (Pathname) abcl; + } else if (lisp instanceof Pathname) { + return (Pathname) lisp; + } + } + if (name.isJar()) { + if (name.type.equals(NIL)) { + name.type = faslInitType; + name.invalidateNamestring(); + Pathname result = findLoadableFile(name); + if (result != null) { + return result; + } + name.type = new SimpleString(COMPILE_FILE_TYPE); + name.invalidateNamestring(); + result = findLoadableFile(name); + if (result != null) { + return result; } } - } else - return file; // the file exists - return null; // this is the error case: the file does not exist - // no need to check again at the caller + } + return null; } public static final LispObject load(Pathname pathname, - String filename, boolean verbose, boolean print, boolean ifDoesNotExist) { - return load(pathname, filename, verbose, print, ifDoesNotExist, false); + return load(pathname, verbose, print, ifDoesNotExist, false); } - public static final LispObject load(Pathname pathname, - String filename, + public static final LispObject load(final Pathname pathname, boolean verbose, boolean print, boolean ifDoesNotExist, boolean returnLastResult) { - String dir = null; - if (!Utilities.isFilenameAbsolute(filename)) { - dir = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS - .symbolValue()).getNamestring(); + Pathname mergedPathname = null; + if (!pathname.isAbsolute() && !pathname.isJar()) { + Pathname pathnameDefaults + = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()); + mergedPathname = Pathname.mergePathnames(pathname, pathnameDefaults); } - String zipFileName = null; - String zipEntryName = null; - if (filename.startsWith("jar:file:")) { - String s = new String(filename); - s = s.substring(9); - int index = s.lastIndexOf('!'); - if (index >= 0) { - zipFileName = s.substring(0, index); - zipEntryName = s.substring(index + 1); - if (zipEntryName.length() > 0 && zipEntryName.charAt(0) == '/') - zipEntryName = zipEntryName.substring(1); - if (Utilities.isPlatformWindows) { - if (zipFileName.length() > 0 && zipFileName.charAt(0) == '/') - zipFileName = zipFileName.substring(1); - } + Pathname truename = findLoadableFile(mergedPathname != null ? mergedPathname : pathname); + + if (truename == null || truename.equals(NIL)) { + if (ifDoesNotExist) { + return error(new FileError("File not found: " + pathname)); + } else { + Debug.trace("Failed to load " + pathname.getNamestring()); + return NIL; } } - File file = findLoadableFile(filename, dir); - if (null == file && null == zipFileName) { - if (ifDoesNotExist) - return error(new FileError("File not found: " + filename, pathname)); - else - return NIL; - } - - if (checkZipFile(file)) { - // Either we are loading a packed FASL (i.e. ZIP with suffix ".abcl") - // Or we are loading from a JAR archive - if (".abcl".equals(getExtension(file.getPath()))) { - // So we adjust the value passed to - // loadFileFromStream() to get any further loading - // within this invocation of LOAD to work properly. - filename = file.getPath(); - } - zipFileName = file.getPath(); - zipEntryName = file.getName(); - } + if (truename.type.getStringValue().equals(COMPILE_FILE_TYPE) + && Utilities.checkZipFile(truename)) + { + String n = truename.getNamestring(); + if (n.startsWith("jar:")) { + n = "jar:" + n + "!/" + truename.name.getStringValue() + "." + faslInitType; + } else { + n = "jar:file:" + n + "!/" + truename.name.getStringValue() + "." + faslInitType; + } + mergedPathname = new Pathname(n); + LispObject initTruename = Pathname.truename(mergedPathname); + if (initTruename == null || initTruename.equals(NIL)) { + String errorMessage + = "Loadable FASL not found for" + + "'" + pathname + "'" + + " in " + + "'" + mergedPathname + "'"; + if (ifDoesNotExist) { + return error(new FileError(errorMessage, mergedPathname)); + } else { + Debug.trace(errorMessage); + return NIL; + } + } + truename = (Pathname)initTruename; + } - String truename = filename; - ZipFile zipfile = null; - - boolean packedFASL = false; - - InputStream in = null; - if (zipFileName != null) { - try { - zipfile = ZipCache.getZip(zipFileName); - } - catch (IOException e) { - return error (new FileError("Zip file not found: " + filename, pathname)); - } - ZipEntry entry = zipfile.getEntry(zipEntryName); - if (null == entry) { - // try appending "._" to base filename - int index = zipEntryName.lastIndexOf('.'); - if (-1 == index) index = zipEntryName.length(); - zipEntryName = zipEntryName.substring(0, index).concat("._"); - entry = zipfile.getEntry(zipEntryName); - } - if (null == entry) { - // try appending ".abcl" to base filename - int index = zipEntryName.lastIndexOf('.'); - if (index == -1) - index = zipEntryName.length(); - zipEntryName = zipEntryName.substring(0, index).concat(".abcl"); - entry = zipfile.getEntry(zipEntryName); - if (entry != null) - packedFASL = true; - } - if (null == entry) { - // Try looking for ".lisp" - int i = zipEntryName.lastIndexOf('.'); - if (i == -1) { - i = zipEntryName.length(); - } - zipEntryName = zipEntryName.substring(0, i).concat(".lisp"); - entry = zipfile.getEntry(zipEntryName); - if (entry == null) { - return error(new LispError("Failed to find " + zipEntryName + " in " - + zipFileName + ".")); - } - } - - if (null == entry) { - return error(new FileError("Can't find zip file entry " - + zipEntryName, pathname)); - } - if (".abcl".equals(getExtension(zipEntryName))) { - packedFASL = true; - } - if (packedFASL) { - // If we are loading a packed FASL from the JAR we - // have to decompress it first, and seek for the '._' - // init FASL. - int i = zipEntryName.lastIndexOf('.'); - int j = zipEntryName.lastIndexOf('/'); - if(j >= i) { - return error(new LispError("Invalid zip entry name: " + zipEntryName)); - } - String subZipEntryName = zipEntryName.substring(j + 1, i).concat("._"); - in = Utilities.getZippedZipEntryAsInputStream(zipfile, - zipEntryName, - subZipEntryName); - } else { - try { - in = zipfile.getInputStream(entry); - } - catch (IOException e) { - return error(new LispError(e.getMessage())); - } - } - } else { - try { - in = new FileInputStream(file); - truename = file.getCanonicalPath(); - } - catch (FileNotFoundException e) { - if (ifDoesNotExist) - return error(new FileError("File not found: " + filename, - pathname)); - else - return NIL; - } - catch (IOException e) { - return error(new LispError(e.getMessage())); - } - } + InputStream in = truename.getInputStream(); + Debug.assertTrue(in != null); + try { - - return loadFileFromStream(null, truename, - new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER), - verbose, print, false, returnLastResult); + return loadFileFromStream(pathname, truename, + new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER), + verbose, print, false, returnLastResult); } catch (FaslVersionMismatch e) { FastStringBuffer sb = @@ -280,14 +213,6 @@ return error(new LispError(e.getMessage())); } } - if (zipfile != null) { - try { - ZipCache.removeZip(zipfile.getName()); - } - catch (IOException e) { - return error(new LispError(e.getMessage())); - } - } } } @@ -327,124 +252,82 @@ } } + static final LispObject faslInitType = new SimpleString("_"); + public static final LispObject loadSystemFile(final String filename, boolean verbose, boolean print, boolean auto) { - final int ARRAY_SIZE = 2; - String[] candidates = new String[ARRAY_SIZE]; - final String extension = getExtension(filename); - if (extension == null) { - // No extension specified. - candidates[0] = filename + '.' + COMPILE_FILE_TYPE; - candidates[1] = filename.concat(".lisp"); - } else if (extension.equals(".abcl")) { - candidates[0] = filename; - candidates[1] = - filename.substring(0, filename.length() - 5).concat(".lisp"); - } else - candidates[0] = filename; InputStream in = null; Pathname pathname = null; - String truename = null; - for (int i = 0; i < ARRAY_SIZE; i++) { - String s = candidates[i]; - if (s == null) - break; - ZipFile zipfile = null; - final String dir = Site.getLispHome(); - try { - if (dir != null) { - File file = new File(dir, s); - if (file.isFile()) { - // File exists. For system files, we know the extension - // will be .abcl if it is a compiled file. - String ext = getExtension(s); - if (ext.equalsIgnoreCase(".abcl")) { - try { - zipfile = ZipCache.getZip(file.getPath()); - String name = file.getName(); - int index = name.lastIndexOf('.'); - Debug.assertTrue(index >= 0); - name = name.substring(0, index).concat("._"); - ZipEntry entry = zipfile.getEntry(name); - if (entry != null) { - in = zipfile.getInputStream(entry); - truename = file.getCanonicalPath(); - } - } - catch (ZipException e) { - // Fall through. - } - catch (IOException e) { - // fall through - } - } - if (in == null) { - try { - in = new FileInputStream(file); - truename = file.getCanonicalPath(); - } - catch (IOException e) { - in = null; - } - } - } - } else { - URL url = Lisp.class.getResource(s); - if (url != null) { - try { - in = url.openStream(); - if ("jar".equals(url.getProtocol()) && - url.getPath().startsWith("file:")) - pathname = new Pathname(url); - truename = getPath(url); - } - catch (IOException e) { - in = null; - } - } - } - if (in != null) { - final LispThread thread = LispThread.currentThread(); - final SpecialBindingsMark mark = thread.markSpecialBindings(); - thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL); - try { - return loadFileFromStream(pathname, truename, - new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER), - verbose, print, auto); - } - catch (FaslVersionMismatch e) { - FastStringBuffer sb = - new FastStringBuffer("; Incorrect fasl version: "); - sb.append(truename); - System.err.println(sb.toString()); - } - finally { - thread.resetSpecialBindings(mark); - try { - in.close(); - } - catch (IOException e) { - return error(new LispError(e.getMessage())); - } - } + Pathname truename = null; + pathname = new Pathname(filename); + Pathname mergedPathname = Pathname.mergePathnames(pathname, Site.getLispHome()); + truename = findLoadableFile(mergedPathname); + if (truename == null || truename.equals(NIL)) { + // Make an attempt to use the boot classpath + String path = pathname.getNamestringWithoutContext(); + URL url = Lisp.class.getResource(path); + if (url == null || url.toString().endsWith("/")) { + url = Lisp.class.getResource(path + ".abcl"); + if (url == null) { + url = Lisp.class.getResource(path + ".lisp"); } } - finally { - if (zipfile != null) { - try { - ZipCache.removeZip(zipfile.getName()); - } - catch (IOException e) { - return error(new LispError(e.getMessage())); - } + if (url == null) { + return error(new LispError("Failed to find loadable system file " + + "'" + path + "'" + + " in boot classpath.")); + } + Pathname urlPathname = new Pathname(url); + truename = findLoadableFile(urlPathname); + if (truename == null) { + return error(new LispError("Failed to find loadable system file in boot classpath " + + "'" + url + "'")); + } + } + + // Look for a init FASL inside a packed FASL + if (truename.type.writeToString().equals(COMPILE_FILE_TYPE) && Utilities.checkZipFile(truename)) { + Pathname init = new Pathname(truename.getNamestring()); + init.type = faslInitType; + LispObject t = Pathname.truename(init); + if (t instanceof Pathname) { + truename = (Pathname)t; + } else { + return error (new LispError("Failed to find loadable init FASL in " + + "'" + init.getNamestring() + "'")); + } + } + + in = truename.getInputStream(); + + if (in != null) { + final LispThread thread = LispThread.currentThread(); + final SpecialBindingsMark mark = thread.markSpecialBindings(); + thread.bindSpecial(_WARN_ON_REDEFINITION_, NIL); + try { + Stream stream = new Stream(Symbol.SYSTEM_STREAM, in, Symbol.CHARACTER); + return loadFileFromStream(pathname, truename, stream, + verbose, print, auto); + } catch (FaslVersionMismatch e) { + FastStringBuffer sb = + new FastStringBuffer("; Incorrect fasl version: "); + sb.append(truename); + System.err.println(sb.toString()); + } finally { + thread.resetSpecialBindings(mark); + try { + in.close(); + } + catch (IOException e) { + return error(new LispError(e.getMessage())); } } } - return error(new LispError("File not found: " + filename)); + return error(new FileError("Failed to load system file: " + truename, truename)); } // ### *fasl-version* @@ -489,8 +372,8 @@ } }; - private static final LispObject loadFileFromStream(LispObject pathname, - String truename, + private static final LispObject loadFileFromStream(Pathname pathname, + Pathname truename, Stream in, boolean verbose, boolean print, @@ -499,8 +382,9 @@ return loadFileFromStream(pathname, truename, in, verbose, print, auto, false); } + // A nil TRUENAME signals a load from stream which has no possible path private static final LispObject loadFileFromStream(LispObject pathname, - String truename, + LispObject truename, Stream in, boolean verbose, boolean print, @@ -525,12 +409,30 @@ thread.bindSpecialToCurrentValue(_EXPLAIN_); final String prefix = getLoadVerbosePrefix(loadDepth); try { - if (pathname == null && truename != null) - pathname = Pathname.parseNamestring(truename); - thread.bindSpecial(Symbol.LOAD_PATHNAME, - pathname != null ? pathname : NIL); - thread.bindSpecial(Symbol.LOAD_TRUENAME, - pathname != null ? pathname : NIL); + thread.bindSpecial(Symbol.LOAD_PATHNAME, pathname); + Pathname truePathname = new Pathname(((Pathname)truename).getNamestring()); + String type = truePathname.type.getStringValue(); + if (type.equals(COMPILE_FILE_TYPE) + || type.equals(faslInitType.toString())) { + thread.bindSpecial(Symbol.LOAD_TRUENAME_FASL, truePathname); + } + if (truePathname.type.getStringValue().equals(faslInitType.getStringValue()) + && truePathname.isJar()) { + if (truePathname.device.cdr() != NIL ) { + // set truename to the enclosing JAR + truePathname.host = NIL; + truePathname.directory = NIL; + truePathname.name = NIL; + truePathname.type = NIL; + } else { + // XXX SimpleString case unimplemented + Debug.assertTrue(truePathname.device.car() instanceof Pathname); + truePathname = (Pathname)truePathname.device.car(); + } + thread.bindSpecial(Symbol.LOAD_TRUENAME, truePathname); + } else { + thread.bindSpecial(Symbol.LOAD_TRUENAME, truename); + } thread.bindSpecial(_SOURCE_, pathname != null ? pathname : NIL); if (verbose) { @@ -538,7 +440,7 @@ out.freshLine(); out._writeString(prefix); out._writeString(auto ? " Autoloading " : " Loading "); - out._writeString(truename != null ? truename : "stream"); + out._writeString(!truename.equals(NIL) ? truePathname.writeToString() : "stream"); out._writeLine(" ..."); out._finishOutput(); LispObject result = loadStream(in, print, thread, returnLastResult); @@ -546,7 +448,7 @@ out.freshLine(); out._writeString(prefix); out._writeString(auto ? " Autoloaded " : " Loaded "); - out._writeString(truename != null ? truename : "stream"); + out._writeString(!truename.equals(NIL) ? truePathname.writeToString() : "stream"); out._writeString(" ("); out._writeString(String.valueOf(((float)elapsed)/1000)); out._writeLine(" seconds)"); @@ -610,7 +512,6 @@ } private static final LispObject faslLoadStream(LispThread thread) - { Stream in = (Stream) _LOAD_STREAM_.symbolValue(thread); final Environment env = new Environment(); @@ -672,32 +573,6 @@ return null; } - private static final boolean checkZipFile(File file) - { - InputStream in = null; - try { - in = new FileInputStream(file); - byte[] bytes = new byte[4]; - int bytesRead = in.read(bytes); - return (bytesRead == 4 - && bytes[0] == 0x50 - && bytes[1] == 0x4b - && bytes[2] == 0x03 - && bytes[3] == 0x04); - } - catch (Throwable t) { // any error probably means 'no' - return false; - } - finally { - if (in != null) { - try { - in.close(); - } - catch (IOException e) {} // ignore exceptions - } - } - } - // ### %load filespec verbose print if-does-not-exist => generalized-boolean private static final Primitive _LOAD = new Primitive("%load", PACKAGE_SYS, false, @@ -737,11 +612,12 @@ pathname = ((FileStream)filespec).getPathname(); else pathname = NIL; - String truename; + // String truename; + LispObject truename; if (pathname instanceof Pathname) - truename = ((Pathname)pathname).getNamestring(); + truename = pathname; else - truename = null; + truename = NIL; return loadFileFromStream(pathname, truename, (Stream) filespec, @@ -756,7 +632,6 @@ if (pathname instanceof LogicalPathname) pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname); return load(pathname, - pathname.getNamestring(), verbose != NIL, print != NIL, ifDoesNotExist != NIL, @@ -793,3 +668,7 @@ } } } + +// Local Variables: +// c-basic-offset: 4 +// End: diff -r 311de2e729d1 src/org/armedbear/lisp/Pathname.java --- a/src/org/armedbear/lisp/Pathname.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Pathname.java Sun Jan 24 15:28:01 2010 +0100 @@ -30,93 +30,80 @@ * obligated to do so. If you do not wish to do so, delete this * exception statement from your version. */ - package org.armedbear.lisp; +import java.util.logging.Level; +import java.util.logging.Logger; import static org.armedbear.lisp.Lisp.*; import java.io.File; import java.io.IOException; +import java.io.InputStream; +import java.io.FileInputStream; +import java.net.JarURLConnection; +import java.net.MalformedURLException; import java.net.URL; +import java.net.URLConnection; import java.net.URLDecoder; import java.util.StringTokenizer; +import java.util.jar.JarEntry; +import java.util.jar.JarFile; +import java.util.zip.ZipEntry; +import java.util.zip.ZipFile; +import java.util.zip.ZipInputStream; -public class Pathname extends LispObject -{ +public class Pathname extends LispObject { + protected LispObject host = NIL; protected LispObject device = NIL; protected LispObject directory = NIL; protected LispObject name = NIL; - // A string, NIL, :WILD or :UNSPECIFIC. protected LispObject type = NIL; - // A positive integer, or NIL, :WILD, :UNSPECIFIC, or :NEWEST. protected LispObject version = NIL; - private String namestring; - protected Pathname() - { + public void invalidateNamestring() { + namestring = null; } - public Pathname(String s) - { + protected Pathname() { + } + + public Pathname(String s) { init(s); } - public Pathname(URL url) - { + public Pathname(URL url) { String protocol = url.getProtocol(); if ("jar".equals(protocol)) { - 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 - s = null; - } - if (s.startsWith("file:")) { - int index = s.indexOf("!/"); - String container = s.substring(5, index); - if (Utilities.isPlatformWindows) { - if (container.length() > 0 && container.charAt(0) == '/') - container = container.substring(1); - } - device = new Pathname(container); - s = s.substring(index + 1); - Pathname p = new Pathname(s); - directory = p.directory; - name = p.name; - type = p.type; + init(url.toString()); return; - } } else if ("file".equals(protocol)) { String s; try { - s = URLDecoder.decode(url.getPath(),"UTF-8"); - } - catch (java.io.UnsupportedEncodingException uee) { + 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; } - if (s != null && s.startsWith("file:")) { - init(s.substring(5)); + if (s != null) { + init(s); return; } } error(new LispError("Unsupported URL: \"" + url.toString() + '"')); } - private final void init(String s) - { - if (s == null) + private final void init(String s) { + if (s == null) { return; - if (s.equals(".") || s.equals("./") || - (Utilities.isPlatformWindows && s.equals(".\\"))) { + } + if (s.equals(".") || s.equals("./") + || (Utilities.isPlatformWindows && s.equals(".\\"))) { directory = new Cons(Keyword.RELATIVE); return; } @@ -126,50 +113,104 @@ } if (Utilities.isPlatformWindows) { if (s.startsWith("\\\\")) { - //UNC path support - // match \\\\[directories-and-files] + //UNC path support + // match \\\\[directories-and-files] - int shareIndex = s.indexOf('\\', 2); - int dirIndex = s.indexOf('\\', shareIndex + 1); + int shareIndex = s.indexOf('\\', 2); + int dirIndex = s.indexOf('\\', shareIndex + 1); - if (shareIndex == -1 || dirIndex == -1) - error(new LispError("Unsupported UNC path format: \"" + s + '"')); + if (shareIndex == -1 || dirIndex == -1) { + error(new LispError("Unsupported UNC path format: \"" + s + '"')); + } - host = new SimpleString(s.substring(2, shareIndex)); - device = new SimpleString(s.substring(shareIndex + 1, dirIndex)); + host = new SimpleString(s.substring(2, shareIndex)); + device = new SimpleString(s.substring(shareIndex + 1, dirIndex)); - Pathname p = new Pathname(s.substring(dirIndex)); - directory = p.directory; - name = p.name; - type = p.type; - version = p.version; - return; + Pathname p = new Pathname(s.substring(dirIndex)); + directory = p.directory; + name = p.name; + type = p.type; + version = p.version; + return; } - + // FIXME must not replace backslashes after bang ("!/") s = s.replace('/', '\\'); } - // Jar file support. - int bang = s.indexOf("!/"); - if (bang >= 0) { - Pathname container = new Pathname(s.substring(0, bang)); - LispObject containerType = container.type; - if (containerType instanceof AbstractString) { - if (containerType.getStringValue().equalsIgnoreCase("jar")) { - device = container; - s = s.substring(bang + 1); - Pathname p = new Pathname(s); - directory = p.directory; - name = p.name; - type = p.type; - return; + + final String separator = "!/"; + + // A JAR file + if (s.startsWith("jar:") && s.endsWith(separator)) { + LispObject jars = NIL; + int i = s.lastIndexOf(separator, s.length() - separator.length() - 1); + String jar = null; + if (i == -1) { + jar = s; + } else { + // There can be no more than two jar references and the + // inner one must be a file reference within the outer. + jar = "jar:file:" + s.substring(i + separator.length()); + s = s.substring("jar:".length(), i + separator.length()); + Pathname p = new Pathname(s); + LispObject first = ((Cons) p.device).car(); + if (first instanceof AbstractString) { + jars = jars.push(first); + } else { + jars = jars.push(p.device.car()); } } + if (jar.startsWith("jar:file:")) { + String jarString = jar.substring("jar:file:".length(), + jar.length() - separator.length()); + Pathname jarPathname = new Pathname(jarString); + if (jarString.endsWith(separator)) { + jars = jars.push(jarPathname.device); + } else { + jars = jars.push(jarPathname); + } + } else { + URL url = null; + try { + url = new URL(jar.substring("jar:".length(), jar.length() - 2)); + jars = jars.push(new SimpleString(url.toString())); + } catch (MalformedURLException e) { + error(new LispError("Failed to parse url '" + url + "'" + + e.getMessage())); + } + } + jars = jars.nreverse(); + device = jars; + return; } + + // An entry in a JAR file + final int separatorIndex = s.lastIndexOf(separator); + if (separatorIndex > 0 && s.startsWith("jar:")) { + final String jarURL = s.substring(0, separatorIndex + separator.length()); + Pathname d = new Pathname(jarURL); + if (device instanceof Cons) { + LispObject[] jars = d.copyToArray(); + // XXX Is this ever not true? If so, need to append lists + Debug.assertTrue(false); + } else { + device = d.device; + } + s = s.substring(separatorIndex + separator.length()); + Pathname p = new Pathname(s); + directory = p.directory; + name = p.name; + type = p.type; + version = p.version; + return; + } + + // Expand user home directories if (Utilities.isPlatformUnix) { - if (s.equals("~")) + if (s.equals("~")) { s = System.getProperty("user.home").concat("/"); - else if (s.startsWith("~/")) + } else if (s.startsWith("~/")) { s = System.getProperty("user.home").concat(s.substring(1)); + } } namestring = s; if (Utilities.isPlatformWindows) { @@ -215,56 +256,59 @@ if (index > 0) { n = s.substring(0, index); t = s.substring(index + 1); - } else if (s.length() > 0) + } else if (s.length() > 0) { n = s; + } if (n != null) { - if (n.equals("*")) + if (n.equals("*")) { name = Keyword.WILD; - else + } else { name = new SimpleString(n); + } } if (t != null) { - if (t.equals("*")) + if (t.equals("*")) { type = Keyword.WILD; - else + } else { type = new SimpleString(t); + } } } - private static final LispObject parseDirectory(String d) - - { - if (d.equals("/") || (Utilities.isPlatformWindows && d.equals("\\"))) + private static final LispObject parseDirectory(String d) { + if (d.equals("/") || (Utilities.isPlatformWindows && d.equals("\\"))) { return new Cons(Keyword.ABSOLUTE); + } LispObject result; - if (d.startsWith("/") || (Utilities.isPlatformWindows && d.startsWith("\\"))) + if (d.startsWith("/") || (Utilities.isPlatformWindows && d.startsWith("\\"))) { result = new Cons(Keyword.ABSOLUTE); - else + } else { result = new Cons(Keyword.RELATIVE); + } StringTokenizer st = new StringTokenizer(d, "/\\"); while (st.hasMoreTokens()) { String token = st.nextToken(); LispObject obj; - if (token.equals("*")) + if (token.equals("*")) { obj = Keyword.WILD; - else if (token.equals("**")) + } else if (token.equals("**")) { obj = Keyword.WILD_INFERIORS; - else if (token.equals("..")) { + } else if (token.equals("..")) { if (result.car() instanceof AbstractString) { result = result.cdr(); continue; } - obj= Keyword.UP; - } else + obj = Keyword.UP; + } else { obj = new SimpleString(token); + } result = new Cons(obj, result); } return result.nreverse(); } @Override - public LispObject getParts() - { + public LispObject getParts() { LispObject parts = NIL; parts = parts.push(new Cons("HOST", host)); parts = parts.push(new Cons("DEVICE", device)); @@ -276,42 +320,41 @@ } @Override - public LispObject typeOf() - { + public LispObject typeOf() { return Symbol.PATHNAME; } @Override - public LispObject classOf() - { + public LispObject classOf() { return BuiltInClass.PATHNAME; } @Override - public LispObject typep(LispObject type) - { - if (type == Symbol.PATHNAME) + public LispObject typep(LispObject type) { + if (type == Symbol.PATHNAME) { return T; - if (type == BuiltInClass.PATHNAME) + } + if (type == BuiltInClass.PATHNAME) { return T; + } return super.typep(type); } - public final LispObject getDevice() - { + public final LispObject getDevice() { return device; } - public String getNamestring() - { - if (namestring != null) + public String getNamestring() { + if (namestring != null) { return namestring; + } if (name == NIL && type != NIL) { Debug.assertTrue(namestring == null); return null; } - if (directory instanceof AbstractString) + if (directory instanceof AbstractString) { Debug.assertTrue(false); + } FastStringBuffer sb = new FastStringBuffer(); // "If a pathname is converted to a namestring, the symbols NIL and // :UNSPECIFIC cause the field to be treated as if it were empty. That @@ -319,26 +362,51 @@ // the namestring." 19.2.2.2.3.1 if (host != NIL) { Debug.assertTrue(host instanceof AbstractString); - if (! (this instanceof LogicalPathname)) - sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path. + if (!(this instanceof LogicalPathname)) { + sb.append("\\\\"); //UNC file support; if there's a host, it's a UNC path. + } sb.append(host.getStringValue()); - if (this instanceof LogicalPathname) - sb.append(':'); - else - sb.append(File.separatorChar); + if (this instanceof LogicalPathname) { + sb.append(':'); + } else { + sb.append(File.separatorChar); + } } if (device == NIL) { } else if (device == Keyword.UNSPECIFIC) { + } else if (device instanceof Cons) { + LispObject[] jars = ((Cons) device).copyToArray(); + int i = 0; + if (jars[0] instanceof AbstractString) { + sb.append("jar:"); + sb.append(((AbstractString) jars[0]).getStringValue()); + sb.append("!/"); + i = 1; + } + FastStringBuffer prefix = new FastStringBuffer(); + for (; i < jars.length; i++) { + prefix.append("jar:"); + if (i == 0) { + sb.append("file:"); + } + if (jars[i] instanceof Pathname) { + sb.append(((Pathname) jars[i]).getNamestring()); + } + sb.append("!/"); + } + sb = prefix.append(sb); + } else if (device instanceof AbstractString + && device.getStringValue().startsWith("jar:")) { + sb.append(device.getStringValue()); } else if (device instanceof AbstractString) { sb.append(device.getStringValue()); if (this instanceof LogicalPathname - || host == NIL) - sb.append(':'); // non-UNC paths - } else if (device instanceof Pathname) { - sb.append(((Pathname)device).getNamestring()); - sb.append("!"); - } else + || host == NIL) { + sb.append(':'); // non-UNC paths + } + } else { Debug.assertTrue(false); + } sb.append(getDirectoryNamestring()); if (name instanceof AbstractString) { String n = name.getStringValue(); @@ -347,8 +415,9 @@ return null; } sb.append(n); - } else if (name == Keyword.WILD) + } else if (name == Keyword.WILD) { sb.append('*'); + } if (type != NIL) { sb.append('.'); if (type instanceof AbstractString) { @@ -358,19 +427,21 @@ return null; } sb.append(t); - } else if (type == Keyword.WILD) + } else if (type == Keyword.WILD) { sb.append('*'); - else + } else { Debug.assertTrue(false); + } } if (this instanceof LogicalPathname) { if (version.integerp()) { sb.append('.'); int base = Fixnum.getValue(Symbol.PRINT_BASE.symbolValue()); - if (version instanceof Fixnum) - sb.append(Integer.toString(((Fixnum)version).value, base).toUpperCase()); - else if (version instanceof Bignum) - sb.append(((Bignum)version).value.toString(base).toUpperCase()); + if (version instanceof Fixnum) { + sb.append(Integer.toString(((Fixnum) version).value, base).toUpperCase()); + } else if (version instanceof Bignum) { + sb.append(((Bignum) version).value.toString(base).toUpperCase()); + } } else if (version == Keyword.WILD) { sb.append(".*"); } else if (version == Keyword.NEWEST) { @@ -380,8 +451,7 @@ return namestring = sb.toString(); } - protected String getDirectoryNamestring() - { + protected String getDirectoryNamestring() { validateDirectory(true); FastStringBuffer sb = new FastStringBuffer(); // "If a pathname is converted to a namestring, the symbols NIL and @@ -390,10 +460,11 @@ // the namestring." 19.2.2.2.3.1 if (directory != NIL) { final char separatorChar; - if (device instanceof Pathname) + if (device instanceof Cons) { separatorChar = '/'; // Jar file. - else + } else { separatorChar = File.separatorChar; + } LispObject temp = directory; LispObject part = temp.car(); temp = temp.cdr(); @@ -407,23 +478,24 @@ } // else: Nothing to do. } else { - error(new FileError("Unsupported directory component " + - part.writeToString() + ".", - this)); + error(new FileError("Unsupported directory component " + + part.writeToString() + ".", + this)); } while (temp != NIL) { part = temp.car(); - if (part instanceof AbstractString) + if (part instanceof AbstractString) { sb.append(part.getStringValue()); - else if (part == Keyword.WILD) + } else if (part == Keyword.WILD) { sb.append('*'); - else if (part == Keyword.WILD_INFERIORS) + } else if (part == Keyword.WILD_INFERIORS) { sb.append("**"); - else if (part == Keyword.UP) + } else if (part == Keyword.UP) { sb.append(".."); - else + } else { error(new FileError("Unsupported directory component " + part.writeToString() + ".", - this)); + this)); + } sb.append(separatorChar); temp = temp.cdr(); } @@ -431,39 +503,57 @@ return sb.toString(); } + /** @return Namestring without HOST or DEVICE present */ + protected String getNamestringWithoutContext() { + Pathname p = new Pathname(getNamestring()); + p.host = NIL; + p.device = NIL; + return p.getNamestring(); + } + @Override - public boolean equal(LispObject obj) - { - if (this == obj) + public boolean equal(LispObject obj) { + if (this == obj) { return true; + } if (obj instanceof Pathname) { Pathname p = (Pathname) obj; if (Utilities.isPlatformWindows) { - if (!host.equalp(p.host)) + if (!host.equalp(p.host)) { return false; - if (!device.equalp(p.device)) + } + if (!device.equalp(p.device)) { return false; - if (!directory.equalp(p.directory)) + } + if (!directory.equalp(p.directory)) { return false; - if (!name.equalp(p.name)) + } + if (!name.equalp(p.name)) { return false; - if (!type.equalp(p.type)) + } + if (!type.equalp(p.type)) { return false; + } // Ignore version component. //if (!version.equalp(p.version)) // return false; } else { // Unix. - if (!host.equal(p.host)) + if (!host.equal(p.host)) { return false; - if (!device.equal(p.device)) + } + if (!device.equal(p.device)) { return false; - if (!directory.equal(p.directory)) + } + if (!directory.equal(p.directory)) { return false; - if (!name.equal(p.name)) + } + if (!name.equal(p.name)) { return false; - if (!type.equal(p.type)) + } + if (!type.equal(p.type)) { return false; + } // Ignore version component. //if (!version.equal(p.version)) // return false; @@ -474,24 +564,21 @@ } @Override - public boolean equalp(LispObject obj) - { + public boolean equalp(LispObject obj) { return equal(obj); } @Override - public int sxhash() - { - return ((host.sxhash() ^ - device.sxhash() ^ - directory.sxhash() ^ - name.sxhash() ^ - type.sxhash()) & 0x7fffffff); + public int sxhash() { + return ((host.sxhash() + ^ device.sxhash() + ^ directory.sxhash() + ^ name.sxhash() + ^ type.sxhash()) & 0x7fffffff); } @Override - public String writeToString() - { + public String writeToString() { final LispThread thread = LispThread.currentThread(); boolean printReadably = (Symbol.PRINT_READABLY.symbolValue(thread) != NIL); boolean printEscape = (Symbol.PRINT_ESCAPE.symbolValue(thread) != NIL); @@ -507,47 +594,52 @@ useNamestring = false; } else if (name instanceof AbstractString) { String n = name.getStringValue(); - if (n.equals(".") || n.equals("..")) + if (n.equals(".") || n.equals("..")) { useNamestring = false; - else if (n.indexOf(File.separatorChar) >= 0) + } else if (n.indexOf(File.separatorChar) >= 0) { useNamestring = false; + } } } - } else - useNamestring = false; + } else { + useNamestring = false; + } FastStringBuffer sb = new FastStringBuffer(); if (useNamestring) { - if (printReadably || printEscape) + if (printReadably || printEscape) { sb.append("#P\""); + } final int limit = s.length(); for (int i = 0; i < limit; i++) { char c = s.charAt(i); if (printReadably || printEscape) { - if (c == '\"' || c == '\\') + if (c == '\"' || c == '\\') { sb.append('\\'); + } } sb.append(c); } - if (printReadably || printEscape) + if (printReadably || printEscape) { sb.append('"'); + } } else { sb.append("#P("); if (host != NIL) { sb.append(":HOST "); sb.append(host.writeToString()); sb.append(' '); - } - if (device != NIL) { - sb.append(":DEVICE "); - sb.append(device.writeToString()); - sb.append(' '); + } + if (device != NIL) { + sb.append(":DEVICE "); + sb.append(device.writeToString()); + sb.append(' '); } if (directory != NIL) { sb.append(":DIRECTORY "); sb.append(directory.writeToString()); sb.append(" "); } - if (name != NIL) { + if (name != NIL) { sb.append(":NAME "); sb.append(name.writeToString()); sb.append(' '); @@ -562,31 +654,26 @@ sb.append(version.writeToString()); sb.append(' '); } - if (sb.charAt(sb.length() - 1) == ' ') + if (sb.charAt(sb.length() - 1) == ' ') { sb.setLength(sb.length() - 1); + } sb.append(')'); - } - return sb.toString(); + } + return sb.toString(); } - // A logical host is represented as the string that names it. // (defvar *logical-pathname-translations* (make-hash-table :test 'equal)) public static EqualHashTable LOGICAL_PATHNAME_TRANSLATIONS = - new EqualHashTable(64, NIL, NIL); + new EqualHashTable(64, NIL, NIL); + private static final Symbol _LOGICAL_PATHNAME_TRANSLATIONS_ = + exportSpecial("*LOGICAL-PATHNAME-TRANSLATIONS*", PACKAGE_SYS, + LOGICAL_PATHNAME_TRANSLATIONS); - private static final Symbol _LOGICAL_PATHNAME_TRANSLATIONS_ = - exportSpecial("*LOGICAL-PATHNAME-TRANSLATIONS*", PACKAGE_SYS, - LOGICAL_PATHNAME_TRANSLATIONS); - - public static Pathname parseNamestring(String s) - - { + public static Pathname parseNamestring(String s) { return new Pathname(s); } - public static Pathname parseNamestring(AbstractString namestring) - - { + public static Pathname parseNamestring(AbstractString namestring) { // Check for a logical pathname host. String s = namestring.getStringValue(); String h = getHostString(s); @@ -598,17 +685,15 @@ } public static Pathname parseNamestring(AbstractString namestring, - AbstractString host) - - { + AbstractString host) { // Look for a logical pathname host in the namestring. String s = namestring.getStringValue(); String h = getHostString(s); if (h != null) { if (!h.equals(host.getStringValue())) { - error(new LispError("Host in " + s + - " does not match requested host " + - host.getStringValue())); + error(new LispError("Host in " + s + + " does not match requested host " + + host.getStringValue())); // Not reached. return null; } @@ -625,197 +710,178 @@ } // "one or more uppercase letters, digits, and hyphens" - protected static String getHostString(String s) - { + protected static String getHostString(String s) { int colon = s.indexOf(':'); - if (colon >= 0) + if (colon >= 0) { return s.substring(0, colon).toUpperCase(); - else + } else { return null; + } } - private static final void checkCaseArgument(LispObject arg) - - { - if (arg != Keyword.COMMON && arg != Keyword.LOCAL) + private static final void checkCaseArgument(LispObject arg) { + if (arg != Keyword.COMMON && arg != Keyword.LOCAL) { type_error(arg, list(Symbol.MEMBER, Keyword.COMMON, - Keyword.LOCAL)); + Keyword.LOCAL)); + } } - // ### %pathname-host private static final Primitive _PATHNAME_HOST = - new Primitive("%pathname-host", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%pathname-host", PACKAGE_SYS, false) { - { - checkCaseArgument(second); - return coerceToPathname(first).host; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + checkCaseArgument(second); + return coerceToPathname(first).host; + } + }; // ### %pathname-device private static final Primitive _PATHNAME_DEVICE = - new Primitive("%pathname-device", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%pathname-device", PACKAGE_SYS, false) { - { - checkCaseArgument(second); - return coerceToPathname(first).device; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + checkCaseArgument(second); + return coerceToPathname(first).device; + } + }; // ### %pathname-directory private static final Primitive _PATHNAME_DIRECTORY = - new Primitive("%pathname-directory", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%pathname-directory", PACKAGE_SYS, false) { - { - checkCaseArgument(second); - return coerceToPathname(first).directory; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + checkCaseArgument(second); + return coerceToPathname(first).directory; + } + }; // ### %pathname-name private static final Primitive _PATHNAME_NAME = - new Primitive("%pathname-name", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%pathname-name", PACKAGE_SYS, false) { - { - checkCaseArgument(second); - return coerceToPathname(first).name; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + checkCaseArgument(second); + return coerceToPathname(first).name; + } + }; // ### %pathname-type private static final Primitive _PATHNAME_TYPE = - new Primitive("%pathname-type", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%pathname-type", PACKAGE_SYS, false) { - { - checkCaseArgument(second); - return coerceToPathname(first).type; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + checkCaseArgument(second); + return coerceToPathname(first).type; + } + }; // ### pathname-version private static final Primitive PATHNAME_VERSION = - new Primitive("pathname-version", "pathname") - { - @Override - public LispObject execute(LispObject arg) - { - return coerceToPathname(arg).version; - } - }; + new Primitive("pathname-version", "pathname") { + @Override + public LispObject execute(LispObject arg) { + return coerceToPathname(arg).version; + } + }; // ### namestring // namestring pathname => namestring private static final Primitive NAMESTRING = - new Primitive("namestring", "pathname") - { - @Override - public LispObject execute(LispObject arg) - { - Pathname pathname = coerceToPathname(arg); - String namestring = pathname.getNamestring(); - if (namestring == null) - error(new SimpleError("Pathname has no namestring: " + - pathname.writeToString())); - return new SimpleString(namestring); - } - }; + new Primitive("namestring", "pathname") { + @Override + public LispObject execute(LispObject arg) { + Pathname pathname = coerceToPathname(arg); + String namestring = pathname.getNamestring(); + if (namestring == null) { + error(new SimpleError("Pathname has no namestring: " + + pathname.writeToString())); + } + return new SimpleString(namestring); + } + }; // ### directory-namestring // directory-namestring pathname => namestring private static final Primitive DIRECTORY_NAMESTRING = - new Primitive("directory-namestring", "pathname") - { - @Override - public LispObject execute(LispObject arg) - { - return new SimpleString(coerceToPathname(arg).getDirectoryNamestring()); - } - }; + new Primitive("directory-namestring", "pathname") { + @Override + public LispObject execute(LispObject arg) { + return new SimpleString(coerceToPathname(arg).getDirectoryNamestring()); + } + }; // ### pathname pathspec => pathname private static final Primitive PATHNAME = - new Primitive("pathname", "pathspec") - { - @Override - public LispObject execute(LispObject arg) - { - return coerceToPathname(arg); - } - }; + new Primitive("pathname", "pathspec") { + @Override + public LispObject execute(LispObject arg) { + return coerceToPathname(arg); + } + }; // ### %parse-namestring string host default-pathname => pathname, position private static final Primitive _PARSE_NAMESTRING = - new Primitive("%parse-namestring", PACKAGE_SYS, false, - "namestring host default-pathname") - { - @Override - public LispObject execute(LispObject first, LispObject second, - LispObject third) + new Primitive("%parse-namestring", PACKAGE_SYS, false, + "namestring host default-pathname") { - { - final LispThread thread = LispThread.currentThread(); - final AbstractString namestring = checkString(first); - // The HOST parameter must be a string or NIL. - if (second == NIL) { - // "If HOST is NIL, DEFAULT-PATHNAME is a logical pathname, and - // THING is a syntactically valid logical pathname namestring - // without an explicit host, then it is parsed as a logical - // pathname namestring on the host that is the host component - // of DEFAULT-PATHNAME." - third = coerceToPathname(third); - if (third instanceof LogicalPathname) - second = ((LogicalPathname)third).host; - else - return thread.setValues(parseNamestring(namestring), - namestring.LENGTH()); - } - Debug.assertTrue(second != NIL); - final AbstractString host = checkString(second); - return thread.setValues(parseNamestring(namestring, host), - namestring.LENGTH()); - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second, + LispObject third) { + final LispThread thread = LispThread.currentThread(); + final AbstractString namestring = checkString(first); + // The HOST parameter must be a string or NIL. + if (second == NIL) { + // "If HOST is NIL, DEFAULT-PATHNAME is a logical pathname, and + // THING is a syntactically valid logical pathname namestring + // without an explicit host, then it is parsed as a logical + // pathname namestring on the host that is the host component + // of DEFAULT-PATHNAME." + third = coerceToPathname(third); + if (third instanceof LogicalPathname) { + second = ((LogicalPathname) third).host; + } else { + return thread.setValues(parseNamestring(namestring), + namestring.LENGTH()); + } + } + Debug.assertTrue(second != NIL); + final AbstractString host = checkString(second); + return thread.setValues(parseNamestring(namestring, host), + namestring.LENGTH()); + } + }; // ### make-pathname private static final Primitive MAKE_PATHNAME = - new Primitive("make-pathname", - "&key host device directory name type version defaults case") - { - @Override - public LispObject execute(LispObject[] args) + new Primitive("make-pathname", + "&key host device directory name type version defaults case") { - { - return _makePathname(args); - } - }; + @Override + public LispObject execute(LispObject[] args) { + return _makePathname(args); + } + }; // Used by the #p reader. - public static final Pathname makePathname(LispObject args) - - { + public static final Pathname makePathname(LispObject args) { return _makePathname(args.copyToArray()); } - private static final Pathname _makePathname(LispObject[] args) + public static final Pathname makePathname(File file) { + String namestring = null; + try { + namestring = file.getCanonicalPath(); + } catch (IOException e) { + Debug.trace("Failed to make a Pathname from " + + "." + file + "'"); + return null; + } + return new Pathname(namestring); + } - { - if (args.length % 2 != 0) + private static final Pathname _makePathname(LispObject[] args) { + if (args.length % 2 != 0) { error(new ProgramError("Odd number of keyword arguments.")); + } LispObject host = NIL; LispObject device = NIL; LispObject directory = NIL; @@ -828,19 +894,20 @@ boolean typeSupplied = false; for (int i = 0; i < args.length; i += 2) { LispObject key = args[i]; - LispObject value = args[i+1]; + LispObject value = args[i + 1]; if (key == Keyword.HOST) { host = value; } else if (key == Keyword.DEVICE) { device = value; deviceSupplied = true; } else if (key == Keyword.DIRECTORY) { - if (value instanceof AbstractString) + if (value instanceof AbstractString) { directory = list(Keyword.ABSOLUTE, value); - else if (value == Keyword.WILD) + } else if (value == Keyword.WILD) { directory = list(Keyword.ABSOLUTE, Keyword.WILD); - else + } else { directory = value; + } } else if (key == Keyword.NAME) { name = value; nameSupplied = true; @@ -852,25 +919,30 @@ } else if (key == Keyword.DEFAULTS) { defaults = coerceToPathname(value); } else if (key == Keyword.CASE) { - // Ignored. + // Ignored. } } if (defaults != null) { - if (host == NIL) + if (host == NIL) { host = defaults.host; + } directory = mergeDirectories(directory, defaults.directory); - if (!deviceSupplied) + if (!deviceSupplied) { device = defaults.device; - if (!nameSupplied) + } + if (!nameSupplied) { name = defaults.name; - if (!typeSupplied) + } + if (!typeSupplied) { type = defaults.type; + } } final Pathname p; final boolean logical; if (host != NIL) { - if (host instanceof AbstractString) - host = LogicalPathname.canonicalizeStringComponent((AbstractString)host); + if (host instanceof AbstractString) { + host = LogicalPathname.canonicalizeStringComponent((AbstractString) host); + } if (LOGICAL_PATHNAME_TRANSLATIONS.get(host) == null) { // Not a defined logical pathname host. error(new LispError(host.writeToString() + " is not defined as a logical pathname host.")); @@ -886,10 +958,12 @@ if (device != NIL) { if (logical) { // "The device component of a logical pathname is always :UNSPECIFIC." - if (device != Keyword.UNSPECIFIC) + if (device != Keyword.UNSPECIFIC) { error(new LispError("The device component of a logical pathname must be :UNSPECIFIC.")); - } else + } + } else { p.device = device; + } } if (directory != NIL) { if (logical) { @@ -897,48 +971,51 @@ LispObject d = NIL; while (directory != NIL) { LispObject component = directory.car(); - if (component instanceof AbstractString) - d = d.push(LogicalPathname.canonicalizeStringComponent((AbstractString)component)); - else + if (component instanceof AbstractString) { + d = d.push(LogicalPathname.canonicalizeStringComponent((AbstractString) component)); + } else { d = d.push(component); + } directory = directory.cdr(); } p.directory = d.nreverse(); - } else if (directory == Keyword.WILD || directory == Keyword.WILD_INFERIORS) + } else if (directory == Keyword.WILD || directory == Keyword.WILD_INFERIORS) { p.directory = directory; - else + } else { error(new LispError("Invalid directory component for logical pathname: " + directory.writeToString())); - } else + } + } else { p.directory = directory; + } } if (name != NIL) { - if (logical && name instanceof AbstractString) - p.name = LogicalPathname.canonicalizeStringComponent((AbstractString)name); - else if (name instanceof AbstractString) - p.name = validateStringComponent((AbstractString)name); - else + if (logical && name instanceof AbstractString) { + p.name = LogicalPathname.canonicalizeStringComponent((AbstractString) name); + } else if (name instanceof AbstractString) { + p.name = validateStringComponent((AbstractString) name); + } else { p.name = name; + } } if (type != NIL) { - if (logical && type instanceof AbstractString) - p.type = LogicalPathname.canonicalizeStringComponent((AbstractString)type); - else + if (logical && type instanceof AbstractString) { + p.type = LogicalPathname.canonicalizeStringComponent((AbstractString) type); + } else { p.type = type; + } } p.version = version; return p; } - private static final AbstractString validateStringComponent(AbstractString s) - - { + private static final AbstractString validateStringComponent(AbstractString s) { final int limit = s.length(); for (int i = 0; i < limit; i++) { char c = s.charAt(i); if (c == '/' || c == '\\' && Utilities.isPlatformWindows) { - error(new LispError("Invalid character #\\" + c + - " in pathname component \"" + s + - '"')); + error(new LispError("Invalid character #\\" + c + + " in pathname component \"" + s + + '"')); // Not reached. return null; } @@ -946,9 +1023,7 @@ return s; } - private final boolean validateDirectory(boolean signalError) - - { + private final boolean validateDirectory(boolean signalError) { LispObject temp = directory; while (temp != NIL) { LispObject first = temp.car(); @@ -970,230 +1045,272 @@ } return true; } - // ### pathnamep private static final Primitive PATHNAMEP = - new Primitive("pathnamep", "object") - { - @Override - public LispObject execute(LispObject arg) - { - return arg instanceof Pathname ? T : NIL; - } - }; + new Primitive("pathnamep", "object") { + @Override + public LispObject execute(LispObject arg) { + return arg instanceof Pathname ? T : NIL; + } + }; // ### logical-pathname-p private static final Primitive LOGICAL_PATHNAME_P = - new Primitive("logical-pathname-p", PACKAGE_SYS, true, "object") - { - @Override - public LispObject execute(LispObject arg) - { - return arg instanceof LogicalPathname ? T : NIL; - } - }; + new Primitive("logical-pathname-p", PACKAGE_SYS, true, "object") { + @Override + public LispObject execute(LispObject arg) { + return arg instanceof LogicalPathname ? T : NIL; + } + }; // ### user-homedir-pathname &optional host => pathname private static final Primitive USER_HOMEDIR_PATHNAME = - new Primitive("user-homedir-pathname", "&optional host") - { - @Override - public LispObject execute(LispObject[] args) - { - switch (args.length) { - case 0: { - String s = System.getProperty("user.home"); - if (!s.endsWith(File.separator)) - s = s.concat(File.separator); - return new Pathname(s); + new Primitive("user-homedir-pathname", "&optional host") { + + @Override + public LispObject execute(LispObject[] args) { + switch (args.length) { + case 0: { + String s = System.getProperty("user.home"); + if (!s.endsWith(File.separator)) { + s = s.concat(File.separator); + } + return new Pathname(s); + } + case 1: + return NIL; + default: + return error(new WrongNumberOfArgumentsException(this)); + } + } + }; + // ### list-directory + private static final Primitive LIST_DIRECTORY = + new Primitive("list-directory", PACKAGE_SYS, true) { + + @Override + public LispObject execute(LispObject arg) { + Pathname pathname = coerceToPathname(arg); + if (pathname instanceof LogicalPathname) { + pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname); + } + LispObject result = NIL; + String s = pathname.getNamestring(); + if (s != null) { + File f = new File(s); + if (f.isDirectory()) { + try { + File[] files = f.listFiles(); + for (int i = files.length; i-- > 0;) { + File file = files[i]; + Pathname p; + if (file.isDirectory()) { + p = Utilities.getDirectoryPathname(file); + } else { + p = new Pathname(file.getCanonicalPath()); + } + result = new Cons(p, result); + } + } catch (IOException e) { + return error(new FileError("Unable to list directory " + pathname.writeToString() + ".", + pathname)); + } catch (SecurityException e) { + } catch (NullPointerException e) { + } + } + } + return result; + } + }; + + public boolean isAbsolute() { + if (!directory.equals(NIL) || !(directory == null)) { + if (directory instanceof Cons) { + if (((Cons)directory).car().equals(Keyword.ABSOLUTE)) { + return true; } - case 1: - return NIL; - default: - return error(new WrongNumberOfArgumentsException(this)); } } - }; - - // ### list-directory - private static final Primitive LIST_DIRECTORY = - new Primitive("list-directory", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject arg) - { - Pathname pathname = coerceToPathname(arg); - if (pathname instanceof LogicalPathname) - pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname); - LispObject result = NIL; - String s = pathname.getNamestring(); - if (s != null) { - File f = new File(s); - if (f.isDirectory()) { - try { - File[] files = f.listFiles(); - for (int i = files.length; i-- > 0;) { - File file = files[i]; - Pathname p; - if (file.isDirectory()) - p = Utilities.getDirectoryPathname(file); - else - p = new Pathname(file.getCanonicalPath()); - result = new Cons(p, result); - } - } - catch (IOException e) { - return error(new FileError("Unable to list directory " + pathname.writeToString() + ".", - pathname)); - } - catch (SecurityException e) { - } - catch (NullPointerException e) { - } - } - } - return result; - } - }; - - public boolean isWild() - { - if (host == Keyword.WILD || host == Keyword.WILD_INFERIORS) - return true; - if (device == Keyword.WILD || device == Keyword.WILD_INFERIORS) - return true; - if (directory instanceof Cons) { - if (memq(Keyword.WILD, directory)) - return true; - if (memq(Keyword.WILD_INFERIORS, directory)) - return true; - } - if (name == Keyword.WILD || name == Keyword.WILD_INFERIORS) - return true; - if (type == Keyword.WILD || type == Keyword.WILD_INFERIORS) - return true; - if (version == Keyword.WILD || version == Keyword.WILD_INFERIORS) - return true; return false; } + public boolean isJar() { + if (device instanceof Cons) { + return true; + } + return false; + } + + public boolean isWild() { + if (host == Keyword.WILD || host == Keyword.WILD_INFERIORS) { + return true; + } + if (device == Keyword.WILD || device == Keyword.WILD_INFERIORS) { + return true; + } + if (directory instanceof Cons) { + if (memq(Keyword.WILD, directory)) { + return true; + } + if (memq(Keyword.WILD_INFERIORS, directory)) { + return true; + } + } + if (name == Keyword.WILD || name == Keyword.WILD_INFERIORS) { + return true; + } + if (type == Keyword.WILD || type == Keyword.WILD_INFERIORS) { + return true; + } + if (version == Keyword.WILD || version == Keyword.WILD_INFERIORS) { + return true; + } + return false; + } // ### %wild-pathname-p private static final Primitive _WILD_PATHNAME_P = - new Primitive("%wild-pathname-p", PACKAGE_SYS, true) - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("%wild-pathname-p", PACKAGE_SYS, true) { - { - Pathname pathname = coerceToPathname(first); - if (second == NIL) - return pathname.isWild() ? T : NIL; - if (second == Keyword.DIRECTORY) { - if (pathname.directory instanceof Cons) { - if (memq(Keyword.WILD, pathname.directory)) - return T; - if (memq(Keyword.WILD_INFERIORS, pathname.directory)) - return T; - } - return NIL; - } - LispObject value; - if (second == Keyword.HOST) - value = pathname.host; - else if (second == Keyword.DEVICE) - value = pathname.device; - else if (second == Keyword.NAME) - value = pathname.name; - else if (second == Keyword.TYPE) - value = pathname.type; - else if (second == Keyword.VERSION) - value = pathname.version; - else - return error(new ProgramError("Unrecognized keyword " + - second.writeToString() + ".")); - if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS) - return T; - else - return NIL; - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + Pathname pathname = coerceToPathname(first); + if (second == NIL) { + return pathname.isWild() ? T : NIL; + } + if (second == Keyword.DIRECTORY) { + if (pathname.directory instanceof Cons) { + if (memq(Keyword.WILD, pathname.directory)) { + return T; + } + if (memq(Keyword.WILD_INFERIORS, pathname.directory)) { + return T; + } + } + return NIL; + } + LispObject value; + if (second == Keyword.HOST) { + value = pathname.host; + } else if (second == Keyword.DEVICE) { + value = pathname.device; + } else if (second == Keyword.NAME) { + value = pathname.name; + } else if (second == Keyword.TYPE) { + value = pathname.type; + } else if (second == Keyword.VERSION) { + value = pathname.version; + } else { + return error(new ProgramError("Unrecognized keyword " + + second.writeToString() + ".")); + } + if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS) { + return T; + } else { + return NIL; + } + } + }; // ### merge-pathnames private static final Primitive MERGE_PATHNAMES = - new Primitive("merge-pathnames", - "pathname &optional default-pathname default-version") - { - @Override - public LispObject execute(LispObject arg) - { - Pathname pathname = coerceToPathname(arg); - Pathname defaultPathname = + new Primitive("merge-pathnames", + "pathname &optional default-pathname default-version") { + + @Override + public LispObject execute(LispObject arg) { + Pathname pathname = coerceToPathname(arg); + Pathname defaultPathname = coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()); - LispObject defaultVersion = Keyword.NEWEST; - return mergePathnames(pathname, defaultPathname, defaultVersion); - } - @Override - public LispObject execute(LispObject first, LispObject second) + LispObject defaultVersion = Keyword.NEWEST; + return mergePathnames(pathname, defaultPathname, defaultVersion); + } - { - Pathname pathname = coerceToPathname(first); - Pathname defaultPathname = + @Override + public LispObject execute(LispObject first, LispObject second) { + Pathname pathname = coerceToPathname(first); + Pathname defaultPathname = coerceToPathname(second); - LispObject defaultVersion = Keyword.NEWEST; - return mergePathnames(pathname, defaultPathname, defaultVersion); - } - @Override - public LispObject execute(LispObject first, LispObject second, - LispObject third) + LispObject defaultVersion = Keyword.NEWEST; + return mergePathnames(pathname, defaultPathname, defaultVersion); + } - { - Pathname pathname = coerceToPathname(first); - Pathname defaultPathname = + @Override + public LispObject execute(LispObject first, LispObject second, + LispObject third) { + Pathname pathname = coerceToPathname(first); + Pathname defaultPathname = coerceToPathname(second); - LispObject defaultVersion = third; - return mergePathnames(pathname, defaultPathname, defaultVersion); - } - }; + LispObject defaultVersion = third; + return mergePathnames(pathname, defaultPathname, defaultVersion); + } + }; + + public static final Pathname mergePathnames(Pathname pathname, Pathname defaultPathname) { + return mergePathnames(pathname, defaultPathname, Keyword.NEWEST); + } public static final Pathname mergePathnames(Pathname pathname, Pathname defaultPathname, - LispObject defaultVersion) - + LispObject defaultVersion) { Pathname p; - if (pathname instanceof LogicalPathname) + if (pathname instanceof LogicalPathname) { p = new LogicalPathname(); - else { + } else { p = new Pathname(); - if (defaultPathname instanceof LogicalPathname) - defaultPathname = LogicalPathname.translateLogicalPathname((LogicalPathname)defaultPathname); + if (defaultPathname instanceof LogicalPathname) { + defaultPathname + = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname); + } } - if (pathname.host != NIL) + if (pathname.host != NIL) { p.host = pathname.host; - else + } else { p.host = defaultPathname.host; - if (pathname.device != NIL) + } + if (pathname.device != NIL) { p.device = pathname.device; - else + } else { p.device = defaultPathname.device; - p.directory = - mergeDirectories(pathname.directory, defaultPathname.directory); - if (pathname.name != NIL) + } + // Merging with a JAR always produces relative directories + if (defaultPathname.device instanceof Cons + && pathname.directory instanceof Cons + && pathname.directory.car().equals(Keyword.ABSOLUTE)) { + if (pathname.directory.cdr().equals(NIL)) { + pathname.directory = NIL; + } else { + ((Cons)pathname.directory).car = Keyword.RELATIVE; + } + } + + if (pathname.isJar()) { + if (pathname.device.car() instanceof Pathname) { + Pathname first = mergePathnames((Pathname)pathname.device.car(), defaultPathname); + p.device = new Cons(first, pathname.device.cdr()); + } + } else { + p.directory = mergeDirectories(pathname.directory, defaultPathname.directory); + } + + if (pathname.name != NIL) { p.name = pathname.name; - else + } else { p.name = defaultPathname.name; - if (pathname.type != NIL) + } + if (pathname.type != NIL) { p.type = pathname.type; - else + } else { p.type = defaultPathname.type; - if (pathname.version != NIL) + } + if (pathname.version != NIL) { p.version = pathname.version; - else if (pathname.name instanceof AbstractString) + } else if (pathname.name instanceof AbstractString) { p.version = defaultVersion; - else if (defaultPathname.version != NIL) + } else if (defaultPathname.version != NIL) { p.version = defaultPathname.version; - else + } else { p.version = defaultVersion; + } if (p instanceof LogicalPathname) { // When we're returning a logical p.device = Keyword.UNSPECIFIC; @@ -1202,27 +1319,29 @@ LispObject canonical = NIL; while (original != NIL) { LispObject component = original.car(); - if (component instanceof AbstractString) - component = LogicalPathname.canonicalizeStringComponent((AbstractString)component); + if (component instanceof AbstractString) { + component = LogicalPathname.canonicalizeStringComponent((AbstractString) component); + } canonical = canonical.push(component); original = original.cdr(); } p.directory = canonical.nreverse(); } - if (p.name instanceof AbstractString) - p.name = LogicalPathname.canonicalizeStringComponent((AbstractString)p.name); - if (p.type instanceof AbstractString) - p.type = LogicalPathname.canonicalizeStringComponent((AbstractString)p.type); + if (p.name instanceof AbstractString) { + p.name = LogicalPathname.canonicalizeStringComponent((AbstractString) p.name); + } + if (p.type instanceof AbstractString) { + p.type = LogicalPathname.canonicalizeStringComponent((AbstractString) p.type); + } } return p; } private static final LispObject mergeDirectories(LispObject dir, - LispObject defaultDir) - - { - if (dir == NIL) + LispObject defaultDir) { + if (dir == NIL) { return defaultDir; + } if (dir.car() == Keyword.RELATIVE && defaultDir != NIL) { LispObject result = NIL; while (defaultDir != NIL) { @@ -1237,154 +1356,440 @@ LispObject[] array = result.copyToArray(); for (int i = 0; i < array.length - 1; i++) { if (array[i] == Keyword.BACK) { - if (array[i+1] instanceof AbstractString || array[i+1] == Keyword.WILD) { + if (array[i + 1] instanceof AbstractString || array[i + 1] == Keyword.WILD) { array[i] = null; - array[i+1] = null; + array[i + 1] = null; } } } result = NIL; for (int i = 0; i < array.length; i++) { - if (array[i] != null) + if (array[i] != null) { result = new Cons(array[i], result); + } } return result; } return dir; } - public static final LispObject truename(LispObject arg, - boolean errorIfDoesNotExist) + public static final LispObject truename(Pathname pathname) { + return truename(pathname, false); + } + public static final LispObject truename(LispObject arg) { + return truename(arg, false); + } + + public static final LispObject truename(LispObject arg, boolean errorIfDoesNotExist) { + final Pathname pathname = coerceToPathname(arg); + return truename(pathname, errorIfDoesNotExist); + } + + /** @return The canonical TRUENAME as a Pathname if the pathname + * exists, otherwise returns NIL or possibly a subtype of + * LispError if there are logical problems with the input. + */ + public static final LispObject truename(Pathname pathname, + boolean errorIfDoesNotExist) { - Pathname pathname = coerceToPathname(arg); - if (pathname instanceof LogicalPathname) - pathname = LogicalPathname.translateLogicalPathname((LogicalPathname)pathname); - if (pathname.isWild()) + if (pathname instanceof LogicalPathname) { + pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname); + } + if (pathname.isWild()) { return error(new FileError("Bad place for a wild pathname.", - pathname)); - final Pathname defaultedPathname = - mergePathnames(pathname, - coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()), - NIL); - final String namestring = defaultedPathname.getNamestring(); - if (namestring == null) - return error(new FileError("Pathname has no namestring: " + defaultedPathname.writeToString(), - defaultedPathname)); - final File file = new File(namestring); - if (file.isDirectory()) - return Utilities.getDirectoryPathname(file); - if (file.exists()) { - try { - return new Pathname(file.getCanonicalPath()); + pathname)); + } + if (!(pathname.device instanceof Cons)) { + pathname + = mergePathnames(pathname, + coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()), + NIL); + final String namestring = pathname.getNamestring(); + if (namestring == null) { + return error(new FileError("Pathname has no namestring: " + + pathname.writeToString(), + pathname)); } - catch (IOException e) { - return error(new LispError(e.getMessage())); + + final File file = new File(namestring); + if (file.isDirectory()) { + return Utilities.getDirectoryPathname(file); + } + if (file.exists()) { + try { + return new Pathname(file.getCanonicalPath()); + } catch (IOException e) { + return error(new FileError(e.getMessage(), pathname)); + } + } + } else + jarfile: { + // Possibly canonicalize jar file directory + Cons jars = (Cons) pathname.device; + LispObject o = jars.car(); + if (o instanceof Pathname) { + LispObject truename = Pathname.truename((Pathname)o, errorIfDoesNotExist); + if (truename != null + && truename instanceof Pathname) { + jars.car = (Pathname)truename; + } else { + break jarfile; + } + } + + // Check for existence of a JAR file and/or JarEntry + // + // Cases: + // 1. JAR + // 2. JAR in JAR + // 3. JAR with Entry + // 4. JAR in JAR with Entry + JarFile jarFile = getJarFile(jars.car()); + String entryPath = pathname.getNamestringWithoutContext(); + if (jarFile != null) { + if (jars.cdr() instanceof Cons) { + Pathname inner = (Pathname) jars.cdr().car(); + InputStream inputStream = Utilities.getInputStream(jarFile, inner); + if (inputStream != null) { + if (entryPath.length() == 0) { + return pathname; // Case 2 + } else { + ZipInputStream zipInputStream + = new ZipInputStream(inputStream); + ZipEntry entry = Utilities.getEntry(zipInputStream, + entryPath, + false); + if (entry != null) { + // XXX this could possibly be a directory? + return pathname; // Case 4 + } + } + } + } else { + if (entryPath.length() == 0) { + return pathname; // Case 1 + } else { + ZipEntry entry = jarFile.getEntry(entryPath); + if (entry != null) { + // ensure this isn't a directory + try { + InputStream input = jarFile.getInputStream(entry); + if (input != null) { + return pathname; // Case 3 + } + } catch (IOException e) { + break jarfile; + } + } + } + } } } + error: if (errorIfDoesNotExist) { FastStringBuffer sb = new FastStringBuffer("The file "); - sb.append(defaultedPathname.writeToString()); + sb.append(pathname.writeToString()); sb.append(" does not exist."); - return error(new FileError(sb.toString(), defaultedPathname)); + return error(new FileError(sb.toString(), pathname)); } return NIL; } + private static URL getJarURL(Pathname p) { + String jarURL = "jar:file:" + p.getNamestring() + "!/"; + URL result = null; + try { + result = new URL(jarURL); + } catch (MalformedURLException ex) { + // XXX + Debug.trace("Could not form URL from pathname " + + "'" + jarURL + "'" + + " because " + ex); + } + return result; + } + + private static URL getJarURL(String url) { + String jarURL = "jar:" + url + "!/"; + URL result = null; + try { + result = new URL(jarURL); + } catch (MalformedURLException ex) { + // XXX + Debug.trace("Could not form jar URL from " + + "'" + jarURL + "'" + + " because " + ex); + } + return result; + } + + private static JarFile getJarFile(LispObject device) { + URL url = null; + if (device instanceof SimpleString) { + url = getJarURL(((SimpleString) device).getStringValue()); + } else { + url = getJarURL((Pathname) device); + } + if (url == null) { + return null; + } + URLConnection connection; + try { + connection = url.openConnection(); + } catch (IOException ex) { + Debug.trace("Failed to open " + + "'" + url + "'"); + return null; + } + if (!(connection instanceof JarURLConnection)) { + // XXX + Debug.trace("Could not get a URLConnection from " + url); + return null; + } + JarURLConnection jarURLConnection = (JarURLConnection) connection; + + JarFile result; + try { + result = jarURLConnection.getJarFile(); + } catch (IOException ex) { + Debug.trace("Could not get a JarURLConnection from " + + "'" + jarURLConnection + "'"); + return null; + } + return result; + } + + public InputStream getInputStream() { + InputStream result = null; + if (isJar()) { + String entryPath = getNamestringWithoutContext(); + // XXX We only return the bytes of an entry in a JAR + Debug.assertTrue(entryPath != null); + JarFile jarFile = Pathname.getJarFile(device.car()); + Debug.assertTrue(jarFile != null); + // Is this a JAR within a JAR? + if (device.cdr() instanceof Cons) { + Pathname inner = (Pathname) device.cdr().car(); + InputStream input = Utilities.getInputStream(jarFile, inner); + ZipInputStream zipInputStream = new ZipInputStream(input); + result = Utilities.getEntryAsInputStream(zipInputStream, entryPath); + } else { + ZipEntry entry = jarFile.getEntry(entryPath); + Debug.assertTrue(entry != null); + try { + result = jarFile.getInputStream(entry); + } catch (IOException e) { + Debug.trace("Failed to get InputStream for read from " + + "'" + getNamestring() + "'" + + ": " + e); + } + } + } else { + File file = Utilities.getFile(this); + try { + result = new FileInputStream(file); + } catch (IOException e) { + Debug.trace("Failed to get InputStream for read from " + + "'" + getNamestring() + "'" + + ": " + e); + } + } + return result; + } + + // ### last-modified pathname => time-in-milliseconds + public static final Primitive LAST_MODIFIED + = new Primitive("LAST-MODIFIED", PACKAGE_EXT, true, "pathname", + "If PATHNAME exists, returns the last modified time in miliseconds since the UNIX epoch.") + { + @Override + public LispObject execute(LispObject arg) { + final Pathname p = coerceToPathname(arg); + if (p.isWild()) { + error(new FileError("Bad place for a wild pathname.", p)); + } + long time = Pathname.getLastModified(p); + return LispInteger.getInstance(time); + } + }; + + /** @return Time in milliseconds since the UNIX epoch at which the + * resource was last modified, or 0 if the time is unknown. + */ + protected static long getLastModified(Pathname p) { + if (!(p.device instanceof Cons)) { + File f = new File(p.getNamestring()); + return f.lastModified(); + } + // JAR cases + // 0. JAR from URL + // 1. JAR + // 2. JAR in JAR + // 3. Entry in JAR + // 4. Entry in JAR in JAR + String entryPath = p.getNamestringWithoutContext(); + Cons device = (Cons)p.device; + if (device.cdr().equals(NIL)) { + if (entryPath.length() == 0) { + LispObject o = device.car(); + if (o instanceof SimpleString) { + // 0. JAR from URL + URL u = getJarURL(o.getStringValue()); + URLConnection c = null; + try { + c = u.openConnection(); + } catch(IOException e) { + Debug.trace("Failed to open Connection for URL " + + "'" + u + "'"); + return 0; + } + c.getLastModified(); + } else { + // 1. JAR + return Pathname.getLastModified((Pathname)o); + } + } else { + // 3. Entry in JAR + final JarEntry entry = getJarFile(device.car()).getJarEntry(entryPath); + final long time = entry.getTime(); + if (time == -1) { + return 0; + } + return time; + } + } else { + JarFile outerJar = getJarFile(device.car()); + if (entryPath.length() == 0) { + // 4. JAR in JAR + String jarPath = ((Pathname)device.cdr()).getNamestringWithoutContext(); + final JarEntry entry = outerJar.getJarEntry(jarPath); + final long time = entry.getTime(); + if (time == -1) { + return 0; + } + return time; + } else { + // 5. Entry in JAR in JAR + String innerJarPath = ((Pathname)device.cdr()).getNamestringWithoutContext(); + ZipEntry entry = outerJar.getEntry(entryPath); + ZipInputStream innerJarInputStream + = Utilities.getZipInputStream(outerJar, innerJarPath); + ZipEntry innerEntry = Utilities.getEntry(innerJarInputStream, + entryPath); + long time = innerEntry.getTime(); + if (time == -1) { + return 0; + } + return time; + } + } + return 0; + } + // ### mkdir private static final Primitive MKDIR = - new Primitive("mkdir", PACKAGE_SYS, false) - { - @Override - public LispObject execute(LispObject arg) - { - final Pathname pathname = coerceToPathname(arg); - if (pathname.isWild()) - error(new FileError("Bad place for a wild pathname.", pathname)); - Pathname defaultedPathname = + new Primitive("mkdir", PACKAGE_SYS, false) { + + @Override + public LispObject execute(LispObject arg) { + final Pathname pathname = coerceToPathname(arg); + if (pathname.isWild()) { + error(new FileError("Bad place for a wild pathname.", pathname)); + } + Pathname defaultedPathname = mergePathnames(pathname, - coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()), - NIL); - File file = Utilities.getFile(defaultedPathname); - return file.mkdir() ? T : NIL; - } - }; - + coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()), + NIL); + File file = Utilities.getFile(defaultedPathname); + return file.mkdir() ? T : NIL; + } + }; // ### rename-file filespec new-name => defaulted-new-name, old-truename, new-truename public static final Primitive RENAME_FILE = - new Primitive("rename-file", "filespec new-name") - { - @Override - public LispObject execute(LispObject first, LispObject second) + new Primitive("rename-file", "filespec new-name") { - { - final Pathname original = (Pathname) truename(first, true); - final String originalNamestring = original.getNamestring(); - Pathname newName = coerceToPathname(second); - if (newName.isWild()) - error(new FileError("Bad place for a wild pathname.", newName)); - newName = mergePathnames(newName, original, NIL); - final String newNamestring; - if (newName instanceof LogicalPathname) - newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname)newName).getNamestring(); - else - newNamestring = newName.getNamestring(); - if (originalNamestring != null && newNamestring != null) { - final File source = new File(originalNamestring); - final File destination = new File(newNamestring); - if (Utilities.isPlatformWindows) { - if (destination.isFile()) - destination.delete(); - } - if (source.renameTo(destination)) - // Success! - return LispThread.currentThread().setValues(newName, original, - truename(newName, true)); - } - return error(new FileError("Unable to rename " + - original.writeToString() + - " to " + newName.writeToString() + - ".")); - } - }; - + @Override + public LispObject execute(LispObject first, LispObject second) { + final Pathname original = (Pathname) truename(first, true); + final String originalNamestring = original.getNamestring(); + Pathname newName = coerceToPathname(second); + if (newName.isWild()) { + error(new FileError("Bad place for a wild pathname.", newName)); + } + newName = mergePathnames(newName, original, NIL); + final String newNamestring; + if (newName instanceof LogicalPathname) { + newNamestring = LogicalPathname.translateLogicalPathname((LogicalPathname) newName).getNamestring(); + } else { + newNamestring = newName.getNamestring(); + } + if (originalNamestring != null && newNamestring != null) { + final File source = new File(originalNamestring); + final File destination = new File(newNamestring); + if (Utilities.isPlatformWindows) { + if (destination.isFile()) { + destination.delete(); + } + } + if (source.renameTo(destination)) // Success! + { + return LispThread.currentThread().setValues(newName, original, + truename(newName, true)); + } + } + return error(new FileError("Unable to rename " + + original.writeToString() + + " to " + newName.writeToString() + + ".")); + } + }; // ### file-namestring pathname => namestring private static final Primitive FILE_NAMESTRING = - new Primitive("file-namestring", "pathname") - { - @Override - public LispObject execute(LispObject arg) - { - Pathname p = coerceToPathname(arg); - FastStringBuffer sb = new FastStringBuffer(); - if (p.name instanceof AbstractString) - sb.append(p.name.getStringValue()); - else if (p.name == Keyword.WILD) - sb.append('*'); - else - return NIL; - if (p.type instanceof AbstractString) { - sb.append('.'); - sb.append(p.type.getStringValue()); - } else if (p.type == Keyword.WILD) - sb.append(".*"); - return new SimpleString(sb); - } - }; + new Primitive("file-namestring", "pathname") { + @Override + public LispObject execute(LispObject arg) { + Pathname p = coerceToPathname(arg); + FastStringBuffer sb = new FastStringBuffer(); + if (p.name instanceof AbstractString) { + sb.append(p.name.getStringValue()); + } else if (p.name == Keyword.WILD) { + sb.append('*'); + } else { + return NIL; + } + if (p.type instanceof AbstractString) { + sb.append('.'); + sb.append(p.type.getStringValue()); + } else if (p.type == Keyword.WILD) { + sb.append(".*"); + } + return new SimpleString(sb); + } + }; // ### host-namestring pathname => namestring private static final Primitive HOST_NAMESTRING = - new Primitive("host-namestring", "pathname") - { - @Override - public LispObject execute(LispObject arg) - { - return coerceToPathname(arg).host; - } - }; + new Primitive("host-namestring", "pathname") { + + @Override + public LispObject execute(LispObject arg) { + return coerceToPathname(arg).host; + } + }; + + public String toString() { + return getNamestring(); + } static { LispObject obj = Symbol.DEFAULT_PATHNAME_DEFAULTS.getSymbolValue(); Symbol.DEFAULT_PATHNAME_DEFAULTS.setSymbolValue(coerceToPathname(obj)); } + + } +// Local Variables: +// c-basic-offset: 4 +// End: + diff -r 311de2e729d1 src/org/armedbear/lisp/Site.java --- a/src/org/armedbear/lisp/Site.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Site.java Sun Jan 24 15:28:01 2010 +0100 @@ -42,40 +42,35 @@ public final class Site { - private static final String LISP_HOME; + private static Pathname LISP_HOME; - static { - String lispHome = System.getProperty("abcl.home"); - if (lispHome == null) { - URL url = Lisp.class.getResource("boot.lisp"); - if (url != null) { - String protocol = url.getProtocol(); - if (protocol != null && protocol.equals("file")) { - String path = url.getPath(); - try { - path = URLDecoder.decode(path, "UTF-8"); - } - catch (java.io.UnsupportedEncodingException uee) { - // can't happen: Java implementations are required to - // support UTF-8 - } - int index = path.lastIndexOf('/'); - if (index >= 0) { - lispHome = path.substring(0, index + 1); - if (Utilities.isPlatformWindows) { - if (lispHome.length() > 0 && lispHome.charAt(0) == '/') - lispHome = lispHome.substring(1); - } - } - } + private static void init() { + String s = System.getProperty("abcl.home"); + if (s != null) { + String fileSeparator = System.getProperty("file.separator"); + if (!s.endsWith(fileSeparator)) { + s += fileSeparator;; } + LISP_HOME = new Pathname(s); + return; } - LISP_HOME = lispHome; + URL url = Lisp.class.getResource("boot.lisp"); + if (url != null) { + LISP_HOME = new Pathname(url); + LISP_HOME.name = NIL; + LISP_HOME.type = NIL; + return; + } + Debug.trace("Unable to determine LISP_HOME."); } - public static final String getLispHome() + + public static final Pathname getLispHome() { - return LISP_HOME; + if (LISP_HOME == null) { + init(); + } + return LISP_HOME; } // ### *lisp-home* @@ -83,8 +78,12 @@ exportSpecial("*LISP-HOME*", PACKAGE_EXT, NIL); static { - String s = Site.getLispHome(); - if (s != null) - _LISP_HOME_.setSymbolValue(new Pathname(s)); + Pathname p = Site.getLispHome(); + if (p != null) + _LISP_HOME_.setSymbolValue(p); } } + +// Local Variables: +// c-basic-offset: 4 +// End: diff -r 311de2e729d1 src/org/armedbear/lisp/Stream.java --- a/src/org/armedbear/lisp/Stream.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Stream.java Sun Jan 24 15:28:01 2010 +0100 @@ -394,7 +394,7 @@ { LispObject result = readPreservingWhitespace(eofError, eofValue, - recursive, thread); + recursive, thread); if (result != eofValue && !recursive) { try { if (_charReady()) { @@ -422,9 +422,9 @@ internSpecial("*SHARP-EQUAL-ALIST*", PACKAGE_SYS, NIL); public LispObject readPreservingWhitespace(boolean eofError, - LispObject eofValue, - boolean recursive, - LispThread thread) + LispObject eofValue, + boolean recursive, + LispThread thread) { if (recursive) { @@ -434,6 +434,7 @@ try { n = _readChar(); } catch (IOException e) { + Debug.trace(e); error(new StreamError(this, e)); } if (n < 0) { @@ -2557,3 +2558,6 @@ } }; } +// Local Variables: +// c-basic-offset: 4 +// End: diff -r 311de2e729d1 src/org/armedbear/lisp/Symbol.java --- a/src/org/armedbear/lisp/Symbol.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Symbol.java Sun Jan 24 15:28:01 2010 +0100 @@ -2909,6 +2909,8 @@ PACKAGE_EXT.addExternalSymbol("GETENV"); public static final Symbol MACROEXPAND_ALL = PACKAGE_EXT.addExternalSymbol("MACROEXPAND-ALL"); + public static final Symbol LOAD_TRUENAME_FASL = + PACKAGE_EXT.addExternalSymbol("*LOAD-TRUENAME-FASL*"); // MOP. public static final Symbol STANDARD_READER_METHOD = diff -r 311de2e729d1 src/org/armedbear/lisp/Utilities.java --- a/src/org/armedbear/lisp/Utilities.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Utilities.java Sun Jan 24 15:28:01 2010 +0100 @@ -33,6 +33,7 @@ package org.armedbear.lisp; +import java.util.jar.JarFile; import static org.armedbear.lisp.Lisp.*; import java.io.ByteArrayInputStream; @@ -124,50 +125,112 @@ return null; } } + + public static ZipInputStream getZipInputStream(ZipFile zipfile, + String entryName) { + return Utilities.getZipInputStream(zipfile, entryName, false); + } + + public static ZipInputStream getZipInputStream(ZipFile zipfile, + String entryName, + boolean errorOnFailure) { + ZipEntry zipEntry = zipfile.getEntry(entryName); + ZipInputStream stream = null; + try { + stream = new ZipInputStream(zipfile.getInputStream(zipEntry)); + } catch (IOException e) { + if (errorOnFailure) { + Lisp.error(new FileError("Failed to open '" + entryName + "' in zipfile '" + + zipfile + "': " + e.getMessage())); + } + return null; + } + return stream; + } + public static byte[] getZippedZipEntryAsByteArray(ZipFile zipfile, String entryName, String subEntryName) { - ZipEntry entry = zipfile.getEntry(entryName); - - ZipInputStream stream = null; + ZipInputStream stream = getZipInputStream(zipfile, entryName, true); + ZipEntry entry = getEntry(stream, subEntryName); + ByteArrayOutputStream buffer = new ByteArrayOutputStream(); + int count; + byte buf[] = new byte[1024]; try { - stream = new ZipInputStream(zipfile.getInputStream(entry)); - } - catch (IOException e) { - Lisp.error(new FileError("Failed to open '" + entryName + "' in zipfile '" - + zipfile + "': " + e.getMessage())); + while ((count = stream.read(buf, 0, buf.length)) != -1) { + buffer.write(buf, 0, count); + } + } catch (java.io.IOException e) { + Lisp.error(new FileError("Failed to read compressed '" + + subEntryName + + "' in '" + + zipfile.getName() + ":" + entryName + ":" + + e.getMessage())); } - // XXX Cache the zipEntries somehow - do { - try { - entry = stream.getNextEntry(); - } catch (IOException e){ - Lisp.error(new FileError("Failed to seek for '" + subEntryName - + "' in '" - + zipfile.getName() + ":" + entryName + ".:" - + e.getMessage())); - } - } while (!entry.getName().equals(subEntryName)); - - ByteArrayOutputStream buffer = new ByteArrayOutputStream(); + return buffer.toByteArray(); + } + + public static InputStream getEntryAsInputStream(ZipInputStream zipInputStream, + String entryName) + { + ZipEntry entry = getEntry(zipInputStream, entryName); + ByteArrayOutputStream bytes = readEntry(zipInputStream); + return new ByteArrayInputStream(bytes.toByteArray()); + + } + + public static ByteArrayOutputStream readEntry(ZipInputStream stream) { + ByteArrayOutputStream result = new ByteArrayOutputStream(); int count; byte buf[] = new byte[1024]; try { while ((count = stream.read(buf, 0, buf.length)) != -1) { - buffer.write(buf, 0, count); + result.write(buf, 0, count); } } catch (java.io.IOException e) { - Lisp.error(new FileError("Failed to read compressed '" - + subEntryName - + "' in '" - + zipfile.getName() + ":" + entryName + ":" - + e.getMessage())); + Debug.trace("Failed to read entry from " + + stream + + ": " + e); + return null; } - return buffer.toByteArray(); + return result; } + + public static ZipEntry getEntry(ZipInputStream zipInputStream, String entryName) { + return Utilities.getEntry(zipInputStream, entryName, false); + } + + public static ZipEntry getEntry(ZipInputStream zipInputStream, + String entryName, + boolean errorOnFailure) + { + ZipEntry entry = null; + do { + try { + entry = zipInputStream.getNextEntry(); + } catch (IOException e) { + if (errorOnFailure) { + Lisp.error(new FileError("Failed to seek for " + + "'" + entryName + "'" + + " in " + zipInputStream.toString())); + } + return null; + } + } while (entry != null && !entry.getName().equals(entryName)); + if (entry != null) { + return entry; + } + if (errorOnFailure) { + Lisp.error(new FileError("Failed to find " + + "'" + entryName + "'" + + " in " + zipInputStream.toString())); + } + return null; + + } public static InputStream getZippedZipEntryAsInputStream(ZipFile zipfile, String entryName, @@ -179,5 +242,56 @@ .getZippedZipEntryAsByteArray(zipfile, entryName, subEntryName)); } + + public static final boolean checkZipFile(Pathname name) { + InputStream input = name.getInputStream(); + try { + byte[] bytes = new byte[4]; + int bytesRead = input.read(bytes); + return (bytesRead == 4 + && bytes[0] == 0x50 + && bytes[1] == 0x4b + && bytes[2] == 0x03 + && bytes[3] == 0x04); + } catch (Throwable t) { // any error probably means 'no' + return false; + } finally { + if (input != null) { + try { + input.close(); + } + catch (IOException e) {} // ignore exceptions + } + } + } + + + @Deprecated + private static final boolean checkZipFile(File file) { + Pathname name = Pathname.makePathname(file); + return checkZipFile(name); + } + + static InputStream getInputStream(JarFile jarFile, Pathname inner) { + String entryPath = inner.getNamestring(); + ZipEntry entry = jarFile.getEntry(entryPath); + InputStream result = null; + try { + result = jarFile.getInputStream(entry); + } catch (IOException e) { + Debug.trace("Failed to open InputStream for " + + "'" + entryPath + "'" + + " in " + + "'" + jarFile + "'"); + return null; + } + return result; + } + + + } +// Local Variables: +// c-basic-offset: 4 +// End: diff -r 311de2e729d1 src/org/armedbear/lisp/Version.java --- a/src/org/armedbear/lisp/Version.java Sat Jan 23 14:40:34 2010 +0100 +++ b/src/org/armedbear/lisp/Version.java Sun Jan 24 15:28:01 2010 +0100 @@ -43,4 +43,8 @@ { return "0.18.0-dev"; } + + public static void main(String args[]) { + System.out.println(Version.getVersion()); + } } diff -r 311de2e729d1 test/lisp/abcl/condition-tests.lisp --- a/test/lisp/abcl/condition-tests.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/condition-tests.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -16,8 +16,6 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -(load (merge-pathnames "test-utilities.lisp" *load-truename*)) - (in-package #:abcl.test.lisp) (defun filter (string) diff -r 311de2e729d1 test/lisp/abcl/file-system-tests.lisp --- a/test/lisp/abcl/file-system-tests.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/file-system-tests.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -33,12 +33,6 @@ :device (pathname-device *load-truename*) :directory (pathname-directory *load-truename*))) -(defmacro signals-error (form error-name) - `(locally (declare (optimize safety)) - (handler-case ,form - (error (c) (typep c ,error-name)) - (:no-error (&rest ignored) (declare (ignore ignored)) nil)))) - (defun pathnames-equal-p (pathname1 pathname2) #-(or allegro clisp cmu lispworks) (equal pathname1 pathname2) @@ -425,7 +419,7 @@ ;; Allegro's version component is :UNSPECIFIC. (pushnew 'user-homedir-pathname.1 *expected-failures*) -(deftest directory-namestring.1 +(deftest file-system.directory-namestring.1 (let ((pathname (user-homedir-pathname))) (equal (namestring pathname) (directory-namestring pathname))) #-windows @@ -434,15 +428,15 @@ ;; The drive prefix ("C:\\") is not part of the directory namestring. nil) #+clisp -(pushnew 'directory-namestring.1 *expected-failures*) +(pushnew 'file-system.directory-namestring.1 *expected-failures*) -(deftest directory-namestring.2 +(deftest file.system.directory-namestring.2 (let ((pathname (user-homedir-pathname))) (equal (directory-namestring pathname) (namestring (make-pathname :directory (pathname-directory pathname))))) t) #+clisp -(pushnew 'directory-namestring.2 *expected-failures*) +(pushnew 'file-system.directory-namestring.2 *expected-failures*) (deftest ensure-directories-exist.1 (let* ((tmp (make-temporary-filename *this-directory*)) diff -r 311de2e729d1 test/lisp/abcl/jar-file.lisp --- a/test/lisp/abcl/jar-file.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/jar-file.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -1,12 +1,15 @@ (in-package #:abcl.test.lisp) -#-:unix (error "Load test setup currently needs UNIX shell script support.") +#-:unix (error "Load test setup currently needs UNIX shell script ~ + support.") + +(defvar *jar-file-init* nil) (defun load-init () - (let* ((*default-pathname-defaults* *this-directory*) + (let* ((*default-pathname-defaults* *abcl-test-directory*) (asdf::*verbose-out* *standard-output*) (package-command (format nil "cd ~A; sh ~A" - *this-directory* + *abcl-test-directory* (merge-pathnames "package-load.sh")))) (compile-file "foo.lisp") (compile-file "bar.lisp") @@ -14,75 +17,214 @@ (asdf:run-shell-command package-command)) (setf *jar-file-init* t)) -(defvar *jar-file-init* nil) - (defmacro with-jar-file-init (&rest body) - `(let ((*default-pathname-defaults* *this-directory*)) + `(let ((*default-pathname-defaults* *abcl-test-directory*)) (progn (unless *jar-file-init* (load-init)) ,@body))) - -(deftest jar-file-load.1 - (with-jar-file-init - (load "foo")) - t) +#+nil +(defmacro with-jar-file-init (&rest body) + `(progv '(*default-pathname-defaults*) '(,*abcl-test-directory*) + (unless *jar-file-init* + (load-init)) + ,@body)) -(deftest jar-file-load.2 - (with-jar-file-init - (load "foo.lisp")) - t) - -(deftest jar-file-load.3 - (with-jar-file-init - (load "foo.abcl")) - t) - -(deftest jar-file-load.4 +(deftest jar-file.load.1 (with-jar-file-init (load "jar:file:baz.jar!/foo")) t) -(deftest jar-file-load.6 +(deftest jar-file.load.2 (with-jar-file-init (load "jar:file:baz.jar!/bar")) t) -(deftest jar-file-load.7 +(deftest jar-file.load.3 (with-jar-file-init (load "jar:file:baz.jar!/bar.abcl")) t) -(deftest jar-file-load.8 +(deftest jar-file.load.4 (with-jar-file-init (load "jar:file:baz.jar!/eek")) t) -(deftest jar-file-load.9 +(deftest jar-file.load.5 (with-jar-file-init (load "jar:file:baz.jar!/eek.lisp")) t) +(deftest jar-file.load.6 + (with-jar-file-init + (load "jar:file:baz.jar!/a/b/foo")) + t) -(deftest jar-file-probe-file.1 +(deftest jar-file.load.7 + (with-jar-file-init + (load "jar:file:baz.jar!/a/b/bar")) + t) + +(deftest jar-file.load.8 + (with-jar-file-init + (load "jar:file:baz.jar!/a/b/bar.abcl")) + t) + +(deftest jar-file.load.9 + (with-jar-file-init + (load "jar:file:baz.jar!/a/b/eek")) + t) + +(deftest jar-file.load.10 + (with-jar-file-init + (load "jar:file:baz.jar!/a/b/eek.lisp")) + t) + +(deftest jar-file.probe-file.1 (with-jar-file-init (probe-file "jar:file:baz.jar!/eek.lisp")) - #p"jar:file:baz.jar!/eek.lisp") ; WRONG: PROBE-FILE should return - ; TRUENAME on existence. + #p#.(format nil "jar:file:~A/baz.jar!/eek.lisp" + (namestring *abcl-test-directory*))) +(deftest jar-file.probe-file.2 + (with-jar-file-init + (probe-file "jar:file:baz.jar!/a/b/bar.abcl")) + #p#.(format nil "jar:file:~A/baz.jar!/a/b/bar.abcl" + (namestring *abcl-test-directory*))) -(deftest jar-file-merge-pathnames.1 +(deftest jar-file.probe-file.3 + (with-jar-file-init + (probe-file "jar:jar:file:baz.jar!/a/b/bar.abcl!/bar._")) + #p#.(format nil "jar:jar:file:~Abaz.jar!/a/b/bar.abcl!/bar._" + (namestring *abcl-test-directory*))) + +(deftest jar-file.probe-file.4 + (with-jar-file-init + (probe-file "jar:file:baz.jar!/a/b")) + nil) + +(deftest jar-file.probe-file.5 + (with-jar-file-init + (probe-file "jar:file:baz.jar!/a/b/")) + #p#.(format nil "jar:file:~Abaz.jar!/a/b/" + (namestring *abcl-test-directory*))) + +(deftest jar-file.merge-pathnames.1 (merge-pathnames - "!/foo" #p"jar:file:baz.jar") + "/bar.abcl" #p"jar:file:baz.jar!/foo") + #p"jar:file:baz.jar!/bar.abcl") + +(deftest jar-file.merge-pathnames.2 + (merge-pathnames + "/bar.abcl" #p"jar:file:baz.jar!/foo/") + #p"jar:file:baz.jar!/foo/bar.abcl") + +(deftest jar-file.merge-pathnames.3 + (merge-pathnames + "jar:file:baz.jar!/foo" "bar") #p"jar:file:baz.jar!/foo") -(deftest jar-file-truename.1 - (truename "jar:file:baz.jar!/foo") - (format nil "jar:file:~S/baz.jar!/foo" - *this-directory*)) - +(deftest jar-file.truename.1 + (signals-error (truename "jar:file:baz.jar!/foo") + 'file-error) + t) +(deftest jar-file.pathname.1 + (let* ((p #p"jar:file:foo/baz.jar!/") + (d (first (pathname-device p)))) + (values + (pathname-directory d) (pathname-name d) (pathname-type d))) + (:relative "foo") "baz" "jar") + +(deftest jar-file.pathname.2 + (let* ((p #p"jar:file:baz.jar!/foo.abcl") + (d (first (pathname-device p)))) + (values + (pathname-name d) (pathname-type d) + (pathname-directory p) (pathname-name p) (pathname-type p))) + "baz" "jar" + nil "foo" "abcl") + +(deftest jar-file.pathname.3 + (let* ((p #p"jar:jar:file:baz.jar!/foo.abcl!/") + (d0 (first (pathname-device p))) + (d1 (second (pathname-device p)))) + (values + (pathname-name d0) (pathname-type d0) + (pathname-name d1) (pathname-type d1))) + "baz" "jar" + "foo" "abcl") + +(deftest jar-file.pathname.4 + (let* ((p #p"jar:jar:file:a/baz.jar!/b/c/foo.abcl!/this/that/foo-20.cls") + (d0 (first (pathname-device p))) + (d1 (second (pathname-device p)))) + (values + (pathname-directory d0) (pathname-name d0) (pathname-type d0) + (pathname-directory d1) (pathname-name d1) (pathname-type d1) + (pathname-directory p) (pathname-name p) (pathname-type p))) + (:relative "a") "baz" "jar" + (:relative "b" "c") "foo" "abcl" + (:relative "this" "that") "foo-20" "cls") + +(deftest jar-file.pathname.5 + (let* ((p #p"jar:jar:file:a/foo/baz.jar!/b/c/foo.abcl!/armed/bear/bar-1.cls") + (d0 (first (pathname-device p))) + (d1 (second (pathname-device p)))) + (values + (pathname-directory d0) (pathname-name d0) (pathname-type d0) + (pathname-directory d1) (pathname-name d1) (pathname-type d1) + (pathname-directory p) (pathname-name p) (pathname-type p))) + (:relative "a" "foo" ) "baz" "jar" + (:relative "b" "c") "foo" "abcl" + (:relative "armed" "bear") "bar-1" "cls") + +(deftest jar-file.pathname.6 + (let* ((p #p"jar:http://example.org/abcl.jar!/org/armedbear/lisp/Version.class") + (d (first (pathname-device p)))) + + (values + d + (pathname-directory p) (pathname-name p) (pathname-type p))) + "http://example.org/abcl.jar" + (:relative "org" "armedbear" "lisp") "Version" "class") + +(deftest jar-file.pathname.7 + (let* ((p #p"jar:jar:http://example.org/abcl.jar!/foo.abcl!/foo-1.cls") + (d (pathname-device p)) + (d0 (first d)) + (d1 (second d))) + (values + d0 + (pathname-name d1) (pathname-type d1) + (pathname-name p) (pathname-type p))) + "http://example.org/abcl.jar" + "foo" "abcl" + "foo-1" "cls") + +(deftest jar-file.pathname.8 + (let* ((p #p"jar:file:/a/b/foo.jar!/") + (d (first (pathname-device p)))) + (values + (pathname-directory d) (pathname-name d) (pathname-type d))) + (:ABSOLUTE "a" "b") "foo" "jar") + +(deftest jar-file.pathname.9 + (let* ((p #p"jar:file:a/b/foo.jar!/c/d/foo.lisp") + (d (first (pathname-device p)))) + (values + (pathname-directory d) (pathname-name d) (pathname-type d) + (pathname-directory p) (pathname-name p) (pathname-type p))) + (:RELATIVE "a" "b") "foo" "jar" + (:RELATIVE "c" "d") "foo" "lisp") + + + + + + + diff -r 311de2e729d1 test/lisp/abcl/math-tests.lisp --- a/test/lisp/abcl/math-tests.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/math-tests.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -35,15 +35,17 @@ #+sbcl `(sb-int:get-floating-point-modes)) #+(or abcl cmu sbcl) -(defun restore-default-floating-point-modes () +(defmacro restore-default-floating-point-modes () #+abcl - (set-floating-point-modes :traps '(:overflow :underflow)) + `(ext:set-floating-point-modes :traps '(:overflow :underflow)) #+(or cmu sbcl) - (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))) + `(set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))) #+(or abcl cmu sbcl) (eval-when (:compile-toplevel :load-toplevel :execute) - (restore-default-floating-point-modes)) + (restore-default-floating-point-modes)) +;; (ext:set-floating-point-modes :traps '(:overflow :underflow))) +;; (deftest most-negative-fixnum.1 (= (/ most-negative-fixnum -1) (- most-negative-fixnum)) @@ -354,7 +356,7 @@ (expt #c(0 0.0) 4) #c(0.0 0.0)) -(deftest expt.25 +(deftest expt.26 (expt #c(0 0.0) 4.0) #c(0.0 0.0)) @@ -451,7 +453,7 @@ (signals-error (truncate least-positive-double-float 2) 'floating-point-underflow) t) -(deftest read-from-string.1 +(deftest math.read-from-string.1 #+(or cmu sbcl) (unwind-protect (signals-error (read-from-string "1.0f-1000") 'reader-error) diff -r 311de2e729d1 test/lisp/abcl/misc-tests.lisp --- a/test/lisp/abcl/misc-tests.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/misc-tests.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -19,12 +19,12 @@ (in-package #:abcl.test.lisp) -(deftest dotimes.1 +(deftest misc.dotimes.1 (progn - (fmakunbound 'dotimes.1) - (defun dotimes.1 () + (fmakunbound 'misc.dotimes.1) + (defun misc.dotimes.1 () (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum)) - (dotimes.1)) + (misc.dotimes.1)) 420) (deftest dotimes.1.compiled @@ -36,12 +36,12 @@ (dotimes.1.compiled)) 420) -(deftest dotimes.2 +(deftest misc.dotimes.2 (progn - (fmakunbound 'dotimes.2) - (defun dotimes.2 (count) + (fmakunbound 'misc.dotimes.2) + (defun misc.dotimes.2 (count) (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum)) - (dotimes.2 10)) + (misc.dotimes.2 10)) 420) (deftest dotimes.2.compiled diff -r 311de2e729d1 test/lisp/abcl/package-load.sh --- a/test/lisp/abcl/package-load.sh Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/package-load.sh Sun Jan 24 15:28:01 2010 +0100 @@ -3,14 +3,20 @@ tmpdir=/tmp/$$ mkdir $tmpdir +mkdir -p $tmpdir/a/b cd $tmpdir +# explode foo.abcl unzip $srcdir/foo.abcl +(cd $tmpdir/a/b; unzip $srcdir/foo.abcl) + cp $srcdir/bar.abcl . +cp $srcdir/bar.abcl a/b cp $srcdir/eek.lisp . +cp $srcdir/eek.lisp a/b jar cfv $srcdir/baz.jar * diff -r 311de2e729d1 test/lisp/abcl/package.lisp --- a/test/lisp/abcl/package.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/package.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -1,31 +1,32 @@ (defpackage #:abcl.test.lisp (:use #:cl #:abcl-rt) - (:nicknames "ABCL-TEST") - (:export #:run)) + (:nicknames "ABCL-TEST-LISP") + (:export + #:run #:run-matching)) (in-package #:abcl.test.lisp) -(defvar *abcl-lisp-test-directory* - (pathname (directory-namestring *load-truename*)) - "The directory in which the ABCL test source files are located.") +(defparameter *abcl-test-directory* + (make-pathname :host (pathname-host *load-truename*) + :device (pathname-device *load-truename*) + :directory (pathname-directory *load-truename*))) (defun run () "Run the Lisp test suite for ABCL." - - (let ((*default-pathname-defaults* *abcl-lisp-test-directory*)) - (rem-all-tests) - - (load "test-utilities.lisp") - - (load "compiler-tests.lisp") - (load "condition-tests.lisp") - (load "file-system-tests.lisp") - (load "java-tests.lisp") - (load "math-tests.lisp") - (load "misc-tests.lisp") - - (when (find :unix *features*) - (load "jar-file.lisp")) - + (let ((*default-pathname-defaults* *abcl-test-directory*)) (do-tests))) +;;; XXX move this into test-utilities.lisp? +(defun run-matching (&optional (match "jar-file.")) + (let* ((matching (string-upcase match)) + (tests + (remove-if-not + (lambda (name) (search matching name)) + (mapcar (lambda (entry) + (symbol-name (abcl-rt::name entry))) + (rest abcl-rt::*entries*))))) + (dolist (test tests) + (do-test (intern test :abcl.test.lisp))))) + + + \ No newline at end of file diff -r 311de2e729d1 test/lisp/abcl/test-utilities.lisp --- a/test/lisp/abcl/test-utilities.lisp Sat Jan 23 14:40:34 2010 +0100 +++ b/test/lisp/abcl/test-utilities.lisp Sun Jan 24 15:28:01 2010 +0100 @@ -24,6 +24,7 @@ #+(and lispworks win32) (pushnew :windows *features*) +#+nil ;; Taken care of by ASDF (unless (member "ABCL-RT" *modules* :test #'string=) (load (merge-pathnames "rt-package.lisp" *load-truename*)) (load #+abcl (compile-file-if-needed (merge-pathnames "rt.lisp" *load-truename*)) @@ -32,15 +33,17 @@ #-abcl (compile-file (merge-pathnames "rt.lisp" *load-truename*))) (provide "ABCL-RT")) + (in-package #:abcl-regression-test) -(export '(signals-error)) - (defmacro signals-error (form error-name) `(locally (declare (optimize safety)) (handler-case ,form (condition (c) (typep c ,error-name)) (:no-error (&rest ignored) (declare (ignore ignored)) nil)))) +(export '(signals-error)) + + #+nil (rem-all-tests) diff -r 311de2e729d1 test/src/org/armedbear/lisp/PathnameTest.java --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/src/org/armedbear/lisp/PathnameTest.java Sun Jan 24 15:28:01 2010 +0100 @@ -0,0 +1,58 @@ +package org.armedbear.lisp; + +import java.net.MalformedURLException; +import org.junit.Test; +import static org.junit.Assert.*; +import org.junit.runner.JUnitCore; + + +import java.net.URL; +import java.io.File; +import java.io.FileWriter; +import java.io.InputStream; +import java.io.InputStreamReader; +import java.io.IOException; + +public class PathnameTest +{ + public static void main(final String args[]) { + JUnitCore.main("org.armedbear.lisp.PathnameTest"); + } + + @Test + public void constructorURL() + { + URL url = null; + try { + url = new URL("file:///Users/evenson/work/abcl/build/classes/org/armedbear/lisp/boot.lisp"); + } catch (MalformedURLException e) { + System.out.println(e.getMessage()); + } + Pathname pathname = new Pathname(url); + assertNotNull(pathname); + assertNotNull(pathname.getNamestring()); + assertNotNull(pathname.name); + assertNotNull(pathname.type); + assertNotNull(pathname.directory); + } + + @Test + public void getInputStream() throws IOException { + File file = File.createTempFile("foo", "lisp"); + FileWriter output = new FileWriter(file); + String contents = "(defun foo () 42)"; + output.append(contents); + output.close(); + Pathname pathname = Pathname.makePathname(file); + InputStream input = pathname.getInputStream(); + InputStreamReader reader = new InputStreamReader(input); + char[] buffer = new char[1024]; + StringBuilder result = new StringBuilder(); + int i; + while((i = reader.read(buffer, 0, buffer.length)) != -1) { + result.append(buffer, 0, i); + } + assertEquals(contents, result.toString()); + file.delete(); + } +} diff -r 311de2e729d1 test/src/org/armedbear/lisp/StreamTest.java --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/src/org/armedbear/lisp/StreamTest.java Sun Jan 24 15:28:01 2010 +0100 @@ -0,0 +1,31 @@ +package org.armedbear.lisp; + +import static org.junit.Assert.*; + +import java.io.File; +import java.io.FileWriter; +import org.junit.Test; +import java.io.IOException; + +public class StreamTest +{ + @Test + public void readLispObject() { + File file = null; + try { + file = File.createTempFile("foo", "lisp"); + FileWriter output = new FileWriter(file); + String contents = "(defun foo () 42)"; + output.append(contents); + output.close(); + } catch (IOException e) { + System.out.println("Failed to create temp file" + e); + return; + } + Pathname pathname = Pathname.makePathname(file); + Stream in = new Stream(Symbol.SYSTEM_STREAM, pathname.getInputStream(), Symbol.CHARACTER); + LispObject o = in.read(false, Lisp.EOF, false, LispThread.currentThread()); + assertFalse(o.equals(Lisp.NIL)); + file.delete(); + } +} \ No newline at end of file