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/] [c37006a.ada] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C37006A.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
-- FOR A COMPONENT OF A RECORD, ACCESS, OR PRIVATE TYPE, OR FOR A 
26
-- LIMITED PRIVATE COMPONENT, CHECK THAT A NON-STATIC EXPRESSION CAN 
27
-- BE USED IN A DISCRIMINANT CONSTRAINT OR (EXCEPTING LIMITED PRIVATE 
28
-- COMPONENTS) IN SPECIFYING A DEFAULT INITIAL VALUE.
29
 
30
-- R.WILLIAMS 8/28/86
31
 
32
WITH REPORT; USE REPORT;
33
PROCEDURE C37006A IS
34
 
35
     SUBTYPE INT IS INTEGER RANGE 0 .. 100;
36
 
37
     TYPE ARR IS ARRAY (INT RANGE <>) OF INTEGER;
38
 
39
     TYPE REC1 (D1, D2 : INT) IS
40
          RECORD
41
               A : ARR (D1 .. D2);
42
          END RECORD;
43
 
44
     TYPE REC1_NAME IS ACCESS REC1;
45
 
46
     PROCEDURE CHECK (AR : ARR; STR : STRING) IS
47
     BEGIN
48
          IF AR'FIRST /= 1 OR AR'LAST /= 2 THEN
49
               FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN COMPONENT " &
50
                        "OF " & STR & " TYPE");
51
          ELSIF AR /= (3, 4) THEN
52
               FAILED ( "INITIALIZATION OF R.COMP.A IN COMPONENT OF " &
53
                         STR & " TYPE FAILED" );
54
          END IF;
55
     END CHECK;
56
 
57
     PACKAGE PACK IS
58
          TYPE PRIV (D1, D2 : INT) IS PRIVATE;
59
          TYPE LIM (D1, D2 : INT) IS LIMITED PRIVATE;
60
          FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV;
61
          PROCEDURE PRIV_CHECK (R : PRIV);
62
          PROCEDURE LIM_CHECK (R : LIM);
63
 
64
     PRIVATE
65
          TYPE PRIV (D1, D2 : INT) IS
66
               RECORD
67
                    A : ARR (D1 .. D2);
68
               END RECORD;
69
 
70
          TYPE LIM (D1, D2 : INT) IS
71
               RECORD
72
                    A : ARR (D1 .. D2);
73
               END RECORD;
74
     END PACK;
75
 
76
     PACKAGE BODY PACK IS
77
 
78
          FUNCTION PRIV_FUN (PARM1, PARM2 : INTEGER) RETURN PRIV IS
79
          BEGIN
80
               RETURN (IDENT_INT (1), IDENT_INT (2),
81
                       ARR'(1 => 3, 2 => 4));
82
          END PRIV_FUN;
83
 
84
          PROCEDURE PRIV_CHECK (R : PRIV) IS
85
          BEGIN
86
               CHECK (R.A, "PRIVATE TYPE" );
87
          END PRIV_CHECK;
88
 
89
          PROCEDURE LIM_CHECK (R : LIM) IS
90
          BEGIN
91
               IF R.A'FIRST /= 1 OR R.A'LAST /= 2 THEN
92
                    FAILED ( "INCORRECT BOUNDS FOR R.COMP.A IN " &
93
                             "COMPONENT OF LIMITED PRIVATE TYPE");
94
               END IF;
95
          END LIM_CHECK;
96
     END PACK;
97
 
98
     USE PACK;
99
 
100
BEGIN
101
 
102
     TEST ( "C37006A", "FOR A COMPONENT OF A RECORD, ACCESS, " &
103
                       "OR PRIVATE TYPE, OR FOR A LIMITED PRIVATE " &
104
                       "COMPONENT, CHECK THAT A NON-STATIC " &
105
                       "EXPRESSION CAN BE USED IN A DISCRIMINANT " &
106
                       "CONSTRAINT OR (EXCEPTING LIMITED PRIVATE " &
107
                       "COMPONENTS) IN SPECIFYING A DEFAULT " &
108
                       "INITIAL VALUE" );
109
 
110
     BEGIN
111
          DECLARE
112
 
113
               TYPE REC2 IS
114
                    RECORD
115
                         COMP : REC1 (IDENT_INT (1), IDENT_INT (2)) :=
116
                                (IDENT_INT (1), IDENT_INT (2),
117
                                 ARR'(1 => 3, 2 => 4));
118
                    END RECORD;
119
 
120
          R : REC2;
121
 
122
          BEGIN
123
               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
124
                    CHECK (R.COMP.A, "RECORD");
125
               ELSE
126
                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
127
                             "OF RECORD TYPE COMPONENT" );
128
               END IF;
129
 
130
          EXCEPTION
131
               WHEN CONSTRAINT_ERROR =>
132
                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
133
                             "SEQUENCE FOLLOWING DECLARATION OF " &
134
                             "RECORD TYPE COMPONENT" );
135
               WHEN OTHERS =>
136
                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
