aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/ca/ca13003.a
blob: 607639efecd2b0fa93d851bd84b1ca0575279a69 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
-- CA13003.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that separate subunits which share an ancestor may have the
--      same name if they have different fully qualified names.  Check
--      the case of separate subunits of separate subunits.
--      This test is a change in semantics from Ada 83 to Ada 9X.
--
-- TEST DESCRIPTION:
--      Declare a package that provides file processing operations.  Declare
--      one separate package to do the file processing, and another to do the
--      auditing.  These packages contain similar functions declared in 
--      separate subunits.  Verify that the main program can call the 
--      separate subunits with the same name.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

-- Simulates a file processing application.  The processing package opens
-- files, reads files, does file processing, and generates reports.
-- The auditing package opens files, read files, and generates reports.

package CA13003_0 is       

   type File_ID is range 1 .. 100;
   subtype File_Name is string (1 .. 10);

   TC_Open_For_Process    : boolean := false;
   TC_Open_For_Audit      : boolean := false;
   TC_Report_From_Process : boolean := false;
   TC_Report_From_Audit   : boolean := false;

   type File_Rec is 
      record
         Name : File_Name;
         ID   : File_ID;
      end record;

   procedure Initialize_File_Rec (Name_In : in     File_Name;
                                  ID_In   : in     File_ID;
                                  File_In :    out File_Rec);
 
   ----------------------------------------------------------------------

   package CA13003_1 is    -- File processing

      procedure CA13003_3;                             -- Open files
      function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
        return File_Name;                              -- Process files
      package CA13003_5 is                             -- Generate report
         procedure Generate_Report;
      end CA13003_5;

   end CA13003_1;

   ----------------------------------------------------------------------

   package CA13003_2 is    -- File auditing

      procedure CA13003_3;                             -- Open files
      function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
        return File_Name;                              -- Process files
      package CA13003_5 is                             -- Generate report
         procedure Generate_Report;
      end CA13003_5;

   end CA13003_2;

end CA13003_0;

     --==================================================================--

package body CA13003_0 is       

   procedure Initialize_File_Rec (Name_In : in     File_Name;
                                  ID_In   : in     File_ID;
                                  File_In :    out File_Rec) is
   -- Not a real initialization.  Real application can use file
   -- database to create the file record.
   begin
      File_In.Name := Name_In;
      File_In.ID   := ID_In;
   end Initialize_File_Rec;

   package body CA13003_1 is separate;
   package body CA13003_2 is separate;

end CA13003_0;

     --==================================================================--

separate (CA13003_0)
package body CA13003_1 is

   procedure CA13003_3 is separate;                 -- Open files
   function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
     return File_Name is separate;                  -- Process files
   package body CA13003_5 is separate;              -- Generate report

end CA13003_1;

     --==================================================================--

separate (CA13003_0.CA13003_1)
procedure CA13003_3 is                              -- Open files
begin
   -- In real file processing application, open file from database, setup
   -- data structure, etc.
   TC_Open_For_Process := true;
end CA13003_3;

     --==================================================================--

separate (CA13003_0.CA13003_1)
function CA13003_4 (ID_In : File_ID;                -- Process files
                    File_In : File_Rec) return File_Name is 
begin
   -- In real file processing application, process files for more information.
   return File_In.Name;
end CA13003_4;

     --==================================================================--

separate (CA13003_0.CA13003_1)
package body CA13003_5 is                           -- Generate report
   procedure Generate_Report is
   begin
      -- In real file processing application, generate various report from the
      -- file database.
      TC_Report_From_Process := true;
   end Generate_Report;

end CA13003_5;

     --==================================================================--

separate (CA13003_0)
package body CA13003_2 is

   procedure CA13003_3 is separate;                 -- Open files
   function CA13003_4 (ID_In : File_ID; File_In : File_Rec) 
     return File_Name is separate;                  -- Process files
   package body CA13003_5 is separate;              -- Generate report

end CA13003_2;

     --==================================================================--

separate (CA13003_0.CA13003_2)
procedure CA13003_3 is                              -- Open files
begin
   TC_Open_For_Audit := true;
end CA13003_3;

     --==================================================================--

separate (CA13003_0.CA13003_2)
function CA13003_4 (ID_In : File_ID; 
                    File_In : File_Rec) return File_Name is 
begin
   return File_In.Name;
end CA13003_4;

     --==================================================================--

separate (CA13003_0.CA13003_2)
package body CA13003_5 is                           -- Generate report
   procedure Generate_Report is
   begin
      TC_Report_From_Audit := true;
   end Generate_Report;

end CA13003_5;

     --==================================================================--

with CA13003_0;
with Report;

procedure CA13003 is
   First_File_Name  : CA13003_0.File_Name := "Joe Smith ";
   First_File_Id    : CA13003_0.File_ID   := 11;
   Second_File_Name : CA13003_0.File_Name := "John Schep";
   Second_File_Id   : CA13003_0.File_ID   := 47;
   Expected_Name    : CA13003_0.File_Name := "          ";
   Student_File     : CA13003_0.File_Rec;
   
   function Process_Input_Files (ID_In   : CA13003_0.File_ID; 
                                 File_In : CA13003_0.File_Rec) return 
     CA13003_0.File_Name renames CA13003_0.CA13003_1.CA13003_4;

   function Process_Audit_Files (ID_In   : CA13003_0.File_ID; 
                                 File_In : CA13003_0.File_Rec) return 
     CA13003_0.File_Name renames CA13003_0.CA13003_2.CA13003_4;
begin
   Report.Test ("CA13003", "Check that separate subunits which share " &
                "an ancestor may have the same name if they have " &
                "different fully qualified names");

   Student_File := (ID => First_File_Id, Name => First_File_Name);

   -- Note that all subunits have the same simple name.
   -- Generate report from file processing.
   CA13003_0.CA13003_1.CA13003_3;
   Expected_Name := Process_Input_Files (First_File_Id, Student_File);
   CA13003_0.CA13003_1.CA13003_5.Generate_Report;

   if not CA13003_0.TC_Open_For_Process or 
     not CA13003_0.TC_Report_From_Process or 
       Expected_Name /= First_File_Name then
         Report.Failed ("Unexpected results in processing file");
   end if;

   CA13003_0.Initialize_File_Rec 
     (Second_File_Name, Second_File_Id, Student_File);

   -- Generate report from file auditing.
   CA13003_0.CA13003_2.CA13003_3;
   Expected_Name := Process_Audit_Files (Second_File_Id, Student_File);
   CA13003_0.CA13003_2.CA13003_5.Generate_Report;

   if not CA13003_0.TC_Open_For_Audit or 
     not CA13003_0.TC_Report_From_Audit or 
       Expected_Name /= Second_File_Name then
         Report.Failed ("Unexpected results in auditing file");
   end if;

   Report.Result;

end CA13003;