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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C371001.A
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
--
26
-- OBJECTIVE:
27
--      Check that if a discriminant constraint depends on a discriminant,
28
--      the evaluation of the expressions in the constraint is deferred
29
--      until an object of the subtype is created.  Check for cases of
30
--      records with private type component.
31
--
32
-- TEST DESCRIPTION:
33
--      This transition test defines record type and incomplete types with
34
--      discriminant components which depend on the discriminants.  The
35
--      discriminants are calculated by function calls.  The test verifies
36
--      that Constraint_Error is raised during the object creations when
37
--      values of discriminants are incompatible with the subtypes.
38
--
39
--      Inspired by C37214A.ADA and C37216A.ADA.
40
--
41
--
42
-- CHANGE HISTORY:
43
--      11 Apr 96   SAIC    Initial version for ACVC 2.1.
44
--      06 Oct 96   SAIC    Added LM references. Replaced "others exception"
45
--                          with "unexpected exception"
46
--
47
--!
48
 
49
with Report;
50
 
51
procedure C371001 is
52
 
53
   subtype Small_Int is Integer range 1..10;
54
 
55
   Func1_Cons : Integer := 0;
56
 
57
   ---------------------------------------------------------
58
   function Func1 return Integer is
59
   begin
60
      Func1_Cons := Func1_Cons + Report.Ident_Int(1);
61
      return Func1_Cons;
62
   end Func1;
63
 
64
 
65
begin
66
   Report.Test ("C371001", "Check that if a discriminant constraint " &
67
                "depends on a discriminant, the evaluation of the "   &
68
                "expressions in the constraint is deferred until "    &
69
                "object declarations");
70
 
71
   ---------------------------------------------------------
72
   -- Constraint checks on an object declaration of a record.
73
 
74
   begin
75
 
76
      declare
77
 
78
         package C371001_0 is
79
 
80
            type PT_W_Disc (D : Small_Int) is private;
81
            type Rec_W_Private (D1 : Integer) is
82
              record
83
                 C : PT_W_Disc (D1);
84
              end record;
85
 
86
            type Rec (D3 : Integer) is
87
              record
88
                 C1 : Rec_W_Private (D3);
89
              end record;
90
 
91
         private
92
            type PT_W_Disc (D : Small_Int) is
93
              record
94
                 Str : String (1 .. D) := (others => '*');
95
              end record;
96
 
97
         end C371001_0;
98
 
99
         --=====================================================--
100
 
101
         Obj : C371001_0.Rec(Report.Ident_Int(0));  -- Constraint_Error raised.
102
 
103
      begin
104
         Report.Failed ("Obj - Constraint_Error should be raised");
105
         if Obj.C1.D1 /= 0 then
106
            Report.Failed ("Obj - Shouldn't get here");
107
         end if;
108
 
109
      exception
110
         when others           =>
111
              Report.Failed ("Obj - exception raised too late");
112
      end;
113
 
114
   exception
115
      when Constraint_Error =>                      -- Exception expected.
116
           null;
117
      when others           =>
118
           Report.Failed ("Obj - unexpected exception raised");
119
   end;
120
 
121
   -------------------------------------------------------------------
122
   -- Constraint checks on an object declaration of an array.
123
 
124
   begin
125
      declare
126
 
127
         package C371001_1 is
128
 
129
            type PT_W_Disc (D : Small_Int) is private;
130
            type Rec_W_Private (D1 : Integer) is
131
              record
132
                 C : PT_W_Disc (D1);
133
              end record;
134
 
135
            type Rec_01 (D3 : Integer) is
136
              record
137
                 C1 : Rec_W_Private (D3);
138
              end record;
139
 
140
            type Arr is array (1 .. 5) of
141
              Rec_01(Report.Ident_Int(0));          -- No Constraint_Error
142
                                                    -- raised.
143
         private
144
            type PT_W_Disc (D : Small_Int) is
145
              record
146
                 Str : String (1 .. D) := (others => '*');