137
                             "SEQUENCE FOLLOWING DECLARATION OF " &
138
                             "RECORD TYPE COMPONENT" );
139
          END;
140
 
141
     EXCEPTION
142
          WHEN CONSTRAINT_ERROR =>
143
               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
144
                        "OF RECORD TYPE COMPONENT" );
145
          WHEN OTHERS =>
146
               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
147
                        "OF RECORD TYPE COMPONENT" );
148
     END;
149
 
150
     BEGIN
151
          DECLARE
152
 
153
               TYPE REC2 IS
154
                    RECORD
155
                         COMP : REC1_NAME (IDENT_INT (1),
156
                                           IDENT_INT (2)) :=
157
                                NEW REC1'(IDENT_INT (1),
158
                                          IDENT_INT (2),
159
                                          ARR'(1 => 3, 2 => 4));
160
                    END RECORD;
161
 
162
          R : REC2;
163
 
164
          BEGIN
165
               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
166
                    CHECK (R.COMP.A, "ACCESS");
167
               ELSE
168
                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
169
                             "OF ACCESS TYPE COMPONENT" );
170
               END IF;
171
 
172
          EXCEPTION
173
               WHEN CONSTRAINT_ERROR =>
174
                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
175
                             "SEQUENCE FOLLOWING DECLARATION OF " &
176
                             "ACCESS TYPE COMPONENT" );
177
               WHEN OTHERS =>
178
                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
179
                             "SEQUENCE FOLLOWING DECLARATION OF " &
180
                             "ACCESS TYPE COMPONENT" );
181
          END;
182
 
183
     EXCEPTION
184
          WHEN CONSTRAINT_ERROR =>
185
               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
186
                        "OF ACCESS TYPE COMPONENT" );
187
          WHEN OTHERS =>
188
               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
189
                        "OF ACCESS TYPE COMPONENT" );
190
     END;
191
 
192
     BEGIN
193
          DECLARE
194
 
195
               TYPE REC2 IS
196
                    RECORD
197
                         COMP : PRIV (IDENT_INT (1), IDENT_INT (2)) :=
198
                                PRIV_FUN (IDENT_INT (1),
199
                                          IDENT_INT (2));
200
                    END RECORD;
201
 
202
          R : REC2;
203
 
204
          BEGIN
205
               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
206
                    PRIV_CHECK (R.COMP);
207
               ELSE
208
                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
209
                             "OF PRIVATE TYPE COMPONENT" );
210
               END IF;
211
 
212
          EXCEPTION
213
               WHEN CONSTRAINT_ERROR =>
214
                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
215
                             "SEQUENCE FOLLOWING DECLARATION OF " &
216
                             "PRIVATE TYPE COMPONENT" );
217
               WHEN OTHERS =>
218
                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
219
                             "SEQUENCE FOLLOWING DECLARATION OF " &
220
                             "PRIVATE TYPE COMPONENT" );
221
          END;
222
 
223
     EXCEPTION
224
          WHEN CONSTRAINT_ERROR =>
225
               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
226
                        "OF PRIVATE TYPE COMPONENT" );
227
          WHEN OTHERS =>
228
               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
229
                        "OF PRIVATE TYPE COMPONENT" );
230
     END;
231
 
232
     BEGIN
233
          DECLARE
234
 
235
               TYPE REC2 IS
236
                    RECORD
237
                         COMP : LIM (IDENT_INT (1), IDENT_INT (2));
238
                    END RECORD;
239
 
240
          R : REC2;
241
 
242
          BEGIN
243
               IF R.COMP.D1 = 1 AND R.COMP.D2 = 2 THEN
244
                    LIM_CHECK (R.COMP);
245
               ELSE
246
                    FAILED ( "INCORRECT VALUE FOR DISCRIMINANTS " &
247
                             "OF LIM PRIV TYPE COMPONENT" );
248
               END IF;
249
 
250
          EXCEPTION
251
               WHEN CONSTRAINT_ERROR =>
252
                    FAILED ( "CONSTRAINT_ERROR RAISED IN STATEMENT " &
253
                             "SEQUENCE FOLLOWING DECLARATION OF " &
254
                             " LIM PRIV TYPE COMPONENT" );
255
               WHEN OTHERS =>
256
                    FAILED ( "OTHER EXCEPTION RAISED IN STATEMENT " &
257
                             "SEQUENCE FOLLOWING DECLARATION OF " &
258
                             " LIM PRIV TYPE COMPONENT" );
259
          END;
260
 
261
     EXCEPTION
262
          WHEN CONSTRAINT_ERROR =>
263
               FAILED ( "CONSTRAINT_ERROR RAISED BY DECLARATION " &
264
                        "OF  LIM PRIV TYPE COMPONENT" );
265
          WHEN OTHERS =>
266
               FAILED ( "OTHER EXCEPTION RAISED BY DECLARATION " &
267
                        "OF  LIM PRIV TYPE COMPONENT" );
268
     END;
269
 
270
     RESULT;
271
 
272
END C37006A;

powered by: WebSVN 2.1.0

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