1-- C393007.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--      where the abstract type is defined in a package, and the type derived
29--      from it is defined in a distinct library package.
30--
31-- TEST DESCRIPTION:
32--      Declare an private (abstract) type; declare two primitive operations
33--      of the type that are explicitly abstract.
34--      Derive an extended type from the (private) abstract type, overriding
35--      both of the primitive operations.
36--      This test also checks to see that name overloading between abstract
37--      and non-abstract functions is resolved correctly.
38--
39--
40-- CHANGE HISTORY:
41--      06 Dec 94   SAIC    ACVC 2.0
42--
43--!
44
45   package C393007_0 is
46        -- Alert_System
47
48     type DT_Type is new Integer;
49
50     type Alert_Type is abstract tagged record
51        Time_Of_Arrival : DT_Type;
52     end record;
53
54     type Log_File_Type is range 0 .. 100;
55
56     Procedure Handle (A : in out Alert_type) is abstract;
57
58     procedure Log    (A : Alert_Type;
59                       L : in out Log_File_Type) is abstract;
60
61     procedure Set_Time (A : in out Alert_Type);
62
63     function Correct_Time_Stamp (A : Alert_Type) return Boolean;
64
65     Day_Time : DT_Type := 100;
66
67   end C393007_0;
68    -- Alert_System;
69
70 --=======================================================================--
71
72   package body C393007_0 is
73             -- Alert_System
74
75     function Time_Stamp return DT_Type is
76       begin
77         Day_Time := Day_Time + 1;
78         return Day_Time;
79       end Time_Stamp;
80
81     procedure Set_Time (A : in out Alert_Type) is
82       begin
83         A.Time_Of_Arrival := Time_Stamp;
84       end Set_time;
85
86     function Correct_Time_Stamp ( A : Alert_Type) return Boolean is
87       begin
88         return (A.Time_Of_Arrival = Day_Time);
89       end Correct_Time_Stamp;
90
91   end C393007_0;
92    -- Alert_System;
93
94 --=======================================================================--
95
96 with Report;
97 with C393007_0;
98   -- Alert_system;
99
100 package C393007_1 is
101
102   type Normal_Alert_Type is
103     new C393007_0.Alert_Type
104     with null record;
105
106   Log_File: C393007_0.Log_File_Type := C393007_0.Log_File_Type'First;
107
108   procedure Handle (A : in out Normal_Alert_Type);  -- Override is required
109
110   procedure Log    (A : Normal_Alert_Type;          -- Override is required
111                     L : in out C393007_0.Log_File_Type);
112 end C393007_1;
113
114 package body C393007_1 is
115   use type C393007_0.Log_File_Type;
116
117   procedure Handle (A : in out Normal_Alert_Type) is
118     begin
119       Set_Time (A);
120       Log (A, Log_File);
121     end Handle;
122
123   procedure Log    (A : Normal_Alert_Type;
124                     L : in out C393007_0.Log_File_Type) is
125      begin
126        L := C393007_0."+"(L, 1);
127      end Log;
128
129 end C393007_1;
130
131 with Report;
132 with C393007_0;
133 with C393007_1;
134   -- Alert_system;
135
136 procedure C393007 is
137   use C393007_0;
138   use C393007_1;
139
140   Alert_One : C393007_1.Normal_Alert_Type;
141
142 begin
143   Report.Test ("C393007", "Check that an extended type can be derived " &
144                           "from an abstract type");
145
146   Handle (Alert_One);
147   if not Correct_Time_Stamp (Alert_One) then
148     Report.Failed ("Wrong results from procedure Handle");
149   end if;
150
151   if Log_File /=1 then
152     Report.Failed ("Wrong results");
153   end if;
154
155   Report.Result;
156
157 end C393007;
158