Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c7/c760013.a @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 -- C760013.A | |
2 -- | |
3 -- Grant of Unlimited Rights | |
4 -- | |
5 -- The Ada Conformity Assessment Authority (ACAA) holds unlimited | |
6 -- rights in the software and documentation contained herein. Unlimited | |
7 -- rights are the same as those granted by the U.S. Government for older | |
8 -- parts of the Ada Conformity Assessment Test Suite, and are defined | |
9 -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA | |
10 -- intends to confer upon all recipients unlimited rights equal to those | |
11 -- held by the ACAA. These rights include rights to use, duplicate, | |
12 -- release or disclose the released technical data and computer software | |
13 -- in whole or in part, in any manner and for any purpose whatsoever, and | |
14 -- to have or permit others 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 Initialize is not called for default-initialized subcomponents | |
28 -- of the ancestor type of an extension aggregate. (Defect Report | |
29 -- 8652/0021, Technical Corrigendum 7.6(11/1)). | |
30 -- | |
31 -- CHANGE HISTORY: | |
32 -- 25 JAN 2001 PHL Initial version. | |
33 -- 29 JUN 2001 RLB Reformatted for ACATS. | |
34 -- | |
35 --! | |
36 with Ada.Finalization; | |
37 use Ada.Finalization; | |
38 package C760013_0 is | |
39 | |
40 type Ctrl1 is new Controlled with | |
41 record | |
42 C : Integer := 0; | |
43 end record; | |
44 type Ctrl2 is new Controlled with | |
45 record | |
46 C : Integer := 0; | |
47 end record; | |
48 | |
49 procedure Initialize (Obj1 : in out Ctrl1); | |
50 procedure Initialize (Obj2 : in out Ctrl2); | |
51 | |
52 end C760013_0; | |
53 | |
54 with Report; | |
55 use Report; | |
56 package body C760013_0 is | |
57 | |
58 procedure Initialize (Obj1 : in out Ctrl1) is | |
59 begin | |
60 Obj1.C := Ident_Int (47); | |
61 end Initialize; | |
62 | |
63 procedure Initialize (Obj2 : in out Ctrl2) is | |
64 begin | |
65 Failed ("Initialize called for type Ctrl2"); | |
66 end Initialize; | |
67 | |
68 end C760013_0; | |
69 | |
70 with Ada.Finalization; | |
71 with C760013_0; | |
72 use C760013_0; | |
73 with Report; | |
74 use Report; | |
75 procedure C760013 is | |
76 | |
77 type T is tagged | |
78 record | |
79 C1 : Ctrl1; | |
80 C2 : Ctrl2 := (Ada.Finalization.Controlled with | |
81 C => Ident_Int (23)); | |
82 end record; | |
83 | |
84 type Nt is new T with | |
85 record | |
86 C3 : Float; | |
87 end record; | |
88 | |
89 X : Nt; | |
90 | |
91 begin | |
92 Test ("C760013", | |
93 "Check that Initialize is not called for " & | |
94 "default-initialized subcomponents of the ancestor type of an " & | |
95 "extension aggregate"); | |
96 | |
97 X := (T with C3 => 5.0); | |
98 | |
99 if X.C1.C /= Ident_Int (47) then | |
100 Failed ("Initialize not called for type Ctrl1"); | |
101 end if; | |
102 if X.C2.C /= Ident_Int (23) then | |
103 Failed ("Initial value not assigned for type Ctrl2"); | |
104 end if; | |
105 | |
106 Result; | |
107 end C760013; | |
108 |