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/] [c3/] [c37108b.ada] - Blame information for rev 309

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn 
-- C37108B.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 IN AN OBJECT DECLARATION IF
26 
-- A DEFAULT INITIAL VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE
27 
-- CONSTRAINTS OF A RECORD OR AN ARRAY TYPE WHOSE CONSTRAINT
28 
-- DEPENDS ON A DISCRIMINANT, AND NO EXPLICIT INITIALIZATION IS
29 
-- PROVIDED FOR THE OBJECT.
30 
 
31 
-- R.WILLIAMS 8/25/86
32 
-- EDS        7/16/98    AVOID OPTIMIZATION
33 
 
34 
WITH REPORT; USE REPORT;
35 
PROCEDURE C37108B IS
36 
 
37 
     TYPE ARR IS ARRAY (POSITIVE RANGE <>) OF INTEGER;
38 
 
39 
     TYPE R (P : POSITIVE) IS
40 
          RECORD
41 
               NULL;
42 
          END RECORD;
43 
 
44 
BEGIN
45 
     TEST ( "C37108B", "CHECK THAT CONSTRAINT_ERROR IS RAISED IN " &
46 
                       "AN OBJECT DECLARATION IF A DEFAULT INITIAL " &
47 
                       "VALUE HAS BEEN SPECIFIED WHICH VIOLATES THE " &
48 
                       "CONSTRAINTS OF A RECORD OR AN ARRAY TYPE " &
49 
                       "WHOSE CONSTRAINT DEPENDS ON A DISCRIMINANT, " &
50 
                       "AND NO EXPLICIT INITIALIZATION IS PROVIDED " &
51 
                       "FOR THE OBJECT" );
52 
 
53 
 
54 
     BEGIN
55 
          DECLARE
56 
               TYPE REC1 (D : NATURAL := IDENT_INT (0)) IS
57 
                    RECORD
58 
                         A : ARR (D .. 5);
59 
                    END RECORD;
60 
 
61 
          BEGIN
62 
               DECLARE
63 
                    R1 : REC1;
64 
 
65 
               BEGIN
66 
                    R1.A (1) := IDENT_INT (2);
67 
                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
68 
                             "R1" & INTEGER'IMAGE(R1.A(5)));  --USE R2
69 
               EXCEPTION
70 
                    WHEN OTHERS =>
71 
                         FAILED ( "EXCEPTION FOR R1 RAISED INSIDE " &
72 
                                  "BLOCK" );
73 
               END;
74 
 
75 
          EXCEPTION
76 
               WHEN CONSTRAINT_ERROR =>
77 
                    NULL;
78 
               WHEN OTHERS =>
79 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
80 
                             "OF R1" );
81 
          END;
82 
 
83 
     EXCEPTION
84 
          WHEN CONSTRAINT_ERROR =>
85 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
86 
                        "DECLARATION OF REC1" );
87 
          WHEN OTHERS =>
88 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
89 
                        "DECLARATION OF REC1" );
90 
     END;
91 
 
92 
     BEGIN
93 
          DECLARE
94 
               TYPE REC2 (D : INTEGER := IDENT_INT (-1)) IS
95 
                    RECORD
96 
                         A : R (P => D);
97 
                    END RECORD;
98 
 
99 
          BEGIN
100 
               DECLARE
101 
                    R2 : REC2;
102 
 
103 
               BEGIN
104 
                    R2.A := R'(P => IDENT_INT (1));
105 
                    FAILED ( "NO EXCEPTION RAISED AT DECLARATION OF " &
106 
                             "R2" & INTEGER'IMAGE(R2.A.P));  --USE R2
107 
               EXCEPTION
108 
                    WHEN OTHERS =>
109 
                         FAILED ( "EXCEPTION FOR R2 RAISED INSIDE " &
110 
                                  "BLOCK" );
111 
               END;
112 
 
113 
          EXCEPTION
114 
               WHEN CONSTRAINT_ERROR =>
115 
                    NULL;
116 
               WHEN OTHERS =>
117 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
118 
                             "OF R2" );
119 
          END;
120 
 
121 
     EXCEPTION
122 
          WHEN CONSTRAINT_ERROR =>
123 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
124 
                        "DECLARATION OF REC2" );
125 
          WHEN OTHERS =>
126 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
127 
                        "DECLARATION OF REC2" );
128 
     END;
129 
 
130 
     BEGIN
131 
          DECLARE
