3 -- Grant of Unlimited Rights
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
7 -- unlimited rights in the software and documentation contained herein.
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
9 -- this public release, the Government intends to confer upon all
10 -- recipients unlimited rights equal to those held by the Government.
11 -- These rights include rights to use, duplicate, release or disclose the
12 -- released technical data and computer software in whole or in part, in
13 -- any manner and for any purpose whatsoever, and to have or permit others
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
27 -- Check that an abstract extended type can be derived from an abstract
28 -- type, and that a a non-abstract type may then be derived from the
29 -- second abstract type.
32 -- Define an abstract type with three primitive operations, two of them
33 -- abstract. Derive an extended type from it, inheriting the non-
34 -- abstract operation, overriding one of the abstract operations with
35 -- a non-abstract operation, and overriding the other abstract operation
36 -- with an abstract operation. The extended type is therefore abstract;
37 -- derive an extended type from it. Override the abstract operation with
38 -- a non-abstract operation; inherit one operation from the original
39 -- abstract type, and inherit one operation from the intermediate
44 -- 06 Dec 94 SAIC ACVC 2.0
51 type Status_Enum
is (None
, Unhandled
, Pending
, Handled
);
52 type Serial_Type
is new Integer range 0 .. Integer'Last;
53 subtype Priority_Type
is Integer range 0..10;
55 type Display_Enum
is (Bit_Bucket
, TTY
, Console
, Big_Screen
);
57 Next
: Serial_Type
:= 1;
58 Display_Device
: Display_Enum
:= Bit_Bucket
;
63 --=======================================================================--
71 package Definitions
renames C393011_0
;
73 type Alert_Type
is abstract tagged record
74 Status
: Definitions
.Status_Enum
:= Definitions
.None
;
75 Serial_Num
: Definitions
.Serial_Type
:= 0;
76 Priority
: Definitions
.Priority_Type
;
78 -- Alert_Type is an abstract type with
79 -- two operations to be overridden
81 procedure Set_Status
( A
: in out Alert_Type
; -- not abstract
82 To
: Definitions
.Status_Enum
);
84 procedure Set_Serial
( A
: in out Alert_Type
) is abstract;
85 procedure Display
( A
: Alert_Type
) is abstract;
90 --=======================================================================--
93 package body C393011_1
is
95 procedure Set_Status
( A
: in out Alert_Type
;
96 To
: Definitions
.Status_Enum
) is
104 --=======================================================================--
115 type New_Alert_Type
is abstract new C393011_1
.Alert_Type
with record
116 Display_Dev
: C393011_0
.Display_Enum
:= C393011_0
.TTY
;
119 -- procedure Set_Status is inherited
121 procedure Set_Serial
( A
: in out New_Alert_Type
); -- override/see body
123 procedure Display
( A
: New_Alert_Type
) is abstract;
124 -- override is abstract
125 -- still can't declare objects of New_Alert_Type
130 --=======================================================================--
133 Package Body C393011_3
is
136 package Definitions
renames C393011_0
;
138 procedure Set_Serial
(A
: in out New_Alert_Type
) is
139 use type Definitions
.Serial_Type
;
141 A
.Serial_Num
:= Definitions
.Next
;
142 Definitions
.Next
:= Definitions
."+"( Definitions
.Next
, 1);
148 --=======================================================================--
153 -- New_Alert -- package Alert is not visible
156 package New_Alert
renames C393011_3
;
157 package Definitions
renames C393011_0
;
159 type Final_Alert_Type
is new New_Alert
.New_Alert_Type
with null record;
160 -- inherits Set_Status including body
161 -- inherits Set_Serial including body
162 -- must override Display since inherited Display is abstract
163 procedure Display
(FA
: in Final_Alert_Type
);
164 procedure Handle
(FA
: in out Final_Alert_Type
);
168 package body C393011_4
is
170 procedure Display
(FA
: in Final_Alert_Type
) is
172 Definitions
.Display_Device
:= FA
.Display_Dev
;
175 procedure Handle
(FA
: in out Final_Alert_Type
) is
177 Set_Status
(FA
, Definitions
.Handled
);
186 -- New_Alert -- package Alert is not visible
193 FA
: Final_Alert_Type
;
197 Report
.Test
("C393011", "Check that an extended type can be derived " &
198 "from an abstract type");
200 if (Definitions
.Display_Device
/= Definitions
.Bit_Bucket
)
201 or (Definitions
.Next
/= 1)
202 or (FA
.Status
/= Definitions
.None
)
203 or (FA
.Serial_Num
/= 0)
204 or (FA
.Display_Dev
/= TTY
) then
205 Report
.Failed
("Incorrect initial conditions");
209 if (Definitions
.Display_Device
/= Definitions
.TTY
)
210 or (Definitions
.Next
/= 2)
211 or (FA
.Status
/= Definitions
.Handled
)
212 or (FA
.Serial_Num
/= 1)
213 or (FA
.Display_Dev
/= TTY
) then
214 Report
.Failed
("Incorrect results from Handle");