← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/progv.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/progv.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Oct 12 10:00:50 2002
 
4
;;;; Contains: Tests for PROGV
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest progv.1
 
9
  (progv () () t)
 
10
  t)
 
11
 
 
12
(deftest progv.2
 
13
  (progv '(x) '(1) (not (not (boundp 'x))))
 
14
  t)
 
15
 
 
16
(deftest progv.3
 
17
  (progv '(x) '(1) (symbol-value 'x))
 
18
  1)
 
19
 
 
20
(deftest progv.4
 
21
  (progv '(x) '(1)
 
22
    (locally (declare (special x))
 
23
             x))
 
24
  1)
 
25
 
 
26
(deftest progv.5
 
27
  (let ((x 0))
 
28
    (progv '(x) '(1) x))
 
29
  0)
 
30
 
 
31
(deftest progv.6
 
32
  (let ((x 0))
 
33
    (declare (special x))
 
34
    (progv '(x) ()
 
35
      (boundp 'x)))
 
36
  nil)
 
37
 
 
38
(deftest progv.6a
 
39
  (let ((x 0))
 
40
    (declare (special x))
 
41
    (progv '(x) () (setq x 1))
 
42
    x)
 
43
  0)
 
44
 
 
45
(deftest progv.7
 
46
  (progv '(x y z) '(1 2 3)
 
47
    (locally (declare (special x y z))
 
48
             (values x y z)))
 
49
  1 2 3)
 
50
 
 
51
(deftest progv.8
 
52
  (progv '(x y z) '(1 2 3 4 5 6 7 8)
 
53
    (locally (declare (special x y z))
 
54
             (values x y z)))
 
55
  1 2 3)
 
56
 
 
57
(deftest progv.9
 
58
  (let ((x 0))
 
59
    (declare (special x))
 
60
    (progv '(x y z w) '(1)
 
61
      (values (not (not (boundp 'x)))
 
62
              (boundp 'y)
 
63
              (boundp 'z)
 
64
              (boundp 'w))))
 
65
  t nil nil nil)
 
66
 
 
67
;; forms are evaluated in order
 
68
 
 
69
(deftest progv.10
 
70
  (let ((x 0) (y 0) (c 0))
 
71
    (progv
 
72
        (progn (setf x (incf c)) nil)
 
73
        (progn (setf y (incf c)) nil)
 
74
      (values x y c)))
 
75
  1 2 2)
 
76
 
 
77
;;; No tagbody
 
78
 
 
79
(deftest progv.11
 
80
  (block nil
 
81
    (tagbody
 
82
     (progv nil nil (go 10) 10 (return 'bad))
 
83
     10
 
84
     (return 'good)))
 
85
  good)
 
86
 
 
87
;;; Variables that are not bound don't have any type constraints
 
88
 
 
89
(deftest progv.12
 
90
  (progv '(x y) '(1)
 
91
    (locally (declare  (special x y) (type nil y))
 
92
             (values
 
93
              x
 
94
              (boundp 'y))))
 
95
  1 nil)