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/] [c8/] [c840001.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- C840001.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, for the type determined by the subtype mark of a use type
28
--      clause, the declaration of each primitive operator is use-visible
29
--      within the scope of the clause, even if explicit operators with the
30
--      same names as the type's operators are declared for the subtype. Check
31
--      that a call to such an operator executes the body of the type's
32
--      operation.
33
--
34
-- TEST DESCRIPTION:
35
--      A type may declare a primitive operator, and a subtype of that type
36
--      may overload the operator. If a use type clause names the subtype,
37
--      it is the primitive operator of the type (not the subtype) which
38
--      is made directly visible, and the primitive operator may be called
39
--      unambiguously. Such a call executes the body of the type's operation.
40
--
41
--      In a package, declare a type for which a predefined operator is
42
--      overridden.  In another package, declare a subtype of the type in the
43
--      previous package.  Declare another version of the predefined operator
44
--      for the subtype.
45
--
46
--      The main program declares objects of both the type and the explicit
47
--      subtype, and uses the "**" operator for both.  In all cases, the
48
--      operator declared for the 1st subtype should be the one executed,
49
--      since it is the primitive operators of the *type* that are made
50
--      visible; the operators which were declared for the explicit subtype
51
--      are not primitive operators of the type, since they were declared in
52
--      a separate package from the original type.
53
--
54
--
55
-- CHANGE HISTORY:
56
--      06 Dec 94   SAIC    ACVC 2.0
57
--      23 Sep 99   RLB     Added test case where operator made visible is
58
--                          not visible by selection (as in AI-00122).
59
--
60
--!
61
 
62
package C840001_0 is
63
-- Usage scenario: the predefined operators for a floating point type
64
-- are overridden in order to take advantage of improved algorithms.
65
 
66
   type Precision_Float is new Float range -100.0 .. 100.0;
67
   -- Implicit: function "**" (Left: Precision_Float; Right: Integer'Base)
68
   -- return Precision_Float;
69
 
70
   function "**" (Left: Precision_Float; Right: Integer'Base)
71
     return Precision_Float;
72
   -- Overrides predefined operator.
73
 
74
   function "+" (Right: Precision_Float)
75
     return Precision_Float;
76
   -- Overrides predefined operator.
77
 
78
   -- ... Other overridden operations.
79
 
80
   TC_Expected : constant Precision_Float := 68.0;
81
 
82
end C840001_0;
83
 
84
 
85
     --==================================================================--
86
 
87
package body C840001_0 is
88
 
89
   function "**" (Left: Precision_Float; Right: Integer'Base)
90
     return Precision_Float is
91
   begin
92
      -- ... Utilize desired algorithm.
93
      return (TC_Expected);  -- Artificial for testing purposes.
94
   end "**";
95
 
96
   function "+" (Right: Precision_Float)
97
     return Precision_Float is
98
   -- Overrides predefined operator.
99
   begin
100
      return Right*2.0;
101
   end "+";
102
 
103
end C840001_0;
104
 
105
 
106
     --==================================================================--
107
 
108
-- Take advantage of some even better algorithms designed for positive
109
-- floating point values.
110
 
111
with C840001_0;
112
package C840001_1 is
113
 
114
   subtype Precision_Pos_Float is C840001_0.Precision_Float
115
     range 0.0 .. 100.0;
116
 
117
-- This is not a new type, so it has no primitives of it own. However, it
118
-- can declare another version of the operator and call it as long as both it
119
-- and the corresponding operator of the 1st subtype are not directly visible
120
-- in the same place.
121
 
122
   function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
123
     return Precision_Pos_Float;           -- Accepts only positive exponent.
124
 
125
end C840001_1;
126
 
127
 
128
     --==================================================================--
129
 
130
package body C840001_1 is
131
 
132
   function "**" (Left: Precision_Pos_Float; Right: Natural'Base)
133
     return Precision_Pos_Float is
134
   begin
135
      -- ... Utilize some other algorithms.
136
      return 57.0;           -- Artificial for testing purposes.
137
   end "**";
138
 
139
end C840001_1;
140
 
141
 
142
     --==================================================================--
143
 
144
with Report;
145
with C840001_1;
146
procedure C840001_2 is
147
 
148
   -- Note that C840001_0 and it's contents is not visible in any form here.
149
 
150
   TC_Operand   : C840001_1.Precision_Pos_Float := 41.0;
151
 
152
   TC_Operand2  : C840001_1.Precision_Pos_Float;
153
 
154
   use type C840001_1.Precision_Pos_Float;
155
      -- Makes the operators of its parent type directly visible, even though
156
      -- the parent type and operators are not otherwise visible at all.
157
 
158
begin
159
 
160
   TC_Operand2 := +TC_Operand; -- Overridden operator is visible and called.
161
 
162
   if TC_Operand2 /= 82.0 then -- Predefined equality.
163
      Report.Failed ("3rd test: type's overridden operation not called for " &
164
                     "operand of 1st subtype");
165
   end if;
166
   if TC_Operand + 3.0 >= TC_Operand2 - 13.0 then -- Various predefined operators.
167
      Report.Failed ("3rd test: wrong result from predefined operators");
168
   end if;
169
 
170
end C840001_2;
171
 
172
     --==================================================================--
173
 
174
 
175
with C840001_0;
176
with C840001_1;
177
with C840001_2;
178
 
179
with Report;
180
 
181
procedure C840001 is
182
 
183
begin
184
   Report.Test ("C840001", "Check that, for the type determined by the "   &
185
                "subtype mark of a use type clause, the declaration of "   &
186
                "each primitive operator is use-visible within the scope " &
187
                "of the clause, even if explicit operators with the same " &
188
                "names as the type's operators are declared for the subtype");
189
 
190
 
191
   Use_Type_Precision_Pos_Float:
192
   declare
193
      TC_Operand          : C840001_0.Precision_Float
194
                          := C840001_0.Precision_Float(-2.0);
195
      TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  6.0;
196
 
197
      TC_Actual_Type      : C840001_0.Precision_Float;
198
      TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
199
 
200
      use type C840001_1.Precision_Pos_Float;
201
      -- Both calls to "**" should return 68.0 (that is, Precision_Float's
202
      -- operation should be called).
203
 
204
   begin
205
 
206
      TC_Actual_Type := TC_Operand**2;
207
 
208
      if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
209
         Report.Failed ("1st block: type's operation not called for " &
210
                        "operand of 1st subtype");
211
      end if;
212
 
213
      TC_Actual_Subtype := TC_Positive_Operand**2;
214
 
215
      if not (C840001_0."="
216
             (TC_Actual_Subtype, C840001_0.TC_Expected)) then
217
         Report.Failed ("1st block: type's operation not called for " &
218
                        "operand of explicit subtype");
219
      end if;
220
 
221
   end Use_Type_Precision_Pos_Float;
222
 
223
   Use_Type_Precision_Float:
224
   declare
225
      TC_Operand          : C840001_0.Precision_Float
226
                          := C840001_0.Precision_Float(4.0);
227
      TC_Positive_Operand : C840001_1.Precision_Pos_Float :=  7.0;
228
 
229
      TC_Actual_Type      : C840001_0.Precision_Float;
230
      TC_Actual_Subtype   : C840001_1.Precision_Pos_Float;
231
 
232
      use type C840001_0.Precision_Float;
233
      -- Again, both calls to "**" should return 68.0.
234
 
235
  begin
236
 
237
      TC_Actual_Type := TC_Operand**2;
238
 
239
      if C840001_0."/="(TC_Actual_Type, C840001_0.TC_Expected) then
240
         Report.Failed ("2nd block: type's operation not called for " &
241
                        "operand of 1st subtype");
242
      end if;
243
 
244
      TC_Actual_Subtype := TC_Positive_Operand**2;
245
 
246
      if not C840001_0."=" (TC_Actual_Subtype, C840001_0.TC_Expected) then
247
         Report.Failed ("2nd block: type's operation not called for " &
248
                        "operand of explicit subtype");
249
      end if;
250
 
251
   end Use_Type_Precision_Float;
252
 
253
   C840001_2; -- 3rd test.
254
 
255
   Report.Result;
256
 
257
end C840001;

powered by: WebSVN 2.1.0

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