| 1 | ;;; misc-tests.lisp |
|---|
| 2 | ;;; |
|---|
| 3 | ;;; Copyright (C) 2005 Peter Graves |
|---|
| 4 | ;;; $Id: misc-tests.lisp 12935 2010-10-02 07:36:08Z 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 | (in-package #:abcl.test.lisp) |
|---|
| 21 | |
|---|
| 22 | (deftest misc.dotimes.1 |
|---|
| 23 | (progn |
|---|
| 24 | (fmakunbound 'misc.dotimes.1) |
|---|
| 25 | (defun misc.dotimes.1 () |
|---|
| 26 | (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum)) |
|---|
| 27 | (misc.dotimes.1)) |
|---|
| 28 | 420) |
|---|
| 29 | |
|---|
| 30 | (deftest dotimes.1.compiled |
|---|
| 31 | (progn |
|---|
| 32 | (fmakunbound 'dotimes.1.compiled) |
|---|
| 33 | (defun dotimes.1.compiled () |
|---|
| 34 | (let ((sum 0)) (dotimes (i 10) (setq i 42) (incf sum i)) sum)) |
|---|
| 35 | (compile 'dotimes.1.compiled) |
|---|
| 36 | (dotimes.1.compiled)) |
|---|
| 37 | 420) |
|---|
| 38 | |
|---|
| 39 | (deftest misc.dotimes.2 |
|---|
| 40 | (progn |
|---|
| 41 | (fmakunbound 'misc.dotimes.2) |
|---|
| 42 | (defun misc.dotimes.2 (count) |
|---|
| 43 | (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum)) |
|---|
| 44 | (misc.dotimes.2 10)) |
|---|
| 45 | 420) |
|---|
| 46 | |
|---|
| 47 | (deftest dotimes.2.compiled |
|---|
| 48 | (progn |
|---|
| 49 | (fmakunbound 'dotimes.2.compiled) |
|---|
| 50 | (defun dotimes.2.compiled (count) |
|---|
| 51 | (let ((sum 0)) (dotimes (i count) (setq i 42) (incf sum i)) sum)) |
|---|
| 52 | (compile 'dotimes.2.compiled) |
|---|
| 53 | (dotimes.2.compiled 10)) |
|---|
| 54 | 420) |
|---|
| 55 | |
|---|
| 56 | (deftest funcall.1 |
|---|
| 57 | (funcall |
|---|
| 58 | (compile nil (lambda (a b c d e f) (list a b c d e f))) |
|---|
| 59 | 1 2 3 4 5 6) |
|---|
| 60 | (1 2 3 4 5 6)) |
|---|
| 61 | |
|---|
| 62 | (deftest funcall.2 |
|---|
| 63 | (funcall |
|---|
| 64 | (compile nil (lambda (a b c d e f g) (list a b c d e f g ))) |
|---|
| 65 | 1 2 3 4 5 6 7) |
|---|
| 66 | (1 2 3 4 5 6 7)) |
|---|
| 67 | |
|---|
| 68 | (deftest funcall.3 |
|---|
| 69 | (funcall |
|---|
| 70 | (compile nil (lambda (a b c d e f g h) (list a b c d e f g h))) |
|---|
| 71 | 1 2 3 4 5 6 7 8) |
|---|
| 72 | (1 2 3 4 5 6 7 8)) |
|---|
| 73 | |
|---|
| 74 | (deftest funcall.4 |
|---|
| 75 | (funcall |
|---|
| 76 | (compile nil (lambda (a b c d e f g h i) (list a b c d e f g h i))) |
|---|
| 77 | 1 2 3 4 5 6 7 8 9) |
|---|
| 78 | (1 2 3 4 5 6 7 8 9)) |
|---|
| 79 | |
|---|
| 80 | (deftest funcall.5 |
|---|
| 81 | (funcall |
|---|
| 82 | (compile nil (lambda (a b c d e f g h i j) (list a b c d e f g h i j))) |
|---|
| 83 | 1 2 3 4 5 6 7 8 9 10) |
|---|
| 84 | (1 2 3 4 5 6 7 8 9 10)) |
|---|
| 85 | |
|---|
| 86 | (deftest copy-list.1 |
|---|
| 87 | (eq (copy-list nil) nil) |
|---|
| 88 | t) |
|---|
| 89 | |
|---|
| 90 | (deftest read-from-string.1 |
|---|
| 91 | (read-from-string "(1 2 #-abcl #k(3 4))") |
|---|
| 92 | (1 2) |
|---|
| 93 | 20) |
|---|
| 94 | |
|---|
| 95 | (deftest read-from-string.2 |
|---|
| 96 | (read-from-string "(1 2 #+nil #k(3 4))") |
|---|
| 97 | (1 2) |
|---|
| 98 | 19) |
|---|
| 99 | |
|---|
| 100 | ;; executed of the compiled expression below |
|---|
| 101 | ;; resulted in an error on pre-0.23 versions |
|---|
| 102 | (defstruct mystruct slot) |
|---|
| 103 | (deftest ticket.107 |
|---|
| 104 | (funcall (compile nil |
|---|
| 105 | '(lambda () |
|---|
| 106 | (let ((struct (make-mystruct)) |
|---|
| 107 | x) |
|---|
| 108 | (setf (values (mystruct-slot struct) |
|---|
| 109 | x) |
|---|
| 110 | (values 42 2)))))) |
|---|
| 111 | 42 2) |
|---|