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

Subversion Repositories openrisc_2011-10-31

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C46044B.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 FOR CONVERSION TO A
26 
-- CONSTRAINED ARRAY TYPE IF THE TARGET TYPE IS NON-NULL AND
27 
-- CORRESPONDING DIMENSIONS OF THE TARGET AND OPERAND DO NOT HAVE
28 
-- THE SAME LENGTH. ALSO, CHECK THAT CONSTRAINT_ERROR IS RAISED IF
29 
-- THE TARGET TYPE IS NULL AND THE OPERAND TYPE IS NON-NULL.
30 
 
31 
-- R.WILLIAMS 9/8/86
32 
 
33 
WITH REPORT; USE REPORT;
34 
PROCEDURE C46044B IS
35 
 
36 
     TYPE ARR1 IS ARRAY (INTEGER RANGE <>) OF INTEGER;
37 
 
38 
     SUBTYPE CARR1A IS ARR1 (IDENT_INT (1) .. IDENT_INT (6));
39 
     C1A : CARR1A := (CARR1A'RANGE => 0);
40 
 
41 
     SUBTYPE CARR1B IS ARR1 (IDENT_INT (2) .. IDENT_INT (5));
42 
     C1B : CARR1B := (CARR1B'RANGE => 0);
43 
 
44 
     SUBTYPE CARR1N IS ARR1 (IDENT_INT (1) .. IDENT_INT (0));
45 
     C1N : CARR1N := (CARR1N'RANGE => 0);
46 
 
47 
     TYPE ARR2 IS ARRAY (INTEGER RANGE <>, INTEGER RANGE <>) OF
48 
          INTEGER;
49 
 
50 
     SUBTYPE CARR2A IS ARR2 (IDENT_INT (1) .. IDENT_INT (2),
51 
                             IDENT_INT (1) .. IDENT_INT (2));
52 
     C2A : CARR2A := (CARR2A'RANGE (1) => (CARR2A'RANGE (2) => 0));
53 
 
54 
     SUBTYPE CARR2B IS ARR2 (IDENT_INT (0) .. IDENT_INT (2),
55 
                             IDENT_INT (0) .. IDENT_INT (2));
56 
     C2B : CARR2B := (CARR2B'RANGE (1) => (CARR2B'RANGE (2) => 0));
57 
 
58 
     SUBTYPE CARR2N IS ARR2 (IDENT_INT (2) .. IDENT_INT (1),
59 
                             IDENT_INT (1) .. IDENT_INT (2));
60 
     C2N : CARR2N := (CARR2N'RANGE (1) => (CARR2N'RANGE (2) => 0));
61 
 
62 
     PROCEDURE CHECK1 (A : ARR1; STR : STRING) IS
63 
     BEGIN
64 
          FAILED ( "NO EXCEPTION RAISED - " & STR );
65 
     END CHECK1;
66 
 
67 
     PROCEDURE CHECK2 (A : ARR2; STR : STRING) IS
68 
     BEGIN
69 
          FAILED ( "NO EXCEPTION RAISED - " & STR );
70 
     END CHECK2;
71 
 
72 
BEGIN
73 
     TEST ( "C46044B", "CHECK THAT CONSTRAINT ERROR IS RAISED FOR " &
74 
                       "CONVERSION TO A CONSTRAINED ARRAY TYPE " &
75 
                       "IF THE TARGET TYPE IS NON-NULL AND " &
76 
                       "CORRESPONDING DIMENSIONS OF THE TARGET AND " &
77 
                       "OPERAND DO NOT HAVE THE SAME LENGTH. " &
78 
                       "ALSO, CHECK THAT CONSTRAINT_ERROR IS " &
79 
                       "RAISED IF THE TARGET TYPE IS NULL AND " &
80 
                       "THE OPERAND TYPE IS NON-NULL" );
81 
 
82 
     BEGIN -- (A).
83 
          C1A := C1B;
84 
          CHECK1 (C1A, "(A)");
85 
     EXCEPTION
86 
          WHEN CONSTRAINT_ERROR =>
87 
               NULL;
88 
          WHEN OTHERS =>
89 
               FAILED ( "WRONG EXCEPTION RAISED - (A)" );
90 
     END;
91 
 
92 
     BEGIN -- (B).
93 
          CHECK1 (CARR1A (C1B), "(B)");
94 
     EXCEPTION
95 
          WHEN CONSTRAINT_ERROR =>
96 
               NULL;
97 
          WHEN OTHERS =>
98 
               FAILED ( "WRONG EXCEPTION RAISED - (B)" );
99 
     END;
100 
 
101 
     BEGIN -- (C).
102 
          C1B := C1A;
103 
          CHECK1 (C1B, "(C)");
104 
     EXCEPTION
105 
          WHEN CONSTRAINT_ERROR =>
106 
               NULL;
107 
          WHEN OTHERS =>
108 
               FAILED ( "WRONG EXCEPTION RAISED - (C)" );
109 
     END;
110 
 
111 
     BEGIN -- (D).
