source: trunk/abcl/test/lisp/abcl/class-file.lisp

Last change on this file was 14095, checked in by ehuelsmann, 12 years ago

Fix test failures by fixing test incorrectnesses.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 15.4 KB
Line 
1;;; compiler-tests.lisp
2;;;
3;;; Copyright (C) 2010 Erik Huelsmann
4;;;
5;;; $Id: class-file.lisp 14095 2012-08-15 22:16:20Z ehuelsmann $
6;;;
7;;; This program is free software; you can redistribute it and/or
8;;; modify it under the terms of the GNU General Public License
9;;; as published by the Free Software Foundation; either version 2
10;;; of the License, or (at your option) any later version.
11;;;
12;;; This program is distributed in the hope that it will be useful,
13;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with this program; if not, write to the Free Software
19;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20
21#+abcl
22(require '#:jvm)
23
24(in-package #:abcl.test.lisp)
25
26
27(deftest fieldtype.1a
28    (string= (jvm::internal-field-type :int) "I")
29  T)
30
31(deftest fieldtype.1b
32    (string= (jvm::internal-field-type :long) "J")
33  T)
34
35(deftest fieldtype.1c
36    (string= (jvm::internal-field-type :float) "F")
37  T)
38
39(deftest fieldtype.1d
40    (string= (jvm::internal-field-type :double) "D")
41  T)
42
43(deftest fieldtype.1e
44    (string= (jvm::internal-field-type :boolean) "Z")
45  T)
46
47(deftest fieldtype.1f
48    (string= (jvm::internal-field-type :char) "C")
49  T)
50
51(deftest fieldtype.1g
52    (string= (jvm::internal-field-type :byte) "B")
53  T)
54
55(deftest fieldtype.1h
56    (string= (jvm::internal-field-type :short) "S")
57  T)
58
59(deftest fieldtype.1i
60    (string= (jvm::internal-field-type :void) "V")
61  T)
62
63(deftest fieldtype.1j
64    (string= (jvm::internal-field-type nil) "V")
65  T)
66
67(deftest fieldtype.2
68    (string= (jvm::internal-field-type jvm::+lisp-object+)
69             "org/armedbear/lisp/LispObject")
70  T)
71
72
73(deftest fieldref.1a
74    (string= (jvm::internal-field-ref :int) "I")
75  T)
76
77(deftest fieldref.1b
78    (string= (jvm::internal-field-ref :long) "J")
79  T)
80
81(deftest fieldref.1c
82    (string= (jvm::internal-field-ref :float) "F")
83  T)
84
85(deftest fieldref.1d
86    (string= (jvm::internal-field-ref :double) "D")
87  T)
88
89(deftest fieldref.1e
90    (string= (jvm::internal-field-ref :boolean) "Z")
91  T)
92
93(deftest fieldref.1f
94    (string= (jvm::internal-field-ref :char) "C")
95  T)
96
97(deftest fieldref.1g
98    (string= (jvm::internal-field-ref :byte) "B")
99  T)
100
101(deftest fieldref.1h
102    (string= (jvm::internal-field-ref :short) "S")
103  T)
104
105(deftest fieldref.1i
106    (string= (jvm::internal-field-ref :void) "V")
107  T)
108
109(deftest fieldref.1j
110    (string= (jvm::internal-field-ref nil) "V")
111  T)
112
113(deftest fieldref.2
114    (string= (jvm::internal-field-ref jvm::+lisp-object+)
115             "Lorg/armedbear/lisp/LispObject;")
116  T)
117
118(deftest descriptor.1
119    (and
120     (string= (jvm::descriptor :void :int :long :boolean)
121              "(IJZ)V")
122     (string= (jvm::descriptor nil :int :long :boolean)
123              "(IJZ)V"))
124  T)
125
126(deftest descriptor.2
127    (string= (jvm::descriptor jvm::+lisp-object+ jvm::+lisp-object+)
128             "(Lorg/armedbear/lisp/LispObject;)Lorg/armedbear/lisp/LispObject;")
129  T)
130
131(deftest map-flags.1
132    (eql (jvm::map-flags '(:public)) #x0001)
133  T)
134
135(deftest pool.1
136    (let* ((pool (jvm::make-pool)))
137      (jvm::pool-add-class pool jvm::+lisp-readtable+)
138      (jvm::pool-add-field-ref pool jvm::+lisp-readtable+ "ABC" :int)
139      (jvm::pool-add-field-ref pool
140                               jvm::+lisp-readtable+ "ABD"
141                               jvm::+lisp-readtable+)
142      (jvm::pool-add-method-ref pool jvm::+lisp-readtable+ "MBC" :int)
143      (jvm::pool-add-method-ref pool jvm::+lisp-readtable+ "MBD"
144                                jvm::+lisp-readtable+)
145      (jvm::pool-add-interface-method-ref pool
146                                          jvm::+lisp-readtable+ "MBD" :int)
147      (jvm::pool-add-interface-method-ref pool
148                                          jvm::+lisp-readtable+ "MBD"
149                                          jvm::+lisp-readtable+)
150      (jvm::pool-add-string pool "string")
151      (jvm::pool-add-int pool 1)
152      (jvm::pool-add-float pool 1.0f0)
153      (jvm::pool-add-long pool 1)
154      (jvm::pool-add-double pool 1.0d0)
155      (jvm::pool-add-name/type pool "name1" :int)
156      (jvm::pool-add-name/type pool "name2" jvm::+lisp-object+)
157      (jvm::pool-add-utf8 pool "utf8")
158      T)
159  T)
160
161(deftest make-class-file.1
162    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/mcf_1"))
163           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public))))
164      (jvm::class-add-field file (jvm::make-field "ABC" :int))
165      (jvm::class-add-field file (jvm::make-field "ABD" jvm::+lisp-object+))
166      (jvm::class-add-method file (jvm::make-jvm-method "MBC" nil :int))
167      (jvm::class-add-method file (jvm::make-jvm-method "MBD" nil jvm::+lisp-object+))
168      (jvm::class-add-method file (jvm::make-jvm-method :constructor :void nil))
169      (jvm::class-add-method file (jvm::make-jvm-method :static-initializer :void nil))
170      T)
171  T)
172
173(deftest finalize-class-file.1
174    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/fcf_1"))
175           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public))))
176      (jvm::class-add-field file (jvm::make-field "ABC" :int))
177      (jvm::class-add-field file (jvm::make-field "ABD" jvm::+lisp-object+))
178      (jvm::class-add-method file (jvm::make-jvm-method "MBC" nil '(:int)))
179      (jvm::class-add-method file
180                             (jvm::make-jvm-method "MBD" nil
181                                                (list jvm::+lisp-object+)))
182      (jvm::finalize-class-file file)
183      file
184      T)
185  T)
186
187(deftest generate-method.1
188    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/gm_1"))
189           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public)))
190           (method (jvm::make-jvm-method :static-initializer :void nil
191                                      :flags '(:static))))
192      (jvm::class-add-method file method)
193      (jvm::with-code-to-method (file method)
194        (jvm::emit 'return))
195      (jvm::finalize-class-file file)
196      (with-open-stream (stream (sys::%make-byte-array-output-stream))
197        (jvm::write-class-file file stream)
198        (sys::load-compiled-function (sys::%get-output-stream-bytes stream)))
199      T)
200  T)
201
202(deftest generate-method.2
203    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/gm_2"))
204           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public)))
205           (method (jvm::make-jvm-method "doNothing" :void nil)))
206      (jvm::class-add-method file method)
207      (jvm::with-code-to-method (file method)
208        (let ((label1 (gensym))
209              (label2 (gensym))
210              (label3 (gensym)))
211          (jvm::label label1)
212          (jvm::emit 'jvm::iconst_1)
213          (jvm::label label2)
214          (jvm::emit 'return)
215          (jvm::label label3)
216          (jvm::code-add-exception-handler (jvm::method-attribute method "Code")
217                                           label1 label2 label3 nil))
218        (jvm::emit 'return))
219      (jvm::finalize-class-file file)
220      (with-open-stream (stream (sys::%make-byte-array-output-stream))
221        (jvm::write-class-file file stream)
222        (sys::load-compiled-function (sys::%get-output-stream-bytes stream)))
223      T)
224  T)
225
226;; generation of an ABCL-like function class
227(deftest generate-method.3
228    (let* ((class (jvm::make-jvm-class-name "org.armedbear.lisp.gm_3"))
229           (file (jvm::make-class-file class jvm::+lisp-primitive+ '(:public)))
230           )
231      (let ((method (jvm::make-jvm-method :constructor :void nil)))
232        (jvm::class-add-method file method)
233        (jvm::with-code-to-method (file method)
234          (jvm::emit 'aload 0)
235          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
236          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
237          (jvm::emit-invokespecial-init jvm::+lisp-primitive+
238                                        (list jvm::+lisp-object+
239                                              jvm::+lisp-object+))
240          (jvm::emit 'return)))
241      (let ((method (jvm::make-jvm-method "execute" jvm::+lisp-object+ nil)))
242        (jvm::class-add-method file method)
243        (jvm::with-code-to-method (file method)
244          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
245          (jvm::emit 'jvm::areturn)))
246      (jvm::finalize-class-file file)
247      (with-open-stream (stream (sys::%make-byte-array-output-stream))
248        (jvm::write-class-file file stream)
249        (funcall (sys::load-compiled-function (sys::%get-output-stream-bytes stream)))))
250  NIL)
251
252;; generation of an ABCL-like function class with static init function and
253;; static field
254(deftest generate-method.4
255    (let* ((class (jvm::make-jvm-class-name "org.armedbear.lisp.gm_4"))
256           (file (jvm::make-class-file class jvm::+lisp-primitive+ '(:public)))
257           )
258      (jvm::class-add-field file (jvm::make-field "N1" jvm::+lisp-object+
259                                                  :flags '(:static :private)))
260      (let ((method (jvm::make-jvm-method :static-initializer :void nil :flags '(:static))))
261        (jvm::class-add-method file method)
262        (jvm::with-code-to-method (file method)
263          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
264          (jvm::emit-putstatic class "N1" jvm::+lisp-object+)
265          (jvm::emit 'return)))
266      (let ((method (jvm::make-jvm-method :constructor :void nil)))
267        (jvm::class-add-method file method)
268        (jvm::with-code-to-method (file method)
269          (jvm::emit 'aload 0)
270          (jvm::emit-getstatic class "N1" jvm::+lisp-object+)
271          (jvm::emit-getstatic class "N1" jvm::+lisp-object+)
272          (jvm::emit-invokespecial-init jvm::+lisp-primitive+
273                                        (list jvm::+lisp-object+
274                                              jvm::+lisp-object+))
275          (jvm::emit 'return)))
276      (let ((method (jvm::make-jvm-method "execute" jvm::+lisp-object+ nil)))
277        (jvm::class-add-method file method)
278        (jvm::with-code-to-method (file method)
279          (jvm::emit-getstatic class "N1" jvm::+lisp-object+)
280          (jvm::emit 'jvm::areturn)))
281      (jvm::finalize-class-file file)
282      (with-open-stream (stream (sys::%make-byte-array-output-stream))
283        (jvm::write-class-file file stream)
284        (funcall (sys::load-compiled-function (sys::%get-output-stream-bytes stream)))))
285  NIL)
286
287
288;; generation of ABCL-like function class with multiple 'execute' methods
289(deftest generate-method.5
290    (let* ((class (jvm::make-jvm-class-name "org.armedbear.lisp.gm_5"))
291           (file (jvm::make-class-file class jvm::+lisp-primitive+ '(:public)))
292           )
293      (let ((method (jvm::make-jvm-method :constructor :void nil)))
294        (jvm::class-add-method file method)
295        (jvm::with-code-to-method (file method)
296          (jvm::emit 'aload 0)
297          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
298          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
299          (jvm::emit-invokespecial-init jvm::+lisp-primitive+
300                                        (list jvm::+lisp-object+
301                                              jvm::+lisp-object+))
302          (jvm::emit 'return)))
303      (let ((method (jvm::make-jvm-method "execute" jvm::+lisp-object+ nil)))
304        (jvm::class-add-method file method)
305        (jvm::with-code-to-method (file method)
306          (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-symbol+)
307          (jvm::emit 'jvm::areturn)))
308      (let ((method (jvm::make-jvm-method "execute" jvm::+lisp-object+
309                                       (list jvm::+lisp-object+))))
310        (jvm::class-add-method file method)
311        (jvm::with-code-to-method (file method)
312          (jvm::emit-getstatic jvm::+lisp+ "T" jvm::+lisp-symbol+)
313          (jvm::emit 'jvm::areturn)))
314      (jvm::finalize-class-file file)
315      (with-open-stream (stream (sys::%make-byte-array-output-stream))
316        (jvm::write-class-file file stream)
317        (let* ((bytes (sys::%get-output-stream-bytes stream))
318               (fn (sys::load-compiled-function bytes)))
319          (values (funcall fn) (funcall fn NIL)))))
320  NIL T)
321
322;;Nested with-code-to-method
323(deftest with-code-to-method.1
324    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/gm_6"))
325           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public)))
326           (method (jvm::make-jvm-method :static-initializer :void nil
327              :flags '(:static)))
328     (registers nil))
329      (jvm::class-add-method file method)
330      (jvm::with-code-to-method (file method)
331  (jvm::allocate-register :int)
332  (push jvm::*register* registers)
333  (jvm::with-code-to-method (file method)
334    (jvm::allocate-register :int)
335    (push jvm::*register* registers)
336    (jvm::with-code-to-method (file method)
337      (jvm::allocate-register :int)
338      (push jvm::*register* registers))
339    (jvm::allocate-register :int)
340    (push jvm::*register* registers))
341  (jvm::allocate-register :int)
342  (push jvm::*register* registers)
343        (jvm::emit 'return))
344      (jvm::finalize-class-file file)
345      (nreverse registers))
346  (1 2 3 4 5))
347
348(deftest with-code-to-method.2
349    (let* ((class (jvm::make-jvm-class-name "org/armedbear/lisp/gm_7"))
350           (file (jvm::make-class-file class jvm::+lisp-object+ '(:public)))
351           (method1 (jvm::make-jvm-method :static-initializer :void nil
352               :flags '(:static)))
353     (method2 (jvm::make-jvm-method "method2" :void nil))
354     (registers nil))
355      (jvm::class-add-method file method1)
356      (jvm::class-add-method file method2)
357      (jvm::with-code-to-method (file method1)
358  (jvm::allocate-register :int)
359  (push jvm::*register* registers)
360  (jvm::with-code-to-method (file method2)
361    (jvm::allocate-register :int)
362    (push jvm::*register* registers)
363    (jvm::with-code-to-method (file method1)
364      (jvm::allocate-register :int)
365      (push jvm::*register* registers))
366    (jvm::allocate-register :int)
367    (push jvm::*register* registers))
368  (jvm::allocate-register :int)
369  (push jvm::*register* registers)
370        (jvm::emit 'return))
371      (jvm::finalize-class-file file)
372      (nreverse registers))
373  (1 1 2 2 3))
374
375;; ;;  generation of an ABCL-like function, with mixed output to constructor,
376;; ;;  static initializer and function method(s)
377;; (deftest generate-method.6
378;;     (let* ((class (jvm::make-jvm-class-name "org.armedbear.lisp.gm_6"))
379;;            (file (jvm::make-class-file class jvm::+lisp-primitive+ '(:public)))
380;;            )
381;;       (let ((method (jvm::make-method :constructor :void nil)))
382;;         (jvm::class-add-method file method)
383;;         (jvm::with-code-to-method (file method)
384;;           (jvm::emit 'aload 0)
385;;           (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-object+)
386;;           (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-object+)
387;;           (jvm::emit-invokespecial-init jvm::+lisp-primitive+
388;;                                         (list jvm::+lisp-object+
389;;                                               jvm::+lisp-object+))
390;;           (jvm::emit 'return)))
391;;       (let ((method (jvm::make-method "execute" jvm::+lisp-object+ nil)))
392;;         (jvm::class-add-method file method)
393;;         (jvm::with-code-to-method (file method)
394;;           (jvm::emit-getstatic jvm::+lisp+ "NIL" jvm::+lisp-object+)
395;;           (jvm::emit 'jvm::areturn)))
396;;       (jvm::finalize-class-file file)
397;;       (with-open-stream (stream (sys::%make-byte-array-output-stream))
398;;         (jvm::write-class-file file stream)
399;;         (ignore-errors (sys::load-compiled-function nil))
400;;         (funcall (sys::load-compiled-function (sys::%get-output-stream-bytes stream))))
401;;       T
402;;       )
403;;   T)
404
Note: See TracBrowser for help on using the repository browser.