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

Last change on this file since 14245 was 14245, checked in by Mark Evenson, 8 years ago

abcl-test: Restore original *PRINT-CASE*.

Also seemingly "fixes" about four failing tests.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.6 KB
RevLine 
[10453]1;;; compiler-tests.lisp
2;;;
3;;; Copyright (C) 2005 Peter Graves
[11297]4;;; $Id: compiler-tests.lisp 14245 2012-11-15 12:33:00Z mevenson $
[10453]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
[10544]20#+abcl
21(require '#:jvm)
22
[11599]23(in-package #:abcl.test.lisp)
[10453]24
[10590]25(defconstant most-positive-java-long 9223372036854775807)
26(defconstant most-negative-java-long -9223372036854775808)
27
[10453]28#+abcl
[10590]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
[10757]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
[10590]49#+abcl
[10453]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
[10456]61     #-lispworks
[10453]62     (multiple-value-list (compile 'unused.2))
[10456]63     #+lispworks
64     (let ((list (multiple-value-list (compile 'unused.2))))
65       (list (first list)
66             (not (null (second list)))
67             (third list)))
[10453]68     (unused.2)))
[13262]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)
[10453]73  17)
74
75(deftest plus.1
76  (progn
[10456]77    (fmakunbound 'plus.1)
[10453]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
[10456]86    (fmakunbound 'plus.2)
[10453]87    (defun plus.2 (x y)
[10456]88      (declare (optimize speed))
[10453]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
[10456]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
[13262]107#-clisp
[10757]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
[13262]122#-clisp
[10757]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
[13262]130#-clisp
[10757]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
[13262]138#-clisp
[10757]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
[13262]146#-clisp
[10453]147(deftest times.1
148  (progn
[10456]149    (fmakunbound 'times.1)
[10453]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
[10456]158    (fmakunbound 'times.2)
[10453]159    (defun times.2 (x y)
[10456]160      (declare (optimize speed))
[10453]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
[10456]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
[10544]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
[10548]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
[13262]263#-clisp
[10590]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
[13262]277#-clisp
[10590]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
[13262]291#-clisp
[10590]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
[13262]305#-clisp
[10590]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
[10614]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
[10623]334(deftest logand-values.1
335  (ignore-errors (funcall (compile nil '(lambda () (logand 18 (values 42 7))))))
336  2)
337
[10626]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
[10630]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
[10635]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
[10757]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
[13262]399#-clisp
[10757]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
[13262]407#-clisp
[10757]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
[13262]422#-clisp
[10757]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
[13262]430#-clisp
[10757]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
[13262]438#-clisp
[10757]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
[13380]446;;; ticket #147
[13539]447#+abcl
[13380]448(deftest compiler.1 
449    (let ((tmpfile (ext::make-temp-file))
[14245]450          (original-print-case *print-case*)
[13380]451          (forms `((in-package :cl-user)
[14245]452                   (eval-when (:compile-toplevel :load-toplevel :execute)
453                     (setf *print-case* ':downcase))
454                   (defstruct rec a b))))
[13380]455      (with-open-file (s tmpfile :direction :output)
456        (dolist (form forms)
457          (write form :stream s)))
458      (let ((result (compile-file tmpfile)))
459        (delete-file tmpfile)
[14245]460        (setf *print-case* original-print-case)
[13380]461        (not (null result))))
462  t)
463
464;;; ticket #156
[13539]465#+abcl
[13380]466(deftest compiler.2
467    (let ((tmpfile (ext::make-temp-file))
468          (line "(defconstant a #.(make-array '(8 256)
469                    :element-type '(unsigned-byte 32) :initial-element 0))"))
470      (with-open-file (s tmpfile :direction :output)
471        (format s "~A" line))
472      (let ((result (compile-file tmpfile)))
473    #+nil    (delete-file tmpfile)
474        (not (null result))))
475  t)
476
477
[14143]478;;; ticket #189
479(deftest compiler.3
480    (eql (funcall (compile nil (lambda (a)
481                           (declare (type unsigned-byte a))
482                           (max 28105919 a 1016934843)))
483                  10545160975)
484         10545160975)
485  t)
[13380]486
[14146]487
488;;; ticket #241
489(deftest compiler.4a
490    (multiple-value-bind
491          (rv error)
492        (ignore-errors
493          (compile nil '(lambda (&rest args &optional x))))
494      (typep error 'program-error))
495  t)
496
497(deftest compiler.4b
498    (multiple-value-bind
499          (rv error)
500        (ignore-errors
501          (compile nil '(lambda (&key args &optional x))))
502      (typep error 'program-error))
[14245]503  t)
Note: See TracBrowser for help on using the repository browser.