Changeset 12486


Ignore:
Timestamp:
02/20/10 11:27:07 (12 years ago)
Author:
Mark Evenson
Message:

Fix a couple of bugs in PATHNAME; reindent primitives.

Restablish (pathname-name #p"...") => "..." behavior which was broken
with [svn r12485]. Fixes ABCL.TEST.LISP::LOTS-OF-DOTS.[12].

MERGE-PATHNAMES fixed for jar-file pathnames referencing a hierarchial
jar entry. JAR-FILE.MERGE-PATHNAMES.5 now tests for this case.

Stack-friendly primitives normalized (reluctantly) to the
Hungarian-style notation ("pf_function") introduced by Ville.

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r12485 r12486  
    365365            directory = parseDirectory(d);
    366366        }
    367         if (s.startsWith(".") && s.indexOf(".", 1) == -1) {
     367        if (s.startsWith(".")
     368            // No TYPE can be parsed
     369            && (s.indexOf(".", 1) == -1
     370                || s.substring(s.length() -1).equals("."))) {
    368371            name = new SimpleString(s);
    369372            return;
    … …  
    859862    }
    860863    // ### %pathname-host
    861     private static final Primitive _PATHNAME_HOST = new _pathname_host();
    862     private static class _pathname_host extends Primitive {
    863         _pathname_host() {
     864    private static final Primitive _PATHNAME_HOST = new pf_pathname_host();
     865    private static class pf_pathname_host extends Primitive {
     866        pf_pathname_host() {
    864867            super("%pathname-host", PACKAGE_SYS, false);
    865868        }
    … …  
    871874    }
    872875    // ### %pathname-device
    873     private static final Primitive _PATHNAME_DEVICE = new _pathname_device();
    874     private static class _pathname_device extends Primitive {
    875         _pathname_device() {
     876    private static final Primitive _PATHNAME_DEVICE = new pf_pathname_device();
     877    private static class pf_pathname_device extends Primitive {
     878        pf_pathname_device() {
    876879            super("%pathname-device", PACKAGE_SYS, false);
    877880        }
    … …  
    883886    }
    884887    // ### %pathname-directory
    885     private static final Primitive _PATHNAME_DIRECTORY = new _pathname_directory();
    886     private static class _pathname_directory extends Primitive {
    887         _pathname_directory() {
     888    private static final Primitive _PATHNAME_DIRECTORY = new pf_pathname_directory();
     889    private static class pf_pathname_directory extends Primitive {
     890        pf_pathname_directory() {
    888891            super("%pathname-directory", PACKAGE_SYS, false);
    889892        }
    … …  
    895898    }
    896899    // ### %pathname-name
    897     private static final Primitive _PATHNAME_NAME = new _pathname_name();
    898     private static class  _pathname_name extends Primitive {
    899         _pathname_name() {
     900    private static final Primitive _PATHNAME_NAME = new pf_pathname_name();
     901    private static class  pf_pathname_name extends Primitive {
     902        pf_pathname_name() {
    900903            super ("%pathname-name", PACKAGE_SYS, false);
    901904        }
    … …  
    907910    }
    908911    // ### %pathname-type
    909     private static final Primitive _PATHNAME_TYPE = new _pathname_type();
    910     private static class _pathname_type extends Primitive {
    911         _pathname_type() {
     912    private static final Primitive _PATHNAME_TYPE = new pf_pathname_type();
     913    private static class pf_pathname_type extends Primitive {
     914        pf_pathname_type() {
    912915            super("%pathname-type", PACKAGE_SYS, false);
    913916        }
    … …  
    919922    }
    920923    // ### pathname-version
    921     private static final Primitive PATHNAME_VERSION = new pathname_version();
    922     private static class pathname_version extends Primitive {
    923         pathname_version() {
     924    private static final Primitive PATHNAME_VERSION = new pf_pathname_version();
     925    private static class pf_pathname_version extends Primitive {
     926        pf_pathname_version() {
    924927            super("pathname-version", "pathname");
    925928        }
    … …  
    931934    // ### namestring
    932935    // namestring pathname => namestring
    933     private static final Primitive NAMESTRING = new namestring();
    934     private static class namestring extends Primitive {
    935         namestring() {
     936    private static final Primitive NAMESTRING = new pf_namestring();
     937    private static class pf_namestring extends Primitive {
     938        pf_namestring() {
    936939            super("namestring", "pathname");
    937940        }
    … …  
    949952    // ### directory-namestring
    950953    // directory-namestring pathname => namestring
    951     private static final Primitive DIRECTORY_NAMESTRING = new directory_namestring();
    952     private static class directory_namestring extends Primitive {
    953         directory_namestring() {
     954    private static final Primitive DIRECTORY_NAMESTRING = new pf_directory_namestring();
     955    private static class pf_directory_namestring extends Primitive {
     956        pf_directory_namestring() {
    954957            super("directory-namestring", "pathname");
    955958        }
    … …  
    960963    }
    961964    // ### pathname pathspec => pathname
    962     private static final Primitive PATHNAME = new pathname();
    963     private static class pathname extends Primitive {
    964         pathname() {
     965    private static final Primitive PATHNAME = new pf_pathname();
     966    private static class pf_pathname extends Primitive {
     967        pf_pathname() {
    965968            super("pathname", "pathspec");
    966969        }
    … …  
    971974    }
    972975    // ### %parse-namestring string host default-pathname => pathname, position
    973     private static final Primitive _PARSE_NAMESTRING = new _parse_namestring();
    974     private static class _parse_namestring extends Primitive {
    975         _parse_namestring() {
     976    private static final Primitive _PARSE_NAMESTRING = new pf_parse_namestring();
     977    private static class pf_parse_namestring extends Primitive {
     978        pf_parse_namestring() {
    976979            super("%parse-namestring", PACKAGE_SYS, false,
    977980                  "namestring host default-pathname");
    … …  
    10031006    }
    10041007    // ### make-pathname
    1005     private static final Primitive MAKE_PATHNAME = new make_pathname();
    1006     private static class make_pathname extends Primitive {
    1007         make_pathname() {
     1008    private static final Primitive MAKE_PATHNAME = new pf_make_pathname();
     1009    private static class pf_make_pathname extends Primitive {
     1010        pf_make_pathname() {
    10081011            super("make-pathname",
    10091012                  "&key host device directory name type version defaults case");
    … …  
    12001203    }
    12011204    // ### pathnamep
    1202     private static final Primitive PATHNAMEP = new pathnamep();
    1203     private static class pathnamep extends Primitive  {
    1204         pathnamep() {
     1205    private static final Primitive PATHNAMEP = new pf_pathnamep();
     1206    private static class pf_pathnamep extends Primitive  {
     1207        pf_pathnamep() {
    12051208            super("pathnamep", "object");
    12061209        }
    … …  
    12111214    }
    12121215    // ### logical-pathname-p
    1213     private static final Primitive LOGICAL_PATHNAME_P = new logical_pathname_p();
    1214     private static class logical_pathname_p extends Primitive {
    1215         logical_pathname_p() {
     1216    private static final Primitive LOGICAL_PATHNAME_P = new pf_logical_pathname_p();
     1217    private static class pf_logical_pathname_p extends Primitive {
     1218        pf_logical_pathname_p() {
    12161219            super("logical-pathname-p", PACKAGE_SYS, true, "object");
    12171220        }
    … …  
    12221225    }
    12231226    // ### user-homedir-pathname &optional host => pathname
    1224     private static final Primitive USER_HOMEDIR_PATHNAME = new user_homedir_pathname();
    1225     private static class user_homedir_pathname extends Primitive {
    1226         user_homedir_pathname() {
     1227    private static final Primitive USER_HOMEDIR_PATHNAME = new pf_user_homedir_pathname();
     1228    private static class pf_user_homedir_pathname extends Primitive {
     1229        pf_user_homedir_pathname() {
    12271230            super("user-homedir-pathname", "&optional host");
    12281231        }
    … …  
    12451248    }
    12461249    // ### list-directory directory
    1247     private static final Primitive LIST_DIRECTORY = new list_directory();
    1248     private static class list_directory extends Primitive {
    1249         list_directory() {
     1250    private static final Primitive LIST_DIRECTORY = new pf_list_directory();
     1251    private static class pf_list_directory extends Primitive {
     1252        pf_list_directory() {
    12501253            super("list-directory", PACKAGE_SYS, true, "directory");
    12511254        }
    … …  
    13021305
    13031306    // ### PATHNAME-JAR-P
    1304     private static final Primitive PATHNAME_JAR_P = new pathname_jar_p();
    1305     private static class pathname_jar_p extends Primitive {
    1306         pathname_jar_p() {
     1307    private static final Primitive PATHNAME_JAR_P = new pf_pathname_jar_p();
     1308    private static class pf_pathname_jar_p extends Primitive {
     1309        pf_pathname_jar_p() {
    13071310            super("pathname-jar-p", PACKAGE_SYS, true, "pathname",
    13081311                  "Predicate for whether PATHNAME references a JAR.");
    … …  
    13491352    }
    13501353    // ### %wild-pathname-p
    1351     private static final Primitive _WILD_PATHNAME_P =
    1352       new Primitive("%wild-pathname-p", PACKAGE_SYS, true) {
    1353 
    1354           @Override
    1355           public LispObject execute(LispObject first, LispObject second) {
    1356               Pathname pathname = coerceToPathname(first);
    1357               if (second == NIL) {
    1358                   return pathname.isWild() ? T : NIL;
    1359               }
    1360               if (second == Keyword.DIRECTORY) {
    1361                   if (pathname.directory instanceof Cons) {
    1362                       if (memq(Keyword.WILD, pathname.directory)) {
    1363                           return T;
    1364                       }
    1365                       if (memq(Keyword.WILD_INFERIORS, pathname.directory)) {
    1366                           return T;
    1367                       }
    1368                   }
    1369                   return NIL;
    1370               }
    1371               LispObject value;
    1372               if (second == Keyword.HOST) {
    1373                   value = pathname.host;
    1374               } else if (second == Keyword.DEVICE) {
    1375                   value = pathname.device;
    1376               } else if (second == Keyword.NAME) {
    1377                   value = pathname.name;
    1378               } else if (second == Keyword.TYPE) {
    1379                   value = pathname.type;
    1380               } else if (second == Keyword.VERSION) {
    1381                   value = pathname.version;
    1382               } else {
    1383                   return error(new ProgramError("Unrecognized keyword "
    1384                     + second.writeToString() + "."));
    1385               }
    1386               if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS) {
    1387                   return T;
    1388               } else {
    1389                   return NIL;
    1390               }
    1391           }
    1392       };
    1393     // ### merge-pathnames
    1394     private static final Primitive MERGE_PATHNAMES =
    1395       new Primitive("merge-pathnames",
    1396       "pathname &optional default-pathname default-version") {
    1397 
    1398           @Override
    1399           public LispObject execute(LispObject arg) {
    1400               Pathname pathname = coerceToPathname(arg);
    1401               Pathname defaultPathname =
     1354    private static final Primitive _WILD_PATHNAME_P = new pf_wild_pathname_p();
     1355    static final class pf_wild_pathname_p extends Primitive {
     1356        pf_wild_pathname_p() {
     1357            super("%wild-pathname-p", PACKAGE_SYS, true);
     1358        }
     1359        @Override
     1360        public LispObject execute(LispObject first, LispObject second) {
     1361            Pathname pathname = coerceToPathname(first);
     1362            if (second == NIL) {
     1363                return pathname.isWild() ? T : NIL;
     1364            }
     1365            if (second == Keyword.DIRECTORY) {
     1366                if (pathname.directory instanceof Cons) {
     1367                    if (memq(Keyword.WILD, pathname.directory)) {
     1368                        return T;
     1369                    }
     1370                    if (memq(Keyword.WILD_INFERIORS, pathname.directory)) {
     1371                        return T;
     1372                    }
     1373                }
     1374                return NIL;
     1375            }
     1376            LispObject value;
     1377            if (second == Keyword.HOST) {
     1378                value = pathname.host;
     1379            } else if (second == Keyword.DEVICE) {
     1380                value = pathname.device;
     1381            } else if (second == Keyword.NAME) {
     1382                value = pathname.name;
     1383            } else if (second == Keyword.TYPE) {
     1384                value = pathname.type;
     1385            } else if (second == Keyword.VERSION) {
     1386                value = pathname.version;
     1387            } else {
     1388                return error(new ProgramError("Unrecognized keyword "
     1389                                              + second.writeToString() + "."));
     1390            }
     1391            if (value == Keyword.WILD || value == Keyword.WILD_INFERIORS) {
     1392                return T;
     1393            } else {
     1394                return NIL;
     1395            }
     1396        }
     1397    }
     1398
     1399    // ### merge-pathnames pathname &optional default-pathname default-version"
     1400    private static final Primitive MERGE_PATHNAMES = new pf_merge_pathnames();
     1401    static final class pf_merge_pathnames extends Primitive {
     1402        pf_merge_pathnames() {
     1403            super("merge-pathnames", "pathname &optional default-pathname default-version");
     1404        }
     1405        @Override
     1406        public LispObject execute(LispObject arg) {
     1407            Pathname pathname = coerceToPathname(arg);
     1408            Pathname defaultPathname =
    14021409                coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue());
    1403               LispObject defaultVersion = Keyword.NEWEST;
    1404               return mergePathnames(pathname, defaultPathname, defaultVersion);
    1405           }
    1406 
    1407           @Override
    1408           public LispObject execute(LispObject first, LispObject second) {
    1409               Pathname pathname = coerceToPathname(first);
    1410               Pathname defaultPathname =
     1410            LispObject defaultVersion = Keyword.NEWEST;
     1411            return mergePathnames(pathname, defaultPathname, defaultVersion);
     1412        }
     1413        @Override
     1414        public LispObject execute(LispObject first, LispObject second) {
     1415            Pathname pathname = coerceToPathname(first);
     1416            Pathname defaultPathname =
    14111417                coerceToPathname(second);
    1412               LispObject defaultVersion = Keyword.NEWEST;
    1413               return mergePathnames(pathname, defaultPathname, defaultVersion);
    1414           }
    1415 
    1416           @Override
    1417           public LispObject execute(LispObject first, LispObject second,
    1418             LispObject third) {
    1419               Pathname pathname = coerceToPathname(first);
    1420               Pathname defaultPathname =
     1418            LispObject defaultVersion = Keyword.NEWEST;
     1419            return mergePathnames(pathname, defaultPathname, defaultVersion);
     1420        }
     1421        @Override
     1422        public LispObject execute(LispObject first, LispObject second,
     1423                                  LispObject third) {
     1424            Pathname pathname = coerceToPathname(first);
     1425            Pathname defaultPathname =
    14211426                coerceToPathname(second);
    1422               LispObject defaultVersion = third;
    1423               return mergePathnames(pathname, defaultPathname, defaultVersion);
    1424           }
    1425       };
     1427            LispObject defaultVersion = third;
     1428            return mergePathnames(pathname, defaultPathname, defaultVersion);
     1429        }
     1430    }
    14261431
    14271432    public static final Pathname mergePathnames(Pathname pathname, Pathname defaultPathname) {
    … …  
    14751480                ((Cons)result.device).car = o;
    14761481            }
     1482            result.directory = p.directory;
    14771483        } else {
    14781484            result.directory = mergeDirectories(p.directory, d.directory);
    … …  
    18501856
    18511857    // ### mkdir pathname
    1852     private static final Primitive MKDIR = new mkdir();
    1853     private static class mkdir extends Primitive {
    1854         mkdir() {
     1858    private static final Primitive MKDIR = new pf_mkdir();
     1859    private static class pf_mkdir extends Primitive {
     1860        pf_mkdir() {
    18551861            super("mkdir", PACKAGE_SYS, false, "pathname");
    18561862        }
    … …  
    18721878
    18731879    // ### rename-file filespec new-name => defaulted-new-name, old-truename, new-truename
    1874     private static final Primitive RENAME_FILE = new rename_file();
    1875     private static class rename_file extends Primitive {
    1876         rename_file() {
     1880    private static final Primitive RENAME_FILE = new pf_rename_file();
     1881    private static class pf_rename_file extends Primitive {
     1882        pf_rename_file() {
    18771883            super("rename-file", "filespec new-name");
    18781884        }
    … …  
    19141920
    19151921    // ### file-namestring pathname => namestring
    1916     private static final Primitive FILE_NAMESTRING = new file_namestring();
    1917     private static class file_namestring extends Primitive {
    1918         file_namestring() {
     1922    private static final Primitive FILE_NAMESTRING = new pf_file_namestring();
     1923    private static class pf_file_namestring extends Primitive {
     1924        pf_file_namestring() {
    19191925            super("file-namestring", "pathname");
    19201926        }
    … …  
    19411947
    19421948    // ### host-namestring pathname => namestring
    1943     private static final Primitive HOST_NAMESTRING = new host_namestring();
    1944     private static class host_namestring extends Primitive {
    1945         host_namestring() {
     1949    private static final Primitive HOST_NAMESTRING = new pf_host_namestring();
     1950    private static class pf_host_namestring extends Primitive {
     1951        pf_host_namestring() {
    19461952            super("host-namestring", "pathname");
    19471953        }

  • trunk/abcl/test/lisp/abcl/jar-file.lisp

    r12424 r12486  
    222222  #p"jar:file:/a/b/baz.jar!/foo")
    223223
     224(deftest jar-file.merge-pathnames.5
     225    (merge-pathnames "jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
     226  #p"jar:file:/a/b/c/foo.jar!/bar/baz.lisp")
     227
    224228(deftest jar-file.truename.1
    225229    (signals-error (truename "jar:file:baz.jar!/foo")
    226230                   'file-error)
    227231  t)
    228 
    229232
    230233(deftest jar-file.pathname.1
Note: See TracChangeset for help on using the changeset viewer.