URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca13003.a] - Rev 338
Compare with Previous | Blame | View Log
-- 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;