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 extended type can be derived from an abstract type
28 -- when that derivation is declared in a child package.
31 -- Add a visible child to Alert_Foundation. Using the abstract type
32 -- Alert as parent, declare an extended type with discriminant and new
33 -- record components. Override the Handle procedure.
36 -- This test depends on the following foundation code:
38 -- F393B00.A Package Alert_Foundation
42 -- 06 Dec 94 SAIC ACVC 2.0
43 -- 15 Oct 95 SAIC Fixed bugs for ACVC 2.0.1
47 package F393B00
.C393B13_0
is
48 -- Alert_Foundation.Public_Child
50 subtype Msg_Length_Range
is integer range 0 .. 240;
51 Max_Msg_Length
: constant Msg_Length_Range
:= 80;
52 Message
: String := "Test Passed";
54 type Child_Alert
(Length
: Msg_Length_Range
)
55 is new Alert
with record -- abstract type is in parent package
56 Times_Handled
: Natural := 0;
57 Msg
: String (1..Length
);
60 procedure Handle
(CA
: in out Child_Alert
); -- required override
62 end F393B00
.C393B13_0
;
63 -- Alert_Foundation.Public_Child;
65 --=======================================================================--
67 package body F393B00
.C393B13_0
is
68 -- Alert_Foundation.Public_Child
70 procedure Handle
(CA
: in out Child_Alert
) is
72 CA
.Msg
(1..Message
'Length) := Message
;
73 CA
.Times_Handled
:= CA
.Times_Handled
+ 1;
76 end F393B00
.C393B13_0
;
77 -- Alert_Foundation.Public_Child
79 --=======================================================================--
82 with F393B00
.C393B13_0
;
83 -- Alert_foundation.Public_Child;
85 package Child
renames F393B00
.C393B13_0
;
86 CA
: Child
.Child_Alert
(Child
.Message
'Length);
90 Report
.Test
("C393B13", "Check that an extended type can be derived " &
91 "from an abstract type");
93 if CA
.Times_Handled
/= 0 then
94 Report
.Failed
("Wrong initialization");
98 if (CA
.Times_Handled
/= 1)
99 or (CA
.Msg
/= Child
.Message
) then
100 Report
.Failed
("Wrong results from Handle");