Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/ada/acats/tests/c3/c354002.a @ 111:04ced10e8804
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 -- | |
2 -- C354002.A | |
3 -- | |
4 -- Grant of Unlimited Rights | |
5 -- | |
6 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687, | |
7 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained | |
8 -- unlimited rights in the software and documentation contained herein. | |
9 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making | |
10 -- this public release, the Government intends to confer upon all | |
11 -- recipients unlimited rights equal to those held by the Government. | |
12 -- These rights include rights to use, duplicate, release or disclose the | |
13 -- released technical data and computer software in whole or in part, in | |
14 -- any manner and for any purpose whatsoever, and to have or permit others | |
15 -- to do so. | |
16 -- | |
17 -- DISCLAIMER | |
18 -- | |
19 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR | |
20 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED | |
21 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE | |
22 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE | |
23 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A | |
24 -- PARTICULAR PURPOSE OF SAID MATERIAL. | |
25 --* | |
26 -- | |
27 -- OBJECTIVE: | |
28 -- Check that the attributes of modular types yield | |
29 -- correct values/results. The attributes checked are: | |
30 -- | |
31 -- First, Last, Range, Base, Min, Max, Succ, Pred, | |
32 -- Image, Width, Value, Pos, and Val | |
33 -- | |
34 -- TEST DESCRIPTION: | |
35 -- This test defines several modular types. One type defined at | |
36 -- each of System.Max_Binary_Modulus, System.Max_Nonbinary_Modulus, | |
37 -- a power of two half that of System.Max_Binary_Modulus, one less | |
38 -- than that power of two; one more than that power of two, two | |
39 -- less than a (large) power of two. For each of these types, | |
40 -- determine the correct operation of the following attributes: | |
41 -- | |
42 -- First, Last, Range, Base, Min, Max, Succ, Pred, Image, Width, | |
43 -- Value, Pos, Val, and Modulus | |
44 -- | |
45 -- The attributes Wide_Image and Wide_Value are deferred to C354003. | |
46 -- | |
47 -- | |
48 -- | |
49 -- CHANGE HISTORY: | |
50 -- 08 SEP 94 SAIC Initial version | |
51 -- 17 NOV 94 SAIC Revised version | |
52 -- 13 DEC 94 SAIC split off Wide_String attributes into C354003 | |
53 -- 06 JAN 95 SAIC Promoted to next release | |
54 -- 19 APR 95 SAIC Revised in accord with reviewer comments | |
55 -- 27 JAN 96 SAIC Eliminated 32/64 bit potential conflict for 2.1 | |
56 -- | |
57 --! | |
58 | |
59 with Report; | |
60 with System; | |
61 with TCTouch; | |
62 procedure C354002 is | |
63 | |
64 function ID(Local_Value: Integer) return Integer renames Report.Ident_Int; | |
65 function ID(Local_Value: String) return String renames Report.Ident_Str; | |
66 | |
67 Power_2_Bits : constant := System.Storage_Unit; | |
68 Half_Max_Binary_Value : constant := System.Max_Binary_Modulus / 2; | |
69 | |
70 type Max_Binary is mod System.Max_Binary_Modulus; | |
71 type Max_NonBinary is mod System.Max_Nonbinary_Modulus; | |
72 type Half_Max_Binary is mod Half_Max_Binary_Value; | |
73 | |
74 type Medium is mod 2048; | |
75 type Medium_Plus is mod 2042; | |
76 type Medium_Minus is mod 2111; | |
77 | |
78 type Small is mod 2; | |
79 type Finger is mod 5; | |
80 | |
81 MBL : constant := Max_NonBinary'Last; | |
82 MNBM : constant := Max_NonBinary'Modulus; | |
83 | |
84 Ones_Complement_Permission : constant Boolean := MBL = MNBM; | |
85 | |
86 type Finger_Id is (Thumb, Index, Middle, Ring, Pinkie); | |
87 | |
88 subtype Midrange is Medium_Minus range 222 .. 1111; | |
89 | |
90 -- a few numbers for testing purposes | |
91 Max_Binary_Mod_Over_3 : constant := Max_Binary'Modulus / 3; | |
92 Max_NonBinary_Mod_Over_4 : constant := Max_NonBinary'Modulus / 4; | |
93 System_Max_Bin_Mod_Pred : constant := System.Max_Binary_Modulus - 1; | |
94 System_Max_NonBin_Mod_Pred : constant := System.Max_Nonbinary_Modulus - 1; | |
95 Half_Max_Bin_Value_Pred : constant := Half_Max_Binary_Value - 1; | |
96 | |
97 AMB, BMB : Max_Binary; | |
98 AHMB, BHMB : Half_Max_Binary; | |
99 AM, BM : Medium; | |
100 AMP, BMP : Medium_Plus; | |
101 AMM, BMM : Medium_Minus; | |
102 AS, BS : Small; | |
103 AF, BF : Finger; | |
104 | |
105 TC_Pass_Case : Boolean := True; | |
106 | |
107 procedure Value_Fault( S: String ) is | |
108 -- check 'Value for failure modes | |
109 begin | |
110 -- the evaluation of the 'Value expression should raise C_E | |
111 TCTouch.Assert_Not( Midrange'Value(S) = 0, "Value_Fault" ); | |
112 if Midrange'Value(S) not in Midrange'Base then | |
113 Report.Failed("'Value(" & S & ") raised no exception"); | |
114 end if; | |
115 exception | |
116 when Constraint_Error => null; -- expected case | |
117 when others => | |
118 Report.Failed("'Value(" & S & ") raised wrong exception"); | |
119 end Value_Fault; | |
120 | |
121 begin -- Main test procedure. | |
122 | |
123 Report.Test ("C354002", "Check attributes of modular types" ); | |
124 | |
125 -- Base | |
126 TCTouch.Assert( Midrange'Base'First = 0, "Midrange'Base'First" ); | |
127 TCTouch.Assert( Midrange'Base'Last = Medium_Minus'Last, | |
128 "Midrange'Base'Last" ); | |
129 | |
130 -- First | |
131 TCTouch.Assert( Max_Binary'First = 0, "Max_Binary'First" ); | |
132 TCTouch.Assert( Max_NonBinary'First = 0, "Max_NonBinary'First" ); | |
133 TCTouch.Assert( Half_Max_Binary'First = 0, "Half_Max_Binary'First" ); | |
134 | |
135 TCTouch.Assert( Medium'First = Medium(ID(0)), "Medium'First" ); | |
136 TCTouch.Assert( Medium_Plus'First = Medium_Plus(ID(0)), | |
137 "Medium_Plus'First" ); | |
138 TCTouch.Assert( Medium_Minus'First = Medium_Minus(ID(0)), | |
139 "Medium_Minus'First" ); | |
140 | |
141 TCTouch.Assert( Small'First = Small(ID(0)), "Small'First" ); | |
142 TCTouch.Assert( Finger'First = Finger(ID(0)), "Finger'First" ); | |
143 TCTouch.Assert( Midrange'First = Midrange(ID(222)), | |
144 "Midrange'First" ); | |
145 | |
146 -- Image | |
147 TCTouch.Assert( Half_Max_Binary'Image(255) = " 255", | |
148 "Half_Max_Binary'Image" ); | |
149 TCTouch.Assert( Medium'Image(0) = ID(" 0"), "Medium'Image" ); | |
150 TCTouch.Assert( Medium_Plus'Image(Medium_Plus'Last) = " 2041", | |
151 "Medium_Plus'Image" ); | |
152 TCTouch.Assert( Medium_Minus'Image(Medium_Minus(ID(1024))) = " 1024", | |
153 "Medium_Minus'Image" ); | |
154 TCTouch.Assert( Small'Image(Small(ID(1))) = " 1", "Small'Image" ); | |
155 TCTouch.Assert( Midrange'Image(Midrange(ID(333))) = " 333", | |
156 "Midrange'Image" ); | |
157 | |
158 -- Last | |
159 TCTouch.Assert( Max_Binary'Last = System_Max_Bin_Mod_Pred, | |
160 "Max_Binary'Last"); | |
161 if Ones_Complement_Permission then | |
162 TCTouch.Assert( Max_NonBinary'Last >= System_Max_NonBin_Mod_Pred, | |
163 "Max_NonBinary'Last (ones comp)"); | |
164 else | |
165 TCTouch.Assert( Max_NonBinary'Last = System_Max_NonBin_Mod_Pred, | |
166 "Max_NonBinary'Last"); | |
167 end if; | |
168 TCTouch.Assert( Half_Max_Binary'Last = Half_Max_Bin_Value_Pred, | |
169 "Half_Max_Binary'Last"); | |
170 | |
171 TCTouch.Assert( Medium'Last = Medium(ID(2047)), "Medium'Last"); | |
172 TCTouch.Assert( Medium_Plus'Last = Medium_Plus(ID(2041)), | |
173 "Medium_Plus'Last"); | |
174 TCTouch.Assert( Medium_Minus'Last = Medium_Minus(ID(2110)), | |
175 "Medium_Minus'Last"); | |
176 TCTouch.Assert( Small'Last = Small(ID(1)), "Small'Last"); | |
177 TCTouch.Assert( Finger'Last = Finger(ID(4)), "Finger'Last"); | |
178 TCTouch.Assert( Midrange'Last = Midrange(ID(1111)), "Midrange'Last"); | |
179 | |
180 -- Max | |
181 TCTouch.Assert( Max_Binary'Max(Power_2_Bits, Max_Binary'Last) | |
182 = Max_Binary'Last, "Max_Binary'Max"); | |
183 TCTouch.Assert( Max_NonBinary'Max(100,2000) = 2000, "Max_NonBinary'Max"); | |
184 TCTouch.Assert( Half_Max_Binary'Max(123,456) = 456, | |
185 "Half_Max_Binary'Max"); | |
186 | |
187 TCTouch.Assert( Medium'Max(0,2040) = 2040, "Medium'Max"); | |
188 TCTouch.Assert( Medium_Plus'Max(0,1) = 1, "Medium_Plus'Max"); | |
189 TCTouch.Assert( Medium_Minus'Max(2001,1995) = 2001, "Medium_Minus'Max"); | |
190 TCTouch.Assert( Small'Max(1,0) = 1, "Small'Max"); | |
191 TCTouch.Assert( Finger'Max(Finger'Last+1,4) = 4, "Finger'Max"); | |
192 TCTouch.Assert( Midrange'Max(Midrange'First+1,222) = Midrange'First+1, | |
193 "Midrange'Max"); | |
194 | |
195 -- Min | |
196 TCTouch.Assert( Max_Binary'Min(Power_2_Bits, Max_Binary'Last) | |
197 = Power_2_Bits, "Max_Binary'Min"); | |
198 TCTouch.Assert( Max_NonBinary'Min(100,2000) = 100, "Max_NonBinary'Min"); | |
199 TCTouch.Assert( Half_Max_Binary'Min(123,456) = 123, | |
200 "Half_Max_Binary'Min"); | |
201 | |
202 TCTouch.Assert( Medium'Min(0,Medium(ID(2040))) = 0, "Medium'Min"); | |
203 TCTouch.Assert( Medium_Plus'Min(0,1) = 0, "Medium_Plus'Min"); | |
204 TCTouch.Assert( Medium_Minus'Min(2001,1995) = 1995, "Medium_Minus'Min"); | |
205 TCTouch.Assert( Small'Min(1,0) = 0, "Small'Min"); | |
206 TCTouch.Assert( Finger'Min(Finger'Last+1,4) /= 4, "Finger'Min"); | |
207 TCTouch.Assert( Midrange'Min(Midrange'First+1,222) = 222, | |
208 "Midrange'Min"); | |
209 -- Modulus | |
210 TCTouch.Assert( Max_Binary'Modulus = System.Max_Binary_Modulus, | |
211 "Max_Binary'Modulus"); | |
212 TCTouch.Assert( Max_NonBinary'Modulus = System.Max_Nonbinary_Modulus, | |
213 "Max_NonBinary'Modulus"); | |
214 TCTouch.Assert( Half_Max_Binary'Modulus = Half_Max_Binary_Value, | |
215 "Half_Max_Binary'Modulus"); | |
216 | |
217 TCTouch.Assert( Medium'Modulus = 2048, "Medium'Modulus"); | |
218 TCTouch.Assert( Medium_Plus'Modulus = 2042, "Medium_Plus'Modulus"); | |
219 TCTouch.Assert( Medium_Minus'Modulus = 2111, "Medium_Minus'Modulus"); | |
220 TCTouch.Assert( Small'Modulus = 2, "Small'Modulus"); | |
221 TCTouch.Assert( Finger'Modulus = 5, "Finger'Modulus"); | |
222 TCTouch.Assert( Midrange'Modulus = ID(2111), "Midrange'Modulus"); | |
223 | |
224 -- Pos | |
225 declare | |
226 Int : Natural := 222; | |
227 begin | |
228 for I in Midrange loop | |
229 TC_Pass_Case := TC_Pass_Case and Midrange'Pos(I) = Int; | |
230 | |
231 Int := Int +1; | |
232 end loop; | |
233 end; | |
234 | |
235 TCTouch.Assert( TC_Pass_Case, "Midrange'Pos"); | |
236 | |
237 -- Pred | |
238 TCTouch.Assert( Max_Binary'Pred(0) = System_Max_Bin_Mod_Pred, | |
239 "Max_Binary'Pred(0)"); | |
240 if Ones_Complement_Permission then | |
241 TCTouch.Assert( Max_NonBinary'Pred(0) >= System_Max_NonBin_Mod_Pred, | |
242 "Max_NonBinary'Pred(0) (ones comp)"); | |
243 else | |
244 TCTouch.Assert( Max_NonBinary'Pred(0) = System_Max_NonBin_Mod_Pred, | |
245 "Max_NonBinary'Pred(0)"); | |
246 end if; | |
247 TCTouch.Assert( Half_Max_Binary'Pred(0) = Half_Max_Bin_Value_Pred, | |
248 "Half_Max_Binary'Pred(0)"); | |
249 | |
250 TCTouch.Assert( Medium'Pred(Medium(ID(0))) = 2047, "Medium'Pred(0)"); | |
251 TCTouch.Assert( Medium_Plus'Pred(0) = 2041, "Medium_Plus'Pred(0)"); | |
252 TCTouch.Assert( Medium_Minus'Pred(0) = 2110, "Medium_Minus'Pred(0)"); | |
253 TCTouch.Assert( Small'Pred(0) = 1, "Small'Pred(0)"); | |
254 TCTouch.Assert( Finger'Pred(Finger(ID(0))) = 4, "Finger'Pred(0)"); | |
255 TCTouch.Assert( Midrange'Pred(222) = 221, "Midrange'Pred('First)"); | |
256 | |
257 -- Range | |
258 for I in Midrange'Range loop | |
259 if I not in Midrange then | |
260 Report.Failed("Midrange loop test"); | |
261 end if; | |
262 end loop; | |
263 for I in Medium'Range loop | |
264 if I not in Medium then | |
265 Report.Failed("Medium loop test"); | |
266 end if; | |
267 end loop; | |
268 for I in Medium_Minus'Range loop | |
269 if I not in 0..2110 then | |
270 Report.Failed("Medium loop test"); | |
271 end if; | |
272 end loop; | |
273 | |
274 -- Succ | |
275 TCTouch.Assert( Max_Binary'Succ(System_Max_Bin_Mod_Pred) = 0, | |
276 "Max_Binary'Succ('Last)"); | |
277 if Ones_Complement_Permission then | |
278 TCTouch.Assert( (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0) | |
279 or (Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) | |
280 = Max_NonBinary'Last), | |
281 "Max_NonBinary'Succ('Last) (ones comp)"); | |
282 else | |
283 TCTouch.Assert( Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0, | |
284 "Max_NonBinary'Succ('Last)"); | |
285 end if; | |
286 TCTouch.Assert( Half_Max_Binary'Succ(Half_Max_Bin_Value_Pred) = 0, | |
287 "Half_Max_Binary'Succ('Last)"); | |
288 | |
289 TCTouch.Assert( Medium'Succ(2047) = 0, "Medium'Succ('Last)"); | |
290 TCTouch.Assert( Medium_Plus'Succ(2041) = 0, "Medium_Plus'Succ('Last)"); | |
291 TCTouch.Assert( Medium_Minus'Succ(2110) = 0, "Medium_Minus'Succ('Last)"); | |
292 TCTouch.Assert( Small'Succ(1) = 0, "Small'Succ('Last)"); | |
293 TCTouch.Assert( Finger'Succ(4) = 0, "Finger'Succ('Last)"); | |
294 TCTouch.Assert( Midrange'Succ(Midrange(ID(1111))) = 1112, | |
295 "Midrange'Succ('Last)"); | |
296 | |
297 -- Val | |
298 for I in Natural range ID(222)..ID(1111) loop | |
299 TCTouch.Assert( Midrange'Val(I) = Medium_Minus(I), "Midrange'Val"); | |
300 end loop; | |
301 | |
302 -- Value | |
303 | |
304 TCTouch.Assert( Half_Max_Binary'Value("255") = 255, | |
305 "Half_Max_Binary'Value" ); | |
306 | |
307 TCTouch.Assert( Medium'Value(" 1e2") = 100, "Medium'Value(""1e2"")" ); | |
308 TCTouch.Assert( Medium'Value(" 0 ") = 0, "Medium'Value" ); | |
309 TCTouch.Assert( Medium_Plus'Value(ID("2041")) = 2041, | |
310 "Medium_Plus'Value" ); | |
311 TCTouch.Assert( Medium_Minus'Value(ID("+10_24")) = 1024, | |
312 "Medium_Minus'Value" ); | |
313 | |
314 TCTouch.Assert( Small'Value("+1") = 1, "Small'Value" ); | |
315 TCTouch.Assert( Midrange'Value(ID("333")) = 333, "Midrange'Value" ); | |
316 TCTouch.Assert( Midrange'Value("1E3") = 1000, | |
317 "Midrange'Value(""1E3"")" ); | |
318 | |
319 Value_Fault( "bad input" ); | |
320 Value_Fault( "-333" ); | |
321 Value_Fault( "9999" ); | |
322 Value_Fault( ".1" ); | |
323 Value_Fault( "1e-1" ); | |
324 | |
325 -- Width | |
326 TCTouch.Assert( Medium'Width = 5, "Medium'Width"); | |
327 TCTouch.Assert( Medium_Plus'Width = 5, "Medium_Plus'Width"); | |
328 TCTouch.Assert( Medium_Minus'Width = 5, "Medium_Minus'Width"); | |
329 TCTouch.Assert( Small'Width = 2, "Small'Width"); | |
330 TCTouch.Assert( Finger'Width = 2, "Finger'Width"); | |
331 TCTouch.Assert( Midrange'Width = 5, "Midrange'Width"); | |
332 | |
333 Report.Result; | |
334 | |
335 end C354002; |