[armedbear-cvs] r13294 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl

mevenson at common-lisp.net mevenson at common-lisp.net
Sat Jun 4 20:26:29 UTC 2011


Author: mevenson
Date: Tue May 24 05:25:55 2011
New Revision: 13294

Log:
Fix #150: MAKE-PATHNAME ignores version in :DEFAULTS.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Pathname.java
   trunk/abcl/test/lisp/abcl/pathname-tests.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Pathname.java	Tue May 24 05:25:39 2011	(r13293)
+++ trunk/abcl/src/org/armedbear/lisp/Pathname.java	Tue May 24 05:25:55 2011	(r13294)
@@ -1254,6 +1254,7 @@
         boolean nameSupplied = false;
         boolean typeSupplied = false;
         boolean directorySupplied = false;
+        boolean versionSupplied = false;
         for (int i = 0; i < args.length; i += 2) {
             LispObject key = args[i];
             LispObject value = args[i + 1];
@@ -1290,6 +1291,7 @@
                 typeSupplied = true;
             } else if (key == Keyword.VERSION) {
                 version = value;
+                versionSupplied = true;
             } else if (key == Keyword.DEFAULTS) {
                 defaults = coerceToPathname(value);
             } else if (key == Keyword.CASE) {
@@ -1312,6 +1314,9 @@
             if (!typeSupplied) {
                 type = defaults.type;
             }
+            if (!versionSupplied) {
+                version = defaults.version;
+            }
         }
         final Pathname p;
         final boolean logical;
@@ -1385,6 +1390,7 @@
                 p.type = type;
             }
         }
+        
         p.version = version;
         return p;
     }

Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/pathname-tests.lisp	Tue May 24 05:25:39 2011	(r13293)
+++ trunk/abcl/test/lisp/abcl/pathname-tests.lisp	Tue May 24 05:25:55 2011	(r13294)
@@ -1717,3 +1717,11 @@
 (deftest pathname.make-pathname.1
     (make-pathname :directory nil :defaults "/home/fare/")
   #p"")
+
+(deftest pathname.make-pathname.2
+    (let ((p (make-pathname 
+              :defaults (make-pathname :name :wild :type :wild :version :wild :directory :wild))))
+      (values 
+       (pathname-name p) (pathname-type p) (pathname-version p) (pathname-directory p)))
+  :wild :wild :wild (:absolute :wild))
+      
\ No newline at end of file




More information about the armedbear-cvs mailing list