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

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

Line No. Rev Author Line
1 294 jeremybenn
-- C371003.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 where the component containing the constraint is present
31
--      in the subtype.
32
--
33
-- TEST DESCRIPTION:
34
--      This transition test defines record types with discriminant components
35
--      which depend on the discriminants.  The discriminants are calculated
36
--      by function calls.  The test verifies that Constraint_Error is raised
37
--      during the object creations when values of discriminants are
38
--      incompatible with the subtypes.  Also check for cases, where the
39
--      component is absent.
40
--
41
--      Inspired by C37213E.ADA, C37213G.ADA, C37215E.ADA, and C37215G.ADA.
42
--
43
--
44
-- CHANGE HISTORY:
45
--      10 Apr 96   SAIC    Initial version for ACVC 2.1.
46
--      14 Jul 96   SAIC    Modified test description.  Added exception handler
47
--                          for VObj_10 assignment.
48
--      26 Oct 96   SAIC    Added LM references.
49
--
50
--!
51
 
52
with Report;
53
 
54
procedure C371003 is
55
 
56
   subtype Small_Int is Integer range 1..10;
57
 
58
   type Rec_W_Disc (Disc1, Disc2 : Small_Int) is
59
     record
60
        Str1 : String (1 .. Disc1) := (others => '*');
61
        Str2 : String (1 .. Disc2) := (others => '*');
62
     end record;
63
 
64
   type My_Array is array (Small_Int range <>) of Integer;
65
 
66
   Func1_Cons : Integer := 0;
67
 
68
   ---------------------------------------------------------
69
   function Chk (Cons    : Integer;
70
                 Value   : Integer;
71
                 Message : String) return Boolean is
72
   begin
73
      if Cons /= Value then
