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

Last change on this file since 14146 was 14146, checked in by ehuelsmann, 8 years ago

Re #241: Add test cases.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.6 KB
Line 
1;;; compiler-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
4;;; $Id: compiler-tests.lisp 14146 2012-09-01 21:45:33Z ehuelsmann $
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  #+allegro            (unused.2 t   nil)
70  #+clisp              (unused.2 1   nil)
71  #+(or cmu sbcl abcl) (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#-clisp
108(define-compiler-test plus.4
109  (lambda (x y)
110    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
111    (+ x y))
112  :args (#.most-positive-java-long #.most-positive-java-long)
113  :results #.(+ most-positive-java-long most-positive-java-long))
114
115(define-compiler-test minus.1
116  (lambda (x)
117    (declare (type fixnum x))
118    (- x))
119  :args (#.most-negative-fixnum)
120  :results #.(- most-negative-fixnum))
121
122#-clisp
123(define-compiler-test minus.2
124  (lambda (x)
125    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x))
126    (- x))
127  :args (#.most-negative-java-long)
128  :results #.(- most-negative-java-long))
129
130#-clisp
131(define-compiler-test minus.3
132  (lambda (x y)
133    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
134    (- x y))
135  :args (#.most-negative-java-long #.most-positive-java-long)
136  :results #.(- most-negative-java-long most-positive-java-long))
137
138#-clisp
139(define-compiler-test logxor-minus.1
140  (lambda (x)
141    (declare (type (integer 0 255) x))
142    (logxor (- x) #.most-positive-java-long))
143  :args (17)
144  :results -9223372036854775792)
145
146#-clisp
147(deftest times.1
148  (progn
149    (fmakunbound 'times.1)
150    (defun times.1 (x y)
151      (* x y))
152    (compile 'times.1)
153    (times.1 most-positive-fixnum most-positive-fixnum))
154  #.(* most-positive-fixnum most-positive-fixnum))
155
156(deftest times.2
157  (progn
158    (fmakunbound 'times.2)
159    (defun times.2 (x y)
160      (declare (optimize speed))
161      (declare (type fixnum x y))
162      (* x y))
163    (compile 'times.2)
164    (times.2 most-positive-fixnum most-positive-fixnum))
165  #.(* most-positive-fixnum most-positive-fixnum))
166
167(deftest times.3
168  (progn
169    (fmakunbound 'times.3)
170    (defun times.3 (x y)
171      (declare (optimize speed (safety 0)))
172      (declare (type fixnum x y))
173      (* x y))
174    (compile 'times.3)
175    (times.3 most-positive-fixnum most-positive-fixnum))
176  #.(* most-positive-fixnum most-positive-fixnum))
177
178(deftest dotimes.1
179  (progn
180    (fmakunbound 'dotimes.1)
181    (defun dotimes.1 ()
182      (declare (optimize speed (safety 0)))
183      (let ((result 0))
184        (dotimes (i 10)
185          (incf result))
186        result))
187    (compile 'dotimes.1)
188    (dotimes.1))
189  10)
190
191(deftest dotimes.2
192  (progn
193    (fmakunbound 'dotimes.2)
194    (defun dotimes.2 ()
195      (declare (optimize speed (safety 0)))
196      (let ((result 0))
197        (declare (type fixnum result))
198        (dotimes (i 10)
199          (incf result))
200        result))
201    (compile 'dotimes.2)
202    (dotimes.2))
203  10)
204
205#+abcl
206(deftest derive-type-logxor.1
207  (let ((type
208         (jvm:derive-compiler-type `(logxor (the (unsigned-byte 8) x)
209                                            (the (unsigned-byte 8) y)))))
210    (and (sys:integer-type-p type)
211         (values
212          (sys:integer-type-low type)
213          (sys:integer-type-high type))))
214  0 255)
215
216#+abcl
217(deftest derive-type-logxor.2
218  (let ((type
219         (jvm:derive-compiler-type `(logxor 441516657
220                                            (the (integer 0 8589934588) x)))))
221    (and (sys:integer-type-p type)
222         (values
223          (sys:integer-type-low type)
224          (sys:integer-type-high type))))
225  0 8589934588)
226
227#+abcl
228(deftest derive-type-logxor.3
229  (let ((type
230         (jvm:derive-compiler-type `(logxor 441516657
231                                            (the (integer 0 8589934588) x)
232                                            (ash (the (integer 0 8589934588) x) -5)))))
233    (and (sys:integer-type-p type)
234         (values
235          (sys:integer-type-low type)
236          (sys:integer-type-high type))))
237  0 8589934588)
238
239(deftest ash.1
240  (progn
241    (fmakunbound 'ash.1)
242    (defun ash.1 (n shift)
243      (declare (type (integer 0 8589934588) n))
244      (declare (type (integer -31 -1) shift))
245      (ash n shift))
246    (compile 'ash.1)
247    (values
248     (ash.1 8589934588 -1)
249     (ash.1 8589934588 -2)
250     (ash.1 8589934588 -3)
251     (ash.1 8589934588 -4)
252     (ash.1 8589934588 -5)
253     (ash.1 8589934588 -6)
254     (ash.1 8589934588 -31)))
255  4294967294
256  2147483647
257  1073741823
258  536870911
259  268435455
260  134217727
261  3)
262
263#-clisp
264(deftest bignum-constant.1
265  (progn
266    (fmakunbound 'bignum-constant.1)
267    (defun bignum-constant.1 () #.most-positive-java-long)
268    (values (funcall 'bignum-constant.1)
269            (multiple-value-list (compile 'bignum-constant.1))
270            (compiled-function-p #'bignum-constant.1)
271            (funcall 'bignum-constant.1)))
272  #.most-positive-java-long
273  (bignum-constant.1 nil nil)
274  t
275  #.most-positive-java-long)
276
277#-clisp
278(deftest bignum-constant.2
279  (progn
280    (fmakunbound 'bignum-constant.2)
281    (defun bignum-constant.2 () #.(1+ most-positive-java-long))
282    (values (funcall 'bignum-constant.2)
283            (multiple-value-list (compile 'bignum-constant.2))
284            (compiled-function-p #'bignum-constant.2)
285            (funcall 'bignum-constant.2)))
286  #.(1+ most-positive-java-long)
287  (bignum-constant.2 nil nil)
288  t
289  #.(1+ most-positive-java-long))
290
291#-clisp
292(deftest bignum-constant.3
293  (progn
294    (fmakunbound 'bignum-constant.3)
295    (defun bignum-constant.3 () #.most-negative-java-long)
296    (values (funcall 'bignum-constant.3)
297            (multiple-value-list (compile 'bignum-constant.3))
298            (compiled-function-p #'bignum-constant.3)
299            (funcall 'bignum-constant.3)))
300  #.most-negative-java-long
301  (bignum-constant.3 nil nil)
302  t
303  #.most-negative-java-long)
304
305#-clisp
306(deftest bignum-constant.4
307  (progn
308    (fmakunbound 'bignum-constant.4)
309    (defun bignum-constant.4 () #.(1- most-negative-java-long))
310    (values (funcall 'bignum-constant.4)
311            (multiple-value-list (compile 'bignum-constant.4))
312            (compiled-function-p #'bignum-constant.4)
313            (funcall 'bignum-constant.4)))
314  #.(1- most-negative-java-long)
315  (bignum-constant.4 nil nil)
316  t
317  #.(1- most-negative-java-long))
318
319(deftest shiftf.1
320  (progn
321    (fmakunbound 'shiftf.1)
322    (defun shiftf.1 (x)
323      (declare (type (integer -5213 238468) x))
324      (+ x (shiftf x 168771)))
325    (values (funcall 'shiftf.1 96411)
326            (multiple-value-list (compile 'shiftf.1))
327            (compiled-function-p #'shiftf.1)
328            (funcall 'shiftf.1 96411)))
329  192822
330  (shiftf.1 nil nil)
331  t
332  192822)
333
334(deftest logand-values.1
335  (ignore-errors (funcall (compile nil '(lambda () (logand 18 (values 42 7))))))
336  2)
337
338(deftest logand-lognot.1
339  (progn
340    (fmakunbound 'logand-lognot.1)
341    (defun logand-lognot.1 (x)
342      (declare (type (unsigned-byte 32) x))
343      (logand #.(1- (expt 2 32)) (lognot x)))
344    (values (funcall 'logand-lognot.1 123456789)
345            (multiple-value-list (compile 'logand-lognot.1))
346            (compiled-function-p #'logand-lognot.1)
347            (funcall 'logand-lognot.1 123456789)))
348  4171510506
349  (logand-lognot.1 nil nil)
350  t
351  4171510506)
352
353(deftest logior-logand-setf.1
354  (progn
355    (fmakunbound 'foo)
356    (defun foo (x y)
357      (declare (type (integer 2005076 2881158415) x))
358      (declare (type (integer -28121355 17748872) y))
359      (logior (logand (setf y -3475589)
360                      x))
361      y)
362    (values (funcall 'foo 12345678 42)
363            (multiple-value-list (compile 'foo))
364            (compiled-function-p #'foo)
365            (funcall 'foo 12345678 42)))
366  -3475589
367  (foo nil nil)
368  t
369  -3475589)
370
371(deftest logxor.1
372  (progn
373    (fmakunbound 'foo)
374    (defun foo ()
375      (logxor -4153366606 (- 0)))
376    (values (funcall 'foo)
377            (multiple-value-list (compile 'foo))
378            (compiled-function-p #'foo)
379            (funcall 'foo)))
380    -4153366606
381    (foo nil nil)
382    t
383    -4153366606)
384
385(define-compiler-test min.1
386  (lambda (x y)
387    (declare (type fixnum x y))
388    (min x y))
389  :args (3 4)
390  :results 3)
391
392(define-compiler-test min.2
393  (lambda (x y)
394    (declare (type fixnum x y))
395    (min x y))
396  :args (#.most-positive-fixnum #.most-negative-fixnum)
397  :results #.most-negative-fixnum)
398
399#-clisp
400(define-compiler-test min.3
401  (lambda (x y)
402    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
403    (min x y))
404  :args (3 4)
405  :results 3)
406
407#-clisp
408(define-compiler-test min.4
409  (lambda (x y)
410    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
411    (min x y))
412  :args (#.most-positive-java-long #.most-negative-java-long)
413  :results #.most-negative-java-long)
414
415(define-compiler-test max.1
416  (lambda (x y)
417    (declare (type fixnum x y))
418    (max x y))
419  :args (3 4)
420  :results 4)
421
422#-clisp
423(define-compiler-test max.2
424  (lambda (x y)
425    (declare (type fixnum x y))
426    (max x y))
427  :args (#.most-positive-fixnum #.most-negative-fixnum)
428  :results #.most-positive-fixnum)
429
430#-clisp
431(define-compiler-test max.3
432  (lambda (x y)
433    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
434    (max x y))
435  :args (3 4)
436  :results 4)
437
438#-clisp
439(define-compiler-test max.4
440  (lambda (x y)
441    (declare (type (integer #.most-negative-java-long #.most-positive-java-long) x y))
442    (max x y))
443  :args (#.most-positive-java-long #.most-negative-java-long)
444  :results #.most-positive-java-long)
445
446;;; ticket #147
447#+abcl
448(deftest compiler.1 
449    (let ((tmpfile (ext::make-temp-file))
450          (forms `((in-package :cl-user)
451                     (eval-when (:compile-toplevel :load-toplevel :execute)
452                       (setf *print-case* ':downcase))
453                     (defstruct rec a b))))
454      (with-open-file (s tmpfile :direction :output)
455        (dolist (form forms)
456          (write form :stream s)))
457      (let ((result (compile-file tmpfile)))
458        (delete-file tmpfile)
459        (not (null result))))
460  t)
461
462;;; ticket #156
463#+abcl
464(deftest compiler.2
465    (let ((tmpfile (ext::make-temp-file))
466          (line "(defconstant a #.(make-array '(8 256)
467                    :element-type '(unsigned-byte 32) :initial-element 0))"))
468      (with-open-file (s tmpfile :direction :output)
469        (format s "~A" line))
470      (let ((result (compile-file tmpfile)))
471    #+nil    (delete-file tmpfile)
472        (not (null result))))
473  t)
474
475
476;;; ticket #189
477(deftest compiler.3
478    (eql (funcall (compile nil (lambda (a)
479                           (declare (type unsigned-byte a))
480                           (max 28105919 a 1016934843)))
481                  10545160975)
482         10545160975)
483  t)
484
485
486;;; ticket #241
487(deftest compiler.4a
488    (multiple-value-bind
489          (rv error)
490        (ignore-errors
491          (compile nil '(lambda (&rest args &optional x))))
492      (typep error 'program-error))
493  t)
494
495(deftest compiler.4b
496    (multiple-value-bind
497          (rv error)
498        (ignore-errors
499          (compile nil '(lambda (&key args &optional x))))
500      (typep error 'program-error))
501  t)
Note: See TracBrowser for help on using the repository browser.