147
              end record;
148
 
149
         end C371001_1;
150
 
151
         --=====================================================--
152
 
153
      begin
154
         declare
155
            Obj1 : C371001_1.Arr;                   -- Constraint_Error raised.
156
         begin
157
            Report.Failed ("Obj1 - Constraint_Error should be raised");
158
            if Obj1(1).D3 /= 0 then
159
               Report.Failed ("Obj1 - Shouldn't get here");
160
            end if;
161
 
162
         exception
163
            when others           =>
164
                 Report.Failed ("Obj1 - exception raised too late");
165
         end;
166
 
167
      exception
168
         when Constraint_Error =>                   -- Exception expected.
169
              null;
170
         when others =>
171
              Report.Failed ("Obj1 - unexpected exception raised");
172
      end;
173
 
174
   exception
175
      when Constraint_Error =>
176
           Report.Failed ("Arr - Constraint_Error raised");
177
      when others =>
178
           Report.Failed ("Arr - unexpected exception raised");
179
   end;
180
 
181
 
182
   -------------------------------------------------------------------
183
   -- Constraint checks on an object declaration of an access type.
184
 
185
   begin
186
      declare
187
 
188
         package C371001_2 is
189
 
190
            type PT_W_Disc (D : Small_Int) is private;
191
            type Rec_W_Private (D1 : Integer) is
192
              record
193
                 C : PT_W_Disc (D1);
194
              end record;
195
 
196
            type Rec_02 (D3 : Integer) is
197
              record
198
                 C1 : Rec_W_Private (D3);
199
              end record;
200
 
201
            type Acc_Rec2 is access Rec_02          -- No Constraint_Error
202
              (Report.Ident_Int(11));               -- raised.
203
 
204
         private
205
            type PT_W_Disc (D : Small_Int) is
206
              record
207
                 Str : String (1 .. D) := (others => '*');
208
              end record;
209
 
210
         end C371001_2;
211
 
212
         --=====================================================--
213
 
214
      begin
215
         declare
216
            Obj2 : C371001_2.Acc_Rec2;              -- No Constraint_Error
217
                                                    -- raised.
218
         begin
219
            Obj2 := new C371001_2.Rec_02 (Report.Ident_Int(11));
220
                                                    -- Constraint_Error raised.
221
 
222
            Report.Failed ("Obj2 - Constraint_Error should be raised");
223
            if Obj2.D3 /= 1 then
224
               Report.Failed ("Obj2 - Shouldn't get here");
225
            end if;
226
 
227
         exception
228
            when Constraint_Error =>                -- Exception expected.
229
               null;
230
            when others           =>
231
               Report.Failed ("Obj2 - unexpected exception raised in " &
232
                              "assignment");
233
         end;
234
 
235
      exception
236
         when Constraint_Error =>
237
              Report.Failed ("Obj2 - Constraint_Error raised in declaration");
238
         when others =>
239
              Report.Failed ("Obj2 - unexpected exception raised in " &
240
                             "declaration");
241
      end;
242
 
243
   exception
244
      when Constraint_Error =>
245
           Report.Failed ("Acc_Rec2 - Constraint_Error raised");
246
      when others =>
247
           Report.Failed ("Acc_Rec2 - unexpected exception raised");
248
   end;
249
 
250
   -------------------------------------------------------------------
251
   -- Constraint checks on an object declaration of a subtype.
252
 
253
   Func1_Cons := -1;
254
 
255
   begin
256
      declare
257
 
258
         package C371001_3 is
259
 
260
            type PT_W_Disc (D1, D2 : Small_Int) is private;
261
            type Rec_W_Private (D3, D4 : Integer) is
262
              record
263
                 C : PT_W_Disc (D3, D4);
264
              end record;
265
 
266
            type Rec_03 (D5 : Integer) is
267
              record
268
                 C1 : Rec_W_Private (D5, Func1);     -- Func1 evaluated,
269
              end record;                            -- value 0.
270
 
