[Armedbear-cvs] r14718 - trunk/abcl/contrib/jss

[mevenson at common-lisp.net]

Author: mevenson
Date: Sun Aug 17 18:04:52 2014
New Revision: 14718

Log:
Extend JSS fix for GET-JAVA-FIELD to SET-JAVA-FIELD.

Thanks to Robert Goldman.

<http://abcl.org/trac/ticket/362>

Modified:
   trunk/abcl/contrib/jss/invoke.lisp

Modified: trunk/abcl/contrib/jss/invoke.lisp
==============================================================================
--- trunk/abcl/contrib/jss/invoke.lisp	Sun Aug 17 17:55:43 2014	(r14717)
+++ trunk/abcl/contrib/jss/invoke.lisp	Sun Aug 17 18:04:52 2014	(r14718)
@@ -314,6 +314,18 @@
 
 (defvar *running-in-osgi* (ignore-errors (jclass "org.osgi.framework.BundleActivator")))
 
+(define-condition no-such-java-field (error)
+  ((field-name
+    :initarg :field-name
+    :reader field-name
+    )
+   (object
+    :initarg :object
+    :reader object
+    ))
+  (:report (lambda (c stream)
+             (error 'no-such-java-field :field-name field :object object))))
+
 (defun get-java-field (object field &optional (try-harder *running-in-osgi*))
   "Get the value of the FIELD contained in OBJECT.
 If OBJECT is a symbol it names a dot qualified static FIELD."
@@ -367,7 +379,8 @@
 			(jobject-class object))))
 	     (jfield (if (java-object-p field)
 			 field
-		       (find field (#"getDeclaredFields" class) :key 'jfield-name :test 'equal))))
+                        (or (find-declared-field field class)
++                            (error 'no-such-java-field :field-name field :object object)))))
 	(#"setAccessible" jfield +true+)
 	(values (#"set" jfield object value) jfield))
     (if (symbolp object)
@@ -377,6 +390,9 @@
             (setf (jfield (jclass-of object) field) value)
             (setf (jfield object field) value)))))
 
+(defun (setf get-java-field) (value object field &optional (try-harder *running-in-osgi*))
+  (set-java-field object field value try-harder))
+
 
 (defconstant +for-name+ 
   (jmethod "java.lang.Class" "forName" "java.lang.String" "boolean" "java.lang.ClassLoader"))