74
         Report.Failed (Message & ": Func1_Cons is " &
75
                        Integer'Image(Func1_Cons));
76
      end if;
77
      return True;
78
   end Chk;
79
 
80
   ---------------------------------------------------------
81
   function Func1 return Integer is
82
   begin
83
      Func1_Cons := Func1_Cons + Report.Ident_Int(1);
84
      return Func1_Cons;
85
   end Func1;
86
 
87
 
88
begin
89
   Report.Test ("C371003", "Check that if a discriminant constraint " &
90
                "depends on a discriminant, the evaluation of the "   &
91
                "expressions in the constraint is deferred until "    &
92
                "object declarations");
93
 
94
   ---------------------------------------------------------
95
   declare
96
      type VRec_01 (D3 : Integer) is
97
        record
98
           case D3 is
99
              when -5..10 =>
100
                 C1 : Rec_W_Disc (D3, Func1);    -- Func1 evaluated, value 1.
101
              when others =>
102
                 C2 : Integer := Report.Ident_Int(0);
103
           end case;
104
        end record;
105
 
106
        Chk1 : Boolean := Chk (Func1_Cons, 1,
107
                               "Func1 not evaluated for VRec_01");
108
 
109
        VObj_1 : VRec_01(1);                     -- Func1 not evaluated again
110
        VObj_2 : VRec_01(2);                     -- Func1 not evaluated again
111
 
112
        Chk2 : Boolean := Chk (Func1_Cons, 1,
113
                               "Func1 evaluated too many times");
114
 
115
   begin
116
      if VObj_1 /= (D3 => 1,
117
                    C1 => (Disc1   => 1,
118
                           Disc2   => 1,
119
                           Str1    => (others => '*'),
120
                           Str2    => (others => '*'))) or
121
         VObj_2 /= (D3 => 2,
122
                    C1 => (Disc1   => 2,
123
                           Disc2   => 1,
124
                           Str1    => (others => '*'),
125
                           Str2    => (others => '*'))) then
126
         Report.Failed ("VObj_1 & VObj_2 - Discriminant values not correct");
127
      end if;
128
   end;
129
 
130
   ---------------------------------------------------------
131
   Func1_Cons := -11;
132
 
133
   declare
134
      type VRec_Of_VRec_01 (D3 : Integer) is
135
        record
136
           case D3 is
137
              when -5..10 =>
138
                 C1 : Rec_W_Disc (Func1, D3);   -- Func1 evaluated, value -10.
139
              when others =>                    -- Constraint_Error not raised.
140
                 C2 : Integer := Report.Ident_Int(0);
141
           end case;
142
        end record;
143
 
144
      type VRec_Of_VRec_02 (D3 : Integer) is
145
        record
146
           case D3 is
147
              when -5..10 =>
148
                 C1 : Rec_W_Disc (1, D3);
149
              when others =>
150
                 C2 : Integer := Report.Ident_Int(0);
151
           end case;
152
        end record;
153
 
154
      type VRec_Of_MyArr_01 (D3 : Integer) is
155
        record
156
           case D3 is
157
              when -5..10 =>
158
                 C1 : My_Array  (Func1..D3);    -- Func1 evaluated, value -9.
159
              when others =>                    -- Constraint_Error not raised.
160
                 C2 : Integer := Report.Ident_Int(0);
161
           end case;
162
        end record;
163
 
164
      type VRec_Of_MyArr_02 (D3 : Integer) is
165
        record
166
           case D3 is
167
              when -5..10 =>
168
                 C1 : My_Array  (D3..1);
169
              when others =>
170
                 C2 : Integer := Report.Ident_Int(0);
171
           end case;
172
        end record;
173
 
174
   begin
175
 
176
      ---------------------------------------------------------
177
      -- Component containing the constraint is present.
178
      begin
179
         declare
180
            VObj_3 : VRec_Of_VRec_01(1);        -- Constraint_Error raised.
181
         begin
182
            Report.Failed ("VObj_3 - Constraint_Error should be raised");
183
            if VObj_3 /= (1, (1, 1, others => (others => '*'))) then
184
                Report.Comment ("VObj_3 - Shouldn't get here");
185
            end if;
186
         end;
187
 
188
      exception
189
         when Constraint_Error =>               -- Exception expected.
190
              null;
191
         when others           =>
192
              Report.Failed ("VObj_3 - unexpected exception raised");
193
      end;
194
 
195
      ---------------------------------------------------------
196
      -- Component containing the constraint is present.
197
      begin
198
         declare
199
            subtype Subtype_VRec is             -- No Constraint_Error raised.
200
              VRec_Of_VRec_01(Report.Ident_Int(1));
201
         begin
202
            declare
203
               VObj_4 : Subtype_VRec;           -- Constraint_Error raised.
204
            begin
205
               Report.Failed ("VObj_4 - Constraint_Error should be raised");
206
               if VObj_4 /= (D3 => 1,
207
                             C1 => (Disc1   => 1,
208
                                    Disc2   => 1,
209
                                    Str1    => (others => '*'),
210
                                    Str2    => (others => '*'))) then
211
                  Report.Comment ("VObj_4 - Shouldn't get here");
212
               end if;
213
            end;
214
 
215
         exception
216
            when Constraint_Error =>            -- Exception expected.
217
                null;
218
            when others =>
219
                Report.Failed ("VObj_4 - unexpected exception raised");
220
         end;
221
 
222
      exception
223
         when Constraint_Error =>
224
              Report.Failed ("Subtype_VRec - Constraint_Error raised");
225
         when others =>
226
              Report.Failed ("Subtype_VRec - unexpected exception raised");
227
      end;
228
 
229
      ---------------------------------------------------------
230
      -- Component containing the constraint is absent.
231
      begin
232
         declare
233
            type Arr is array (1..5) of
234
              VRec_Of_VRec_01(Report.Ident_Int(-6)); -- No Constraint_Error
235
            VObj_5 : Arr;                            -- for either declaration.
236
 
237
         begin
238
            if VObj_5 /= (1 .. 5 => (-6, 0)) then
239
               Report.Comment ("VObj_5 - wrong values");
240
            end if;
241
         end;
242
 
243
      exception
244
         when others =>
245
              Report.Failed ("Arr - unexpected exception raised");
246
      end;
247
 
248
      ---------------------------------------------------------
249
      -- Component containing the constraint is present.
250
      begin
251
         declare
252
            type Rec_Of_Rec_Of_MyArr is
253
              record
254
                 C1 : VRec_Of_MyArr_01(1);    -- No Constraint_Error raised.
255
              end record;
256
         begin
257
            declare
258
               Obj_6 : Rec_Of_Rec_Of_MyArr;   -- Constraint_Error raised.
259
            begin
260
               Report.Failed ("Obj_6 - Constraint_Error should be raised");
261
               if Obj_6 /= (C1 => (1, (1, 1))) then
262
                  Report.Comment ("Obj_6 - Shouldn't get here");
263
               end if;
264
            end;
265
 
266
         exception
267
            when Constraint_Error =>         -- Exception expected.
268
                null;
269
            when others =>
270
                Report.Failed ("Obj_6 - unexpected exception raised");
271
         end;
272
 
273
      exception
274
         when Constraint_Error =>
275
              Report.Failed ("Rec_Of_Rec_Of_MyArr - Constraint_Error raised");
276
         when others =>
277
              Report.Failed ("Rec_Of_Rec_Of_MyArr - unexpected exception " &
278
                             "raised");
279
      end;
280
 
281
      ---------------------------------------------------------
282
      -- Component containing the constraint is absent.
283
      begin
284
         declare
285
            type New_VRec_Arr is
286
              new VRec_Of_MyArr_01(11);       -- No Constraint_Error raised
287
            Obj_7 : New_VRec_Arr;             -- for either declaration.
288
 
289
         begin
290
            if Obj_7 /= (11, 0) then
291
               Report.Failed ("Obj_7 - value incorrect");
292
            end if;
293
         end;
294
 
295
      exception
296
         when others =>
297
              Report.Failed ("New_VRec_Arr - unexpected exception raised");
298
      end;
299
 
300
      ---------------------------------------------------------
301
      -- Component containing the constraint is present.
302
      begin
303
         declare
304
            type New_VRec is new
305
              VRec_Of_VRec_02(Report.Ident_Int(0)); -- No Constraint_Error
306
                                                    -- raised.
307
         begin
308
            declare
309
                VObj_8 : New_VRec;                  -- Constraint_Error raised.
310
            begin
311
               Report.Failed ("VObj_8 - Constraint_Error should be raised");
312
               if VObj_8 /= (1, (1, 1, others => (others => '*'))) then
313
                  Report.Comment ("VObj_8 - Shouldn't get here");
314
               end if;
315
            end;
316
 
317
         exception
318
            when Constraint_Error =>               -- Exception expected.
319
                null;
320
            when others =>
321
                Report.Failed ("VObj_8 - unexpected exception raised");
322
         end;
323
 
324
      exception
325
         when Constraint_Error =>
326
              Report.Failed ("New_VRec - Constraint_Error raised");
327
         when others =>
328
              Report.Failed ("New_VRec - unexpected exception raised");
329
      end;
330
 
331
      ---------------------------------------------------------
332
      -- Component containing the constraint is absent.
333
      begin
334
         declare
335
            subtype Sub_VRec is
336
              VRec_Of_VRec_02(Report.Ident_Int(11)); -- No Constraint_Error
337
            VObj_9 : Sub_VRec;                       -- raised for either
338
                                                     -- declaration.
339
         begin
340
            if VObj_9 /= (11, 0) then
341
               Report.Comment ("VObj_9 - wrong values");
342
            end if;
343
         end;
344
 
345
      exception
346
         when others =>
347
              Report.Failed ("Sub_VRec - unexpected exception raised");
348
      end;
349
 
350
      ---------------------------------------------------------
351
      -- Component containing the constraint is present.
352
      begin
353
         declare
354
            type Acc_VRec_01 is access
355
              VRec_Of_VRec_02(Report.Ident_Int(0));  -- No Constraint_Error
356
                                                     -- raised.
357
         begin
358
            declare
359
               VObj_10 : Acc_VRec_01;                -- No Constraint_Error
360
                                                     -- raised.
361
            begin
362
               VObj_10 := new VRec_Of_VRec_02
363
                            (Report.Ident_Int(0));   -- Constraint_Error
364
                                                     -- raised.
365
               Report.Failed ("VObj_10 - Constraint_Error should be raised");
366
               if VObj_10.all /= (1, (1, 1, others => (others => '*'))) then
367
                  Report.Comment ("VObj_10 - Shouldn't get here");
368
               end if;
369
 
370
            exception
371
               when Constraint_Error =>              -- Exception expected.
372
                   null;
373
               when others =>
374
                   Report.Failed ("VObj_10 - unexpected exception raised");
375
            end;
376
 
377
         exception
378
            when Constraint_Error =>
379
                Report.Failed ("VObj_10 - Constraint_Error exception raised");
380
            when others =>
381
                Report.Failed ("VObj_10 - unexpected exception raised at " &
382
                               "declaration");
383
         end;
384
 
385
      exception
386
         when Constraint_Error =>
387
              Report.Failed ("Acc_VRec_01 - Constraint_Error raised");
388
         when others =>
389
              Report.Failed ("Acc_VRec_01 - unexpected exception raised");
390
      end;
391
 
392
      ---------------------------------------------------------
393
      -- Component containing the constraint is absent.
394
      begin
395
         declare
396
            type Acc_VRec_02 is access
397
              VRec_Of_VRec_02(11);                  -- No Constraint_Error
398
                                                    -- raised for either
399
            VObj_11 :  Acc_VRec_02;                 -- declaration.
400
 
401
         begin
402
            VObj_11 := new VRec_Of_VRec_02(11);
403
            if VObj_11.all /= (11, 0) then
404
               Report.Comment ("VObj_11 - wrong values");
405
            end if;
406
         end;
407
 
408
      exception
409
         when others =>
410
              Report.Failed ("Acc_VRec_02 - unexpected exception raised");
411
      end;
412
 
413
      ---------------------------------------------------------
414
      -- Component containing the constraint is present.
415
      begin
416
         declare
417
            type Acc_VRec_03 is access
418
              VRec_Of_MyArr_02;                    -- No Constraint_Error
419
                                                   -- raised for either
420
            VObj_12 : Acc_VRec_03;                 -- declaration.
421
         begin
422
            VObj_12 := new VRec_Of_MyArr_02
423
                           (Report.Ident_Int(0)); -- Constraint_Error raised.
424
 
425
            Report.Failed ("VObj_12 - Constraint_Error should be raised");
426
            if VObj_12.all /= (1, (1, 1)) then
427
               Report.Comment ("VObj_12 - Shouldn't get here");
428
            end if;
429
 
430
         exception
431
            when Constraint_Error =>              -- Exception expected.
432
                null;
433
            when others =>
434
                Report.Failed ("VObj_12 - unexpected exception raised");
435
         end;
436
 
437
      exception
438
         when Constraint_Error =>
439
              Report.Failed ("Acc_VRec_03 - Constraint_Error raised");
440
         when others =>
441
              Report.Failed ("Acc_VRec_03 - unexpected exception raised");
442
      end;
443
 
444
      ---------------------------------------------------------
445
      -- Component containing the constraint is absent.
446
      begin
447
         declare
448
            type Acc_VRec_04 is access
449
              VRec_Of_MyArr_02(11);                 -- No Constraint_Error
450
                                                    -- raised for either
451
            VObj_13 :  Acc_VRec_04;                 -- declaration.
452
 
453
         begin
454
            VObj_13 := new VRec_Of_MyArr_02(11);
455
            if VObj_13.all /= (11, 0) then
456
               Report.Comment ("VObj_13 - wrong values");
457
            end if;
458
         end;
459
 
460
      exception
461
         when others =>
462
              Report.Failed ("Acc_VRec_04 - unexpected exception raised");
463
      end;
464
 
465
   end;
466
 
467
   Report.Result;
468
 
469
exception
470
     when others =>
471
          Report.Failed ("Discriminant value checked too soon");
472
          Report.Result;
473
 
474
end C371003;

powered by: WebSVN 2.1.0

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