OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [ca/] [ca11b01.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11B01.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 a type derived in a public child inherits primitive
28
--      operations from parent.
29
--
30
-- TEST DESCRIPTION:
31
--      Declare a root record type with discriminant in a package
32
--      specification. Declare a primitive subprogram for the type
33
--      (foundation code).
34
--
35
--      Add a public child to the above package.  Derive a new type
36
--      with constraint to the discriminant record type from the parent
37
--      package.  Declare a new primitive subprogram to write to the child
38
--      derived type.
39
--
40
--      Add a new public child to the above package.  This grandchild package
41
--      derives a new type using the record type from the above package.
42
--      Declare a new primitive subprogram to write to the grandchild derived
43
--      type.
44
--
45
--      In the main program, "with" the grandchild.  Access the inherited
46
--      operations from grandparent, parent, and grandchild packages.
47
--
48
-- TEST FILES:
49
--      This test depends on the following foundation code:
50
--
51
--         FA11B00.A
52
--
53
--
54
-- CHANGE HISTORY:
55
--      06 Dec 94   SAIC    ACVC 2.0
56
--
57
--!
58
 
59
-- Child package of FA11B00.
60
package FA11B00.CA11B01_0 is          -- Application_Two_Widget
61
-- This public child declares a derived type from its parent.  It
62
-- represents processing of widgets in a window system.
63
 
64
   type App2_Widget is new App1_Widget (Maximum_Size => 5000);
65
   -- Inherits procedure Create_Widget from parent.
66
 
67
   -- Primitive operation of type App2_Widget.
68
   -- To be inherited by its children derivatives.
69
   procedure App2_Widget_Specific_Oper (The_Widget : in out App2_Widget;
70
                                        Loc        : in     Widget_Location);
71
 
72
end FA11B00.CA11B01_0;                -- Application_Two_Widget
73
 
74
--=======================================================================--
75
 
76
package body FA11B00.CA11B01_0 is     -- Application_Two_Widget
77
 
78
   procedure App2_Widget_Specific_Oper
79
     (The_Widget : in out App2_Widget;
80
      Loc        : in     Widget_Location) is
81
   begin
82
      The_Widget.Location := Loc;
83
   end App2_Widget_Specific_Oper;
84
 
85
end FA11B00.CA11B01_0;                -- Application_Two_Widget
86
 
87
--=======================================================================--
88
 
89
-- Grandchild package of FA11B00, child package of FA11B00.CA11B01_0.
90
package FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
91
-- This public grandchild declares a derived type from its parent.  It
92
-- represents processing of widgets in a window system.
93
 
94
   type App3_Widget is new App2_Widget;    -- Derived record of App2_Widget.
95
 
96
   -- Inherits (inherited) procedure Create_Widget from Application_One_Widget.
97
   -- Inherits procedure App2_Widget_Specific_Oper from App2_Widget.
98
 
99
   -- Primitive operation of type App3_Widget.
100
   procedure App3_Widget_Specific_Oper (The_Widget : in out App3_Widget;
101
                                        S          : in     Widget_Size);
102
 
103
end FA11B00.CA11B01_0.CA11B01_1;           -- Application_Three_Widget
104
 
105
--=======================================================================--
106
 
107
package body FA11B00.CA11B01_0.CA11B01_1 is     -- Application_Three_Widget
108
 
109
   procedure App3_Widget_Specific_Oper
110
     (The_Widget : in out App3_Widget;
111
      S          : in     Widget_Size) is
112
   begin
113
      The_Widget.Size := S;
114
   end App3_Widget_Specific_Oper;
115
 
116
end FA11B00.CA11B01_0.CA11B01_1;                -- Application_Three_Widget
117
 
118
--=======================================================================--
119
 
120
with FA11B00.CA11B01_0.CA11B01_1; -- Application_Three_Widget,
121
                                  -- implicitly with Application_Two_Widget,
122
                                  -- implicitly with Application_Three_Widget.
123
with Report;
124
 
125
procedure CA11B01 is
126
 
127
   package Application_One_Widget renames FA11B00;
128
   package Application_Two_Widget renames FA11B00.CA11B01_0;
129
   package Application_Three_Widget renames FA11B00.CA11B01_0.CA11B01_1;
130
 
131
   use Application_One_Widget;
132
   use Application_Two_Widget;
133
   use Application_Three_Widget;
134
 
135
begin
136
 
137
   Report.Test ("CA11B01", "Check that a type derived in a public " &
138
                "child inherits primitive operations from parent");
139
 
140
   Application_One_Subtest:
141
   declare
142
      White_Widget : App1_Widget;
143
 
144
   begin
145
      -- perform an App1_Widget specific operation.
146
      App1_Widget_Specific_Oper (C => White, L => "Line Editor    ",
147
                                 The_Widget => White_Widget, I => 10);
148
 
149
      If White_Widget.Color /= White or
150
        White_Widget.Id /= Widget_ID
151
          (Report.Ident_Int (10)) or
152
            White_Widget.Label  /= "Line Editor    " then
153
              Report.Failed ("Incorrect result for White_Widget");
154
      end if;
155
 
156
   end Application_One_Subtest;
157
   ---------------------------------------------------------------
158
   Application_Two_Subtest:
159
   declare
160
      Amber_Widget : App2_Widget;
161
 
162
   begin
163
      App1_Widget_Specific_Oper (Amber_Widget, I => 11,
164
                                 C => Amber, L => "Alarm_Clock    ");
165
                                 -- Inherited from Application_One_Widget.
166
 
167
      -- perform an App2_Widget specific operation.
168
      App2_Widget_Specific_Oper (The_Widget => Amber_Widget, Loc => (380,512));
169
 
170
      If Amber_Widget.Color /= Amber or
171
        Amber_Widget.Id /= Widget_ID (Report.Ident_Int (11)) or
172
            Amber_Widget.Label  /= "Alarm_Clock    " or
173
              Amber_Widget.Location /= (380,512) then
174
                Report.Failed ("Incorrect result for Amber_Widget");
175
      end if;
176
 
177
   end Application_Two_Subtest;
178
   ---------------------------------------------------------------
179
   Application_Three_Subtest:
180
   declare
181
      Green_Widget : App3_Widget;
182
 
183
   begin
184
      App1_Widget_Specific_Oper (Green_Widget, 100, Green,
185
                                 "Screen Editor  ");
186
                                   -- Inherited (inherited) from Basic_Widget.
187
 
188
      -- perform an App2_Widget specific operation.
189
      App2_Widget_Specific_Oper (Loc => (1024,760),
190
                                 The_Widget => Green_Widget);
191
                                    -- Inherited from App_1_Widget.
192
 
193
      -- perform an App3_Widget specific operation.
194
      App3_Widget_Specific_Oper (Green_Widget, S => (100,100));
195
 
196
      If Green_Widget.Color /= Green or
197
        Green_Widget.Id /= Widget_ID (Report.Ident_Int (100)) or
198
          Green_Widget.Label  /= "Screen Editor  " or
199
            Green_Widget.Location /= (1024,760) or
200
              Green_Widget.Size /= (100,100) then
201
                Report.Failed ("Incorrect result for Green_Widget");
202
      end if;
203
 
204
   end Application_Three_Subtest;
205
 
206
   Report.Result;
207
 
208
end CA11B01;

powered by: WebSVN 2.1.0

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