Changeset 15396

Timestamp:

10/10/20 21:43:30 (3 years ago)

Author:

Mark Evenson

Message:

Ensure that we behave like previous implementation

Seemingly working for simple loads

TODO: No relative pathnames for jars or urls

Everything but PATHNAME-URL loads seem to be working

• * *

Properly signal PARSE-ERROR when choking on namestrings

• * *

Validate JAR-PATHNAME components better

Enables ABCL/TEST/LISP to at least complete locally.

TODO: incomplete checking for all possible code paths to object
constructions, notably missing is PathnameURL construction/validation.

• * *

IN-PROGRESS restore MERGE-PATHNAMES relative-jar

Need to reinstate relative local PATHNAME-JAR

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Lisp.java (modified) (2 diffs)
• Load.java (modified) (4 diffs)
• Pathname.java (modified) (11 diffs)
• PathnameJar.java (modified) (6 diffs)
• PathnameURL.java (modified) (6 diffs)
• Symbol.java (modified) (1 diff)
• abcl-contrib.lisp (modified) (2 diffs)
• java.lisp (modified) (1 diff)
• open.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Lisp.java

@@ -455 +455 @@
   {
     return error(new TypeError(datum, expectedType));
+  }
+
+  public static final LispObject type_error(String message,
+                                            LispObject datum,
+                                            LispObject expectedType)  {
+    return error(new TypeError(message, datum, expectedType));
   }
 
@@ -1922 +1928 @@
       return ((URLStream)arg).getPathname();
     type_error(arg, list(Symbol.OR,
-                           Symbol.STRING,
-                           Symbol.PATHNAME, Symbol.JAR_PATHNAME, Symbol.URL_PATHNAME,
-                           Symbol.FILE_STREAM, Symbol.JAR_STREAM, Symbol.URL_STREAM));
+                         Symbol.STRING,
+                         Symbol.PATHNAME, Symbol.JAR_PATHNAME, Symbol.URL_PATHNAME,
+                         Symbol.FILE_STREAM, Symbol.JAR_STREAM, Symbol.URL_STREAM));
     // Not reached.
     return null;

trunk/abcl/src/org/armedbear/lisp/Load.java

@@ -108 +108 @@
           }
           name.setType(new SimpleString(COMPILE_FILE_TYPE));
-          name.invalidateNamestring();
           result = findLoadableFile(name);
           if (result != null) {
@@ -158 +157 @@
         }
         Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
