[Armedbear-cvs] r14721 - in trunk/abcl: . src/org/armedbear/lisp test/lisp/abcl

[mevenson at common-lisp.net]

Author: mevenson
Date: Sun Aug 17 19:38:08 2014
New Revision: 14721

Log:
Intermediary JNEW-RUNTIME-CLASS work: start adding failing tests.

Run the failing tests via

CL-USER> (asdf:load-system :abcl) (asdf:test-system :abcl-test-lisp)

c.f. <http://abcl.org/trac/ticket/330> and  <http://abcl.org/trac/ticket/346>.

Start editing documentation for JNEW-RUNTIME-CLASS.

Add failing tests for cases that should work, indicating that we have
basic problems with the code at this point.

Added:
   trunk/abcl/test/lisp/abcl/runtime-class.lisp
Modified:
   trunk/abcl/abcl.asd
   trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	Sun Aug 17 19:32:05 2014	(r14720)
+++ trunk/abcl/abcl.asd	Sun Aug 17 19:38:08 2014	(r14721)
@@ -65,6 +65,8 @@
                       (:file "pathname-tests" :depends-on 
                              ("utilities"))
                       #+abcl
+                      (:file "runtime-class")
+                      #+abcl
                       (:file "package-local-nicknames-tests")))))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'abcl-test-lisp))))

Modified: trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp	Sun Aug 17 19:32:05 2014	(r14720)
+++ trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp	Sun Aug 17 19:38:08 2014	(r14721)
@@ -28,10 +28,20 @@
    be called with the second and first arguments.
 
    Method definitions are lists of the form
-   (method-name return-type argument-types function &key modifiers annotations)
-   where method-name is a string, return-type and argument-types are strings or keywords for
-   primitive types (:void, :int, etc.), and function is a Lisp function of minimum arity
-   (1+ (length argument-types)); the instance (`this') is passed in as the first argument.
+
+     (METHOD-NAME RETURN-TYPE ARGUMENT-TYPES FUNCTION &key MODIFIERS ANNOTATIONS)
+
+   where 
+      METHOD-NAME is a string 
+      RETURN-TYPE denotes the type of the object returned by the method
+      ARGUMENT-TYPES is a list of parameters to the method
+      
+        The types are either strings naming fully qualified java classes or Lisp keywords referring to 
+        primitive types (:void, :int, etc.).
+
+     FUNCTION is a Lisp function of minimum arity (1+ (length
+     argument-types)). The instance (`this') is passed as the first
+     argument.
 
    Field definitions are lists of the form (field-name type &key modifiers annotations)."
   (declare (ignorable superclass interfaces constructors methods fields access-flags annotations))
@@ -73,8 +83,10 @@
     (write-class-file class-file stream)
     (finish-output stream)
     #+test-record-generated-class-file
-    (with-open-file (f (format nil "~A.class" class-name) :direction :output :element-type '(signed-byte 8))
-      (write-sequence (java::list-from-jarray (sys::%get-output-stream-bytes stream)) f))
+    (let ((filename (merge-pathnames (format nil "~A.class" class-name))))
+      (with-open-file (f filename :direction :output :element-type '(signed-byte 8))
+        (write-sequence (java::list-from-jarray (sys::%get-output-stream-bytes stream)) f))
+      (format *standard-output* "~&Wrote class file ~A.~%" filename))
     (values class-file method-implementation-fields)))
 
 (defun java::make-accessor-name (prefix name)

Added: trunk/abcl/test/lisp/abcl/runtime-class.lisp
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/abcl/test/lisp/abcl/runtime-class.lisp	Sun Aug 17 19:38:08 2014	(r14721)
@@ -0,0 +1,70 @@
+(in-package :abcl.test.lisp)
+
+
+;; method with no arguments
+(deftest runtime-class.1
+    (java:jnew-runtime-class 
+     "Actor"
+     :fields `(("name" "java.lang.String"))
+     :methods `(("getName" "java.lang.String" nil
+                           (lambda (this)
+                             (java:jfield this "name")))))
+  t)
+
+;; method with primitive type
+(deftest runtime-class.2
+    (java:jnew-runtime-class 
+     "Actor"
+     :fields `(("name" "java.lang.String"))
+     :methods `(("getName" "java.lang.String" (:int)
+                           (lambda (this) 
+                             (java:jfield this "name")))))
+  t)
+
+;; inheritance of type 
+
+(deftest runtime-class.3
+    (progn 
+      (java:jnew-runtime-class 
+       "foo.Actor"
+       :fields `(("name" "java.lang.String")))
+      (java:jnew-runtime-class 
+       "foo.StageActor"
+       :superclass "foo.Actor"
+       :fields (list '("givenName" "java.lang.String"))))
+  t)
+
+
+#|
+// Simple constructor test
+public class Actor {
+  String name;
+  
+  public Actor(String name) {
+    this.name = name;
+  }
+
+  public String getName() {
+    return name;
+  }
+  
+}
+|#
+
+;; constructor
+(deftest runtime-class.4
+    (java:jnew-runtime-class 
+     "Actor"
+     :constructors `(("java.lang.String") 
+                     (lambda (name) 
+                       (setf (jfield this "name")
+                             name)))
+     :methods `(("getName" "java.lang.String" ("java.lang.String")  ;; no-arg methods not working
+                           (lambda (this dummy) 
+                             (declare (ignore dummy))
+                             (java:jfield this "name"))))
+     :fields `(("name" "java.lang.String")))
+  t)
+
+
+