Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb2002.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 -- CXB2002.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 subprograms Shift_Left, Shift_Right,
28 -- Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right are available
29 -- and produce correct results for values of signed and modular
30 -- integer types of 16 bits.
31 --
32 -- TEST DESCRIPTION:
33 -- This test uses the shift and rotate functions of package Interfaces
34 -- with a modular type representative of 16 bits. The functions
35 -- are used as the right hand of assignment statements, as part of
36 -- conditional statements, and as arguments in other function calls.
37 --
38 -- APPLICABILITY CRITERIA:
39 -- This test is applicable to all implementations that support signed
40 -- and modular integer types of 16 bits.
41 --
42 --
43 -- CHANGE HISTORY:
44 -- 21 Aug 95 SAIC Initial prerelease version.
45 -- 07 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
46 -- 26 Oct 96 SAIC Removed subtests based on Big/Little Endian.
47 -- 17 Feb 97 PWB.CTA Corrected "-" to "+" in parenthesized expressions.
48 --!
49
50 with Report;
51 with Interfaces;
52 with Ada.Exceptions;
53
54 procedure CXB2002 is
55 begin
56
57 Report.Test ("CXB2002",
58 "Check that subprograms Shift_Left, Shift_Right, " &
59 "Shift_Right_Arithmetic, Rotate_Left, and Rotate_Right " &
60 "produce correct results for values of signed and " &
61 "modular integer types of 16 bits");
62
63 Test_Block:
64 declare
65
66 use Ada.Exceptions;
67 use Interfaces;
68
69 TC_Amount : Natural := Natural'First;
70
71 -- Range of type Unsigned_16 is 0..65535 (0..Modulus-1).
72 TC_Val_Unsigned_16,
73 TC_Result_Unsigned_16 : Unsigned_16 := Unsigned_16'First;
74
75 begin
76
77 -- Note: The shifting and rotating subprograms operate on a bit-by-bit
78 -- basis, using the binary representation of the value of the
79 -- operands to yield a binary representation for the result.
80
81 -- Function Shift_Left.
82
83 TC_Amount := 3;
84 TC_Val_Unsigned_16 := Unsigned_16'Last; -- 65535.
85 TC_Result_Unsigned_16 := Shift_Left(TC_Val_Unsigned_16, TC_Amount);
86
87 if TC_Result_Unsigned_16 /= Unsigned_16'Last - (2**0 + 2**1 + 2**2)
88 then
89 Report.Failed("Incorrect result from Shift_Left - 1");
90 end if;
91
92 if Shift_Left(TC_Val_Unsigned_16, 0) /= Unsigned_16'Last or
93 Shift_Left(TC_Val_Unsigned_16, 5) /=
94 Unsigned_16'Last - (2**0 + 2**1 + 2**2 + 2**3 +2**4) or
95 Shift_Left(TC_Val_Unsigned_16, 16) /= 0
96 then
97 Report.Failed("Incorrect result from Shift_Left - 2");
98 end if;
99
100
101 -- Function Shift_Right.
102
103 TC_Amount := 3;
104 TC_Val_Unsigned_16 := Unsigned_16'Last; -- 65535.
105 TC_Result_Unsigned_16 := Shift_Right(Value => TC_Val_Unsigned_16,
106 Amount => TC_Amount);
107
108 if TC_Result_Unsigned_16 /= Unsigned_16'Last-(2**15 + 2**14 + 2**13)
109 then
110 Report.Failed("Incorrect result from Shift_Right - 1");
111 end if;
112
113 if Shift_Right(TC_Val_Unsigned_16, 0) /= Unsigned_16'Last or
114 Shift_Right(TC_Val_Unsigned_16, 5) /=
115 Unsigned_16'Last-(2**15 + 2**14 + 2**13 + 2**12 + 2**11) or
116 Shift_Right(TC_Val_Unsigned_16, 16) /= 0
117 then
118 Report.Failed("Incorrect result from Shift_Right - 2");
119 end if;
120
121
122 -- Tests of Shift_Left and Shift_Right in combination.
123
124 TC_Val_Unsigned_16 := Unsigned_16'Last;
125
126 if Shift_Left(Shift_Right(TC_Val_Unsigned_16, 4), 4) /=
127 Unsigned_16'Last-(2**0 + 2**1 + 2**2 + 2**3) or
128 Shift_Left(Shift_Right(TC_Val_Unsigned_16, 1), 3) /=
129 Unsigned_16'Last-(2**0 + 2**1 + 2**2) or
130 Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2), 4) /=
131 Unsigned_16'Last-(2**15+ 2**14 + 2**13 + 2**12) or
132 Shift_Right(Shift_Left(TC_Val_Unsigned_16, 2), 16) /= 0
133 then
134 Report.Failed("Incorrect result from Shift_Left - " &
135 "Shift_Right functions used in combination");
136 end if;
137
138
139 -- Function Shift_Right_Arithmetic.
140
141 -- Case where the parameter Value is less than
142 -- one half of the modulus. Zero bits will be shifted in.
143 -- Modulus of type Unsigned_16 is 2**16; one half is 2**15.
144
145 TC_Amount := 3;
146 TC_Val_Unsigned_16 := 2**15 - 1; -- Less than one half of modulus.
147 TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
148 TC_Amount);
149 if TC_Result_Unsigned_16 /=
150 TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12)
151 then
152 Report.Failed
153 ("Incorrect result from Shift_Right_Arithmetic - 1");
154 end if;
155
156 if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0) /=
157 TC_Val_Unsigned_16 or
158 Shift_Right_Arithmetic(TC_Val_Unsigned_16, 5) /=
159 TC_Val_Unsigned_16 - (2**14 + 2**13 + 2**12 + 2**11 + 2**10) or
160 Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /= 0
161 then
162 Report.Failed
163 ("Incorrect result from Shift_Right_Arithmetic - 2");
164 end if;
165
166 -- Case where the parameter Value is greater than or equal to
167 -- one half of the modulus. One bits will be shifted in.
168
169 TC_Amount := 1;
170 TC_Val_Unsigned_16 := 2**15; -- One half of modulus.
171 TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
172 TC_Amount);
173 if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 then
174 Report.Failed
175 ("Incorrect result from Shift_Right_Arithmetic - 3");
176 end if;
177
178 TC_Amount := 1;
179 TC_Val_Unsigned_16 := 2**15 + 1; -- Greater than half of modulus.
180 TC_Result_Unsigned_16 := Shift_Right_Arithmetic(TC_Val_Unsigned_16,
181 TC_Amount);
182 if TC_Result_Unsigned_16 /= TC_Val_Unsigned_16 + 2**14 - 2**0 then
183 Report.Failed
184 ("Incorrect result from Shift_Right_Arithmetic - 4");
185 end if;
186
187 if Shift_Right_Arithmetic(TC_Val_Unsigned_16, 0) /=
188 TC_Val_Unsigned_16 or
189 Shift_Right_Arithmetic(TC_Val_Unsigned_16, 4) /=
190 TC_Val_Unsigned_16 - 2**0 + 2**14 + 2**13 + 2**12 + 2**11 or
191 Shift_Right_Arithmetic(TC_Val_Unsigned_16, 16) /= Unsigned_16'Last
192 then
193 Report.Failed
194 ("Incorrect result from Shift_Right_Arithmetic - 5");
195 end if;
196
197
198 -- Function Rotate_Left.
199
200 TC_Amount := 3;
201 TC_Val_Unsigned_16 := Unsigned_16'Last; -- 65535.
202 TC_Result_Unsigned_16 := Rotate_Left(Value => TC_Val_Unsigned_16,
203 Amount => TC_Amount);
204 if TC_Result_Unsigned_16 /= Unsigned_16'Last then
205 Report.Failed("Incorrect result from Rotate_Left - 1");
206 end if;
207
208 TC_Val_Unsigned_16 := 2**15 + 2**14 + 2**1 + 2**0;
209 if Rotate_Left(TC_Val_Unsigned_16, 0) /=
210 2**15 + 2**14 + 2**1 + 2**0 or
211 Rotate_Left(TC_Val_Unsigned_16, 5) /=
212 2**6 + 2**5 + 2**4 + 2**3 or
213 Rotate_Left(TC_Val_Unsigned_16, 16) /= TC_Val_Unsigned_16
214 then
215 Report.Failed("Incorrect result from Rotate_Left - 2");
216 end if;
217
218
219 -- Function Rotate_Right.
220
221 TC_Amount := 1;
222 TC_Val_Unsigned_16 := 2**1 + 2**0;
223 TC_Result_Unsigned_16 := Rotate_Right(Value => TC_Val_Unsigned_16,
224 Amount => TC_Amount);
225 if TC_Result_Unsigned_16 /= 2**15 + 2**0 then
226 Report.Failed("Incorrect result from Rotate_Right - 1");
227 end if;
228
229 if Rotate_Right(TC_Val_Unsigned_16, 0) /= 2**1 + 2**0 or
230 Rotate_Right(TC_Val_Unsigned_16, 5) /= 2**12 + 2**11 or
231 Rotate_Right(TC_Val_Unsigned_16, 16) /= 2**1 + 2**0
232 then
233 Report.Failed("Incorrect result from Rotate_Right - 2");
234 end if;
235
236
237 -- Tests of Rotate_Left and Rotate_Right in combination.
238
239 TC_Val_Unsigned_16 := 32769;
240
241 if Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 4), 3) /= 49152 or
242 Rotate_Left(Rotate_Right(TC_Val_Unsigned_16, 1), 3) /= 6 or
243 Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 3), 7) /= 6144 or
244 Rotate_Right(Rotate_Left(TC_Val_Unsigned_16, 1), 16) /= 3
245 then
246 Report.Failed("Incorrect result from Rotate_Left - " &
247 "Rotate_Right functions used in combination");
248 end if;
249
250
251 exception
252 when The_Error : others =>
253 Report.Failed ("The following exception was raised in the " &
254 "Test_Block: " & Exception_Name(The_Error));
255 end Test_Block;
256
257 Report.Result;
258
259 end CXB2002;