aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/ada/acats/tests/cc/cc70a02.a
blob: 3601ce443e140558e6b7082b888bdff5014ddf9c (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
-- CC70A02.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 the visible part of a generic formal package includes the
--      first list of basic declarative items of the package specification.
--      Check for a generic subprogram which declares a formal package with
--      (<>) as its actual part.
--
-- TEST DESCRIPTION:
--      The "first list of basic declarative items" of a package specification
--      is the visible part of the package. Thus, the declarations in the
--      visible part of the actual instance corresponding to a formal
--      package are available in the generic which declares the formal package.
--       
--      Declare a generic package which simulates a complex integer abstraction
--      (foundation code).
--
--      Declare a second generic package which defines a "signature" for
--      mathematical groups. Declare a generic function within a package
--      which utilizes the second generic package as a generic formal package
--      (with a (<>) actual_part).
--
--      In the main program, instantiate the first generic package, then
--      instantiate the second generic package with objects, types, and
--      operations declared in the first instance.
--
--      Instantiate the generic function and pass the second instance
--      to it as a generic actual parameter. Check that the instance of the
--      generic function performs as expected.
--
--
-- CHANGE HISTORY:
--      06 Dec 94   SAIC    ACVC 2.0
--
--!

generic               -- Mathematical group signature.

   type Group_Type is private;

   Identity : in Group_Type;

   with function Operation (Left, Right : Group_Type) return Group_Type;
   with function Inverse   (Right : Group_Type)       return Group_Type;

package CC70A02_0 is end;

-- No body for CC70A02_0.


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


with CC70A02_0;       -- Mathematical group signature.

package CC70A02_1 is  -- Mathematical group operations.

   --                                  --
   -- Generic formal package used here --
   --                                  --

   generic            -- Powers for mathematical groups.
      with package Group is new CC70A02_0 (<>);
   function Power (Left : Group.Group_Type; Right : Integer)
     return Group.Group_Type;


end CC70A02_1;


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


package body CC70A02_1 is  -- Mathematical group operations.



   function Power (Left : Group.Group_Type; Right : Integer)
     return Group.Group_Type is
      Result : Group.Group_Type := Group.Identity;
   begin
      for I in 1 .. abs(Right) loop                 -- Repeat group operations
         Result := Group.Operation (Result, Left);  -- the specified number of
      end loop;                                     -- times.

      if Right < 0 then                             -- If specified power is
         return Group.Inverse (Result);             -- negative, return the
      else                                          -- inverse of the result.
         return Result;                             -- If it is zero, return
      end if;                                       -- the identity.
   end Power;


end CC70A02_1;


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


with Report;

with FC70A00;    -- Complex integer abstraction.
with CC70A02_0;  -- Mathematical group signature.
with CC70A02_1;  -- Mathematical group operations.

procedure CC70A02 is

   -- Declare an instance of complex integers:

   type My_Integer is range -100 .. 100;
   package Complex_Integers is new FC70A00 (My_Integer);


   -- Define an addition group for complex integers:

   package Complex_Addition_Group is new CC70A02_0
     (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
      Identity   => Complex_Integers.Zero,          -- Additive identity.
      Operation  => Complex_Integers."+",           -- Additive operation.
      Inverse    => Complex_Integers."-");          -- Additive inverse.

   function Complex_Multiplication is new           -- Multiplication of a
     CC70A02_1.Power(Complex_Addition_Group);       -- complex integer by a
                                                    -- constant.


   -- Define a multiplication group for complex integers:

   package Complex_Multiplication_Group is new CC70A02_0
     (Group_Type => Complex_Integers.Complex_Type,  -- For complex integers...
      Identity   => Complex_Integers.One,           -- Multiplicative identity.
      Operation  => Complex_Integers."*",           -- Multiplicative oper.
      Inverse    => Complex_Integers.Reciprocal);   -- Multiplicative inverse.

   function Complex_Exponentiation is new           -- Exponentiation of a
     CC70A02_1.Power(Complex_Multiplication_Group); -- complex integer by a
                                                    -- constant.

   use Complex_Integers;


begin  -- Main program.

   Report.Test ("CC70A02", "Check that the visible part of a generic " &
                "formal package includes the first list of basic " &
                "declarative items of the package specification. Check " &
                "for a generic subprogram where formal package has (<>) " &
                "actual part");

   declare
      Mult_Operand         : constant Complex_Type := Complex ( -4,  9);
      Exp_Operand          : constant Complex_Type := Complex (  0, -7);

      Expected_Mult_Result : constant Complex_Type := Complex ( 28, -63);
      Expected_Exp_Result  : constant Complex_Type := Complex (-49,   0);
   begin

      if Complex_Multiplication (Mult_Operand, -7) /= Expected_Mult_Result then
         Report.Failed ("Incorrect results from complex multiplication");
      end if;

      if Complex_Exponentiation (Exp_Operand, 2) /= Expected_Exp_Result then
         Report.Failed ("Incorrect results from complex exponentiation");
      end if;

   end;

   Report.Result;

end CC70A02;