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

[Mark Evenson]

Author: mevenson
Date: Tue Mar 23 08:59:08 2010
New Revision: 12570

Log:
Fix JAVA-OBJECT whose tynot being properly coerced to array of primitive types.

Fix proposed by Douglas Miles.

An array of primitive types which were first stuffed into a
type-erasing Java collection and then retrieved could not be used as
the original type.

Updated JAVA-OBJECT's getParts() protocol to return information about
what type the wrapped object thinks it should be.

Added test BUGS.JAVA.1 to test that this has been fixed.



Modified:
   trunk/abcl/src/org/armedbear/lisp/JavaObject.java
   trunk/abcl/test/lisp/abcl/bugs.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/JavaObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/JavaObject.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/JavaObject.java	Tue Mar 23 08:59:08 2010
@@ -35,11 +35,14 @@
 
 import static org.armedbear.lisp.Lisp.*;
 
-import java.lang.reflect.*;
-
+import java.lang.reflect.Array;
+import java.lang.reflect.Field;
 import java.math.BigInteger;
-
-import java.util.*;
+import java.util.ArrayList;
+import java.util.Collection;
+import java.util.HashSet;
+import java.util.LinkedList;
+import java.util.Set;
 
 public final class JavaObject extends LispObject {
     final Object obj;
@@ -242,7 +245,16 @@
 	    return obj;
 	} else {
 	    c = Java.maybeBoxClass(c);
-	    if(c.isAssignableFrom(intendedClass)) {
+	    if (c.isAssignableFrom(intendedClass) || c.isInstance(obj)) {
+              // XXX In the case that c.isInstance(obj) should we then
+              // "fix" the intendedClass field with the (presumably)
+              // narrower type of 'obj'?
+
+              // ME 20100323: I decided not to because a) we don't
+              // know the "proper" class to narrow to (i.e. maybe
+              // there's something "narrower" and b) I'm not sure how
+              // primitive types relate to their boxed
+              // representations.  
 		return obj;
 	    } else {
 		return error(new TypeError(intendedClass.getName() + " is not assignable to " + c.getName()));
@@ -328,20 +340,22 @@
     public LispObject getParts() {
 	if(obj != null) {
 	    LispObject parts = NIL;
-	    if(obj.getClass().isArray()) {
-		SimpleString empty = new SimpleString("");
+            parts = parts.push(new Cons("Java class",
+                                        new JavaObject(obj.getClass())));
+            if (intendedClass != null) {
+                parts = parts.push(new Cons("intendedClass", new SimpleString(intendedClass.getCanonicalName())));
+            }
+	    if (obj.getClass().isArray()) {
 		int length = Array.getLength(obj);
-		for(int i = 0; i < length; i++) {
-		    parts = parts.push
-			(new Cons(empty, JavaObject.getInstance(Array.get(obj, i))));
+		for (int i = 0; i < length; i++) {
+		    parts = parts
+                        .push(new Cons(new SimpleString(i), 
+                                       JavaObject.getInstance(Array.get(obj, i))));
 		}
-		parts = parts.nreverse();
 	    } else {
-		parts = parts.push(new Cons("Java class",
-					    new JavaObject(obj.getClass())));
 		parts = Symbol.NCONC.execute(parts, getInspectedFields());
 	    }
-	    return parts;
+	    return parts.nreverse();
 	} else {
 	    return NIL;
 	}

Modified: trunk/abcl/test/lisp/abcl/bugs.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/bugs.lisp	(original)
+++ trunk/abcl/test/lisp/abcl/bugs.lisp	Tue Mar 23 08:59:08 2010
@@ -39,3 +39,36 @@
   #p"/usr/lisp/abcl/native/test/foo.fasl")
 
       
+(deftest bugs.pathname.1
+    (namestring (make-pathname :directory '(:relative) :name "file" 
+                   :type :unspecific 
+                   :host nil :device nil))
+  "./file")
+
+(deftest bugs.pathname.2
+    (TRANSLATE-PATHNAME 
+     #P"/Users/evenson/work/bordeaux-threads/src/bordeaux-threads.abcl" 
+     #P"/**/**/*.*" 
+     #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/**/*.*")
+  #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/bordeaux-threads.abcl")
+
+(deftest bugs.pathname.3  
+    (namestring (MAKE-PATHNAME :HOST NIL :DEVICE NIL 
+                               :DIRECTORY '(:RELATIVE :WILD-INFERIORS) 
+                               :DEFAULTS "/**/"))
+  "**/")
+
+(deftest bugs.java.1
+    (let* ((a (java:jnew-array "byte" 1))
+           (b (let ((array-list (java:jnew (java:jconstructor
+                                       "java.util.ArrayList"))))
+                (java:jcall (java:jmethod "java.util.AbstractList" "add"
+                                          "java.lang.Object")
+                            array-list a)
+                (java:jcall (java:jmethod "java.util.AbstractList" "get" "int")
+                            array-list 0))))
+      (type-of (sys::%make-byte-array-input-stream b)))
+  stream)
+                
+                    
+                    
\ No newline at end of file