OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c41104a.ada] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- C41104A.ADA
2
 
3
--                             Grant of Unlimited Rights
4
--
5
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
7
--     unlimited rights in the software and documentation contained herein.
8
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
9
--     this public release, the Government intends to confer upon all 
10
--     recipients unlimited rights  equal to those held by the Government.  
11
--     These rights include rights to use, duplicate, release or disclose the 
12
--     released technical data and computer software in whole or in part, in 
13
--     any manner and for any purpose whatsoever, and to have or permit others 
14
--     to do so.
15
--
16
--                                    DISCLAIMER
17
--
18
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
20
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
22
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23
--     PARTICULAR PURPOSE OF SAID MATERIAL.
24
--*
25
-- CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN EXPRESSION GIVES AN INDEX
26
-- VALUE OUTSIDE THE RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND ACCESS
27
-- TYPES.
28
 
29
-- TBN  9/12/86
30
-- EDS  8/03/98  AVOID OPTIMIZATION
31
 
32
WITH REPORT; USE REPORT;
33
PROCEDURE C41104A IS
34
 
35
     SUBTYPE INT IS INTEGER RANGE 1 .. 5;
36
     SUBTYPE BOOL IS BOOLEAN RANGE TRUE .. TRUE;
37
     SUBTYPE CHAR IS CHARACTER RANGE 'W' .. 'Z';
38
     TYPE ARRAY1 IS ARRAY (INT RANGE <>) OF INTEGER;
39
     TYPE ARRAY2 IS ARRAY (3 .. 1) OF INTEGER;
40
     TYPE ARRAY3 IS ARRAY (BOOL RANGE <>) OF INTEGER;
41
     TYPE ARRAY4 IS ARRAY (CHAR RANGE <>) OF INTEGER;
42
 
43
     TYPE REC (D : INT) IS
44
          RECORD
45
               A : ARRAY1 (1 .. D);
46
          END RECORD;
47
 
48
     TYPE B_REC (D : BOOL) IS
49
          RECORD
50
               A : ARRAY3 (TRUE .. D);
51
          END RECORD;
52
 
53
     TYPE NULL_REC (D : INT) IS
54
          RECORD
55
               A : ARRAY1 (D .. 1);
56
          END RECORD;
57
 
58
     TYPE NULL_CREC (D : CHAR) IS
59
          RECORD
60
               A : ARRAY4 (D .. 'W');
61
          END RECORD;
62
 
63
BEGIN
64
     TEST ("C41104A", "CHECK THAT CONSTRAINT_ERROR IS RAISED IF AN " &
65
                      "EXPRESSION GIVES AN INDEX VALUE OUTSIDE THE " &
66
                      "RANGE SPECIFIED FOR THE INDEX FOR ARRAYS AND " &
67
                      "ACCESS TYPES");
68
 
69
     DECLARE
70
          ARA1 : ARRAY1 (1 .. 5) := (1, 2, 3, 4, 5);
71
     BEGIN
72
          ARA1 (IDENT_INT(0)) := 1;
73
 
74
          BEGIN
75
               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
76
                        INTEGER'IMAGE(ARA1 (1)));
77
          EXCEPTION
78
               WHEN OTHERS =>
79
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
80
          END;
81
 
82
     EXCEPTION
83
          WHEN CONSTRAINT_ERROR =>
84
               NULL;
85
          WHEN OTHERS =>
86
               FAILED ("WRONG EXCEPTION RAISED - 1");
87
     END;
88
------------------------------------------------------------------------
89
     DECLARE
90
          TYPE ACC_ARRAY IS ACCESS ARRAY3 (TRUE .. TRUE);
91
          ACC_ARA : ACC_ARRAY := NEW ARRAY3'(TRUE => 2);
92
     BEGIN
93
          ACC_ARA (IDENT_BOOL(FALSE)) := 2;
94
 
95
          BEGIN
96
 
97
               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
98
                        INTEGER'IMAGE(ACC_ARA (TRUE)));
99
          EXCEPTION
100
               WHEN OTHERS =>
101
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
102
          END;
103
 
104
     EXCEPTION
105
          WHEN CONSTRAINT_ERROR =>
106
               NULL;
107
          WHEN OTHERS =>
108
               FAILED ("WRONG EXCEPTION RAISED - 2");
109
     END;
110
------------------------------------------------------------------------
111
     DECLARE
112
          ARA2 : ARRAY4 ('Z' .. 'Y');
113
     BEGIN
114
          ARA2 (IDENT_CHAR('Y')) := 3;
115
 
116
          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 3");
117
 
118
          BEGIN
