source: branches/1.3.1/test/lisp/abcl/java-tests.lisp @ 14683

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

Backport r14682: Make JCALL work in more places.

A reimplementation of org.apache.commons.lang.ClassUtils?.isAssignable
instead of the standard isAssignableFrom test.

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

From Olof.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 12.3 KB
Line 
1;;; java-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: java-tests.lisp 14683 2014-04-17 11:50:49Z 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 jfield.1
207  (type-of (jfield "java.lang.Integer" "TYPE"))
208  #+abcl    java-object
209  #+allegro tran-struct)
210
211(deftest jmethod.1
212  (jcall (jmethod "java.lang.Object" "toString")
213         (jmethod "java.lang.String" "substring" 1))
214  "public java.lang.String java.lang.String.substring(int)")
215
216(deftest jmethod.2
217  (jcall (jmethod "java.lang.Object" "toString")
218         (jmethod "java.lang.String" "substring" 2))
219  "public java.lang.String java.lang.String.substring(int,int)")
220
221(deftest jmethod.3
222  (signals-error (jmethod "java.lang.String" "substring" 3) 'error)
223  t)
224
225#+abcl
226(deftest jmethod-return-type.1
227  (jclass-name (jmethod-return-type (jmethod "java.lang.String" "length")))
228  "int")
229
230#+abcl
231(deftest jmethod-return-type.2
232  (jclass-name (jmethod-return-type (jmethod "java.lang.String" "substring" 1)))
233  "java.lang.String")
234
235#+abcl
236(deftest jmethod-return-type.error.1
237  (signals-error (jmethod-return-type (jclass "java.lang.String")) 'error)
238  t)
239
240#+abcl
241(deftest jmethod-return-type.error.2
242  (signals-error (jmethod-return-type 42) 'error)
243  t)
244
245#+abcl
246(deftest define-condition.1
247  (progn
248    (define-condition throwable (java-exception) ())
249    (let ((c (make-condition 'throwable)))
250      (signals-error (simple-condition-format-control c) 'unbound-slot)))
251  t)
252
253#+abcl
254(deftest define-condition.2
255  (progn
256    (define-condition throwable (java-exception) ())
257    (let ((c (make-condition 'throwable)))
258      (simple-condition-format-arguments c)))
259  nil)
260
261#+abcl
262(deftest define-condition.3
263  (progn
264    (define-condition throwable (java-exception) ())
265    (let ((c (make-condition 'throwable
266                             :format-control "The bear is armed.")))
267      (simple-condition-format-control c)))
268  "The bear is armed.")
269
270#+abcl
271(deftest define-condition.4
272  (progn
273    (define-condition throwable (java-exception) ())
274    (let ((c (make-condition 'throwable
275                             :format-control "The bear is armed.")))
276      (simple-condition-format-arguments c)))
277  nil)
278
279#+abcl
280(deftest java-exception-cause.1
281  (progn
282    (define-condition throwable (java-exception) ())
283    (signals-error (java-exception-cause (make-condition 'throwable))
284                   'unbound-slot))
285  t)
286
287#+abcl
288(deftest java-exception-cause.2
289  (progn
290    (define-condition throwable (java-exception) ())
291    (java-exception-cause (make-condition 'throwable :cause 42)))
292  42)
293
294#+abcl
295(deftest unregister-java-exception.1
296  (progn
297    (define-condition throwable (java-exception) ())
298    (register-java-exception "java.lang.Throwable" 'throwable)
299    (unregister-java-exception "java.lang.Throwable"))
300  t)
301
302#+abcl
303(deftest unregister-java-exception.2
304  (unregister-java-exception "java.lang.Throwable")
305  nil)
306
307#+abcl
308(deftest register-java-exception.1
309  (progn
310    (define-condition throwable (java-exception) ())
311    (with-registered-exception "java.lang.Throwable" 'throwable
312      (signals-error
313       (jnew (jconstructor "java.lang.String" "java.lang.String")
314             (make-immediate-object nil :ref))
315       'throwable)))
316  t)
317
318#+abcl
319(deftest register-java-exception.1a
320  (progn
321    (define-condition throwable (java-exception) ())
322    (with-registered-exception "java.lang.Throwable" 'throwable
323      (handler-case
324          (jnew (jconstructor "java.lang.String" "java.lang.String")
325                (make-immediate-object nil :ref))
326        (condition (c) (values (type-of c) (princ-to-string c))))))
327  throwable
328  "java.lang.NullPointerException")
329
330#+abcl
331(deftest register-java-exception.2
332  (progn
333    (define-condition throwable (java-exception) ())
334    (with-registered-exception "java.lang.Throwable" 'throwable
335      (signals-error
336       (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
337       'throwable)))
338  t)
339
340#+abcl
341;; Behavior is non-deterministic.
342(deftest register-java-exception.2a
343  (progn
344    (define-condition throwable (java-exception) ())
345    (with-registered-exception "java.lang.Throwable" 'throwable
346      (handler-case
347          (jnew (jconstructor "java.lang.String" "java.lang.String") 42)
348        (condition (c) (let* ((s (princ-to-string c)))
349                         ;; The actual string returned by Throwable.getMessage()
350                         ;; is either "argument type mismatch" or something
351                         ;; like "java.lang.ClassCastException@9d0366".
352                         (or (string= s "argument type mismatch")
353                             (and (> (length s) (length "java.lang.ClassCastException"))
354                                  (string= (subseq s 0 (length "java.lang.ClassCastException"))
355                                           "java.lang.ClassCastException"))))))))
356  t)
357
358#+abcl
359(deftest register-java-exception.3
360  (progn
361    (define-condition throwable (java-exception) ())
362    (with-registered-exception "java.lang.Throwable" 'throwable
363      (signals-error
364       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
365       'throwable)))
366  t)
367
368#+abcl
369;; Behavior is non-deterministic.
370(deftest register-java-exception.3a
371  (progn
372    (define-condition throwable (java-exception) ())
373    (with-registered-exception "java.lang.Throwable" 'throwable
374      (handler-case
375          (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
376        (condition (c) (let ((s (princ-to-string c)))
377                         (or (string= s "argument type mismatch")
378                             (string= s "java.lang.IllegalArgumentException")))))))
379  t)
380
381#+abcl
382(deftest register-java-exception.4
383  (progn
384    (define-condition throwable (java-exception) ())
385    (define-condition illegal-argument-exception (java-exception) ())
386    (with-registered-exception "java.lang.Throwable" 'throwable
387      (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
388        (signals-error
389         (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
390         'throwable))))
391  nil)
392
393#+abcl
394(deftest register-java-exception.5
395  (progn
396    (define-condition throwable (java-exception) ())
397    (define-condition illegal-argument-exception (java-exception) ())
398    (with-registered-exception "java.lang.Throwable" 'throwable
399      (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
400        (signals-error
401         (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
402         'illegal-argument-exception))))
403  t)
404
405
406#+abcl
407(deftest register-java-exception.6
408  (progn 
409    (define-condition foo () ())
410    (register-java-exception "java.lang.Throwable" 'foo))
411  nil)
412
413#+abcl
414(deftest register-java-exception.7
415  (progn 
416    (define-condition throwable (java-exception) ())
417    (register-java-exception "java.lang.Throwable" 'throwable))
418  t)
419
420#+abcl
421(deftest register-java-exception.8
422  (progn 
423    (define-condition throwable (java-exception) ())
424    (with-registered-exception "java.lang.Throwable" 'throwable
425      (define-condition throwable () ())
426      (signals-error
427       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
428       'java-exception)))
429  t)
430     
431#+abcl
432(deftest register-java-exception.9
433  (progn 
434    (define-condition throwable (java-exception) ())
435    (define-condition illegal-argument-exception (throwable) ())
436    (with-registered-exception "java.lang.IllegalArgumentException" 'illegal-argument-exception
437      (signals-error
438       (jstatic (jmethod "java.lang.String" "valueOf" "int") "java.lang.String" "12")
439       'illegal-argument-exception)))
440  t)
441
442;;#+allegro
443;;(jlinker-end)
Note: See TracBrowser for help on using the repository browser.