Changeset 15396


Ignore:
Timestamp:
10/10/20 21:43:30 (2 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:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r15395 r15396  
    455455  {
    456456    return error(new TypeError(datum, expectedType));
     457  }
     458
     459  public static final LispObject type_error(String message,
     460                                            LispObject datum,
     461                                            LispObject expectedType)  {
     462    return error(new TypeError(message, datum, expectedType));
    457463  }
    458464
     
    19221928      return ((URLStream)arg).getPathname();
    19231929    type_error(arg, list(Symbol.OR,
    1924                            Symbol.STRING,
    1925                            Symbol.PATHNAME, Symbol.JAR_PATHNAME, Symbol.URL_PATHNAME,
    1926                            Symbol.FILE_STREAM, Symbol.JAR_STREAM, Symbol.URL_STREAM));
     1930                         Symbol.STRING,
     1931                         Symbol.PATHNAME, Symbol.JAR_PATHNAME, Symbol.URL_PATHNAME,
     1932                         Symbol.FILE_STREAM, Symbol.JAR_STREAM, Symbol.URL_STREAM));
    19271933    // Not reached.
    19281934    return null;
  • trunk/abcl/src/org/armedbear/lisp/Load.java

    r15395 r15396  
    108108          }
    109109          name.setType(new SimpleString(COMPILE_FILE_TYPE));
    110           name.invalidateNamestring();
    111110          result = findLoadableFile(name);
    112111          if (result != null) {
     
    158157        }
    159158        Pathname loadableFile = findLoadableFile(mergedPathname != null ? mergedPathname : pathname);
    160         Pathname truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
    161 
    162         if (truename.equals(NIL)) {
     159        Pathname truename = (loadableFile != null
     160                             ? (Pathname)Symbol.PROBE_FILE.execute(loadableFile)
     161                             : null);
     162       
     163        if (truename == null || truename.equals(NIL)) {
    163164          if (ifDoesNotExist) {
    164165            return error(new FileError("File not found: " + pathname.princToString(), pathname));
     
    298299        if (bootPath instanceof Pathname) {
    299300          mergedPathname = (Pathname)Symbol.MERGE_PATHNAMES.execute(pathname, bootPath);
     301          // So PROBE-FILE won't attempt to merge when
     302          // *DEFAULT-PATHNAME-DEFAULTS* is a JAR
     303          if (mergedPathname.getDevice().equals(NIL)) {
     304            mergedPathname.setDevice(Keyword.UNSPECIFIC);
     305          }
    300306        } else {
    301307          mergedPathname = pathname;
     
    303309        URL url = null;
    304310        Pathname loadableFile = findLoadableFile(mergedPathname);
    305         truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
     311        if (loadableFile == null) {
     312          truename = null;
     313        } else {
     314          truename = (Pathname)Symbol.PROBE_FILE.execute(loadableFile);
     315        }
    306316       
    307317        final String COMPILE_FILE_TYPE
  • trunk/abcl/src/org/armedbear/lisp/Pathname.java

    r15395 r15396  
    320320      Pathname result = new Pathname();
    321321        if (s == null) {
    322           return (Pathname)simple_error("Refusing to create a PATHNAME for the null reference.");
     322          return (Pathname)parse_error("Refusing to create a PATHNAME for the null reference.");
    323323        }
    324324        if (s.equals(".") || s.equals("./")
     
    347347            }
    348348            if (shareIndex == -1 || dirIndex == -1) {
    349               return Pathname_simple_error("Unsupported UNC path format: \"" + s + '"');
     349              return (Pathname)parse_error("Unsupported UNC path format: \"" + s + '"');
    350350            }
    351351
     
    582582        if (getDevice() == NIL) {
    583583        } else if (getDevice() == Keyword.UNSPECIFIC) {
    584         // } else if (isJar()) {
    585         //     LispObject[] jars = ((Cons) getDevice()).copyToArray();
    586         //     StringBuilder prefix = new StringBuilder();
    587         //     for (int i = 0; i < jars.length; i++) {
    588         //         prefix.append("jar:");
    589         //         LispObject component = jars[i];
    590         //         if (!(component instanceof Pathname)) {
    591         //           return null; // If DEVICE is a CONS, it should only contain Pathname
    592         //         }
    593         //         if (! ((Pathname)component).isURL() && i == 0) {
    594         //           sb.append("file:");
    595         //           uriEncoded = true;
    596         //         }
    597         //         Pathname jar = (Pathname) component;
    598         //         String encodedNamestring;
    599         //         if (uriEncoded) {
    600         //           encodedNamestring = uriEncode(jar.getNamestring());
    601         //         } else {
    602         //           encodedNamestring = jar.getNamestring();
    603         //         }
    604         //         sb.append(encodedNamestring);
    605         //         sb.append("!/");
    606         //     }
    607         //     sb = prefix.append(sb);
    608584        } else if (getDevice() instanceof AbstractString) {
    609585            sb.append(getDevice().getStringValue());
     
    613589            }
    614590        } else {
    615             Debug.assertTrue(false);
     591          simple_error("Transitional error in pathname: should be a JAR-PATHNAME", this);
    616592        }
    617593        String directoryNamestring = getDirectoryNamestring();
     
    664640            }
    665641        }
    666        
    667         // if (isURL()) {
    668         //     LispObject o = Symbol.GETF.execute(getHost(), QUERY, NIL);
    669         //     if (o != NIL) {
    670         //         sb.append("?");
    671         //         sb.append(o.getStringValue());
    672         //     }
    673         //     o = Symbol.GETF.execute(getHost(), FRAGMENT, NIL);
    674         //     if (o != NIL) {
    675         //         sb.append("#");
    676         //         sb.append(o.getStringValue());
    677         //     }
    678         // }
    679642           
    680643        if (this instanceof LogicalPathname) {
     
    13571320        p.setVersion(version);
    13581321        p.validateDirectory(true);
     1322
     1323        // TODO:  need to check for downcast to PathnameURL as well
     1324        // Possibly downcast type to PathnameJar
     1325        if (p.getDevice() instanceof Cons) {
     1326          PathnameJar result = new PathnameJar();
     1327          ncoerce(p, result);
     1328          // sanity check that the pathname has been constructed correctly
     1329          result.validateComponents();
     1330
     1331          return result;
     1332        }
    13591333       
    13601334        return p;
     
    17351709   
    17361710  public static final LispObject mergePathnames(final Pathname pathname,
    1737                                               final Pathname defaultPathname,
    1738                                               final LispObject defaultVersion) {
     1711                                                final Pathname defaultPathname,
     1712                                                final LispObject defaultVersion) {
    17391713    Pathname result;
    17401714    Pathname p = Pathname.create(pathname);
    17411715    Pathname d;
    17421716
    1743       if (pathname instanceof LogicalPathname) {
    1744         result = LogicalPathname.create();
    1745         d = Pathname.create(defaultPathname);
     1717    if (pathname instanceof LogicalPathname) {
     1718      result = LogicalPathname.create();
     1719      d = Pathname.create(defaultPathname);
     1720    } else {
     1721      if (pathname instanceof PathnameJar
     1722          // If the defaults contain a JAR-PATHNAME, and the pathname to
     1723          // be be merged is not a JAR-PATHNAME, does not have a specified
     1724          // DEVICE, a specified HOST, and doesn't contain a relative
     1725          // DIRECTORY, then the result will not be a JAR-PATHNAME
     1726          || (defaultPathname instanceof PathnameJar
     1727              && !(pathname instanceof PathnameJar)
     1728              && pathname.getDevice().equals(NIL)
     1729              && !(!pathname.getDirectory().equals(NIL)
     1730                   && pathname.getDirectory().car().equals(Keyword.ABSOLUTE)))) {
     1731        result = PathnameJar.create();
     1732      } else if (pathname instanceof PathnameURL) {
     1733        result = PathnameURL.create();
    17461734      } else {
    1747         if ((pathname instanceof PathnameJar)
    1748             || (defaultPathname instanceof PathnameJar)) {
    1749           result = PathnameJar.create();
     1735        result = Pathname.create();
     1736      }
     1737             
     1738      if (defaultPathname instanceof LogicalPathname) {
     1739        d = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname);
     1740      } else {
     1741        if (defaultPathname instanceof PathnameJar) {
     1742          d = PathnameJar.create(defaultPathname);
     1743        } else if (defaultPathname instanceof PathnameURL) {
     1744          d = PathnameURL.create(defaultPathname);
    17501745        } else {
    1751           result = Pathname.create();
    1752         }
    1753              
    1754         if (defaultPathname instanceof LogicalPathname) {
    1755           d = LogicalPathname.translateLogicalPathname((LogicalPathname) defaultPathname);
    1756         } else {
    1757           if (defaultPathname instanceof PathnameJar) {
    1758             d = PathnameJar.create(defaultPathname);
    1759           } else {
    1760             d = Pathname.create(defaultPathname);
    1761           }
    1762         }
    1763       }
     1746          d = Pathname.create(defaultPathname);
     1747        }
     1748      }
     1749    }
    17641750
    17651751      if (pathname.getHost() != NIL) {
     
    17721758        result.setDevice(p.getDevice());
    17731759      } else {
    1774         if (d instanceof PathnameJar) {
    1775           // If the defaults contain a JAR-PATHNAME, and the pathname
    1776           // to be be merged does not have a specified DEVICE, a
    1777           // specified HOST, and doesn't contain a relative DIRECTORY,
    1778           // then on non-MSDOG, set its device to :UNSPECIFIC.
     1760        // If the defaults contain a JAR-PATHNAME, and the pathname
     1761        // to be be merged is not a JAR-PATHNAME, does not have a
     1762        // specified DEVICE, a specified HOST, and doesn't contain a
     1763        // relative DIRECTORY, then on non-MSDOG, set its device to
     1764        // :UNSPECIFIC.
     1765        if ((d instanceof PathnameJar)
     1766            && (result instanceof Pathname)) {
    17791767          if (pathname.getHost() == NIL
    17801768              && pathname.getDevice() == NIL
     
    17901778            result.setDevice(d.getDevice());
    17911779          }
    1792         }
    1793       }
    1794 
    1795       // This part I no longer understand
     1780        } else {
     1781          result.setDevice(d.getDevice());
     1782        }
     1783      }
     1784
     1785      // Merge the directory of a relative JAR-PATHNAME with the
     1786      // default directory. 
    17961787      // if (pathname.isJar()) {
    1797       //   Cons jars = (Cons)result.getDevice();
     1788      //   Pathname root = ((PathnameJar)result).getRootJar();
     1789       
     1790
    17981791      //   LispObject jar = jars.car;
    17991792      //   if (jar instanceof Pathname) {
     
    18131806      //   result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
    18141807      // }
    1815       result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
     1808
     1809      if (pathname.isJar()) {
     1810        result.setDirectory(p.getDirectory());
     1811      } else {
     1812        result.setDirectory(mergeDirectories(p.getDirectory(), d.getDirectory()));
     1813      }
    18161814     
    18171815      if (pathname.getName() != NIL) {
     
    20082006  private static final class pf_get_input_stream extends Primitive {
    20092007    pf_get_input_stream() {
    2010       super("ensure-input-stream", PACKAGE_SYS, true);
     2008      super(Symbol.GET_INPUT_STREAM, "pathname");
    20112009    }
    20122010    @Override
  • trunk/abcl/src/org/armedbear/lisp/PathnameJar.java

    r15395 r15396  
    5858  protected PathnameJar() {}
    5959
     60  public static Pathname create() {
     61    return new PathnameJar();
     62  }
     63
    6064  public static PathnameJar create(PathnameJar p) {
    6165    return (PathnameJar)PathnameJar.create(p.getNamestring());
     
    197201  }
    198202
    199   static public Pathname create() {
    200     return new PathnameJar();
    201   }
    202203  static public LispObject create(String s) {
    203204    if (!s.startsWith(JAR_URI_PREFIX)) {
     
    238239    jars = jars.nreverse();
    239240    result.setDevice(jars);
     241    result.validateComponents();
    240242    return result;
    241243  }
     244
     245  public LispObject validateComponents() {
     246    if (!(getDevice() instanceof Cons)) {
     247      return type_error("Invalid DEVICE for JAR-PATHNAME", getDevice(), Symbol.CONS);
     248    }
     249
     250    LispObject jars = getDevice();
     251    while (!jars.car().equals(NIL)) {
     252      LispObject jar = jars.car();
     253      if (!((jar instanceof Pathname)
     254            || (jar instanceof PathnameURL))) {
     255        return type_error("The value in DEVICE component of a JAR-PATHNAME is not of expected type",
     256                          jar,
     257                          list(Symbol.OR,
     258                               Symbol.PATHNAME, Symbol.URL_PATHNAME));
     259      }
     260      jars = jars.cdr();
     261    }
     262
     263    return T;
     264  }
     265   
    242266
    243267  public String getNamestring() {
     
    246270    LispObject jars = getDevice();
    247271
    248     if (jars.equals(NIL)) { // DESCRIBE ends up here somehow
    249       // attempt to return some sort of representation
    250       return super.getNamestring();
     272    if (jars.equals(NIL) || jars.equals(Keyword.UNSPECIFIC)) {
     273        System.out.println("Pathname transitional problem: JAR-PATHNAME has bad PATHNAME-DEVICE");
     274        return null;
    251275    }
    252276
     
    306330
    307331  LispObject getRootJar() {
    308     return getDevice().car();
     332    LispObject jars = getJars();
     333    if (!(jars instanceof Cons)) {
     334      System.out.println("Transitional pathname error: PATHNAME-DEVICE is not a Cons cell");
     335      return NIL;
     336    }
     337     
     338    return jars.car();
    309339  }
    310340
     
    324354      // FIXME implement me
    325355      simple_error("Unimplemented TRUENAME for non-file root jar.");
    326     } else {
    327       rootJar = (Pathname)Symbol.MERGE_PATHNAMES.execute(rootJar);
    328     }
    329 
    330     rootJar = (Pathname)Symbol.TRUENAME.execute(rootJar);
     356    }
    331357
    332358    PathnameJar p = new PathnameJar();
  • trunk/abcl/src/org/armedbear/lisp/PathnameURL.java

    r15395 r15396  
    5454  protected PathnameURL() {}
    5555
     56  public static Pathname create() {
     57    return new PathnameURL();
     58  }
     59
    5660  public static PathnameURL create(PathnameURL p) {
    5761    return (PathnameURL) PathnameURL.create(p.getNamestring());
     
    6872  public static LispObject create(String s) {
    6973    if (!isValidURL(s)) {
    70       error(new SimpleError("Cannot form a PATHNAME-URL from " + s));
     74      parse_error("Cannot form a PATHNAME-URL from " + s);
    7175    }
    7276    if (s.startsWith("jar:")) {
     
    7983      url = new URL(s);
    8084    } catch (MalformedURLException e) {
    81       Debug.assertTrue(false);
     85      return parse_error("Malformed URL in namestring '" + s + "': " + e.toString());
    8286    }
    8387    String scheme = url.getProtocol();
     
    8791        uri = new URI(s);
    8892      } catch (URISyntaxException ex) {
    89         error(new SimpleError("Improper URI syntax for "
    90                               + "'" + url.toString() + "'"
    91                               + ": " + ex.toString()));
     93        return parse_error("Improper URI syntax for "
     94                           + "'" + url.toString() + "'"
     95                           + ": " + ex.toString());
    9296      }
    9397           
     
    98102        uriPath = uri.getSchemeSpecificPart();
    99103        if (uriPath == null || uriPath.equals("")) {
    100           error(new LispError("The URI has no path: " + uri));
     104          return parse_error("The namestring URI has no path: " + uri);
    101105        }
    102106      }
     
    120124      uri = url.toURI().normalize();
    121125    } catch (URISyntaxException e) {
    122       error(new LispError("Couldn't form URI from "
    123                           + "'" + url + "'"
    124                           + " because: " + e));
     126      return parse_error("Couldn't form URI from "
     127                         + "'" + url + "'"
     128                         + " because: " + e);
    125129    }
    126130    String authority = uri.getAuthority();
  • trunk/abcl/src/org/armedbear/lisp/Symbol.java

    r15395 r15396  
    30933093  public static final Symbol _ENABLE_AUTOCOMPILE_ =
    30943094    PACKAGE_SYS.addExternalSymbol("*ENABLE-AUTOCOMPILE*");
    3095   public static final Symbol ENSURE_INPUT_STREAM =
    3096     PACKAGE_SYS.addExternalSymbol("ENSURE-INPUT-STREAM");
     3095  public static final Symbol GET_INPUT_STREAM =
     3096    PACKAGE_SYS.addExternalSymbol("GET-INPUT-STREAM");
    30973097  public static final Symbol ENVIRONMENT =
    30983098    PACKAGE_SYS.addExternalSymbol("ENVIRONMENT");
  • trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp

    r15341 r15396  
    5757   ;; it would minimally need to check version information.
    5858   (ignore-errors
    59      #p"https://abcl.org/releases/1.7.1/abcl.jar")))
     59     #p"jar:file:https://abcl.org/releases/1.7.1/abcl.jar!/")))
    6060
    6161(defun flatten (list)
     
    115115      (let ((jar (some predicate entries)))
    116116  (when jar
    117     (return-from find-jar jar))))))
     117    (return-from find-jar
     118            (make-pathname :device (list jar))))))))
    118119
    119120(defun find-system-jar ()
  • trunk/abcl/src/org/armedbear/lisp/java.lisp

    r15116 r15396  
    583583(defun jinput-stream (pathname)
    584584  "Returns a java.io.InputStream for resource denoted by PATHNAME."
    585   (sys:ensure-input-stream pathname))
     585  (sys:get-input-stream pathname))
    586586
    587587(provide "JAVA")
  • trunk/abcl/src/org/armedbear/lisp/open.lisp

    r14902 r15396  
    122122      (error 'file-error
    123123       :pathname pathname
    124        :format-control "Bad place for a wild pathname."))
     124       :format-control "Cannot OPEN a wild pathname."))
    125125    (when (memq direction '(:output :io))
    126126      (unless if-exists-given
Note: See TracChangeset for help on using the changeset viewer.