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

Subversion Repositories openrisc_me

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CA11001.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 child unit can be used to provide an alternate view and
28
--      operations on a private type in its parent package.  Check that a
29
--      child unit can be a package.  Check that a WITH of a child unit
30
--      includes an implicit WITH of its ancestor unit.
31
--
32
-- TEST DESCRIPTION:
33
--      Declare a private type in a package specification. Declare
34
--      subprograms for the type.
35
--
36
--      Add a public child to the above package.  Within the body of this
37
--      package, access the private type. Declare operations to read and
38
--      write to its parent private type.
39
--
40
--      In the main program, "with" the child.  Declare objects of the
41
--      parent private type.  Access the subprograms from both parent and
42
--      child packages.
43
--
44
--
45
-- CHANGE HISTORY:
46
--      06 Dec 94   SAIC    ACVC 2.0
47
--
48
--!
49
 
50
package CA11001_0 is   -- Cartesian_Complex
51
--  This package represents a Cartesian view of a complex number.  It contains
52
--  a private type plus subprograms to construct and decompose a complex
53
--  number.
54
 
55
   type Complex_Int is range 0 .. 100;
56
 
57
   type Complex_Type is private;
58
 
59
   Constant_Complex : constant Complex_Type;
60
 
61
   Complex_Error : exception;
62
 
63
   procedure Cartesian_Assign   (R, I : in     Complex_Int;
64
                                 C    :    out Complex_Type);
65
 
66
   function Cartesian_Real_Part (C : Complex_Type)
67
     return Complex_Int;
68
 
69
   function Cartesian_Imag_Part (C : Complex_Type)
70
     return Complex_Int;
71
 
72
   function Complex (Real, Imaginary : Complex_Int)
73
     return Complex_Type;
74
 
75
private
76
   type Complex_Type is                      -- Parent private type
77
      record
78
         Real, Imaginary : Complex_Int;
79
      end record;
80
 
81
   Constant_Complex : constant Complex_Type := (Real => 0, Imaginary => 0);
82
 
83
end CA11001_0;       -- Cartesian_Complex
84
 
85
--=======================================================================--
86
 
87
package body CA11001_0 is  -- Cartesian_Complex
88
 
89
   procedure Cartesian_Assign (R, I : in     Complex_Int;
90
                               C    :    out Complex_Type) is
91
   begin
92
      C.Real      := R;
93
      C.Imaginary := I;
94
   end Cartesian_Assign;
95
   -------------------------------------------------------------
96
   function Cartesian_Real_Part (C : Complex_Type)
97
     return Complex_Int is
98
   begin
99
      return C.Real;
100
   end Cartesian_Real_Part;
101
   -------------------------------------------------------------
102
   function Cartesian_Imag_Part (C : Complex_Type)
103
     return Complex_Int is
104
   begin
105
      return C.Imaginary;
106
   end Cartesian_Imag_Part;
107
   -------------------------------------------------------------
108
   function Complex (Real, Imaginary : Complex_Int)
109
     return Complex_Type is
110
   begin
111
      return (Real, Imaginary);
112
   end Complex;
113
 
114
end CA11001_0;      -- Cartesian_Complex
115
 
116
--=======================================================================--
117
 
118
package CA11001_0.CA11001_1 is    -- Polar_Complex
119
--  This public child provides a different view of the private type from its
120
--  parent.  It provides a polar view by the provision of subprograms which
121
--  construct and decompose a complex number.
122
 
123
   procedure Polar_Assign (R, Theta : in     Complex_Int;
124
                           C        :    out Complex_Type);
125
                                             -- Complex_Type is a
126
                                             -- record of CA11001_0
127
 
128
   function Polar_Real_Part (C: Complex_Type) return Complex_Int;
129
 
130
   function Polar_Imag_Part (C: Complex_Type) return Complex_Int;
131
 
132
   function Equals_Const (Num : Complex_Type) return Boolean;
133
 
134
end CA11001_0.CA11001_1;    -- Polar_Complex
135
 
136
--=======================================================================--
137
 
138
package body CA11001_0.CA11001_1 is   -- Polar_Complex
139
 
140
   function Cos (Angle : Complex_Int) return Complex_Int is
141
      Num : constant Complex_Int := 2;
142
   begin
143
      return (Angle * Num);   -- not true Cosine function
144
   end Cos;
145
   -------------------------------------------------------------
146
   function Sine (Angle : Complex_Int) return Complex_Int is
147
   begin
148
      return 1;     -- not true Sine function
149
   end Sine;
150
   -------------------------------------------------------------
151
   function Sqrt (Num : Complex_Int)
152
     return Complex_Int is
153
   begin
154
     return (Num);     -- not true Square root function
155
   end Sqrt;
156
   -------------------------------------------------------------
157
   function Tan  (Angle : Complex_Int) return Complex_Int is
158
   begin
159
     return Angle;     -- not true Tangent function
160
   end Tan;
161
   -------------------------------------------------------------
162
   procedure Polar_Assign (R, Theta : in     Complex_Int;
163
                           C        :    out Complex_Type) is
