← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/prog.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/prog.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Oct 19 09:21:57 2002
 
4
;;;; Contains: Tests of PROG
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest prog.1
 
9
  (prog ())
 
10
  nil)
 
11
 
 
12
(deftest prog.2
 
13
  (prog () 'a)
 
14
  nil)
 
15
 
 
16
(deftest prog.3
 
17
  (prog () (return 'a))
 
18
  a)
 
19
 
 
20
(deftest prog.4
 
21
  (prog () (return (values 1 2 3 4 5)))
 
22
  1 2 3 4 5)
 
23
 
 
24
(deftest prog.5
 
25
  (let ((x 'a))
 
26
    (prog ((x 'b) (y x))
 
27
          (declare (type symbol x y))
 
28
          (return (values x y))))
 
29
  b a)
 
30
 
 
31
(deftest prog.6
 
32
  (let ((x 'a))
 
33
    (prog (x) (setq x 'b))
 
34
    x)
 
35
  a)
 
36
 
 
37
(deftest prog.7
 
38
  (prog ((i 1) (s 0))
 
39
        (declare (type fixnum i s))
 
40
        again
 
41
        (when (> i 10) (return s))
 
42
        (incf s i)
 
43
        (incf i)
 
44
        (go again))
 
45
  55)
 
46
 
 
47
(deftest prog.8
 
48
  (let ((x 0))
 
49
    (prog ((y (incf x)) (z (incf x)))
 
50
          (return (values x y z))))
 
51
  2 1 2)
 
52
 
 
53
(deftest prog.9
 
54
  (flet ((%f () (locally (declare (special z)) z)))
 
55
    (prog ((z 10))
 
56
          (declare (special z))
 
57
          (return (%f))))
 
58
  10)
 
59
 
 
60
(deftest prog.10
 
61
  (prog ()
 
62
        (return
 
63
         (1+
 
64
          (prog ()
 
65
                (go end)
 
66
                done
 
67
                (return 1)
 
68
                end
 
69
                (go done))))
 
70
        done
 
71
        (return 'bad))
 
72
  2)
 
73
 
 
74
(def-macro-test prog.error.1 (prog nil))
 
75
 
 
76
;;; Tests of PROG*
 
77
 
 
78
(deftest prog*.1
 
79
  (prog* ())
 
80
  nil)
 
81
 
 
82
(deftest prog*.2
 
83
  (prog* () 'a)
 
84
  nil)
 
85
 
 
86
(deftest prog*.3
 
87
  (prog* () (return 'a))
 
88
  a)
 
89
 
 
90
(deftest prog*.4
 
91
  (prog* () (return (values 1 2 3 4 5)))
 
92
  1 2 3 4 5)
 
93
 
 
94
(deftest prog*.5
 
95
  (let ((x 'a))
 
96
    (prog* ((z x) (x 'b) (y x))
 
97
          (declare (type symbol x y))
 
98
          (return (values x y z))))
 
99
  b b a)
 
100
 
 
101
(deftest prog*.6
 
102
  (let ((x 'a))
 
103
    (prog* (x) (setq x 'b))
 
104
    x)
 
105
  a)
 
106
 
 
107
(deftest prog*.7
 
108
  (prog* ((i 1) (s 0))
 
109
        (declare (type fixnum i s))
 
110
        again
 
111
        (when (> i 10) (return s))
 
112
        (incf s i)
 
113
        (incf i)
 
114
        (go again))
 
115
  55)
 
116
 
 
117
(deftest prog*.8
 
118
  (let ((x 0))
 
119
    (prog* ((y (incf x)) (z (incf x)))
 
120
          (return (values x y z))))
 
121
  2 1 2)
 
122
 
 
123
(deftest prog*.9
 
124
  (flet ((%f () (locally (declare (special z)) z)))
 
125
    (prog* ((z 10))
 
126
          (declare (special z))
 
127
          (return (%f))))
 
128
  10)
 
129
 
 
130
(deftest prog*.10
 
131
  (prog* ()
 
132
        (return
 
133
         (1+
 
134
          (prog* ()
 
135
                (go end)
 
136
                done
 
137
                (return 1)
 
138
                end
 
139
                (go done))))
 
140
        done
 
141
        (return 'bad))
 
142
  2)
 
143
 
 
144
(def-macro-test prog*.error.1 (prog* nil))