2003-12-26 Guilhem Lavaux <guilhem@kaffe.org>
[official-gcc.git] / gcc / testsuite / ada / acats / tests / ca / ca13003.a
blob607639efecd2b0fa93d851bd84b1ca0575279a69
1 -- CA13003.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.
16 -- DISCLAIMER
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 --*
26 -- OBJECTIVE:
27 -- Check that separate subunits which share an ancestor may have the
28 -- same name if they have different fully qualified names. Check
29 -- the case of separate subunits of separate subunits.
30 -- This test is a change in semantics from Ada 83 to Ada 9X.
32 -- TEST DESCRIPTION:
33 -- Declare a package that provides file processing operations. Declare
34 -- one separate package to do the file processing, and another to do the
35 -- auditing. These packages contain similar functions declared in
36 -- separate subunits. Verify that the main program can call the
37 -- separate subunits with the same name.
40 -- CHANGE HISTORY:
41 -- 06 Dec 94 SAIC ACVC 2.0
43 --!
45 -- Simulates a file processing application. The processing package opens
46 -- files, reads files, does file processing, and generates reports.
47 -- The auditing package opens files, read files, and generates reports.
49 package CA13003_0 is
51 type File_ID is range 1 .. 100;
52 subtype File_Name is string (1 .. 10);
54 TC_Open_For_Process : boolean := false;
55 TC_Open_For_Audit : boolean := false;
56 TC_Report_From_Process : boolean := false;
57 TC_Report_From_Audit : boolean := false;
59 type File_Rec is
60 record
61 Name : File_Name;
62 ID : File_ID;
63 end record;
65 procedure Initialize_File_Rec (Name_In : in File_Name;
66 ID_In : in File_ID;
67 File_In : out File_Rec);
69 ----------------------------------------------------------------------
71 package CA13003_1 is -- File processing
73 procedure CA13003_3; -- Open files
74 function CA13003_4 (ID_In : File_ID; File_In : File_Rec)
75 return File_Name; -- Process files
76 package CA13003_5 is -- Generate report
77 procedure Generate_Report;
78 end CA13003_5;
80 end CA13003_1;
82 ----------------------------------------------------------------------
84 package CA13003_2 is -- File auditing
86 procedure CA13003_3; -- Open files
87 function CA13003_4 (ID_In : File_ID; File_In : File_Rec)
88 return File_Name; -- Process files
89 package CA13003_5 is -- Generate report
90 procedure Generate_Report;
91 end CA13003_5;
93 end CA13003_2;
95 end CA13003_0;
97 --==================================================================--
99 package body CA13003_0 is
101 procedure Initialize_File_Rec (Name_In : in File_Name;
102 ID_In : in File_ID;
103 File_In : out File_Rec) is
104 -- Not a real initialization. Real application can use file
105 -- database to create the file record.
106 begin
107 File_In.Name := Name_In;
108 File_In.ID := ID_In;
109 end Initialize_File_Rec;
111 package body CA13003_1 is separate;
112 package body CA13003_2 is separate;
114 end CA13003_0;
116 --==================================================================--
118 separate (CA13003_0)
119 package body CA13003_1 is
121 procedure CA13003_3 is separate; -- Open files
122 function CA13003_4 (ID_In : File_ID; File_In : File_Rec)
123 return File_Name is separate; -- Process files
124 package body CA13003_5 is separate; -- Generate report
126 end CA13003_1;
128 --==================================================================--
130 separate (CA13003_0.CA13003_1)
131 procedure CA13003_3 is -- Open files
132 begin
133 -- In real file processing application, open file from database, setup
134 -- data structure, etc.
135 TC_Open_For_Process := true;
136 end CA13003_3;
138 --==================================================================--
140 separate (CA13003_0.CA13003_1)
141 function CA13003_4 (ID_In : File_ID; -- Process files
142 File_In : File_Rec) return File_Name is
143 begin
144 -- In real file processing application, process files for more information.
145 return File_In.Name;
146 end CA13003_4;
148 --==================================================================--
150 separate (CA13003_0.CA13003_1)
151 package body CA13003_5 is -- Generate report
152 procedure Generate_Report is
153 begin
154 -- In real file processing application, generate various report from the
155 -- file database.
156 TC_Report_From_Process := true;
157 end Generate_Report;
159 end CA13003_5;
161 --==================================================================--
163 separate (CA13003_0)
164 package body CA13003_2 is
166 procedure CA13003_3 is separate; -- Open files
167 function CA13003_4 (ID_In : File_ID; File_In : File_Rec)
168 return File_Name is separate; -- Process files
169 package body CA13003_5 is separate; -- Generate report
171 end CA13003_2;
173 --==================================================================--
175 separate (CA13003_0.CA13003_2)
176 procedure CA13003_3 is -- Open files
177 begin
178 TC_Open_For_Audit := true;
179 end CA13003_3;
181 --==================================================================--
183 separate (CA13003_0.CA13003_2)
184 function CA13003_4 (ID_In : File_ID;
185 File_In : File_Rec) return File_Name is
186 begin
187 return File_In.Name;
188 end CA13003_4;
190 --==================================================================--
192 separate (CA13003_0.CA13003_2)
193 package body CA13003_5 is -- Generate report
194 procedure Generate_Report is
195 begin
196 TC_Report_From_Audit := true;
197 end Generate_Report;
199 end CA13003_5;
201 --==================================================================--
203 with CA13003_0;
204 with Report;
206 procedure CA13003 is
207 First_File_Name : CA13003_0.File_Name := "Joe Smith ";
208 First_File_Id : CA13003_0.File_ID := 11;
209 Second_File_Name : CA13003_0.File_Name := "John Schep";
210 Second_File_Id : CA13003_0.File_ID := 47;
211 Expected_Name : CA13003_0.File_Name := " ";
212 Student_File : CA13003_0.File_Rec;
214 function Process_Input_Files (ID_In : CA13003_0.File_ID;
215 File_In : CA13003_0.File_Rec) return
216 CA13003_0.File_Name renames CA13003_0.CA13003_1.CA13003_4;
218 function Process_Audit_Files (ID_In : CA13003_0.File_ID;
219 File_In : CA13003_0.File_Rec) return
220 CA13003_0.File_Name renames CA13003_0.CA13003_2.CA13003_4;
221 begin
222 Report.Test ("CA13003", "Check that separate subunits which share " &
223 "an ancestor may have the same name if they have " &
224 "different fully qualified names");
226 Student_File := (ID => First_File_Id, Name => First_File_Name);
228 -- Note that all subunits have the same simple name.
229 -- Generate report from file processing.
230 CA13003_0.CA13003_1.CA13003_3;
231 Expected_Name := Process_Input_Files (First_File_Id, Student_File);
232 CA13003_0.CA13003_1.CA13003_5.Generate_Report;
234 if not CA13003_0.TC_Open_For_Process or
235 not CA13003_0.TC_Report_From_Process or
236 Expected_Name /= First_File_Name then
237 Report.Failed ("Unexpected results in processing file");
238 end if;
240 CA13003_0.Initialize_File_Rec
241 (Second_File_Name, Second_File_Id, Student_File);
243 -- Generate report from file auditing.
244 CA13003_0.CA13003_2.CA13003_3;
245 Expected_Name := Process_Audit_Files (Second_File_Id, Student_File);
246 CA13003_0.CA13003_2.CA13003_5.Generate_Report;
248 if not CA13003_0.TC_Open_For_Audit or
249 not CA13003_0.TC_Report_From_Audit or
250 Expected_Name /= Second_File_Name then
251 Report.Failed ("Unexpected results in auditing file");
252 end if;
254 Report.Result;
256 end CA13003;