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

Last change on this file since 11605 was 11605, checked in by mevenson, 9 years ago

ABCL included Lisp tests now working from ASDF and Ant.

The following targets now work from Ant:

'test.ansi.compiled'
'test.ansi.intepreted'
'test.abcl.lisp'

invoking the GCL ANSI tests compiled, GCL ANSI tests interpreted, and the internal ABCL tests.

Packaged the internal ANSI Lisp test use of REGRESSION-TEST as
ABCL-REGRESSION-TEST (nickname abcl-rt) to avoid conflicting with
other test suites that use this.

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