OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cc/] [cc30001.a] - Blame information for rev 720

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 720 jeremybenn
-- CC30001.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
-- OBJECTIVE:
27
--      Check that if a non-overriding primitive subprogram is declared for
28
--      a type derived from a formal derived tagged type, the copy of that
29
--      subprogram in an instance can override a subprogram inherited from the
30
--      actual type.
31
--
32
-- TEST DESCRIPTION:
33
--      User writes program to handle both mail messages and system messages.
34
--
35
--      Mail messages are created by instantiating a generic "mail" package
36
--      with a root message type. System messages are created by
37
--      instantiating the generic with a system message type derived from the
38
--      root in a separate package. The system message type has a primitive
39
--      subprogram called Send.
40
--
41
--      Inside the generic, a "mail" type is derived from the generic formal
42
--      derived type, and a "Send" operation is declared.
43
--
44
--      Declare a root tagged type T. Declare a generic package with a formal
45
--      derived type using the root tagged type as ancestor. In the generic,
46
--      derive a type from the formal derived type and declare a primitive
47
--      subprogram for it. In a separate package, declare a derivative DT of
48
--      the root tagged type T and declare a primitive subprogram which is
49
--      type conformant with (and hence, overridable for) the primitive
50
--      declared in the generic. Instantiate the generic for DT. Make both
51
--      dispatching and non-dispatching calls to the primitive subprogram. In
52
--      both cases the version of the subprogram in the instance should be
53
--      called (since it overrides the implementation inherited from the
54
--      actual).
55
--
56
--
57
-- CHANGE HISTORY:
58
--      06 Dec 94   SAIC    ACVC 2.0
59
--      13 Apr 95   SAIC    Replaced call involving instance for root tagged
60
--                          type with a dispatching call involving instance
61
--                          for derived type. Updated commentary. Moved
62
--                          instantiations (and related commentary) to
63
--                          library-level to avoid accessibility violation.
64
--                          Commented out instantiation for root tagged type.
65
--      27 Feb 97   PWB.CTA Added elaboration pragma.
66
--!
67
 
68
package CC30001_0 is  -- Root message type.
69
 
70
   type Msg_Type is tagged record
71
      Text         : String (1 .. 20);
72
      Message_Sent : Boolean;
73
   end record;
74
 
75
end CC30001_0;
76
 
77
 
78
     --==================================================================--
79
 
80
 
81
with CC30001_0;  -- Root message type.
82
generic          -- Generic "mail" package.
83
   type Message is new CC30001_0.Msg_Type with private;
84
package CC30001_1 is
85
 
86
   type Mail_Type is new Message with record   -- Derived from formal type.
87
      To : String (1 .. 8);
88
   end record;
89
 
90
   procedure Send (M : in out Mail_Type);      -- For this test, this version
91
                                               -- of Send should be called in
92
   -- ... Other operations.                    -- all cases.
93
 
94
end CC30001_1;
95
 
96
 
97
     --==================================================================--
98
 
99
 
100
package body CC30001_1 is
101
 
102
   procedure Send (M : in out Mail_Type) is
103
   begin
104
      -- ... Code to send message omitted for brevity.
105
      M.Message_Sent := True;
106
   end Send;
107
 
108
end CC30001_1;
109
 
110
 
111
     --==================================================================--
112
 
113
 
114
with CC30001_0;       -- Root message type.
115
package CC30001_2 is  -- System message type and operations.
116
 
117
   type Signal_Type is (Note, Warning, Error);
118
 
119
   type Sys_Message is new CC30001_0.Msg_Type with record   -- Derived from
120
      Signal : Signal_Type := Warning;                      -- root type.
121
   end record;
122
 
123
   procedure Send (Item : in out Sys_Message); -- For this test, this version
124
                                               -- of Send should never be
125
   -- ... Other operations.                    -- called (it will have been
126
                                               -- overridden).
127
end CC30001_2;
128
 
129
 
130
     --==================================================================--
131
 
132
 
133
package body CC30001_2 is
134
 
135
   procedure Send (Item : in out Sys_Message) is
136
   begin
137
      -- ... Code to send message omitted for brevity.
138
      Item.Message_Sent := False;  -- Ensure this procedure gives a different
139
   end Send;                       -- result than CC30001_1.Send.
140
 
141
end CC30001_2;
142
 
143
 
144
     --==================================================================--
145
 
146
 
147
-- User first sets up support for mail messages by instantiating the
148
-- generic mail package for the root message type. An operation "Send" is
149
-- declared for the mail message type in the instance.
150
--
151
-- with CC30001_0;  -- Root message type.
152
-- with CC30001_1;  -- Generic "mail" package.
153
-- package Mail_Messages is new CC30001_1 (CC30001_0.Msg_Type);
154
 
155
 
156
     --==================================================================--
157
 
158
 
159
-- Next, the user sets up support for system messages by instantiating the
160
-- generic mail package with the system message type. An operation "Send"
161
-- is declared for the "system" mail message type in the instance. This
162
-- operation overrides the "Send" operation inherited from the system
163
-- message type actual (a situation the user may not have intended).
164
 
165
with CC30001_1;  -- Generic "mail" package.
166
with CC30001_2;  -- System message type and operations.
167
pragma Elaborate (CC30001_1);
168
package CC30001_3 is new CC30001_1 (CC30001_2.Sys_Message);
169
 
170
 
171
     --==================================================================--
172
 
173
with CC30001_2;  -- System message type and operations.
174
with CC30001_3;  -- Instance with mail type and operations.
175
 
176
with Report;
177
procedure CC30001 is
178
 
179
   package System_Messages renames CC30001_3;
180
 
181
 
182
   Sys_Msg1 : System_Messages.Mail_Type := (Text   => "System shutting down",
183
                                            Signal => CC30001_2.Warning,
184
                                            To     => "AllUsers",
185
                                            Message_Sent => False);
186
 
187
   Sys_Msg2 : System_Messages.Mail_Type'Class := Sys_Msg1;
188
 
189
 
190
   use System_Messages, CC30001_2;                 -- All versions of "Send"
191
                                                   -- directly visible.
192
 
193
begin
194
 
195
   Report.Test ("CC30001", "Check that if a non-overriding primitive "     &
196
                "subprogram is declared for a type derived from a formal " &
197
                "derived tagged type, the copy of that subprogram in an "  &
198
                "instance can override a subprogram inherited from the "   &
199
                "actual type");
200
 
201
 
202
   Send (Sys_Msg1);   -- Calls version declared in instance (version declared
203
                      -- in CC30001_2 has been overridden).
204
 
205
   if not Sys_Msg1.Message_Sent then
206
      Report.Failed ("Non-dispatching call: instance operation not called");
207
   end if;
208
 
209
 
210
   Send (Sys_Msg2);   -- Calls version declared in instance (version declared
211
                      -- in CC30001_2 has been overridden).
212
 
213
   if not Sys_Msg2.Message_Sent then
214
      Report.Failed ("Dispatching call: instance operation not called");
215
   end if;
216
 
217
 
218
   Report.Result;
219
end CC30001;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.