Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/c4/c460007.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- C460007.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, in a numeric type conversion, if the target type is an
28 -- integer type and the operand type is real, the result is rounded
29 -- to the nearest integer, and away from zero if the result is exactly
30 -- halfway between two integers. Check for static and non-static type
31 -- conversions.
32 --
33 -- TEST DESCRIPTION:
34 -- The following cases are considered:
35 --
36 -- X.5 X.5 + delta -X.5 + delta
37 -- -X.5 X.5 - delta -X.5 - delta
38 --
39 -- Both zero and non-zero values are used for X. The value of delta is
40 -- chosen to be a very small increment (on the order of 1.0E-10). For
41 -- fixed and floating point cases, the value of delta is chosen such that
42 -- "(-)X.5 +(-) delta" is a multiple of the small, or a machine number,
43 -- respectively.
44 --
45 -- The following type conversions are performed:
46 --
47 -- ID Real operand Cases Target integer subtype
48 -- ------------------------------------------------------------------
49 -- 1 Real named number X.5 Nonstatic
50 -- 2 X.5 - delta Nonstatic
51 -- 3 -X.5 - delta Static
52 -- 4 Real literal -X.5 Static
53 -- 5 X.5 + delta Static
54 -- 6 -X.5 + delta Nonstatic
55 -- 7 Floating point object -X.5 - delta Nonstatic
56 -- 8 X.5 - delta Static
57 -- 9 Fixed point object X.5 Static
58 -- 10 X.5 + delta Static
59 -- 11 -X.5 + delta Nonstatic
60 -- The conversion is either assigned to a variable of the target subtype
61 -- or passed as a parameter to a subprogram (both nonstatic contexts).
62 --
63 -- The subprogram Equal is used to circumvent potential optimizations.
64 --
65 --
66 -- CHANGE HISTORY:
67 -- 03 Oct 95 SAIC Initial prerelease version.
68 --
69 --!
70
71 with System;
72 package C460007_0 is
73
74 --
75 -- Target integer subtype (static):
76 --
77
78 type Static_Integer_Subtype is range -32_000 .. 32_000;
79
80 Static_Target : Static_Integer_Subtype;
81
82 function Equal (L, R: Static_Integer_Subtype) return Boolean;
83
84
85 --
86 -- Named numbers:
87 --
88
89 NN_Half : constant := 0.5000000000;
90 NN_Less_Half : constant := 126.4999999999;
91 NN_More_Half : constant := -NN_Half - 0.0000000001;
92
93
94 --
95 -- Floating point:
96 --
97
98 type My_Float is digits System.Max_Digits;
99
100 Flt_Rnd_Toward_Zero : My_Float := My_Float'Pred(NN_Half);
101 Flt_Rnd_Away_Zero : constant My_Float := My_Float'Pred(-113.5);
102
103
104 --
105 -- Fixed point:
106 --
107
108 type My_Fixed is delta 0.1 range -5.0 .. 5.0;
109
110 Fix_Half : My_Fixed := 0.5;
111 Fix_Rnd_Away_Zero : My_Fixed := Fix_Half + My_Fixed'Small;
112 Fix_Rnd_Toward_Zero : constant My_Fixed := -3.5 + My_Fixed'Small;
113
114 end C460007_0;
115
116
117 --==================================================================--
118
119
120 package body C460007_0 is
121
122 function Equal (L, R: Static_Integer_Subtype) return Boolean is
123 begin
124 return (L = R);
125 end Equal;
126
127 end C460007_0;
128
129
130 --==================================================================--
131
132
133 with C460007_0;
134 use C460007_0;
135
136 with Report;
137 procedure C460007 is
138
139 --
140 -- Target integer subtype (nonstatic):
141 --
142
143 Limit : Static_Integer_Subtype :=
144 Static_Integer_Subtype(Report.Ident_Int(128));
145
146 subtype Nonstatic_Integer_Subtype is Static_Integer_Subtype
147 range -Limit .. Limit;
148
149 Nonstatic_Target : Static_Integer_Subtype;
150
151 begin
152
153 Report.Test ("C460007", "Rounding for type conversions of real operand " &
154 "to integer target");
155
156
157 -- --------------------------
158 -- Named number/literal cases:
159 -- --------------------------
160
161 Nonstatic_Target := Nonstatic_Integer_Subtype(NN_Half);
162
163 if not Equal(Nonstatic_Target, 1) then -- Case 1.
164 Report.Failed ("Wrong result for named number operand" &
165 "(case 1), nonstatic target subtype");
166 end if;
167
168 if not Equal(Nonstatic_Integer_Subtype(NN_Less_Half), 126) then -- Case 2.
169 Report.Failed ("Wrong result for named number operand" &
170 "(case 2), nonstatic target subtype");
171 end if;
172
173 Static_Target := Static_Integer_Subtype(NN_More_Half);
174
175 if not Equal(Static_Target, -1) then -- Case 3.
176 Report.Failed ("Wrong result for named number operand" &
177 "(case 3), static target subtype");
178 end if;
179
180 if not Equal(Static_Integer_Subtype(-0.50), -1) then -- Case 4.
181 Report.Failed ("Wrong result for literal operand" &
182 "(case 4), static target subtype");
183 end if;
184
185 if not Equal(Static_Integer_Subtype(29_546.5001), 29_547) then -- Case 5.
186 Report.Failed ("Wrong result for literal operand" &
187 "(case 5), static target subtype");
188 end if;
189
190 if not Equal(Nonstatic_Integer_Subtype(-66.499), -66) then -- Case 6.
191 Report.Failed ("Wrong result for literal operand" &
192 "(case 6), nonstatic target subtype");
193 end if;
194
195
196 -- --------------------
197 -- Floating point cases:
198 -- --------------------
199
200 Nonstatic_Target := Nonstatic_Integer_Subtype(Flt_Rnd_Away_Zero);
201
202 if not Equal(Nonstatic_Target, -114) then -- Case 7.
203 Report.Failed ("Wrong result for floating point operand" &
204 "(case 7), nonstatic target subtype");
205 end if;
206 -- Case 8.
207 if not Equal(Static_Integer_Subtype(Flt_Rnd_Toward_Zero), 0) then
208 Report.Failed ("Wrong result for floating point operand" &
209 "(case 8), static target subtype");
210 end if;
211
212
213 -- -----------------
214 -- Fixed point cases:
215 -- -----------------
216
217 Static_Target := Static_Integer_Subtype(Fix_Half);
218
219 if not Equal(Static_Target, 1) then -- Case 9.
220 Report.Failed ("Wrong result for fixed point operand" &
221 "(case 9), static target subtype");
222 end if;
223
224 if not Equal(Static_Integer_Subtype(Fix_Rnd_Away_Zero), 1) then -- Case 10.
225 Report.Failed ("Wrong result for fixed point operand" &
226 "(case 10), static target subtype");
227 end if;
228
229 Nonstatic_Target := Nonstatic_Integer_Subtype(Fix_Rnd_Toward_Zero);
230
231 if not Equal(Nonstatic_Target, -3) then -- Case 11.
232 Report.Failed ("Wrong result for fixed point operand" &
233 "(case 11), nonstatic target subtype");
234 end if;
235
236
237 Report.Result;
238
239 end C460007;