1-- C3900063.AM
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-- OBJECTIVE:
27--      Check that a private tagged type declared in a package specification
28--      may be extended with a private extension in a different package
29--      specification, and that this private extension may in turn be extended
30--      by a record extension in a third package.
31--
32--      Check that each derivative inherits the user-defined primitive
33--      subprograms of its parent (including those that its parent inherited),
34--      that it may override these inherited primitive subprograms, and that it
35--      may also declare its own primitive subprograms.
36--
37--      Check that type conversion is defined from a type extension to its
38--      parent, and that this parent itself may be a type extension.
39--
40-- TEST DESCRIPTION:
41--      Declare a root tagged private type and two associated primitive
42--      subprograms in a package specification. Declare operations to verify
43--      the correctness of the components. Declare operations which return
44--      values of the type's private components, and which will be inherited
45--      by later derivatives.
46--
47--      Extend the root type with a private extension in a second package
48--      specification. Declare a new primitive subprogram for the extension,
49--      and override one of the two inherited subprograms. Within the
50--      overriding subprogram, utilize type conversion to call the parent's
51--      implementation of the same subprogram. Also within the overriding
52--      subprogram, call the new primitive subprogram and each inherited
53--      subprogram. Declare operations of the private extension which
54--      override the verification operations of its parent. Declare
55--      operations which return values of the extension's private components,
56--      and which will be inherited by later derivatives.
57--
58--      Extend the extension with a record extension in a third package
59--      specification. Declare a new primitive subprogram for this record
60--      extension, and override one of the three inherited subprograms.
61--      Within the overriding subprogram, utilize type conversion to call the
62--      parent's implementation of the same subprogram. Also within the
63--      overriding subprogram, call the new primitive subprogram and each
64--      inherited subprogram. Declare operations of the record extension
65--      which override the verification operations of its parent.
66--
67--      In the main program, declare objects of the root tagged type and
68--      the two type extensions. For each object, call the overriding
69--      subprogram, and verify the correctness of the components by calling
70--      the verification operations.
71--
72-- TEST FILES:
73--      This test consists of the following files:
74--
75--         C3900060.A
76--         C3900061.A
77--         C3900062.A
78--      => C3900063.AM
79--
80--
81-- CHANGE HISTORY:
82--      06 Dec 94   SAIC    ACVC 2.0
83--      04 Jun 96   SAIC    ACVC 2.1: Modified prologue.
84--
85--!
86
87with Report;
88
89with C3900060; -- Basic alert abstraction.
90with C3900062; -- Further extended alert abstraction.
91
92use  C3900060; -- Primitive operations of Alert_Type directly visible.
93
94procedure C3900063 is
95begin
96
97   Report.Test ("C390006", "Primitive operation inheritance by type " &
98                "extensions: all extensions declared in different " &
99                "packages; root type and 1st extension are private, " &
100                "2nd extension is record extension");
101
102
103   -- The cases for type C3900060.Alert_Type and C3900061.Low_Alert_Type
104   -- are tested in C390005. Those subtests are not repeated here.
105
106
107   MEDIUM_ALERT_SUBTEST: ------------------------------------------------------
108
109      declare
110         Medium_Alarm : C3900062.Medium_Alert_Type; -- Rec. ext. of extension.
111         use C3900062; -- Primitive operations of extension directly visible.
112      begin
113         if not Initial_Values_Okay (Medium_Alarm) then
114            Report.Failed ("Wrong initial values for Medium_Alert_Type");
115         end if;
116
117         Handle (Medium_Alarm);
118
119         if Bad_Final_Values (Medium_Alarm) then
120            Report.Failed ("Wrong values for Medium_Alert_Type after Handle");
121         end if;
122      end Medium_Alert_Subtest;
123
124
125   -- Check final display counts:
126
127   if C3900060.Display_Count_For /= (Null_Device => 1,
128                                     Teletype    => 1,
129                                     Console     => 1,
130                                     Big_Screen  => 0)
131   then
132      Report.Failed ("Wrong display counts after Medium_Alert_Type");
133   end if;
134
135
136   Report.Result;
137
138end C3900063;
139