URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [c3/] [c393007.a] - Rev 384
Compare with Previous | Blame | View Log
-- C393007.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.
--*
--
-- TEST OBJECTIVE:
-- Check that an extended type can be derived from an abstract type,
-- where the abstract type is defined in a package, and the type derived
-- from it is defined in a distinct library package.
--
-- TEST DESCRIPTION:
-- Declare an private (abstract) type; declare two primitive operations
-- of the type that are explicitly abstract.
-- Derive an extended type from the (private) abstract type, overriding
-- both of the primitive operations.
-- This test also checks to see that name overloading between abstract
-- and non-abstract functions is resolved correctly.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
--
--!
package C393007_0 is
-- Alert_System
type DT_Type is new Integer;
type Alert_Type is abstract tagged record
Time_Of_Arrival : DT_Type;
end record;
type Log_File_Type is range 0 .. 100;
Procedure Handle (A : in out Alert_type) is abstract;
procedure Log (A : Alert_Type;
L : in out Log_File_Type) is abstract;
procedure Set_Time (A : in out Alert_Type);
function Correct_Time_Stamp (A : Alert_Type) return Boolean;
Day_Time : DT_Type := 100;
end C393007_0;
-- Alert_System;
--=======================================================================--
package body C393007_0 is
-- Alert_System
function Time_Stamp return DT_Type is
begin
Day_Time := Day_Time + 1;
return Day_Time;
end Time_Stamp;
procedure Set_Time (A : in out Alert_Type) is
begin
A.Time_Of_Arrival := Time_Stamp;
end Set_time;
function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
begin
return (A.Time_Of_Arrival = Day_Time);
end Correct_Time_Stamp;
end C393007_0;
-- Alert_System;
--=======================================================================--
with Report;
with C393007_0;
-- Alert_system;
package C393007_1 is
type Normal_Alert_Type is
new C393007_0.Alert_Type
with null record;
Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
procedure Handle (A : in out Normal_Alert_Type); -- Override is required
procedure Log (A : Normal_Alert_Type; -- Override is required
L : in out C393007_0.Log_File_Type);
end C393007_1;
package body C393007_1 is
use type C393007_0.Log_File_Type;
procedure Handle (A : in out Normal_Alert_Type) is
begin
Set_Time (A);
Log (A, Log_File);
end Handle;
procedure Log (A : Normal_Alert_Type;
L : in out C393007_0.Log_File_Type) is
begin
L := C393007_0."+"(L, 1);
end Log;
end C393007_1;
with Report;
with C393007_0;
with C393007_1;
-- Alert_system;
procedure C393007 is
use C393007_0;
use C393007_1;
Alert_One : C393007_1.Normal_Alert_Type;
begin
Report.Test ("C393007", "Check that an extended type can be derived " &
"from an abstract type");
Handle (Alert_One);
if not Correct_Time_Stamp (Alert_One) then
Report.Failed ("Wrong results from procedure Handle");
end if;
if Log_File /=1 then
Report.Failed ("Wrong results");
end if;
Report.Result;
end C393007;