aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/ca/ca11013.a
blob: c7f442788c12607a83b4292e40a39b5fff198f60 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
-- CA11013.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that a child function of a library level instantiation
--      of a generic can be the instantiation of a child function of
--      the generic. Check that the child instance can use its parent's
--      declarations and operations, including a formal subprogram of the 
--      parent.                                                           
--      
-- TEST DESCRIPTION:
--      Declare a generic package which simulates a real complex
--      abstraction.  Declare a generic child function of this package 
--      which builds a random complex number.  Declare a second
--      package which defines a random complex number generator.  This
--      package provides actual parameters for the generic parent package.
--
--      Instantiate the first generic package, then instantiate the child 
--      generic function as a child unit of the first instance.  In the main
--      program, check that the operations in both instances perform as 
--      expected.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--      16 Nov 95   SAIC    Update and repair for ACVC 2.0.1
--      19 Oct 96   SAIC    ACVC 2.1: Added pragma Elaborate to context
--                          clause of CA11013_3.
--      27 Feb 97   CTA.PWB Added elaboration pragma at package CA11013_3
--!
  
generic               -- Complex number abstraction.
   type Real_Type is digits <>;
   with function Random_Generator (Seed : Real_Type) return Real_Type;

package CA11013_0 is
 
   -- Simulate a generic complex number support package. Complex numbers
   -- are treated as coordinates in the Cartesian plane.

   type Complex_Type is
     record
        Real : Real_Type;
        Imag : Real_Type;
     end record;

   function Make (Real, Imag : Real_Type)           -- Create a complex
     return Complex_Type;                           -- number.

   procedure Components (Complex_No           : in Complex_Type;
                         Real_Part, Imag_Part : out Real_Type);

end CA11013_0;

     --==================================================================--

package body CA11013_0 is

   function Make (Real, Imag : Real_Type) return Complex_Type is
   begin
      return (Real, Imag);
   end Make;
   -------------------------------------------------------------
   procedure Components (Complex_No           : in Complex_Type;
                         Real_Part, Imag_Part : out Real_Type) is
   begin
      Real_Part := Complex_No.Real;
      Imag_Part := Complex_No.Imag;
   end Components;

end CA11013_0;

     --==================================================================--

-- Generic child of complex number package.  This child adds a layer of 
-- functionality to the parent generic.

generic               -- Random complex number operation.

function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type;

               --==============================================--

function CA11013_0.CA11013_1 (Seed : Real_Type) return Complex_Type is

   Random_Real_Part  :  Real_Type  := Random_Generator (Seed);
                                      -- parent's formal subprogram
   Random_Imag_Part  :  Real_Type  
                     := Random_Generator (Random_Generator (Seed));
                                      -- parent's formal subprogram
   Random_Complex_No :  Complex_Type;

begin -- CA11013_0.CA11013_1

   Random_Complex_No := Make (Random_Real_Part, Random_Imag_Part);
                                      -- operation from parent
   return (Random_Complex_No); 

end CA11013_0.CA11013_1;

     --==================================================================--

package CA11013_2 is
 
   -- To be used as actual parameters for random number generator
   -- in the parent package.

   type My_Float is digits 6 range -10.0 .. 100.0;

   function Random_Complex (Seed : My_float) return My_Float;

end CA11013_2;

     --==================================================================--

package body CA11013_2 is

   -- Not a real random number generator.
   function Random_Complex (Seed : My_float) return My_Float is
   begin
      return (Seed + 3.0);    
   end Random_Complex;

end CA11013_2;

     --==================================================================--

-- Declare instances of the generic complex packages for real type.  
-- The instance of the child must itself be declared as a child of the 
-- instance of the parent.

with CA11013_0;                       -- Complex number.
with CA11013_2;                       -- Random number generator.
pragma Elaborate (CA11013_0);
package CA11013_3 is new 
  CA11013_0 (Random_Generator => CA11013_2.Random_Complex,
             Real_Type        => CA11013_2.My_Float);

with CA11013_0.CA11013_1;             -- Random complex number operation.
with CA11013_3;
pragma Elaborate (CA11013_3);
function CA11013_3.CA11013_4 is new CA11013_3.CA11013_1;
  
     --==================================================================--

with Report;
with CA11013_2;                       -- Random number generator.
with CA11013_3.CA11013_4;             -- Complex abstraction + Random complex 
                                      -- number operation.
procedure CA11013 is

   package My_Complex_Pkg renames CA11013_3;
   use type CA11013_2.My_Float;

   My_Complex                 : My_Complex_Pkg.Complex_Type;
   My_Literal                 : CA11013_2.My_Float := 3.0;
   My_Real_Part, My_Imag_Part : CA11013_2.My_Float;

begin

   Report.Test ("CA11013", "Check that child instance can use its parent's "  &
                           "declarations and operations, including a formal " &
                           "subprogram of the parent");

   My_Complex := CA11013_3.CA11013_4 (My_Literal); 
                 -- Operation from the generic child function.

   My_Complex_Pkg.Components (My_Complex, My_Real_Part, My_Imag_Part);
                 -- Operation from the generic parent package.

   if My_Real_Part /= 6.0           -- Operation from the generic 
     or My_Imag_Part /= 9.0         -- parent package.
       then
         Report.Failed ("Incorrect results from complex operation");
   end if;

   Report.Result;

end CA11013;