dynamic-extent.lsp 3.54 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat May 21 09:10:52 2005
;;;; Contains: Tests of DYNAMIC-EXTENT

(in-package :cl-test)

(deftest dynamic-extent.1
  (let () (declare (dynamic-extent)))
  nil)

(deftest dynamic-extent.2
  (let ((x 'a))
14
    (declare (dynamic-extent x) (optimize speed (safety 0)))
15 16 17 18 19
    x)
  a)

(deftest dynamic-extent.3
  (let ((x (list 'a 'b 'c)))
20
    (declare (dynamic-extent x) (optimize speed (safety 0)))
21 22 23 24 25
    (length x))
  3)

(deftest dynamic-extent.4
  (let ((x (vector 'a 'b 'c)))
26
    (declare (dynamic-extent x) (optimize speed (safety 0)))
27 28 29 30 31
    (length x))
  3)

(deftest dynamic-extent.5
  (flet ((%f (x) (list 'a x)))
32
    (declare (dynamic-extent (function %f))
sds's avatar
sds committed
33
             (optimize speed (safety 0)))
34 35 36 37 38
    (mapcar #'%f '(1 2 3)))
  ((a 1) (a 2) (a 3)))

(deftest dynamic-extent.6
  (labels ((%f (x) (list 'a x)))
39
    (declare (dynamic-extent (function %f))
sds's avatar
sds committed
40
             (optimize speed (safety 0)))
41 42 43 44 45
    (mapcar #'%f '(1 2 3)))
  ((a 1) (a 2) (a 3)))

(deftest dynamic-extent.7
  (labels ((%f (x) (if (consp x)
sds's avatar
sds committed
46 47
                       (cons (%f (car x)) (%f (cdr x)))
                     '*)))
48
    (declare (dynamic-extent (function %f))
sds's avatar
sds committed
49
             (optimize speed (safety 0)))
50 51 52 53 54
    (mapcar #'%f '((1) 2 (3 4 5))))
  ((* . *) * (* * * . *)))

(deftest dynamic-extent.8
  (let ((x (+ most-positive-fixnum 2)))
55
    (declare (dynamic-extent x)
sds's avatar
sds committed
56
             (optimize speed (safety 0)))
57 58 59 60 61 62
    (1- x))
  #.(1+ most-positive-fixnum))

(deftest dynamic-extent.9
  (flet ((f () (list 'a 'b)))
    (let ((f (list 'c 'd)))
63
      (declare (dynamic-extent (function f))
sds's avatar
sds committed
64
               (optimize speed (safety 0)))
65 66 67 68 69 70 71
      f))
  (c d))

(deftest dynamic-extent.10
  (let ((x nil))
    (values
     x
72
     (locally (declare (dynamic-extent x) (notinline length)
sds's avatar
sds committed
73 74 75
                       (optimize speed (safety 0)))
              (setq x (list 'a 'b 'c 'd 'e))
              (prog1 (length x) (setq x t)))
76 77 78 79 80
     x))
  nil 5 t)

(deftest dynamic-extent.11
  (let* ((x (list 'a 'b))
sds's avatar
sds committed
81
         (y (cons 'c x)))
82
    (declare (dynamic-extent y)
sds's avatar
sds committed
83
             (optimize speed (safety 0)))
84 85 86
    (cdr y))
  (a b))

pfdietz's avatar
pfdietz committed
87 88
(deftest dynamic-extent.12
  (let* ((contents '(1 0 0 1 1 0 1 1 0 1))
sds's avatar
sds committed
89
         (n (length contents)))
pfdietz's avatar
pfdietz committed
90
    (loop for i from 1 to 32
sds's avatar
sds committed
91 92 93 94 95 96 97 98 99 100 101
          for type = `(unsigned-byte ,i)
          for form1 = `(make-array '(,n) :initial-contents ',contents
                                   :element-type ',type)
          for form2 = `(let ((a ,form1))
                         (declare (dynamic-extent a))
                         (declare (type (simple-array ,type (,n))))
                         (declare (notinline coerce))
                         (declare (optimize speed (safety 0)))
                         (equal (coerce a 'list) ',contents))
          unless (funcall (compile nil `(lambda () ,form2)))
          collect i))
pfdietz's avatar
pfdietz committed
102 103 104 105 106 107 108 109 110 111
  nil)

(deftest dynamic-extent.13
  (let ((s (make-string 10 :initial-element #\a)))
    (declare (dynamic-extent s) (optimize speed (safety 0)))
    (notnot (every #'(lambda (c) (eql c #\a)) s)))
  t)

(deftest dynamic-extent.14
  (let ((s (make-string 10 :initial-element #\a
sds's avatar
sds committed
112
                        :element-type 'base-char)))
pfdietz's avatar
pfdietz committed
113 114 115
    (declare (dynamic-extent s) (notinline every) (optimize speed (safety 0)))
    (notnot (every #'(lambda (c) (eql c #\a)) s)))
  t)
116

117 118
(deftest dynamic-extent.15
  (flet (((setf %f) (x y) (setf (car y) x)))
sds's avatar
sds committed
119 120
        (declare (dynamic-extent #'(setf %f)))
        :good)
121 122 123 124
  :good)

(deftest dynamic-extent.16
  (labels (((setf %f) (x y) (setf (car y) x)))
sds's avatar
sds committed
125 126
          (declare (dynamic-extent #'(setf %f)))
          :good)
127
  :good)
128 129