Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/ca/ca11c01.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 -- CA11C01.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 when primitive operations declared in a child package | |
28 -- override operations declared in ancestor packages, a client of the | |
29 -- child package inherits the operations correctly. | |
30 -- | |
31 -- TEST DESCRIPTION: | |
32 -- | |
33 -- This test builds on the foundation code file (FA11C00) that contains | |
34 -- a parent package, child package, and grandchild package. The parent | |
35 -- package declares a tagged type and primitive operation. The child | |
36 -- package extends the type, and overrides the primitive operation. The | |
37 -- grandchild package does the same. | |
38 -- | |
39 -- The test procedure "withs" the grandchild package, and receives | |
40 -- visibility to all of its ancestor packages, types and operations. | |
41 -- Three procedures, each with a formal parameter of a specific type are | |
42 -- defined. Each of these invokes a particular version of the overridden | |
43 -- primitive operation Image. Calls to these local procedures are made, | |
44 -- with objects of each of the tagged types as parameters, and the global | |
45 -- variable is finally examined to ensure that the correct version of | |
46 -- primitive operation was inherited by the client and invoked by the | |
47 -- call. | |
48 -- | |
49 -- TEST FILES: | |
50 -- This test depends on the following foundation code: | |
51 -- | |
52 -- FA11C00.A | |
53 -- | |
54 -- | |
55 -- CHANGE HISTORY: | |
56 -- 06 Dec 94 SAIC ACVC 2.0 | |
57 -- | |
58 --! | |
59 | |
60 with FA11C00_0.FA11C00_1.FA11C00_2; -- Package Animal.Mammal.Primate | |
61 with Report; | |
62 | |
63 procedure CA11C01 is | |
64 | |
65 package Animal_Package renames FA11C00_0; | |
66 package Mammal_Package renames FA11C00_0.FA11C00_1; | |
67 package Primate_Package renames FA11C00_0.FA11C00_1.FA11C00_2; | |
68 | |
69 Max_Animals : constant := 3; | |
70 | |
71 subtype Data_String is String (1 .. 37); | |
72 type Data_Base_Type is array (1 .. Max_Animals) of Data_String; | |
73 | |
74 Zoo_Data_Base : Data_Base_Type := (others => (others => ' ')); | |
75 -- Global variable. | |
76 | |
77 Salmon : Animal_Package.Animal := (Common_Name => "Chinook Salmon ", | |
78 Weight => 10); | |
79 | |
80 Platypus : Mammal_Package.Mammal := (Common_Name => "Tasmanian Platypus ", | |
81 Weight => 13, | |
82 Hair_Color => Mammal_Package.Brown); | |
83 | |
84 Orangutan : Primate_Package.Primate := | |
85 (Common_Name => "Sumatran Orangutan ", | |
86 Weight => 220, | |
87 Hair_Color => Mammal_Package.Red, | |
88 Habitat => Primate_Package.Arboreal); | |
89 begin | |
90 | |
91 Report.Test ("CA11C01", "Check that when primitive operations declared " & | |
92 "in a child package override operations declared " & | |
93 "in ancestor packages, a client of the child " & | |
94 "package inherits the operations correctly"); | |
95 | |
96 declare | |
97 | |
98 use Animal_Package, Mammal_Package, Primate_Package; | |
99 | |
100 -- The function Image has been overridden in the child and grandchild | |
101 -- packages, but the client has inherited all versions of the function, | |
102 -- and can successfully use them to enter data into the database. | |
103 -- Each of the following procedures updates the global variable | |
104 -- Zoo_Data_Base. | |
105 | |
106 procedure Enter_Animal_Data (A : Animal; I : Integer) is | |
107 begin | |
108 Zoo_Data_Base (I) := Image (A); | |
109 end Enter_Animal_Data; | |
110 | |
111 procedure Enter_Mammal_Data (M : Mammal; I : Integer) is | |
112 begin | |
113 Zoo_Data_Base (I) := Image (M); | |
114 end Enter_Mammal_Data; | |
115 | |
116 procedure Enter_Primate_Data (P : Primate; I : Integer) is | |
117 begin | |
118 Zoo_Data_Base (I) := Image (P); | |
119 end Enter_Primate_Data; | |
120 | |
121 begin | |
122 | |
123 -- Verify initial test conditions. | |
124 | |
125 if not (Zoo_Data_Base(1)(1..6) = " ") | |
126 or else | |
127 (Zoo_Data_Base(2)(1..6) /= " ") | |
128 or else | |
129 (Zoo_Data_Base(3)(1..6) /= " ") | |
130 then | |
131 Report.Failed ("Initial condition failure"); | |
132 end if; | |
133 | |
134 | |
135 -- Enter data from all three animals into the zoo database. | |
136 | |
137 Enter_Animal_Data (A => Salmon, I => 1); -- First entry in database. | |
138 Enter_Mammal_Data (M => Platypus, I => 2); -- Second entry. | |
139 Enter_Primate_Data (P => Orangutan, I => 3); -- Third entry. | |
140 | |
141 -- Verify the correct version of the overridden function Image was used | |
142 -- for entering the specific data. | |
143 | |
144 if Zoo_Data_Base(1)(1 .. 6) /= "Animal" | |
145 or else | |
146 Zoo_Data_Base(1)(26 .. 31) /= "Salmon" | |
147 then | |
148 Report.Failed ("Incorrect version of Image for parent type"); | |
149 end if; | |
150 | |
151 if (Zoo_Data_Base(2)(1 .. 6) /= "Mammal") | |
152 or | |
153 (Zoo_Data_Base(2)(28 .. 35) /= "Platypus") | |
154 then | |
155 Report.Failed ("Incorrect version of Image for child type"); | |
156 end if; | |
157 | |
158 if ((Zoo_Data_Base(3)(1 .. 7) /= "Primate") | |
159 or | |
160 (Zoo_Data_Base(3)(27 .. 35) /= "Orangutan")) | |
161 then | |
162 Report.Failed ("Incorrect version of Image for grandchild type"); | |
163 end if; | |
164 | |
165 end; | |
166 | |
167 | |
168 Report.Result; | |
169 | |
170 end CA11C01; |