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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c37108b.ada] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 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.