source: trunk/source/tests/ansi-tests/dynamic-extent.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.2 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat May 21 09:10:52 2005
4;;;; Contains: Tests of DYNAMIC-EXTENT
5
6(in-package :cl-test)
7
8(deftest dynamic-extent.1
9  (let () (declare (dynamic-extent)))
10  nil)
11
12(deftest dynamic-extent.2
13  (let ((x 'a))
14    (declare (dynamic-extent x) (optimize speed (safety 0)))
15    x)
16  a)
17
18(deftest dynamic-extent.3
19  (let ((x (list 'a 'b 'c)))
20    (declare (dynamic-extent x) (optimize speed (safety 0)))
21    (length x))
22  3)
23
24(deftest dynamic-extent.4
25  (let ((x (vector 'a 'b 'c)))
26    (declare (dynamic-extent x) (optimize speed (safety 0)))
27    (length x))
28  3)
29
30(deftest dynamic-extent.5
31  (flet ((%f (x) (list 'a x)))
32    (declare (dynamic-extent (function %f))
33             (optimize speed (safety 0)))
34    (mapcar #'%f '(1 2 3)))
35  ((a 1) (a 2) (a 3)))
36
37(deftest dynamic-extent.6
38  (labels ((%f (x) (list 'a x)))
39    (declare (dynamic-extent (function %f))
40             (optimize speed (safety 0)))
41    (mapcar #'%f '(1 2 3)))
42  ((a 1) (a 2) (a 3)))
43
44(deftest dynamic-extent.7
45  (labels ((%f (x) (if (consp x)
46                       (cons (%f (car x)) (%f (cdr x)))
47                     '*)))
48    (declare (dynamic-extent (function %f))
49             (optimize speed (safety 0)))
50    (mapcar #'%f '((1) 2 (3 4 5))))
51  ((* . *) * (* * * . *)))
52
53(deftest dynamic-extent.8
54  (let ((x (+ most-positive-fixnum 2)))
55    (declare (dynamic-extent x)
56             (optimize speed (safety 0)))
57    (1- x))
58  #.(1+ most-positive-fixnum))
59
60(deftest dynamic-extent.9
61  (flet ((f () (list 'a 'b)))
62    (let ((f (list 'c 'd)))
63      (declare (dynamic-extent (function f))
64               (optimize speed (safety 0)))
65      f))
66  (c d))
67
68(deftest dynamic-extent.10
69  (let ((x nil))
70    (values
71     x
72     (locally (declare (dynamic-extent x) (notinline length)
73                       (optimize speed (safety 0)))
74              (setq x (list 'a 'b 'c 'd 'e))
75              (prog1 (length x) (setq x t)))
76     x))
77  nil 5 t)
78
79(deftest dynamic-extent.11
80  (let* ((x (list 'a 'b))
81         (y (cons 'c x)))
82    (declare (dynamic-extent y)
83             (optimize speed (safety 0)))
84    (cdr y))
85  (a b))
86
87(deftest dynamic-extent.12
88  (let* ((contents '(1 0 0 1 1 0 1 1 0 1))
89         (n (length contents)))
90    (loop for i from 1 to 32
91          for type = `(unsigned-byte ,i)
92          for form1 = `(make-array '(,n) :initial-contents ',contents
93                                   :element-type ',type)
94          for form2 = `(let ((a ,form1))
95                         (declare (dynamic-extent a))
96                         (declare (type (simple-array ,type (,n))))
97                         (declare (notinline coerce))
98                         (declare (optimize speed (safety 0)))
99                         (equal (coerce a 'list) ',contents))
100          unless (funcall (compile nil `(lambda () ,form2)))
101          collect i))
102  nil)
103
104(deftest dynamic-extent.13
105  (let ((s (make-string 10 :initial-element #\a)))
106    (declare (dynamic-extent s) (optimize speed (safety 0)))
107    (notnot (every #'(lambda (c) (eql c #\a)) s)))
108  t)
109
110(deftest dynamic-extent.14
111  (let ((s (make-string 10 :initial-element #\a
112                        :element-type 'base-char)))
113    (declare (dynamic-extent s) (notinline every) (optimize speed (safety 0)))
114    (notnot (every #'(lambda (c) (eql c #\a)) s)))
115  t)
116
117(deftest dynamic-extent.15
118  (flet (((setf %f) (x y) (setf (car y) x)))
119        (declare (dynamic-extent #'(setf %f)))
120        :good)
121  :good)
122
123(deftest dynamic-extent.16
124  (labels (((setf %f) (x y) (setf (car y) x)))
125          (declare (dynamic-extent #'(setf %f)))
126          :good)
127  :good)
128
129
Note: See TracBrowser for help on using the repository browser.