OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c4/] [c43206a.ada] - Blame information for rev 338

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.