132 
               PACKAGE PRIV IS
133 
                    TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS
134 
                         PRIVATE;
135 
                    PROCEDURE PROC (R :REC3);
136 
 
137 
               PRIVATE
138 
                    TYPE REC3 (D : INTEGER := IDENT_INT (-1)) IS
139 
                         RECORD
140 
                              A : R (P => D);
141 
                         END RECORD;
142 
               END PRIV;
143 
 
144 
               PACKAGE BODY PRIV IS
145 
                    PROCEDURE PROC (R : REC3) IS
146 
                         I : INTEGER;
147 
                    BEGIN
148 
                         I := IDENT_INT (R.A.P);
149 
                         IF EQUAL(2, IDENT_INT(1)) THEN
150 
                              FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
151 
                         END IF;
152 
                    END PROC;
153 
               END PRIV;
154 
 
155 
               USE PRIV;
156 
 
157 
          BEGIN
158 
               DECLARE
159 
                    R3 : REC3;
160 
 
161 
               BEGIN
162 
                    PROC (R3);
163 
                    FAILED ( "NO EXCEPTION RAISED AT " &
164 
                              "DECLARATION OF R3" );
165 
               EXCEPTION
166 
                    WHEN OTHERS =>
167 
                         FAILED ( "EXCEPTION FOR R3 RAISED INSIDE " &
168 
                                  "BLOCK" );
169 
               END;
170 
 
171 
          EXCEPTION
172 
               WHEN CONSTRAINT_ERROR =>
173 
                    NULL;
174 
               WHEN OTHERS =>
175 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
176 
                             "OF R3" );
177 
          END;
178 
 
179 
     EXCEPTION
180 
          WHEN CONSTRAINT_ERROR =>
181 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
182 
                        "DECLARATION OF REC3" );
183 
          WHEN OTHERS =>
184 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
185 
                        "DECLARATION OF REC3" );
186 
     END;
187 
 
188 
     BEGIN
189 
          DECLARE
190 
               PACKAGE LPRIV IS
191 
                    TYPE REC4 (D : NATURAL := IDENT_INT (0))
192 
                         IS LIMITED PRIVATE;
193 
                    PROCEDURE PROC (R :REC4);
194 
 
195 
               PRIVATE
196 
                    TYPE REC4 (D : NATURAL := IDENT_INT (0)) IS
197 
                         RECORD
198 
                              A : ARR (D .. 5);
199 
                         END RECORD;
200 
               END LPRIV;
201 
 
202 
               PACKAGE BODY LPRIV IS
203 
                    PROCEDURE PROC (R : REC4) IS
204 
                         I : INTEGER;
205 
                    BEGIN
206 
                         I := IDENT_INT (R.A'FIRST);
207 
                         IF EQUAL(2, IDENT_INT(1)) THEN
208 
                              FAILED("IMPOSSIBLE " & INTEGER'IMAGE(I));  --USE I
209 
                         END IF;
210 
                    END PROC;
211 
               END LPRIV;
212 
 
213 
               USE LPRIV;
214 
 
215 
          BEGIN
216 
               DECLARE
217 
                    R4 : REC4;
218 
 
219 
               BEGIN
220 
                    PROC (R4);
221 
                    FAILED ( "NO EXCEPTION RAISED AT " &
222 
                             "DECLARATION OF R4" );
223 
               EXCEPTION
224 
                    WHEN OTHERS =>
225 
                         FAILED ( "EXCEPTION FOR R4 RAISED INSIDE " &
226 
                                  "BLOCK" );
227 
               END;
228 
 
229 
          EXCEPTION
230 
               WHEN CONSTRAINT_ERROR =>
231 
                    NULL;
232 
               WHEN OTHERS =>
233 
                    FAILED ( "WRONG EXCEPTION RAISED AT DECLARATION " &
234 
                             "OF R4" );
235 
          END;
236 
 
237 
     EXCEPTION
238 
          WHEN CONSTRAINT_ERROR =>
239 
               FAILED ( "CONSTRAINT_ERROR RAISED FOR TYPE " &
240 
                        "DECLARATION OF REC4" );
241 
          WHEN OTHERS =>
242 
               FAILED ( "OTHER EXCEPTION RAISED FOR TYPE " &
243 
                        "DECLARATION OF REC4" );
244 
     END;
245 
 
246 
     RESULT;
247 
END C37108B;

powered by: WebSVN 2.1.0

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