119
               COMMENT ("ARA2 (Y) IS " & INTEGER'IMAGE(ARA2 ('Y')));
120
          EXCEPTION
121
               WHEN OTHERS =>
122
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
123
          END;
124
 
125
     EXCEPTION
126
          WHEN CONSTRAINT_ERROR =>
127
               NULL;
128
          WHEN OTHERS =>
129
               FAILED ("WRONG EXCEPTION RAISED - 3");
130
     END;
131
------------------------------------------------------------------------
132
     DECLARE
133
          TYPE ACC_ARRAY IS ACCESS ARRAY2;
134
          ACC_ARA : ACC_ARRAY := NEW ARRAY2;
135
     BEGIN
136
          ACC_ARA (IDENT_INT(4)) := 4;
137
 
138
          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 4");
139
 
140
          BEGIN
141
               COMMENT ("ACC_ARA (4) IS " & INTEGER'IMAGE(ACC_ARA (4)));
142
          EXCEPTION
143
               WHEN OTHERS =>
144
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
145
          END;
146
 
147
     EXCEPTION
148
          WHEN CONSTRAINT_ERROR =>
149
               NULL;
150
          WHEN OTHERS =>
151
               FAILED ("WRONG EXCEPTION RAISED - 4");
152
     END;
153
------------------------------------------------------------------------
154
     DECLARE
155
          REC1 : B_REC (TRUE) := (TRUE, A => (TRUE => 5));
156
     BEGIN
157
          REC1.A (IDENT_BOOL (FALSE)) := 1;
158
 
159
          BEGIN
160
               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
161
                       INTEGER'IMAGE(REC1.A (TRUE)));
162
          EXCEPTION
163
               WHEN OTHERS =>
164
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
165
          END;
166
 
167
     EXCEPTION
168
          WHEN CONSTRAINT_ERROR =>
169
               NULL;
170
          WHEN OTHERS =>
171
               FAILED ("WRONG EXCEPTION RAISED - 5");
172
     END;
173
------------------------------------------------------------------------
174
     DECLARE
175
          TYPE ACC_REC IS ACCESS REC (3);
176
          ACC_REC1 : ACC_REC := NEW REC'(3, (4, 5, 6));
177
     BEGIN
178
          ACC_REC1.A (IDENT_INT(4)) := 4;
179
 
180
          BEGIN
181
               FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - " &
182
                        INTEGER'IMAGE(ACC_REC1.A (3)));
183
          EXCEPTION
184
               WHEN OTHERS =>
185
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
186
          END;
187
 
188
     EXCEPTION
189
          WHEN CONSTRAINT_ERROR =>
190
               NULL;
191
          WHEN OTHERS =>
192
               FAILED ("WRONG EXCEPTION RAISED - 6");
193
     END;
194
------------------------------------------------------------------------
195
     DECLARE
196
          REC1 : NULL_REC (2);
197
     BEGIN
198
          REC1.A (IDENT_INT(2)) := 1;
199
 
200
          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 7");
201
 
202
          BEGIN
203
               COMMENT ("REC1.A (2) IS " & INTEGER'IMAGE(REC1.A (2)));
204
          EXCEPTION
205
               WHEN OTHERS =>
206
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
207
          END;
208
 
209
     EXCEPTION
210
          WHEN CONSTRAINT_ERROR =>
211
               NULL;
212
          WHEN OTHERS =>
213
               FAILED ("WRONG EXCEPTION RAISED - 7");
214
     END;
215
------------------------------------------------------------------------
216
     DECLARE
217
          TYPE ACC_REC IS ACCESS NULL_CREC ('Z');
218
          ACC_REC1 : ACC_REC := NEW NULL_CREC ('Z');
219
     BEGIN
220
          ACC_REC1.A (IDENT_CHAR('A')) := 4;
221
 
222
          FAILED ("CONSTRAINT_ERROR WAS NOT RAISED - 8");
223
          BEGIN
224
               COMMENT ("ACC_REC1.A (A) IS " &
225
                         INTEGER'IMAGE(ACC_REC1.A ('A')));
226
          EXCEPTION
227
               WHEN OTHERS =>
228
                    FAILED ("EXCEPTION ON ATTEMPT TO USE OBJECT");
229
          END;
230
 
231
     EXCEPTION
232
          WHEN CONSTRAINT_ERROR =>
233
               NULL;
234
          WHEN OTHERS =>
235
               FAILED ("WRONG EXCEPTION RAISED - 8");
236
     END;
237
------------------------------------------------------------------------
238
 
239
     RESULT;
240
END C41104A;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.