diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/ca/ca13003.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/ca/ca13003.a | 256 |
1 files changed, 256 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/ca/ca13003.a b/gcc/testsuite/ada/acats/tests/ca/ca13003.a new file mode 100644 index 000000000..607639efe --- /dev/null +++ b/gcc/testsuite/ada/acats/tests/ca/ca13003.a @@ -0,0 +1,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; |