source: trunk/abcl/test/lisp/abcl/java-tests.lisp @ 14694

Last change on this file since 14694 was 14694, checked in by mevenson, 3 years ago

Convert Lisp truth values to Java equivalents in JCALL/JSTATIC.

We now convert CL:T and CL:NIL to JAVA:+TRUE+ and JAVA:+FALSE+
respectively when invoking JVM methods through the JAVA package,
establishing the "natural" equivalence for boolean truth values. This
may break some existing usage in that previously CL:NIL was converted
to a Java 'null' reference. Users now need to specify JAVA:+NULL+
explicitly when desiring to pass 'null' Java references as an argument
in invoking JVM methods.

Addresses <http://abcl.org/trac/ticket/84> (#84) and
<http://abcl.org/trac/ticket/339> (#339).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.5 KB
Line 
1;;; java-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: java-tests.lisp 14694 2014-04-25 07:55:53Z mevenson $
5;;;
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19
20(in-package #:abcl.test.lisp)
21
22#+abcl
23(use-package '#:java)
24
25#+allegro
26(require :jlinker)
27#+allegro
28(use-package '#:javatools.jlinker)
29#+allegro
30(use-package '#:javatools.jlinker '#:cl-user) ;; For convenience only.
31#+(and allegro mswindows)
32(use-package '#:javatools.jlinker '#:cg-user) ;; For convenience only.
33#+allegro
34(load (merge-pathnames "jl-config.cl" *load-truename*))
35#+allegro
36(or (jlinker-query) (jlinker-init))
37
38#+abcl
39(defmacro with-registered-exception (exception condition &body body)
40  `(unwind-protect
41       (progn
42         (register-java-exception ,exception ,condition)
43         ,@body)
44     (unregister-java-exception ,exception)))
45
46#+abcl
47(deftest java-object.1
48  (class-name (find-class 'java-object nil))
49  java-object)
50
51(deftest jclass.1
52  (jcall (jmethod "java.lang.Object" "toString") (jclass "java.lang.String"))
53  "class java.lang.String")
54
55(deftest jclass.2
56  (equal (jcall (jmethod "java.lang.Object" "getClass") "foo")
57         (jclass "java.lang.String"))
58  #+abcl    t
59  #+allegro nil)
60
61(deftest jclass.3
62  (equal (jclass '|java.lang.String|) (jclass "java.lang.String"))
63  t)
64
65(deftest jclass.4
66  (let ((class1 (jcall (jmethod "java.lang.Object" "getClass") "foo"))
67        (class2 (jclass "java.lang.String")))
68    (jcall (jmethod "java.lang.Object" "equals" "java.lang.Object")
69           class1 class2))
70  t)
71
72(deftest jclass.5
73  (jcall (jmethod "java.lang.Object" "toString") (jclass "int"))
74  "int")
75
76(deftest jclass.6
77  (equal (jclass '|int|) (jclass "int"))
78  t)
79
80;; No such class.
81(deftest jclass.error.1
82  (signals-error (jclass "foo") 'error)
83  t)
84
85;; Silly argument.
86(deftest jclass.error.2
87  (signals-error (jclass 42) 'error)
88  t)
89
90(deftest jclass-of.1
91  (jclass-of "foo")
92  "java.lang.String"
93  "java.lang.String")
94
95(deftest jclass-of.2
96  (jclass-of "foo" "java.lang.String")
97  t
98  "java.lang.String")
99
100(deftest jclass-of.3
101  (jclass-of "foo" "bar")
102  nil
103  "java.lang.String")
104
105(deftest jclass-of.4
106  (jclass-of 42)
107  nil
108  nil)
109
110(deftest jclass-of.5
111  (jclass-of 'foo)
112  nil
113  nil)
114
115(deftest jclass-name.1
116  (jclass-name "java.lang.String")
117  "java.lang.String")
118
119(deftest jclass-name.2
120  (signals-error (jclass-name "foo") 'error)
121  t)
122
123(deftest jclass-name.3
124  (signals-error (jclass-name 42) 'error)
125  t)
126
127(deftest jclass-name.4
128  (jclass-name (jclass "java.lang.String"))
129  "java.lang.String")
130
131(deftest jclass-name.5
132  (jclass-name (jclass "java.lang.String") "java.lang.String")
133  t
134  "java.lang.String")
135
136(deftest jclass-name.6
137  (jclass-name (jclass "java.lang.String") "java.lang.Object")
138  nil
139  "java.lang.String")
140
141(deftest jclass-name.7
142  (jclass-name (jclass "java.lang.String") "foo")
143  nil
144  "java.lang.String")
145
146(deftest jclass-name.8
147  (jclass-name (jclass "int"))
148  "int")
149
150(deftest jconstructor.1
151  (jclass-of (jconstructor "java.lang.String" "java.lang.String"))
152  "java.lang.reflect.Constructor"
153  "java.lang.reflect.Constructor")
154
155(deftest jnew.1
156  (let ((constructor (jconstructor "java.lang.String" "java.lang.String")))
157    (jclass-of (jnew constructor "foo")))
158  "java.lang.String"
159  "java.lang.String")
160
161(deftest jnew.2
162  (jclass-of (jnew (jconstructor "java.awt.Point")))
163  "java.awt.Point"
164  "java.awt.Point")
165
166#-abcl
167(deftest jnew.3
168  (jclass-of (jnew "java.awt.Point") "java.awt.Point")
169  t
170  "java.awt.Point")
171
172(deftest jnew.error.1
173  (signals-error (jnew (jconstructor "java.lang.String" "java.lang.String")
174                       (make-immediate-object nil :ref))
175                 #+abcl    'java-exception
176                 #+allegro 'jlinker-error)
177  t)
178
179(deftest jcall.1
180  (let ((method (jmethod "java.lang.String" "length")))
181    (jcall method "test"))
182  4)
183
184(deftest jcall.2
185  (jcall "length" "test")
186  4)
187
188(deftest jcall.3
189  (let ((method (jmethod "java.lang.String" "regionMatches" 4)))
190    (jcall method "test" 0 "this is a test" 10 4))
191  t)
192
193(deftest jcall.4
194  (let ((method (jmethod "java.lang.String" "regionMatches" 5)))
195    (jcall method "test" (make-immediate-object nil :boolean) 0 "this is a test" 10 4))
196  t)
197
198(deftest jcall.5
199  (jcall "join" (jstatic "currentThread" "java.lang.Thread") 1 1)
200  nil)
201
202(deftest jcall.6
203  (jcall "offsetByCodePoints" "foobar" 0 #\Nul)
204  0)
205
206(deftest jcall.7
207  (signals-error (jcall "offsetByCodePoints" "foobar" 0 nil)
208                 #+abcl    'java-exception
209                 #+allegro 'jlinker-error))
210
211(deftest jfield.1
212  (type-of (jfield "java.lang.Integer" "TYPE"))
213  #+abcl    java-object
214  #+allegro tran-struct)
215
216(deftest jmethod.1
217  (jcall (jmethod "java.lang.Object" "toString")
218         (jmethod "java.lang.String" "substring" 1))
219  "public java.lang.String java.lang.String.substring(int)")
220
221(deftest jmethod.2
222  (jcall (jmethod "java.lang.Object" "toString")
223         (jmethod "java.lang.String" "substring" 2))
224  "public java.lang.String java.lang.String.substring(int,int)")
225
226(deftest jmethod.3
227  (signals-error (jmethod "java.lang.String" "substring" 3) 'error)
228  t)
229
230#+abcl
231(deftest jmethod-return-type.1
232  (jclass-name (jmethod-return-type (jmethod "java.lang.String" "length")))
233  "int")
234
235#+abcl
236(deftest jmethod-return-type.2
237  (jclass-name (jmethod-return-type (jmethod "java.lang.String" "substring" 1)))
238  "java.lang.String")
239
240#+abcl
241(deftest jmethod-return-type.error.1
242  (signals-error (jmethod-return-type (jclass "java.lang.String")) 'error)
243  t)
244
245#+abcl
246(deftest jmethod-return-type.error.2
247  (signals-error (jmethod-return-type 42) 'error)
248  t)
249
250#+abcl
251(deftest define-condition.1
252  (progn
253    (define-condition throwable (java-exception) ())
254    (let ((c (make-condition 'throwable)))
255      (signals-error (simple-condition-format-control c) 'unbound-slot)))
256  t)
257
258#+abcl
259(deftest define-condition.2
260  (progn
261    (define-condition throwable (java-exception) ())
262    (let ((c (make-condition 'throwable)))
263      (simple-condition-format-arguments c)))
264  nil)
265
266#+abcl
267(deftest define-condition.3
268  (progn
269    (define-condition throwable (java-exception) ())
270    (let ((c (make-condition 'throwable
271                             :format-control "The bear is armed.")))
272      (simple-condition-format-control c)))
273  "The bear is armed.")
274
275#+abcl
276(deftest define-condition.4
277  (progn
278    (define-condition throwable (java-exception) ())
279    (let ((c (make-condition 'throwable
280                             :format-control "The bear is armed.")))
281      (simple-condition-format-arguments c)))
282  nil)
283
284#+abcl
285(deftest java-exception-cause.1
286  (progn
287    (define-condition throwable (java-exception) ())
288    (signals-error (java-exception-cause (make-condition 'throwable))
289                   'unbound-slot))
290  t)
291
292#+abcl
293(deftest java-exception-cause.2
294  (progn
295    (define-condition throwable (java-exception) ())
296    (java-exception-cause (make-condition 'throwable :cause 42)))
297  42)
298
299#+abcl
300(deftest unregister-java-exception.1
301  (progn
302    (define-condition throwable (java-exception) ())
303    (register-java-exception "java.lang.Throwable" 'throwable)
304    (unregister-java-exception "java.lang.Throwable"))
305  t)
306
307#+abcl
308(deftest unregister-java-exception.2
309  (unregister-java-exception "java.lang.Throwable")
310  nil)
311
312#+abcl
313(deftest register-java-exception.1
314  (progn
315    (define-condition throwable (java-exception) ())
316    (with-registered-exception "java.lang.Throwable" 'throwable
317      (signals-error
318       (jnew (jconstructor "java.lang.String" "java.lang.String")
319             (make-immediate-object nil :ref))
320       'throwable)))
321  t)
322
323#+abcl
324(deftest register-java-exception.1a
325  (progn
326    (define-condition throwable (java-exception) ())
327    (with-registered-exception "java.lang.Throwable" 'throwable
328      (handler-case
329          (jnew (jconstructor "java.lang.String" "java.lang.String")
330                (make-immediate-object nil :ref))
331        (condition (c) (values (type-of c) (princ-to-string c))))))
332  throwable
333  "java.lang.NullPointerException")
334
335#+abcl
336(deftest register-java-exception.2
337  (progn
338    (define-condition throwable (java-exception) ())
339    (with-registered-exception "java.lang.Throwable" 'throwable
340      (signals-error
341       (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
342       'throwable)))
343  t)
344
345#+abcl
346;; Behavior is non-deterministic.
347(deftest register-java-exception.2a
348  (progn
349    (define-condition throwable (java-exception) ())
350    (with-registered-exception "java.lang.Throwable" 'throwable
351      (handler-case
352          (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
353        (condition (c) (let* ((s (princ-to-string c)))
354                         ;; The actual string returned by Throwable.getMessage()
355                         ;; is either "argument type mismatch" or something
356                         ;; like "java.lang.ClassCastException@9d0366".
357                         (or (string= s "argument type mismatch")
358                             (and (> (length s) (length "java.lang.ClassCastException"))
359                                  (string= (subseq s 0 (length "java.lang.ClassCastException"))
360                                           "java.lang.ClassCastException"))))))))
361  t)
362
363#+abcl
364(deftest register-java-exception.3
365  (progn
366    (define-condition throwable (java-exception) ())
367    (with-registered-exception "java.lang.Throwable" 'throwable
368      (signals-error
369       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
370       'throwable)))
371  t)
372
373#+abcl
374;; Behavior is non-deterministic.
375(deftest register-java-exception.3a
376  (progn
377    (define-condition throwable (java-exception) ())
378    (with-registered-exception "java.lang.Throwable" 'throwable
379      (handler-case
380          (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
381        (condition (c) (let ((s (princ-to-string c)))
382                         (or (string= s "argument type mismatch")
383                             (string= s "java.lang.IllegalArgumentException")))))))
384  t)
385
386#+abcl
387(deftest register-java-exception.4
388  (progn
389    (define-condition throwable (java-exception) ())
390    (define-condition illegal-argument-exception (java-exception) ())
391    (with-registered-exception "java.lang.Throwable" 'throwable
392      (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
393        (signals-error
394         (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
395         'throwable))))
396  nil)
397
398#+abcl
399(deftest register-java-exception.5
400  (progn
401    (define-condition throwable (java-exception) ())
402    (define-condition illegal-argument-exception (java-exception) ())
403    (with-registered-exception "java.lang.Throwable" 'throwable
404      (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
405        (signals-error
406         (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
407         'illegal-argument-exception))))
408  t)
409
410
411#+abcl
412(deftest register-java-exception.6
413  (progn 
414    (define-condition foo () ())
415    (register-java-exception "java.lang.Throwable" 'foo))
416  nil)
417
418#+abcl
419(deftest register-java-exception.7
420  (progn 
421    (define-condition throwable (java-exception) ())
422    (register-java-exception "java.lang.Throwable" 'throwable))
423  t)
424
425#+abcl
426(deftest register-java-exception.8
427  (progn 
428    (define-condition throwable (java-exception) ())
429    (with-registered-exception "java.lang.Throwable" 'throwable
430      (define-condition throwable () ())
431      (signals-error
432       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
433       'java-exception)))
434  t)
435     
436#+abcl
437(deftest register-java-exception.9
438  (progn 
439    (define-condition throwable (java-exception) ())
440    (define-condition illegal-argument-exception (throwable) ())
441    (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
442      (signals-error
443       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
444       'illegal-argument-exception)))
445  t)
446
447;;#+allegro
448;;(jlinker-end)
449
Note: See TracBrowser for help on using the repository browser.