164
   begin
165
      if R = 0 and Theta = 0 then
166
         raise Complex_Error;
167
      end if;
168
      C.Real := R * Cos (Theta);
169
      C.Imaginary := R * Sine (Theta);
170
   end Polar_Assign;
171
   -------------------------------------------------------------
172
   function Polar_Real_Part (C: Complex_Type) return Complex_Int is
173
   begin
174
      return Sqrt ((Cartesian_Imag_Part (C)) ** 2 +
175
                   (Cartesian_Real_Part (C)) ** 2);
176
   end Polar_Real_Part;
177
   -------------------------------------------------------------
178
   function Polar_Imag_Part (C: Complex_Type) return Complex_Int is
179
   begin
180
      return (Tan (Cartesian_Imag_Part (C) /
181
              Cartesian_Real_Part (C)));
182
   end Polar_Imag_Part;
183
   -------------------------------------------------------------
184
   function Equals_Const (Num : Complex_Type) return Boolean is
185
   begin
186
      return Num.Real = Constant_Complex.Real and
187
         Num.Imaginary = Constant_Complex.Imaginary;
188
   end Equals_Const;
189
 
190
end CA11001_0.CA11001_1;     -- Polar_Complex
191
 
192
--=======================================================================--
193
 
194
with CA11001_0.CA11001_1;        -- Polar_Complex
195
with Report;
196
 
197
procedure CA11001 is
198
 
199
   Complex_No  : CA11001_0.Complex_Type;    -- Complex_Type is a
200
                                            -- record of CA11001_0
201
 
202
   Complex_5x2 : CA11001_0.Complex_Type := CA11001_0.Complex (5, 2);
203
 
204
   Int_2       :  CA11001_0.Complex_Int
205
               := CA11001_0.Complex_Int (Report.Ident_Int (2));
206
 
207
begin
208
 
209
   Report.Test ("CA11001", "Check that a child unit can be used " &
210
                "to provide an alternate view and operations " &
211
                "on a private type in its parent package");
212
 
213
   Basic_View_Subtest:
214
 
215
   begin
216
      -- Assign using Cartesian coordinates.
217
      CA11001_0.Cartesian_Assign
218
        (CA11001_0.Complex_Int (Report.Ident_Int (1)), Int_2, Complex_No);
219
 
220
      -- Read back in Polar coordinates.
221
      -- Polar values are surrogates used in checking for correct
222
      -- subprogram calls.
223
      if CA11001_0."/=" (CA11001_0.CA11001_1.Polar_Real_Part (Complex_No),
224
        CA11001_0.Cartesian_Real_Part (Complex_5x2)) and CA11001_0."/="
225
          (CA11001_0.CA11001_1.Polar_Imag_Part (Complex_No),
226
            CA11001_0.Cartesian_Imag_Part (Complex_5x2)) then
227
           Report.Failed ("Incorrect Cartesian result");
228
      end if;
229
 
230
   end Basic_View_Subtest;
231
   -------------------------------------------------------------
232
   Alternate_View_Subtest:
233
   begin
234
      -- Assign using Polar coordinates.
235
      CA11001_0.CA11001_1.Polar_Assign
236
        (Int_2, CA11001_0.Complex_Int (Report.Ident_Int (3)), Complex_No);
237
 
238
      -- Read back in Cartesian coordinates.
239
      if CA11001_0."/=" (CA11001_0.Cartesian_Real_Part
240
        (Complex_No), CA11001_0.Complex_Int (Report.Ident_Int (12))) or
241
          CA11001_0."/=" (CA11001_0.Cartesian_Imag_Part (Complex_No), Int_2)
242
      then
243
         Report.Failed ("Incorrect Polar result");
244
      end if;
245
   end Alternate_View_Subtest;
246
   -------------------------------------------------------------
247
   Other_Subtest:
248
   begin
249
      -- Assign using Polar coordinates.
250
      CA11001_0.CA11001_1.Polar_Assign
251
        (CA11001_0.Complex_Int (Report.Ident_Int (0)), Int_2, Complex_No);
252
 
253
      -- Compare with Complex_Num in CA11001_0.
254
      if not CA11001_0.CA11001_1.Equals_Const (Complex_No)
255
        then
256
         Report.Failed ("Incorrect result");
257
      end if;
258
   end Other_Subtest;
259
   -------------------------------------------------------------
260
   Exception_Subtest:
261
   begin
262
      -- Raised parent's exception.
263
      CA11001_0.CA11001_1.Polar_Assign
264
        (CA11001_0.Complex_Int (Report.Ident_Int (0)),
265
           CA11001_0.Complex_Int (Report.Ident_Int (0)), Complex_No);
266
      Report.Failed ("Exception was not raised");
267
   exception
268
      when CA11001_0.Complex_Error =>
269
         null;
270
      when others                  =>
271
         Report.Failed ("Unexpected exception raised in test");
272
   end Exception_Subtest;
273
 
274
   Report.Result;
275
 
276
end CA11001;

powered by: WebSVN 2.1.0

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