112 
          CHECK1 (CARR1B (C1A), "(D)");
113 
     EXCEPTION
114 
          WHEN CONSTRAINT_ERROR =>
115 
               NULL;
116 
          WHEN OTHERS =>
117 
               FAILED ( "WRONG EXCEPTION RAISED - (D)" );
118 
     END;
119 
 
120 
     BEGIN -- (E).
121 
          C1A := C1N;
122 
          CHECK1 (C1A, "(E)");
123 
     EXCEPTION
124 
          WHEN CONSTRAINT_ERROR =>
125 
               NULL;
126 
          WHEN OTHERS =>
127 
               FAILED ( "WRONG EXCEPTION RAISED - (E)" );
128 
     END;
129 
 
130 
     BEGIN -- (F).
131 
          CHECK1 (CARR1A (C1N), "(F)");
132 
     EXCEPTION
133 
          WHEN CONSTRAINT_ERROR =>
134 
               NULL;
135 
          WHEN OTHERS =>
136 
               FAILED ( "WRONG EXCEPTION RAISED - (F)" );
137 
     END;
138 
 
139 
     BEGIN -- (G).
140 
          C2A := C2B;
141 
          CHECK2 (C2A, "(G)");
142 
     EXCEPTION
143 
          WHEN CONSTRAINT_ERROR =>
144 
               NULL;
145 
          WHEN OTHERS =>
146 
               FAILED ( "WRONG EXCEPTION RAISED - (G)" );
147 
     END;
148 
 
149 
     BEGIN -- (H).
150 
          CHECK2 (CARR2A (C2B), "(H)");
151 
     EXCEPTION
152 
          WHEN CONSTRAINT_ERROR =>
153 
               NULL;
154 
          WHEN OTHERS =>
155 
               FAILED ( "WRONG EXCEPTION RAISED - (H)" );
156 
     END;
157 
 
158 
     BEGIN -- (I).
159 
          C2B := C2A;
160 
          CHECK2 (C2B, "(I)");
161 
     EXCEPTION
162 
          WHEN CONSTRAINT_ERROR =>
163 
               NULL;
164 
          WHEN OTHERS =>
165 
               FAILED ( "WRONG EXCEPTION RAISED - (I)" );
166 
     END;
167 
 
168 
     BEGIN -- (J).
169 
          CHECK2 (CARR2A (C2B), "(J)");
170 
     EXCEPTION
171 
          WHEN CONSTRAINT_ERROR =>
172 
               NULL;
173 
          WHEN OTHERS =>
174 
               FAILED ( "WRONG EXCEPTION RAISED - (J)" );
175 
     END;
176 
 
177 
     BEGIN -- (K).
178 
          C2A := C2N;
179 
          CHECK2 (C2A, "(K)");
180 
     EXCEPTION
181 
          WHEN CONSTRAINT_ERROR =>
182 
               NULL;
183 
          WHEN OTHERS =>
184 
               FAILED ( "WRONG EXCEPTION RAISED - (K)" );
185 
     END;
186 
 
187 
     BEGIN -- (L).
188 
          CHECK2 (CARR2A (C2N), "(L)");
189 
     EXCEPTION
190 
          WHEN CONSTRAINT_ERROR =>
191 
               NULL;
192 
          WHEN OTHERS =>
193 
               FAILED ( "WRONG EXCEPTION RAISED - (L)" );
194 
     END;
195 
 
196 
     BEGIN -- (M).
197 
          C1N := C1A;
198 
          CHECK1 (C1N, "(M)");
199 
     EXCEPTION
200 
          WHEN CONSTRAINT_ERROR =>
201 
               NULL;
202 
          WHEN OTHERS =>
203 
               FAILED ( "WRONG EXCEPTION RAISED - (M)" );
204 
     END;
205 
 
206 
     BEGIN -- (N).
207 
          CHECK1 (CARR1N (C1A), "(N)");
208 
     EXCEPTION
209 
          WHEN CONSTRAINT_ERROR =>
210 
               NULL;
211 
          WHEN OTHERS =>
212 
               FAILED ( "WRONG EXCEPTION RAISED - (N)" );
213 
     END;
214 
 
215 
     BEGIN -- (O).
216 
          C2N := C2A;
217 
          CHECK2 (C2N, "(O)");
218 
     EXCEPTION
219 
          WHEN CONSTRAINT_ERROR =>
220 
               NULL;
221 
          WHEN OTHERS =>
222 
               FAILED ( "WRONG EXCEPTION RAISED - (O)" );
223 
     END;
224 
 
225 
     BEGIN -- (P).
226 
          CHECK2 (CARR2N (C2A), "(P)");
227 
     EXCEPTION
228 
          WHEN CONSTRAINT_ERROR =>
229 
               NULL;
230 
          WHEN OTHERS =>
231 
               FAILED ( "WRONG EXCEPTION RAISED - (P)" );
232 
     END;
233 
 
234 
     RESULT;
235 
END C46044B;

powered by: WebSVN 2.1.0

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