-- C393007.A
|
-- C393007.A
|
--
|
--
|
-- Grant of Unlimited Rights
|
-- Grant of Unlimited Rights
|
--
|
--
|
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
-- 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
|
-- 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 in the software and documentation contained herein.
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
-- this public release, the Government intends to confer upon all
|
-- this public release, the Government intends to confer upon all
|
-- recipients unlimited rights equal to those held by the Government.
|
-- recipients unlimited rights equal to those held by the Government.
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- These rights include rights to use, duplicate, release or disclose the
|
-- released technical data and computer software in whole or in part, in
|
-- 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
|
-- any manner and for any purpose whatsoever, and to have or permit others
|
-- to do so.
|
-- to do so.
|
--
|
--
|
-- DISCLAIMER
|
-- DISCLAIMER
|
--
|
--
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
-- PARTICULAR PURPOSE OF SAID MATERIAL.
|
--*
|
--*
|
--
|
--
|
-- TEST OBJECTIVE:
|
-- TEST OBJECTIVE:
|
-- Check that an extended type can be derived from an abstract type,
|
-- 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
|
-- where the abstract type is defined in a package, and the type derived
|
-- from it is defined in a distinct library package.
|
-- from it is defined in a distinct library package.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare an private (abstract) type; declare two primitive operations
|
-- Declare an private (abstract) type; declare two primitive operations
|
-- of the type that are explicitly abstract.
|
-- of the type that are explicitly abstract.
|
-- Derive an extended type from the (private) abstract type, overriding
|
-- Derive an extended type from the (private) abstract type, overriding
|
-- both of the primitive operations.
|
-- both of the primitive operations.
|
-- This test also checks to see that name overloading between abstract
|
-- This test also checks to see that name overloading between abstract
|
-- and non-abstract functions is resolved correctly.
|
-- and non-abstract functions is resolved correctly.
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
--
|
--
|
--!
|
--!
|
|
|
package C393007_0 is
|
package C393007_0 is
|
-- Alert_System
|
-- Alert_System
|
|
|
type DT_Type is new Integer;
|
type DT_Type is new Integer;
|
|
|
type Alert_Type is abstract tagged record
|
type Alert_Type is abstract tagged record
|
Time_Of_Arrival : DT_Type;
|
Time_Of_Arrival : DT_Type;
|
end record;
|
end record;
|
|
|
type Log_File_Type is range 0 .. 100;
|
type Log_File_Type is range 0 .. 100;
|
|
|
Procedure Handle (A : in out Alert_type) is abstract;
|
Procedure Handle (A : in out Alert_type) is abstract;
|
|
|
procedure Log (A : Alert_Type;
|
procedure Log (A : Alert_Type;
|
L : in out Log_File_Type) is abstract;
|
L : in out Log_File_Type) is abstract;
|
|
|
procedure Set_Time (A : in out Alert_Type);
|
procedure Set_Time (A : in out Alert_Type);
|
|
|
function Correct_Time_Stamp (A : Alert_Type) return Boolean;
|
function Correct_Time_Stamp (A : Alert_Type) return Boolean;
|
|
|
Day_Time : DT_Type := 100;
|
Day_Time : DT_Type := 100;
|
|
|
end C393007_0;
|
end C393007_0;
|
-- Alert_System;
|
-- Alert_System;
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
package body C393007_0 is
|
package body C393007_0 is
|
-- Alert_System
|
-- Alert_System
|
|
|
function Time_Stamp return DT_Type is
|
function Time_Stamp return DT_Type is
|
begin
|
begin
|
Day_Time := Day_Time + 1;
|
Day_Time := Day_Time + 1;
|
return Day_Time;
|
return Day_Time;
|
end Time_Stamp;
|
end Time_Stamp;
|
|
|
procedure Set_Time (A : in out Alert_Type) is
|
procedure Set_Time (A : in out Alert_Type) is
|
begin
|
begin
|
A.Time_Of_Arrival := Time_Stamp;
|
A.Time_Of_Arrival := Time_Stamp;
|
end Set_time;
|
end Set_time;
|
|
|
function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
|
function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
|
begin
|
begin
|
return (A.Time_Of_Arrival = Day_Time);
|
return (A.Time_Of_Arrival = Day_Time);
|
end Correct_Time_Stamp;
|
end Correct_Time_Stamp;
|
|
|
end C393007_0;
|
end C393007_0;
|
-- Alert_System;
|
-- Alert_System;
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
with Report;
|
with Report;
|
with C393007_0;
|
with C393007_0;
|
-- Alert_system;
|
-- Alert_system;
|
|
|
package C393007_1 is
|
package C393007_1 is
|
|
|
type Normal_Alert_Type is
|
type Normal_Alert_Type is
|
new C393007_0.Alert_Type
|
new C393007_0.Alert_Type
|
with null record;
|
with null record;
|
|
|
Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
|
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 Handle (A : in out Normal_Alert_Type); -- Override is required
|
|
|
procedure Log (A : Normal_Alert_Type; -- Override is required
|
procedure Log (A : Normal_Alert_Type; -- Override is required
|
L : in out C393007_0.Log_File_Type);
|
L : in out C393007_0.Log_File_Type);
|
end C393007_1;
|
end C393007_1;
|
|
|
package body C393007_1 is
|
package body C393007_1 is
|
use type C393007_0.Log_File_Type;
|
use type C393007_0.Log_File_Type;
|
|
|
procedure Handle (A : in out Normal_Alert_Type) is
|
procedure Handle (A : in out Normal_Alert_Type) is
|
begin
|
begin
|
Set_Time (A);
|
Set_Time (A);
|
Log (A, Log_File);
|
Log (A, Log_File);
|
end Handle;
|
end Handle;
|
|
|
procedure Log (A : Normal_Alert_Type;
|
procedure Log (A : Normal_Alert_Type;
|
L : in out C393007_0.Log_File_Type) is
|
L : in out C393007_0.Log_File_Type) is
|
begin
|
begin
|
L := C393007_0."+"(L, 1);
|
L := C393007_0."+"(L, 1);
|
end Log;
|
end Log;
|
|
|
end C393007_1;
|
end C393007_1;
|
|
|
with Report;
|
with Report;
|
with C393007_0;
|
with C393007_0;
|
with C393007_1;
|
with C393007_1;
|
-- Alert_system;
|
-- Alert_system;
|
|
|
procedure C393007 is
|
procedure C393007 is
|
use C393007_0;
|
use C393007_0;
|
use C393007_1;
|
use C393007_1;
|
|
|
Alert_One : C393007_1.Normal_Alert_Type;
|
Alert_One : C393007_1.Normal_Alert_Type;
|
|
|
begin
|
begin
|
Report.Test ("C393007", "Check that an extended type can be derived " &
|
Report.Test ("C393007", "Check that an extended type can be derived " &
|
"from an abstract type");
|
"from an abstract type");
|
|
|
Handle (Alert_One);
|
Handle (Alert_One);
|
if not Correct_Time_Stamp (Alert_One) then
|
if not Correct_Time_Stamp (Alert_One) then
|
Report.Failed ("Wrong results from procedure Handle");
|
Report.Failed ("Wrong results from procedure Handle");
|
end if;
|
end if;
|
|
|
if Log_File /=1 then
|
if Log_File /=1 then
|
Report.Failed ("Wrong results");
|
Report.Failed ("Wrong results");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C393007;
|
end C393007;
|
|
|
