Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/ca/ca11007.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 -- CA11007.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 the private part of a grandchild library unit can
28 -- utilize its grandparent unit's private definition.
29 --
30 -- TEST DESCRIPTION:
31 -- Declare a package, child package, and grandchild package, all
32 -- with private parts in their specifications.
33 --
34 -- The private part of the grandchild package will make use of components
35 -- that have been declared in the private part of the grandparent
36 -- specification.
37 --
38 -- The child package demonstrates the extension of a parent file type
39 -- into an abstraction of an analog file structure. The grandchild package
40 -- extends the grandparent file type into an abstraction of a digital
41 -- file structure, and provides conversion capability to/from the parent
42 -- analog file structure.
43 --
44 --
45 -- CHANGE HISTORY:
46 -- 06 Dec 94 SAIC ACVC 2.0
47 --
48 --!
49
50 package CA11007_0 is -- Package File_Package
51
52 type File_Descriptor is private;
53 type File_Type is tagged private;
54
55 function Next_Available_File return File_Descriptor;
56
57 private
58
59 type File_Measure_Type is range 0 .. 1000;
60 type File_Descriptor is new Integer;
61
62 Null_Measure : constant File_Measure_Type := File_Measure_Type'First;
63 Null_File : constant File_Descriptor := 0;
64
65 type File_Type is tagged
66 record
67 Descriptor : File_Descriptor := Null_File;
68 end record;
69
70 end CA11007_0; -- Package File_Package
71
72 --=================================================================--
73
74 package body CA11007_0 is -- Package body File_Package
75
76 File_Count : Integer := 0;
77
78 function Next_Available_File return File_Descriptor is
79 begin
80 File_Count := File_Count + 1;
81 return File_Descriptor (File_Count);
82 end Next_Available_File;
83
84 end CA11007_0; -- Package body File_Package
85
86 --=================================================================--
87
88 package CA11007_0.CA11007_1 is -- Child package Analog
89
90 type Analog_File_Type is new File_Type with private;
91
92 private
93
94 type Wavelength_Type is new File_Measure_Type;
95
96 Min_Wavelength : constant Wavelength_Type := Wavelength_Type'First;
97
98 type Analog_File_Type is new File_Type with -- Parent type.
99 record
100 Wavelength : Wavelength_Type := Min_Wavelength;
101 end record;
102
103 end CA11007_0.CA11007_1; -- Child package Analog
104
105 --=================================================================--
106
107 package CA11007_0.CA11007_1.CA11007_2 is -- Grandchild package Digital
108
109 type Digital_File_Type is new File_Type with private;
110
111 procedure Recording (File : out Digital_File_Type);
112
113 procedure Convert (From : in Analog_File_Type;
114 To : out Digital_File_Type);
115
116 function Validate (File : in Digital_File_Type) return Boolean;
117 function Valid_Conversion (To : Digital_File_Type) return Boolean;
118 function Valid_Initial (From : Analog_File_Type) return Boolean;
119
120 private
121
122 type Track_Type is new File_Measure_Type; -- Grandparent type.
123
124 Min_Tracks : constant Track_Type :=
125 Track_Type (Null_Measure) + Track_Type'First; -- Grandparent private
126 Max_Tracks : constant Track_Type := -- constant.
127 Track_Type (Null_Measure) + Track_Type'Last;
128
129 type Digital_File_Type is new File_Type with -- Grandparent type.
130 record
131 Tracks : Track_Type := Min_Tracks;
132 end record;
133
134 end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package Digital
135
136 --=================================================================--
137
138 -- Grandchild package body Digital
139 package body CA11007_0.CA11007_1.CA11007_2 is
140
141 procedure Recording (File : out Digital_File_Type) is
142 begin
143 File.Descriptor := Next_Available_File; -- Assign new file descriptor.
144 File.Tracks := Max_Tracks; -- Change initial value.
145 end Recording;
146 --------------------------------------------------------------------------
147 procedure Convert (From : in Analog_File_Type;
148 To : out Digital_File_Type) is
149 begin
150 To.Descriptor := From.Descriptor + 100; -- Dummy conversion.
151 To.Tracks := Track_Type (From.Wavelength) / 2;
152 end Convert;
153 --------------------------------------------------------------------------
154 function Validate (File : in Digital_File_Type) return Boolean is
155 Result : Boolean := False;
156 begin
157 if not (File.Tracks /= Max_Tracks) then
158 Result := True;
159 end if;
160 return Result;
161 end Validate;
162 --------------------------------------------------------------------------
163 function Valid_Conversion (To : Digital_File_Type) return Boolean is
164 begin
165 return (To.Descriptor = 100) and (To.Tracks = (Min_Tracks / 2));
166 end Valid_Conversion;
167 --------------------------------------------------------------------------
168 function Valid_Initial (From : Analog_File_Type) return Boolean is
169 begin
170 return (From.Wavelength = Min_Wavelength); -- Validate initial
171 end Valid_Initial; -- conditions.
172
173 end CA11007_0.CA11007_1.CA11007_2; -- Grandchild package body Digital
174
175 --=================================================================--
176
177 with CA11007_0.CA11007_1.CA11007_2; -- with Grandchild package Digital
178 with Report;
179
180 procedure CA11007 is
181
182 package Analog renames CA11007_0.CA11007_1;
183 package Digital renames CA11007_0.CA11007_1.CA11007_2;
184
185 Original_Digital_File,
186 Converted_Digital_File : Digital.Digital_File_Type;
187
188 Original_Analog_File : Analog.Analog_File_Type;
189
190 begin
191
192 -- This code demonstrates how private extensions could be utilized
193 -- in child packages to allow for recording on different media.
194 -- The processing contained in the procedures and functions is
195 -- "dummy" processing, not intended to perform actual recording,
196 -- conversion, or validation operations, but simply to demonstrate
197 -- this type of structural decomposition as a possible solution to
198 -- a user's design problem.
199
200 Report.Test ("CA11007", "Check that the private part of a grandchild " &
201 "library unit can utilize its grandparent " &
202 "unit's private definition");
203
204 if not Digital.Valid_Initial (Original_Analog_File)
205 then
206 Report.Failed ("Incorrect initialization of Analog File");
207 end if;
208
209 ---
210
211 Digital.Convert (From => Original_Analog_File, -- Convert file to
212 To => Converted_Digital_File); -- digital format.
213
214 if not Digital.Valid_Conversion (To => Converted_Digital_File) then
215 Report.Failed ("Incorrect conversion of analog file");
216 end if;
217
218 ---
219
220 Digital.Recording (Original_Digital_File); -- Create file in
221 -- digital format.
222 if not Digital.Validate (Original_Digital_File) then
223 Report.Failed ("Incorrect recording of digital file");
224 end if;
225
226 Report.Result;
227
228 end CA11007;