-        Pathname truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
-
-        if (truename.equals(NIL)) {
+        Pathname truename = (loadableFile != null
+                             ? (Pathname)Symbol.PROBE_FILE.execute(loadableFile)
+                             : null);
+        
+        if (truename == null || truename.equals(NIL)) {
           if (ifDoesNotExist) {
             return error(new FileError("File not found: " + pathname.princToString(), pathname));
@@ -298 +299 @@
         if (bootPath instanceof Pathname) {
           mergedPathname = (Pathname)Symbol.MERGE_PATHNAMES.execute(pathname, bootPath);
+          // So PROBE-FILE won't attempt to merge when
+          // *DEFAULT-PATHNAME-DEFAULTS* is a JAR
+          if (mergedPathname.getDevice().equals(NIL)) {
+            mergedPathname.setDevice(Keyword.UNSPECIFIC);
+          }
         } else {
           mergedPathname = pathname;
@@ -303 +309 @@
         URL url = null;
         Pathname loadableFile = findLoadableFile(mergedPathname);
-        truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
+        if (loadableFile == null) {
+          truename = null;
+        } else {
+          truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
+        }
         
         final String COMPILE_FILE_TYPE 

trunk/abcl/src/org/armedbear/lisp/Pathname.java

@@ -320 +320 @@
       Pathname result = new Pathname();
         if (s == null) {
-          return (Pathname)simple_error("Refusing to create a PATHNAME for the null reference.");
+          return (Pathname)parse_error("Refusing to create a PATHNAME for the null reference.");
         }
         if (s.equals(".") || s.equals("./")
@@ -347 +347 @@
             }
             if (shareIndex == -1 || dirIndex == -1) {
-              return Pathname_simple_error("Unsupported UNC path format: \"" + s + '"');
+              return (Pathname)parse_error("Unsupported UNC path format: \"" + s + '"');
             }
 
@@ -582 +582 @@
         if (getDevice() == NIL) {
         } else if (getDevice() == Keyword.UNSPECIFIC) {
-        // } else if (isJar()) {
-        //     LispObject[] jars = ((Cons) getDevice()).copyToArray();
-        //     StringBuilder prefix = new StringBuilder();
-        //     for (int i = 0; i < jars.length; i++) {
-        //         prefix.append("jar:");
-        //         LispObject component = jars[i];
-        //         if (!(component instanceof Pathname)) {
-        //           return null; // If DEVICE is a CONS, it should only contain Pathname 
-        //         }
-        //         if (! ((Pathname)component).isURL() && i == 0) {
-        //           sb.append("file:");
-        //           uriEncoded = true;
-        //         }
-        //         Pathname jar = (Pathname) component;
-        //         String encodedNamestring;
-        //         if (uriEncoded) {
-        //           encodedNamestring = uriEncode(jar.getNamestring());
-        //         } else { 
-        //           encodedNamestring = jar.getNamestring();
-        //         }
-        //         sb.append(encodedNamestring);
-        //         sb.append("!/");
-        //     }
-        //     sb = prefix.append(sb);
         } else if (getDevice() instanceof AbstractString) {
             sb.append(getDevice().getStringValue());
@@ -613 +589 @@
             }
         } else {
-            Debug.assertTrue(false);
+          simple_error("Transitional error in pathname: should be a JAR-PATHNAME", this);
         }
         String directoryNamestring = getDirectoryNamestring();
@@ -664 +640 @@
             }
         }
-        
-        // if (isURL()) {
-        //     LispObject o = Symbol.GETF.execute(getHost(), QUERY, NIL);
-        //     if (o != NIL) {
-        //         sb.append("?");
-        //         sb.append(o.getStringValue());
-        //     }
-        //     o = Symbol.GETF.execute(getHost(), FRAGMENT, NIL);
-        //     if (o != NIL) {
-        //         sb.append("#");
-        //         sb.append(o.getStringValue());
-        //     }
-        // }
             
         if (this instanceof LogicalPathname) {
@@ -1357 +1320 @@
         p.setVersion(version);
         p.validateDirectory(true);
+
+        // TODO:  need to check for downcast to PathnameURL as well
+        // Possibly downcast type to PathnameJar
+        if (p.getDevice() instanceof Cons) {
+          PathnameJar result = new PathnameJar();
+          ncoerce(p, result);
+          // sanity check that the pathname has been constructed correctly
+          result.validateComponents();
+
+          return result;
+        }
         
         return p;
@@ -1735 +1709 @@
     
   public static final LispObject mergePathnames(final Pathname pathname,
-                                              final Pathname defaultPathname,
-                                              final LispObject defaultVersion) {
+                                                final Pathname defaultPathname,
+                                                final LispObject defaultVersion) {
     Pathname result;
     Pathname p = Pathname.create(pathname);
     Pathname d;
 
-      if (pathname instanceof LogicalPathname) {
-        result = LogicalPathname.create();
-        d = Pathname.create(defaultPathname);
+    if (pathname instanceof LogicalPathname) {
+      result = LogicalPathname.create();
+      d = Pathname.create(defaultPathname);
+    } else {
+      if (pathname instanceof PathnameJar
+          // If the defaults contain a JAR-PATHNAME, and the pathname to
+          // be be merged is not a JAR-PATHNAME, does not have a specified
+          // DEVICE, a specified HOST, and doesn't contain a relative
+          // DIRECTORY, then the result will not be a JAR-PATHNAME
+          || (defaultPathname instanceof PathnameJar
+              && !(pathname instanceof PathnameJar)
+              && pathname.getDevice().equals(NIL)
+              && !(!pathname.getDirectory().equals(NIL)
+                   && pathname.getDirectory().car().equals(Keyword.ABSOLUTE)))) {
+        result = PathnameJar.create();
+      } else if (pathname instanceof PathnameURL) {
+        result = PathnameURL.create();
       } else {
-        if ((pathname instanceof PathnameJar)
-            || (defaultPathname instanceof PathnameJar)) {
-          result = PathnameJar.create();
+        result = Pathname.create();
+      }
+              
+      if (defaultPathname instanceof LogicalPathname) {
+        d = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname);
+      } else {
+        if (defaultPathname instanceof PathnameJar) {
+          d = PathnameJar.create(defaultPathname);
+        } else if (defaultPathname instanceof PathnameURL) {
+          d = PathnameURL.create(defaultPathname);
         } else {
-          result = Pathname.create();
-        }
-              
-        if (defaultPathname instanceof LogicalPathname) {
-          d = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname);
-        } else {
-          if (defaultPathname instanceof PathnameJar) {
-            d = PathnameJar.create(defaultPathname);
-          } else {
-            d = Pathname.create(defaultPathname);
-          }
-        }
-      }
+          d = Pathname.create(defaultPathname);
+        }
+      }
+    }
 
       if (pathname.getHost() != NIL) {
@@ -1772 +1758 @@
         result.setDevice(p.getDevice());
       } else {
-        if (d instanceof PathnameJar) {
-          // If the defaults contain a JAR-PATHNAME, and the pathname
-          // to be be merged does not have a specified DEVICE, a
-          // specified HOST, and doesn't contain a relative DIRECTORY,
-          // then on non-MSDOG, set its device to :UNSPECIFIC.
+        // If the defaults contain a JAR-PATHNAME, and the pathname
+        // to be be merged is not a JAR-PATHNAME, does not have a
+        // specified DEVICE, a specified HOST, and doesn't contain a
+        // relative DIRECTORY, then on non-MSDOG, set its device to
+        // :UNSPECIFIC.
+        if ((d instanceof PathnameJar)
+            && (result instanceof Pathname)) {
           if (pathname.getHost() == NIL
               && pathname.getDevice() == NIL
@@ -1790 +1778 @@
             result.setDevice(d.getDevice());
           }
-        }
-      }
-
-      // This part I no longer understand
+        } else {
+          result.setDevice(d.getDevice());
+        }
+      }
+
+      // Merge the directory of a relative JAR-PATHNAME with the
+      // default directory.  
       // if (pathname.isJar()) {
