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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c43206a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C43206A.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 THE BOUNDS OF A NULL ARRAY AGGREGATE ARE DETERMINED
26
-- BY THE BOUNDS SPECIFIED BY THE CHOICES. IN PARTICULAR, CHECK
27
-- THAT:
28
 
29
--   A) THE UPPER BOUND IS NOT REQUIRED TO BE THE PREDECESSOR OF
30
--      THE LOWER BOUND.
31
 
32
--   B) NEITHER THE UPPER NOR THE LOWER BOUND NEED BELONG TO THE
33
--      INDEX SUBTYPE FOR NULL RANGES.
34
 
35
--   C) IF ONE CHOICE OF A MULTIDIMENSIONAL AGGREGATE IS NON-NULL
36
--      BUT THE AGGREGATE IS A NULL ARRAY, CONSTRAINT_ERROR IS 
37
--      RAISED WHEN THE NON-NULL CHOICES DO NOT BELONG TO THE
38
--      INDEX SUBTYPE.
39
 
40
-- *** NOTE: This test has been modified since ACVC version 1.11 to    -- 9X
41
-- ***       remove incompatibilities associated with the transition   -- 9X
42
-- ***       to Ada 9X.                                                -- 9X
43
 
44
-- EG  02/02/84
45
-- JBG 12/6/84
46
-- JRL 03/30/93 REMOVED NUMERIC_ERROR FROM TEST.
47
 
48
WITH REPORT;
49
 
50
PROCEDURE C43206A IS
51
 
52
     USE REPORT;
53
 
54
BEGIN
55
 
56
     TEST("C43206A", "CHECK THAT THE BOUNDS OF A NULL ARRAY ARE " &
57
                     "DETERMINED BY THE BOUNDS SPECIFIED BY THE " &
58
                     "CHOICES");
59
 
60
     DECLARE
61
 
62
          SUBTYPE ST1 IS INTEGER RANGE 10 .. 15;
63
          SUBTYPE ST2 IS INTEGER RANGE 1 .. 5;
64
 
65
          TYPE T1 IS ARRAY (ST1 RANGE <>) OF INTEGER;
66
          TYPE T2 IS ARRAY (ST2 RANGE <>, ST1 RANGE <>) OF INTEGER;
67
 
68
     BEGIN
69
 
70
CASE_A :  BEGIN
71
 
72
     CASE_A1 : DECLARE
73
 
74
                    PROCEDURE PROC1 (A : T1) IS
75
                    BEGIN
76
                         IF A'FIRST /= 12 OR A'LAST /= 10 THEN
77
                              FAILED ("CASE A1 : INCORRECT BOUNDS");
78
                         END IF;
79
                    END PROC1;
80
 
81
               BEGIN
82
 
83
                    PROC1((12 .. 10 => -2));
84
 
85
               EXCEPTION
86
 
87
                    WHEN OTHERS =>
88
                         FAILED ("CASE A1 : EXCEPTION RAISED");
89
 
90
               END CASE_A1;
91
 
92
     CASE_A2 : DECLARE
93
 
94
                    PROCEDURE PROC1 (A : STRING) IS
95
                    BEGIN
96
                         IF A'FIRST /= 5 OR A'LAST /= 2 THEN
97
                              FAILED ("CASE A2 : INCORRECT BOUNDS");
98
                         END IF;
99
                    END PROC1;
100
 
101
               BEGIN
102
 
103
                    PROC1 ((5 .. 2 => 'E'));
104
 
105
               EXCEPTION
106
 
107
                    WHEN OTHERS =>
108
                         FAILED ("CASE A2 : EXCEPTION RAISED");
109
 
110
               END CASE_A2;
111
 
112
          END CASE_A;
113
 
114
CASE_B :  BEGIN
115
 
116
     CASE_B1 : DECLARE
117
 
118
                    PROCEDURE PROC1 (A : T1; L, U : INTEGER) IS
119
                    BEGIN
120
                         IF A'FIRST /= L OR A'LAST /= U THEN
121
                              FAILED ("CASE B1 : INCORRECT BOUNDS");
122
                         END IF;
123
                    END PROC1;
124
 
125
               BEGIN
126
 
127
                    BEGIN
128
 
