source: trunk/abcl/test/lisp/abcl/compiler-tests.lisp @ 11599

Last change on this file since 11599 was 11599, checked in by Mark Evenson, 13 years ago

Use HANDLER-CASE for ANSI tests to quit invoking Lisp if an error in generated.

Further incremental work on ABCL-TEST-LISP (aka the internal ABCL
tests) necessitated by the fact that both it and the ANSI tests use
the REGRESSION-TEST framework which doesn't work well in the same Lisp
instances. Trying to repackage this correctly, but it needs more work.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.9 KB
Line 
1;;; compiler-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: compiler-tests.lisp 11599 2009-01-29 16:00:07Z 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#+abcl
21(require '#:jvm)
22
23(in-package #:abcl.test.lisp)
24
25(defconstant most-positive-java-long 9223372036854775807)
26(defconstant most-negative-java-long -9223372036854775808)
27
28#+abcl
29(assert (eql most-positive-java-long ext:most-positive-java-long))
30#+abcl
31(assert (eql most-negative-java-long ext:most-negative-java-long))
32
33(defmacro define-compiler-test (name lambda-form &key args results)
34  `(deftest ,name
35     (progn
36       (fmakunbound ',name)
37       (defun ,name ,(cadr lambda-form)
38         ,@(cddr lambda-form))
39       (values
40        (funcall ',name ,@args)
41        (multiple-value-list (compile ',name))
42        (compiled-function-p #',name)
43        (funcall ',name ,@args)))
44     ,results
45     (,name nil nil)
46     t
47     ,results))
48
49#+abcl
50(deftest unused.1
51  (let ((output (with-output-to-string (*error-output*)
52                  (compile nil '(lambda () (let ((x 42)) 17))))))
53    (integerp (search "The variable X is defined but never used." output)))
54  t)
55
56(deftest unused.2
57  (progn
58    (fmakunbound 'unused.2)
59    (defun unused.2 () (let ((x 42)) 17))
60    (values
61     #-lispworks
62     (multiple-value-list (compile 'unused.2))
63     #+lispworks
64     (let ((list (multiple-value-list (compile 'unused.2))))
65       (list (first list)
66             (not (null (second list)))
67             (third list)))
68     (unused.2)))
69  #+(or abcl allegro) (unused.2 t   nil)
70  #+clisp             (unused.2 1   nil)
71  #+(or cmu sbcl)     (unused.2 nil nil)
72  #+lispworks         (unused.2 t   nil)
73  17)
74
75(deftest plus.1
76  (progn
77    (fmakunbound 'plus.1)
78    (defun plus.1 (x y)
79      (+ x y))
80    (compile 'plus.1)
81    (plus.1 most-positive-fixnum most-positive-fixnum))
82  #.(+ most-positive-fixnum most-positive-fixnum))
83
84(deftest plus.2
85  (progn
86    (fmakunbound 'plus.2)
87    (defun plus.2 (x y)
88      (declare (optimize speed))
89      (declare (type fixnum x y))
90      (+ x y))
91    (compile 'plus.2)
92    (plus.2 most-positive-fixnum most-positive-fixnum))
93  #.(+ most-positive-fixnum most-positive-fixnum))
94
95(deftest plus.3
96  (progn
97    (fmakunbound 'plus.3)
98    (defun plus.3 (x y)
99      (declare (optimize speed (safety 0)))
100      (declare (type fixnum x y))
101      (+ x y))
102    (compile 'plus.3)
103    (plus.3 most-positive-fixnum most-positive-fixnum))
104  #.(+ most-positive-fixnum most-positive-fixnum))
105#+allegro (pushnew 'plus.3 *expected-failures*)
106
107(define-compiler-test plus.4
108  (lambda (x y)
109    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
110    (+ x y))
111  :args (#.most-positive-java-long #.most-positive-java-long)
112  :results #.(+ most-positive-java-long most-positive-java-long))
113
114(define-compiler-test minus.1
115  (lambda (x)
116    (declare (type fixnum x))
117    (- x))
118  :args (#.most-negative-fixnum)
119  :results #.(- most-negative-fixnum))
120
121(define-compiler-test minus.2
122  (lambda (x)
123    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x))
124    (- x))
125  :args (#.most-negative-java-long)
126  :results #.(- most-negative-java-long))
127
128(define-compiler-test minus.3
129  (lambda (x y)
130    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
131    (- x y))
132  :args (#.most-negative-java-long #.most-positive-java-long)
133  :results #.(- most-negative-java-long most-positive-java-long))
134
135(define-compiler-test logxor-minus.1
136  (lambda (x)
137    (declare (type (integer 0 255) x))
138    (logxor (- x) #.most-positive-java-long))
139  :args (17)
140  :results -9223372036854775792)
141
142(deftest times.1
143  (progn
144    (fmakunbound 'times.1)
145    (defun times.1 (x y)
146      (* x y))
147    (compile 'times.1)
148    (times.1 most-positive-fixnum most-positive-fixnum))
149  #.(* most-positive-fixnum most-positive-fixnum))
150
151(deftest times.2
152  (progn
153    (fmakunbound 'times.2)
154    (defun times.2 (x y)
155      (declare (optimize speed))
156      (declare (type fixnum x y))
157      (* x y))
158    (compile 'times.2)
159    (times.2 most-positive-fixnum most-positive-fixnum))
160  #.(* most-positive-fixnum most-positive-fixnum))
161
162(deftest times.3
163  (progn
164    (fmakunbound 'times.3)
165    (defun times.3 (x y)
166      (declare (optimize speed (safety 0)))
167      (declare (type fixnum x y))
168      (* x y))
169    (compile 'times.3)
170    (times.3 most-positive-fixnum most-positive-fixnum))
171  #.(* most-positive-fixnum most-positive-fixnum))
172
173(deftest dotimes.1
174  (progn
175    (fmakunbound 'dotimes.1)
176    (defun dotimes.1 ()
177      (declare (optimize speed (safety 0)))
178      (let ((result 0))
179        (dotimes (i 10)
180          (incf result))
181        result))
182    (compile 'dotimes.1)
183    (dotimes.1))
184  10)
185
186(deftest dotimes.2
187  (progn
188    (fmakunbound 'dotimes.2)
189    (defun dotimes.2 ()
190      (declare (optimize speed (safety 0)))
191      (let ((result 0))
192        (declare (type fixnum result))
193        (dotimes (i 10)
194          (incf result))
195        result))
196    (compile 'dotimes.2)
197    (dotimes.2))
198  10)
199
200#+abcl
201(deftest derive-type-logxor.1
202  (let ((type
203         (jvm:derive-compiler-type `(logxor (the (unsigned-byte 8) x)
204                                            (the (unsigned-byte 8) y)))))
205    (and (sys:integer-type-p type)
206         (values
207          (sys:integer-type-low type)
208          (sys:integer-type-high type))))
209  0 255)
210
211#+abcl
212(deftest derive-type-logxor.2
213  (let ((type
214         (jvm:derive-compiler-type `(logxor 441516657
215                                            (the (integer 0 8589934588) x)))))
216    (and (sys:integer-type-p type)
217         (values
218          (sys:integer-type-low type)
219          (sys:integer-type-high type))))
220  0 8589934588)
221
222#+abcl
223(deftest derive-type-logxor.3
224  (let ((type
225         (jvm:derive-compiler-type `(logxor 441516657
226                                            (the (integer 0 8589934588) x)
227                                            (ash (the (integer 0 8589934588) x) -5)))))
228    (and (sys:integer-type-p type)
229         (values
230          (sys:integer-type-low type)
231          (sys:integer-type-high type))))
232  0 8589934588)
233
234(deftest ash.1
235  (progn
236    (fmakunbound 'ash.1)
237    (defun ash.1 (n shift)
238      (declare (type (integer 0 8589934588) n))
239      (declare (type (integer -31 -1) shift))
240      (ash n shift))
241    (compile 'ash.1)
242    (values
243     (ash.1 8589934588 -1)
244     (ash.1 8589934588 -2)
245     (ash.1 8589934588 -3)
246     (ash.1 8589934588 -4)
247     (ash.1 8589934588 -5)
248     (ash.1 8589934588 -6)
249     (ash.1 8589934588 -31)))
250  4294967294
251  2147483647
252  1073741823
253  536870911
254  268435455
255  134217727
256  3)
257
258(deftest bignum-constant.1
259  (progn
260    (fmakunbound 'bignum-constant.1)
261    (defun bignum-constant.1 () #.most-positive-java-long)
262    (values (funcall 'bignum-constant.1)
263            (multiple-value-list (compile 'bignum-constant.1))
264            (compiled-function-p #'bignum-constant.1)
265            (funcall 'bignum-constant.1)))
266  #.most-positive-java-long
267  (bignum-constant.1 nil nil)
268  t
269  #.most-positive-java-long)
270
271(deftest bignum-constant.2
272  (progn
273    (fmakunbound 'bignum-constant.2)
274    (defun bignum-constant.2 () #.(1+ most-positive-java-long))
275    (values (funcall 'bignum-constant.2)
276            (multiple-value-list (compile 'bignum-constant.2))
277            (compiled-function-p #'bignum-constant.2)
278            (funcall 'bignum-constant.2)))
279  #.(1+ most-positive-java-long)
280  (bignum-constant.2 nil nil)
281  t
282  #.(1+ most-positive-java-long))
283
284(deftest bignum-constant.3
285  (progn
286    (fmakunbound 'bignum-constant.3)
287    (defun bignum-constant.3 () #.most-negative-java-long)
288    (values (funcall 'bignum-constant.3)
289            (multiple-value-list (compile 'bignum-constant.3))
290            (compiled-function-p #'bignum-constant.3)
291            (funcall 'bignum-constant.3)))
292  #.most-negative-java-long
293  (bignum-constant.3 nil nil)
294  t
295  #.most-negative-java-long)
296
297(deftest bignum-constant.4
298  (progn
299    (fmakunbound 'bignum-constant.4)
300    (defun bignum-constant.4 () #.(1- most-negative-java-long))
301    (values (funcall 'bignum-constant.4)
302            (multiple-value-list (compile 'bignum-constant.4))
303            (compiled-function-p #'bignum-constant.4)
304            (funcall 'bignum-constant.4)))
305  #.(1- most-negative-java-long)
306  (bignum-constant.4 nil nil)
307  t
308  #.(1- most-negative-java-long))
309
310(deftest shiftf.1
311  (progn
312    (fmakunbound 'shiftf.1)
313    (defun shiftf.1 (x)
314      (declare (type (integer -5213 238468) x))
315      (+ x (shiftf x 168771)))
316    (values (funcall 'shiftf.1 96411)
317            (multiple-value-list (compile 'shiftf.1))
318            (compiled-function-p #'shiftf.1)
319            (funcall 'shiftf.1 96411)))
320  192822
321  (shiftf.1 nil nil)
322  t
323  192822)
324
325(deftest logand-values.1
326  (ignore-errors (funcall (compile nil '(lambda () (logand 18 (values 42 7))))))
327  2)
328
329(deftest logand-lognot.1
330  (progn
331    (fmakunbound 'logand-lognot.1)
332    (defun logand-lognot.1 (x)
333      (declare (type (unsigned-byte 32) x))
334      (logand #.(1- (expt 2 32)) (lognot x)))
335    (values (funcall 'logand-lognot.1 123456789)
336            (multiple-value-list (compile 'logand-lognot.1))
337            (compiled-function-p #'logand-lognot.1)
338            (funcall 'logand-lognot.1 123456789)))
339  4171510506
340  (logand-lognot.1 nil nil)
341  t
342  4171510506)
343
344(deftest logior-logand-setf.1
345  (progn
346    (fmakunbound 'foo)
347    (defun foo (x y)
348      (declare (type (integer 2005076 2881158415) x))
349      (declare (type (integer -28121355 17748872) y))
350      (logior (logand (setf y -3475589)
351                      x))
352      y)
353    (values (funcall 'foo 12345678 42)
354            (multiple-value-list (compile 'foo))
355            (compiled-function-p #'foo)
356            (funcall 'foo 12345678 42)))
357  -3475589
358  (foo nil nil)
359  t
360  -3475589)
361
362(deftest logxor.1
363  (progn
364    (fmakunbound 'foo)
365    (defun foo ()
366      (logxor -4153366606 (- 0)))
367    (values (funcall 'foo)
368            (multiple-value-list (compile 'foo))
369            (compiled-function-p #'foo)
370            (funcall 'foo)))
371    -4153366606
372    (foo nil nil)
373    t
374    -4153366606)
375
376(define-compiler-test min.1
377  (lambda (x y)
378    (declare (type fixnum x y))
379    (min x y))
380  :args (3 4)
381  :results 3)
382
383(define-compiler-test min.2
384  (lambda (x y)
385    (declare (type fixnum x y))
386    (min x y))
387  :args (#.most-positive-fixnum #.most-negative-fixnum)
388  :results #.most-negative-fixnum)
389
390(define-compiler-test min.3
391  (lambda (x y)
392    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
393    (min x y))
394  :args (3 4)
395  :results 3)
396
397(define-compiler-test min.4
398  (lambda (x y)
399    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
400    (min x y))
401  :args (#.most-positive-java-long #.most-negative-java-long)
402  :results #.most-negative-java-long)
403
404(define-compiler-test max.1
405  (lambda (x y)
406    (declare (type fixnum x y))
407    (max x y))
408  :args (3 4)
409  :results 4)
410
411(define-compiler-test max.2
412  (lambda (x y)
413    (declare (type fixnum x y))
414    (max x y))
415  :args (#.most-positive-fixnum #.most-negative-fixnum)
416  :results #.most-positive-fixnum)
417
418(define-compiler-test max.3
419  (lambda (x y)
420    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
421    (max x y))
422  :args (3 4)
423  :results 4)
424
425(define-compiler-test max.4
426  (lambda (x y)
427    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
428    (max x y))
429  :args (#.most-positive-java-long #.most-negative-java-long)
430  :results #.most-positive-java-long)
431
Note: See TracBrowser for help on using the repository browser.