-      //   Cons jars = (Cons)result.getDevice();
+      //   Pathname root = ((PathnameJar)result).getRootJar();
+        
+
       //   LispObject jar = jars.car;
       //   if (jar instanceof Pathname) {
@@ -1813 +1806 @@
       //   result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
       // }
-      result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
+
+      if (pathname.isJar()) {
+        result.setDirectory(p.getDirectory());
+      } else {
+        result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
+      }
       
       if (pathname.getName() != NIL) {
@@ -2008 +2006 @@
   private static final class pf_get_input_stream extends Primitive {
     pf_get_input_stream() {
-      super("ensure-input-stream", PACKAGE_SYS, true);
+      super(Symbol.GET_INPUT_STREAM, "pathname");
     }
     @Override

trunk/abcl/src/org/armedbear/lisp/PathnameJar.java

@@ -58 +58 @@
   protected PathnameJar() {}
 
+  public static Pathname create() {
+    return new PathnameJar();
+  }
+
   public static PathnameJar create(PathnameJar p) {
     return (PathnameJar)PathnameJar.create(p.getNamestring());
@@ -197 +201 @@
   }
 
-  static public Pathname create() {
-    return new PathnameJar();
-  }
   static public LispObject create(String s) {
     if (!s.startsWith(JAR_URI_PREFIX)) {
@@ -238 +239 @@
     jars = jars.nreverse();
     result.setDevice(jars);
+    result.validateComponents();
     return result;
   }
+
+  public LispObject validateComponents() {
+    if (!(getDevice() instanceof Cons)) {
+      return type_error("Invalid DEVICE for JAR-PATHNAME", getDevice(), Symbol.CONS);
+    }
+
+    LispObject jars = getDevice();
+    while (!jars.car().equals(NIL)) {
+      LispObject jar = jars.car();
+      if (!((jar instanceof Pathname)
+            || (jar instanceof PathnameURL))) {
+        return type_error("The value in DEVICE component of a JAR-PATHNAME is not of expected type",
+                          jar,
+                          list(Symbol.OR,
+                               Symbol.PATHNAME, Symbol.URL_PATHNAME));
+      }
+      jars = jars.cdr();
+    }
+
+    return T;
+  }
+    
 
   public String getNamestring() {
@@ -246 +270 @@
     LispObject jars = getDevice();
 
-    if (jars.equals(NIL)) { // DESCRIBE ends up here somehow
-      // attempt to return some sort of representation
-      return super.getNamestring();
+    if (jars.equals(NIL) || jars.equals(Keyword.UNSPECIFIC)) { 
+        System.out.println("Pathname transitional problem: JAR-PATHNAME has bad PATHNAME-DEVICE");
+        return null;
     }
 
@@ -306 +330 @@
 
   LispObject getRootJar() {
-    return getDevice().car();
+    LispObject jars = getJars();
+    if (!(jars instanceof Cons)) {
+      System.out.println("Transitional pathname error: PATHNAME-DEVICE is not a Cons cell");
+      return NIL;
+    }
+      
+    return jars.car();
   }
 
@@ -324 +354 @@
       // FIXME implement me
       simple_error("Unimplemented TRUENAME for non-file root jar.");
-    } else {
-      rootJar = (Pathname)Symbol.MERGE_PATHNAMES.execute(rootJar);
-    }
-
-    rootJar = (Pathname)Symbol.TRUENAME.execute(rootJar);
+    } 
 
     PathnameJar p = new PathnameJar();

trunk/abcl/src/org/armedbear/lisp/PathnameURL.java

@@ -54 +54 @@
   protected PathnameURL() {}
 
+  public static Pathname create() {
+    return new PathnameURL();
+  }
+
   public static PathnameURL create(PathnameURL p) {
     return (PathnameURL) PathnameURL.create(p.getNamestring());
@@ -68 +72 @@
   public static LispObject create(String s) {
     if (!isValidURL(s)) {
-      error(new SimpleError("Cannot form a PATHNAME-URL from " + s));
+      parse_error("Cannot form a PATHNAME-URL from " + s);
     }
     if (s.startsWith("jar:")) {
@@ -79 +83 @@
       url = new URL(s);
     } catch (MalformedURLException e) {
-      Debug.assertTrue(false);
+      return parse_error("Malformed URL in namestring '" + s + "': " + e.toString());
     }
     String scheme = url.getProtocol();
@@ -87 +91 @@
         uri = new URI(s);
       } catch (URISyntaxException ex) {
-        error(new SimpleError("Improper URI syntax for "
-                              + "'" + url.toString() + "'"
-                              + ": " + ex.toString()));
+        return parse_error("Improper URI syntax for "
+                           + "'" + url.toString() + "'"
+                           + ": " + ex.toString());
       }
             
@@ -98 +102 @@
         uriPath = uri.getSchemeSpecificPart();
         if (uriPath == null || uriPath.equals("")) {
-          error(new LispError("The URI has no path: " + uri));
+          return parse_error("The namestring URI has no path: " + uri);
         }
       }
@@ -120 +124 @@
       uri = url.toURI().normalize();
     } catch (URISyntaxException e) {
-      error(new LispError("Couldn't form URI from "
-                          + "'" + url + "'"
-                          + " because: " + e));
+      return parse_error("Couldn't form URI from "
+                         + "'" + url + "'"
+                         + " because: " + e);
     }
     String authority = uri.getAuthority();

trunk/abcl/src/org/armedbear/lisp/Symbol.java

@@ -3093 +3093 @@
   public static final Symbol _ENABLE_AUTOCOMPILE_ =
     PACKAGE_SYS.addExternalSymbol("*ENABLE-AUTOCOMPILE*");
-  public static final Symbol ENSURE_INPUT_STREAM =
-    PACKAGE_SYS.addExternalSymbol("ENSURE-INPUT-STREAM");
+  public static final Symbol GET_INPUT_STREAM =
+    PACKAGE_SYS.addExternalSymbol("GET-INPUT-STREAM");
   public static final Symbol ENVIRONMENT =
     PACKAGE_SYS.addExternalSymbol("ENVIRONMENT");

trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

@@ -57 +57 @@
    ;; it would minimally need to check version information.
    (ignore-errors
-     #p"https://abcl.org/releases/1.7.1/abcl.jar")))
+     #p"jar:file:https://abcl.org/releases/1.7.1/abcl.jar!/")))
 
 (defun flatten (list)
@@ -115 +115 @@
       (let ((jar (some predicate entries)))
   (when jar
-    (return-from find-jar jar))))))
+    (return-from find-jar
+            (make-pathname :device (list jar))))))))
 
 (defun find-system-jar ()

trunk/abcl/src/org/armedbear/lisp/java.lisp

@@ -583 +583 @@
 (defun jinput-stream (pathname)
   "Returns a java.io.InputStream for resource denoted by PATHNAME."
-  (sys:ensure-input-stream pathname))
+  (sys:get-input-stream pathname))
 
 (provide "JAVA")

trunk/abcl/src/org/armedbear/lisp/open.lisp

@@ -122 +122 @@
       (error 'file-error
        :pathname pathname
-       :format-control "Bad place for a wild pathname."))
+       :format-control "Cannot OPEN a wild pathname."))
     (when (memq direction '(:output :io))
       (unless if-exists-given