129
                         PROC1 ((5 .. INTEGER'FIRST => -2),
130
                                 5, INTEGER'FIRST);
131
 
132
                    EXCEPTION
133
 
134
                         WHEN CONSTRAINT_ERROR =>
135
                              FAILED ("CASE B1A : CONSTRAINT_ERROR " &
136
                                      "RAISED FOR NULL RANGE");
137
                         WHEN OTHERS =>
138
                              FAILED ("CASE B1A : EXCEPTION RAISED");
139
 
140
                    END;
141
 
142
                    BEGIN
143
 
144
                         PROC1 ((IDENT_INT(6) .. 3 => -2),6,3);
145
 
146
                    EXCEPTION
147
 
148
                         WHEN OTHERS =>
149
                              FAILED ("CASE B1B : EXCEPTION RAISED");
150
 
151
                    END;
152
 
153
               END CASE_B1;
154
 
155
     CASE_B2 : DECLARE
156
 
157
                    PROCEDURE PROC1 (A : STRING) IS
158
                    BEGIN
159
                         IF A'FIRST /= 1 OR
160
                            A'LAST /= INTEGER'FIRST THEN
161
                              FAILED ("CASE B2 : INCORRECT BOUNDS");
162
                         END IF;
163
                    END PROC1;
164
 
165
               BEGIN
166
 
167
                    PROC1 ((1 .. INTEGER'FIRST => ' '));
168
 
169
               EXCEPTION
170
 
171
                    WHEN OTHERS =>
172
                         FAILED ("CASE B2 : EXCEPTION RAISED");
173
 
174
               END CASE_B2;
175
 
176
          END CASE_B;
177
 
178
CASE_C :  BEGIN
179
 
180
     CASE_C1 : DECLARE
181
 
182
                    PROCEDURE PROC1 (A : T2) IS
183
                    BEGIN
184
                         IF A'FIRST(1) /=  5 OR A'LAST(1) /=  3 OR
185
                            A'FIRST(2) /= INTEGER'LAST-1 OR
186
                            A'LAST(2)  /= INTEGER'LAST THEN
187
                              FAILED ("CASE C1 : INCORRECT BOUNDS");
188
                         END IF;
189
                    END PROC1;
190
 
191
               BEGIN
192
 
193
                    PROC1 ((5 .. 3 =>
194
                              (IDENT_INT(INTEGER'LAST-1) ..
195
                               IDENT_INT(INTEGER'LAST) => -2)));
196
                    FAILED ("CASE C1 : CONSTRAINT_ERROR NOT RAISED");
197
 
198
               EXCEPTION
199
 
200
                    WHEN CONSTRAINT_ERROR =>
201
                         NULL;
202
 
203
                    WHEN OTHERS =>
204
                         FAILED ("CASE C1 : EXCEPTION RAISED");
205
 
206
               END CASE_C1;
207
 
208
     CASE_C2 : DECLARE
209
 
210
                    PROCEDURE PROC1 (A : T2) IS
211
                    BEGIN
212
                         IF A'FIRST(1) /=  INTEGER'FIRST OR
213
                            A'LAST(1)  /=  INTEGER'FIRST+1 OR
214
                            A'FIRST(2) /= 14 OR A'LAST(2) /= 11 THEN
215
                              FAILED ("CASE C2 : INCORRECT BOUNDS");
216
                         END IF;
217
                    END PROC1;
218
 
219
               BEGIN
220
 
221
                    PROC1 ((IDENT_INT(INTEGER'FIRST) ..
222
                            IDENT_INT(INTEGER'FIRST+1) =>
223
                                    (14 .. IDENT_INT(11) => -2)));
224
                    FAILED ("CASE C2 : CONSTRAINT_ERROR NOT RAISED");
225
 
226
               EXCEPTION
227
 
228
                    WHEN CONSTRAINT_ERROR =>
229
                         NULL;
230
 
231
                    WHEN OTHERS =>
232
                         FAILED ("CASE C2 : EXCEPTION RAISED");
233
 
234
               END CASE_C2;
235
 
236
          END CASE_C;
237
 
238
     END;
239
 
240
     RESULT;
241
 
242
END C43206A;

powered by: WebSVN 2.1.0

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