271
            subtype Subtype_Rec is Rec_03(1);        -- No Constraint_Error
272
                                                     -- raised.
273
         private
274
            type PT_W_Disc (D1, D2 : Small_Int) is
275
              record
276
                 Str1 : String (1 .. D1) := (others => '*');
277
                 Str2 : String (1 .. D2) := (others => '*');
278
              end record;
279
 
280
         end C371001_3;
281
 
282
         --=====================================================--
283
 
284
      begin
285
         declare
286
            Obj3 : C371001_3.Subtype_Rec;            -- Constraint_Error raised.
287
         begin
288
            Report.Failed ("Obj3 - Constraint_Error should be raised");
289
            if Obj3.D5 /= 1 then
290
               Report.Failed ("Obj3 - Shouldn't get here");
291
            end if;
292
 
293
         exception
294
            when others           =>
295
                 Report.Failed ("Obj3 - exception raised too late");
296
         end;
297
 
298
      exception
299
         when Constraint_Error =>                    -- Exception expected.
300
              null;
301
         when others =>
302
              Report.Failed ("Obj3 - unexpected exception raised");
303
      end;
304
 
305
   exception
306
      when Constraint_Error =>
307
           Report.Failed ("Subtype_Rec - Constraint_Error raised");
308
      when others =>
309
           Report.Failed ("Subtype_Rec - unexpected exception raised");
310
   end;
311
 
312
   -------------------------------------------------------------------
313
   -- Constraint checks on an object declaration of an incomplete type.
314
 
315
   Func1_Cons := 10;
316
 
317
   begin
318
      declare
319
 
320
         package C371001_4 is
321
 
322
            type Rec_04 (D3 : Integer);
323
            type PT_W_Disc (D : Small_Int) is private;
324
            type Rec_W_Private (D1, D2 : Small_Int) is
325
              record
326
                 C : PT_W_Disc (D2);
327
              end record;
328
 
329
            type Rec_04 (D3 : Integer) is
330
              record
331
                 C1 : Rec_W_Private (D3, Func1);     -- Func1 evaluated
332
              end record;                            -- value 11.
333
 
334
            type Acc_Rec4 is access Rec_04 (1);      -- No Constraint_Error
335
                                                     -- raised.
336
         private
337
            type PT_W_Disc (D : Small_Int) is
338
              record
339
                 Str : String (1 .. D) := (others => '*');
340
              end record;
341
 
342
         end C371001_4;
343
 
344
         --=====================================================--
345
 
346
      begin
347
         declare
348
            Obj4 : C371001_4.Acc_Rec4;               -- No Constraint_Error
349
                                                     -- raised.
350
         begin
351
            Obj4 := new C371001_4.Rec_04 (1);        -- Constraint_Error raised.
352
 
353
            Report.Failed ("Obj4 - Constraint_Error should be raised");
354
            if Obj4.D3 /= 1 then
355
               Report.Failed ("Obj4 - Shouldn't get here");
356
            end if;
357
 
358
         exception
359
            when Constraint_Error =>                 -- Exception expected.
360
               null;
361
            when others           =>
362
               Report.Failed ("Obj4 - unexpected exception raised in " &
363
                              "assignment");
364
         end;
365
 
366
      exception
367
         when Constraint_Error =>
368
              Report.Failed ("Obj4 - Constraint_Error raised in declaration");
369
         when others =>
370
              Report.Failed ("Obj4 - unexpected exception raised in " &
371
                             "declaration");
372
      end;
373
 
374
   exception
375
      when Constraint_Error =>
376
           Report.Failed ("Acc_Rec4 - Constraint_Error raised");
377
      when others =>
378
           Report.Failed ("Acc_Rec4 - unexpected exception raised");
379
   end;
380
 
381
   Report.Result;
382
 
383
exception
384
   when others =>
385
        Report.Failed ("Discriminant value checked too soon");
386
        Report.Result;
387
 
388
end C371001;

powered by: WebSVN 2.1.0

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