-- C393009.A
|
-- C393009.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.
|
--
|
--
|
-- TEST DESCRIPTION:
|
-- TEST DESCRIPTION:
|
-- Declare an abstract type in the specification of a generic package.
|
-- Declare an abstract type in the specification of a generic package.
|
-- Instantiate the package and derive an extended type from the abstract
|
-- Instantiate the package and derive an extended type from the abstract
|
-- (instantiated) type; override all abstract operations; use all
|
-- (instantiated) type; override all abstract operations; use all
|
-- inherited operations;
|
-- inherited operations;
|
--
|
--
|
--
|
--
|
-- CHANGE HISTORY:
|
-- CHANGE HISTORY:
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 06 Dec 94 SAIC ACVC 2.0
|
-- 14 Oct 95 SAIC Fixed for ACVC 2.0.1
|
-- 14 Oct 95 SAIC Fixed for ACVC 2.0.1
|
--
|
--
|
--!
|
--!
|
|
|
with Report;
|
with Report;
|
procedure C393009 is
|
procedure C393009 is
|
|
|
package Display_Devices is
|
package Display_Devices is
|
|
|
type Display_Device_Enum is (None, TTY, Console, Big_Screen);
|
type Display_Device_Enum is (None, TTY, Console, Big_Screen);
|
Display : Display_Device_Enum := None;
|
Display : Display_Device_Enum := None;
|
|
|
end Display_Devices;
|
end Display_Devices;
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
generic
|
generic
|
|
|
type Generic_Status is (<>);
|
type Generic_Status is (<>);
|
|
|
type Serial_Type is (<>);
|
type Serial_Type is (<>);
|
|
|
package Alert_System is
|
package Alert_System is
|
|
|
type Alert_Type (Serial : Serial_Type) is abstract tagged record
|
type Alert_Type (Serial : Serial_Type) is abstract tagged record
|
Status : Generic_Status;
|
Status : Generic_Status;
|
end record;
|
end record;
|
|
|
Next_Serial_Number : Serial_Type := Serial_Type'First;
|
Next_Serial_Number : Serial_Type := Serial_Type'First;
|
|
|
procedure Handle (A : in out Alert_Type) is abstract;
|
procedure Handle (A : in out Alert_Type) is abstract;
|
-- abstract operation - must be overridden after instantiation
|
-- abstract operation - must be overridden after instantiation
|
|
|
procedure Display ( A : Alert_Type;
|
procedure Display ( A : Alert_Type;
|
On : Display_Devices.Display_Device_Enum);
|
On : Display_Devices.Display_Device_Enum);
|
-- primitive operation of Alert_Type
|
-- primitive operation of Alert_Type
|
-- not required to be overridden
|
-- not required to be overridden
|
|
|
function Get_Serial_Number (A : Alert_Type) return Serial_Type;
|
function Get_Serial_Number (A : Alert_Type) return Serial_Type;
|
-- primitive operation of Alert_Type
|
-- primitive operation of Alert_Type
|
-- not required to be overridden
|
-- not required to be overridden
|
|
|
end Alert_System;
|
end Alert_System;
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
package body Alert_System is
|
package body Alert_System is
|
|
|
procedure Display ( A : in Alert_Type;
|
procedure Display ( A : in Alert_Type;
|
On : Display_Devices.Display_Device_Enum) is
|
On : Display_Devices.Display_Device_Enum) is
|
begin
|
begin
|
Display_Devices.Display := On;
|
Display_Devices.Display := On;
|
end Display;
|
end Display;
|
|
|
function Get_Serial_Number (A : Alert_Type)
|
function Get_Serial_Number (A : Alert_Type)
|
return Serial_Type is
|
return Serial_Type is
|
begin
|
begin
|
return A.Serial;
|
return A.Serial;
|
end Get_Serial_Number;
|
end Get_Serial_Number;
|
|
|
end Alert_System;
|
end Alert_System;
|
|
|
--=======================================================================--
|
--=======================================================================--
|
|
|
package NCC_1701 is
|
package NCC_1701 is
|
|
|
type Status_Kind is (Green, Yellow, Red);
|
type Status_Kind is (Green, Yellow, Red);
|
type Serial_Number_Type is new Integer range 1..Integer'Last;
|
type Serial_Number_Type is new Integer range 1..Integer'Last;
|
|
|
subtype Msg_Str is String (1..16);
|
subtype Msg_Str is String (1..16);
|
Alert_Msg : Msg_Str := "C393009 passed.";
|
Alert_Msg : Msg_Str := "C393009 passed.";
|
-- 123456789A123456
|
-- 123456789A123456
|
|
|
package Alert_Pkg is new Alert_System (Status_Kind, Serial_Number_Type);
|
package Alert_Pkg is new Alert_System (Status_Kind, Serial_Number_Type);
|
|
|
type New_Alert_Type(Serial : Serial_Number_Type) is
|
type New_Alert_Type(Serial : Serial_Number_Type) is
|
new Alert_Pkg.Alert_Type(Serial) with record
|
new Alert_Pkg.Alert_Type(Serial) with record
|
Message : Msg_Str;
|
Message : Msg_Str;
|
end record;
|
end record;
|
|
|
-- procedure Display is inherited by New_Alert_Type
|
-- procedure Display is inherited by New_Alert_Type
|
|
|
-- function Get_Serial_Number is inherited by New_Alert_Type
|
-- function Get_Serial_Number is inherited by New_Alert_Type
|
procedure Handle (NA : in out New_Alert_Type); -- must be overridden
|
procedure Handle (NA : in out New_Alert_Type); -- must be overridden
|
procedure Init (NA : in out New_Alert_Type); -- new primitive
|
procedure Init (NA : in out New_Alert_Type); -- new primitive
|
|
|
NA : New_Alert_Type(Alert_Pkg.Next_Serial_Number);
|
NA : New_Alert_Type(Alert_Pkg.Next_Serial_Number);
|
-- New_Alert_Type is not abstract, so an object of that
|
-- New_Alert_Type is not abstract, so an object of that
|
-- type may be declared
|
-- type may be declared
|
|
|
end NCC_1701;
|
end NCC_1701;
|
|
|
package body NCC_1701 is
|
package body NCC_1701 is
|
|
|
procedure Handle (NA : in out New_Alert_Type) is
|
procedure Handle (NA : in out New_Alert_Type) is
|
begin
|
begin
|
NA.Message := Alert_Msg;
|
NA.Message := Alert_Msg;
|
Display (NA, On => Display_Devices.TTY);
|
Display (NA, On => Display_Devices.TTY);
|
end Handle;
|
end Handle;
|
|
|
procedure Init (NA : in out New_Alert_Type) is -- new primitive operation
|
procedure Init (NA : in out New_Alert_Type) is -- new primitive operation
|
begin -- for New_Alert_Type
|
begin -- for New_Alert_Type
|
NA := (Serial=> NA.Serial, Status => Green, Message => (others => ' '));
|
NA := (Serial=> NA.Serial, Status => Green, Message => (others => ' '));
|
end Init;
|
end Init;
|
|
|
end NCC_1701;
|
end NCC_1701;
|
|
|
use NCC_1701;
|
use NCC_1701;
|
use type Display_Devices.Display_Device_Enum;
|
use type Display_Devices.Display_Device_Enum;
|
|
|
begin
|
begin
|
|
|
Report.Test ("C393009", "Check that an extended type can be derived " &
|
Report.Test ("C393009", "Check that an extended type can be derived " &
|
"from an abstract type");
|
"from an abstract type");
|
|
|
Init (NA);
|
Init (NA);
|
if (Get_Serial_Number (NA) /= 1)
|
if (Get_Serial_Number (NA) /= 1)
|
or (NA.Status /= Green)
|
or (NA.Status /= Green)
|
or (Display_Devices.Display /= Display_Devices.None) then
|
or (Display_Devices.Display /= Display_Devices.None) then
|
Report.Failed ("Wrong Initialization");
|
Report.Failed ("Wrong Initialization");
|
end if;
|
end if;
|
|
|
Handle (NA);
|
Handle (NA);
|
if (Get_Serial_Number (NA) /= 1)
|
if (Get_Serial_Number (NA) /= 1)
|
or (NA.Status /= Green)
|
or (NA.Status /= Green)
|
or (NA.Message /= Alert_Msg)
|
or (NA.Message /= Alert_Msg)
|
or (Display_Devices.Display /= Display_Devices.TTY) then
|
or (Display_Devices.Display /= Display_Devices.TTY) then
|
Report.Failed ("Wrong results from Handle");
|
Report.Failed ("Wrong results from Handle");
|
end if;
|
end if;
|
|
|
Report.Result;
|
Report.Result;
|
|
|
end C393009;
|
end C393009;
|
|
|
