1-- C393B13.A
2--
3--                             Grant of Unlimited Rights
4--
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
14--     to do so.
15--
16--                                    DISCLAIMER
17--
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.
24--*
25--
26-- TEST OBJECTIVE:
27--      Check that an extended type can be derived from an abstract type
28--      when that derivation is declared in a child package.
29--
30-- TEST DESCRIPTION:
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.
34--
35-- TEST FILES:
36--      This test depends on the following foundation code:
37--
38--         F393B00.A  Package Alert_Foundation
39--
40--
41-- CHANGE HISTORY:
42--      06 Dec 94   SAIC    ACVC 2.0
43--      15 Oct 95   SAIC    Fixed bugs for ACVC 2.0.1
44--
45--!
46
47package F393B00.C393B13_0 is
48     -- Alert_Foundation.Public_Child
49
50  subtype Msg_Length_Range is integer range 0 .. 240;
51  Max_Msg_Length : constant Msg_Length_Range := 80;
52  Message : String := "Test Passed";
53
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);
58    end record;
59
60  procedure Handle (CA : in out Child_Alert);  -- required override
61
62end F393B00.C393B13_0;
63 -- Alert_Foundation.Public_Child;
64
65--=======================================================================--
66
67package body F393B00.C393B13_0 is
68          -- Alert_Foundation.Public_Child
69
70  procedure Handle (CA : in out Child_Alert) is
71    begin
72      CA.Msg(1..Message'Length) := Message;
73      CA.Times_Handled := CA.Times_Handled + 1;
74    end;
75
76end F393B00.C393B13_0;
77 -- Alert_Foundation.Public_Child
78
79--=======================================================================--
80
81with Report;
82with F393B00.C393B13_0;
83  -- Alert_foundation.Public_Child;
84procedure C393B13 is
85  package Child renames F393B00.C393B13_0;
86  CA : Child.Child_Alert(Child.Message'Length);
87
88begin
89
90  Report.Test ("C393B13", "Check that an extended type can be derived " &
91                          "from an abstract type");
92
93  if CA.Times_Handled /= 0 then
94    Report.Failed ("Wrong initialization");
95  end if;
96
97  Child.Handle (CA);
98  if (CA.Times_Handled /= 1)
99  or (CA.Msg /= Child.Message) then
100    Report.Failed ("Wrong results from Handle");
101  end if;
102
103  Report.Result;
104
105end C393B13;
106