4 -- Grant of Unlimited Rights
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
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.
28 -- Check that the attributes of modular types yield
29 -- correct values/results. The attributes checked are:
31 -- First, Last, Range, Base, Min, Max, Succ, Pred,
32 -- Image, Width, Value, Pos, and Val
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:
42 -- First, Last, Range, Base, Min, Max, Succ, Pred, Image, Width,
43 -- Value, Pos, Val, and Modulus
45 -- The attributes Wide_Image and Wide_Value are deferred to C354003.
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
64 function ID
(Local_Value
: Integer) return Integer renames Report
.Ident_Int
;
65 function ID
(Local_Value
: String) return String renames Report
.Ident_Str
;
67 Power_2_Bits
: constant := System
.Storage_Unit
;
68 Half_Max_Binary_Value
: constant := System
.Max_Binary_Modulus
/ 2;
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
;
74 type Medium
is mod 2048;
75 type Medium_Plus
is mod 2042;
76 type Medium_Minus
is mod 2111;
81 MBL
: constant := Max_NonBinary
'Last;
82 MNBM
: constant := Max_NonBinary
'Modulus;
84 Ones_Complement_Permission
: constant Boolean := MBL
= MNBM
;
86 type Finger_Id
is (Thumb
, Index
, Middle
, Ring
, Pinkie
);
88 subtype Midrange
is Medium_Minus
range 222 .. 1111;
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;
97 AMB
, BMB
: Max_Binary
;
98 AHMB
, BHMB
: Half_Max_Binary
;
100 AMP
, BMP
: Medium_Plus
;
101 AMM
, BMM
: Medium_Minus
;
105 TC_Pass_Case
: Boolean := True;
107 procedure Value_Fault
( S
: String ) is
108 -- check 'Value for failure modes
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");
116 when Constraint_Error
=> null; -- expected case
118 Report
.Failed
("'Value(" & S
& ") raised wrong exception");
121 begin -- Main test procedure.
123 Report
.Test
("C354002", "Check attributes of modular types" );
126 TCTouch
.Assert
( Midrange
'Base'First = 0, "Midrange'Base'First
" );
127 TCTouch.Assert( Midrange'Base'Last = Medium_Minus'Last,
128 "Midrange
'Base'Last" );
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" );
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" );
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)),
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",
159 TCTouch.Assert( Max_Binary'Last = System_Max_Bin_Mod_Pred,
161 if Ones_Complement_Permission then
162 TCTouch.Assert( Max_NonBinary'Last >= System_Max_NonBin_Mod_Pred,
163 "Max_NonBinary'Last (ones comp)");
165 TCTouch.Assert( Max_NonBinary'Last = System_Max_NonBin_Mod_Pred,
166 "Max_NonBinary'Last");
168 TCTouch.Assert( Half_Max_Binary'Last = Half_Max_Bin_Value_Pred,
169 "Half_Max_Binary'Last");
171 TCTouch.Assert( Medium'Last = Medium(ID(2047)), "Medium'Last");
172 TCTouch.Assert( Medium_Plus'Last = Medium_Plus(ID(2041)),
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");
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");
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,
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");
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,
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");
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");
226 Int : Natural := 222;
228 for I in Midrange loop
229 TC_Pass_Case := TC_Pass_Case and Midrange'Pos(I) = Int;
235 TCTouch.Assert( TC_Pass_Case, "Midrange'Pos");
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)");
244 TCTouch.Assert( Max_NonBinary'Pred(0) = System_Max_NonBin_Mod_Pred,
245 "Max_NonBinary'Pred(0)");
247 TCTouch.Assert( Half_Max_Binary'Pred(0) = Half_Max_Bin_Value_Pred,
248 "Half_Max_Binary'Pred(0)");
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
)");
258 for I in Midrange'Range loop
259 if I not in Midrange then
260 Report.Failed("Midrange
loop test
");
263 for I in Medium'Range loop
264 if I not in Medium then
265 Report.Failed("Medium
loop test
");
268 for I in Medium_Minus'Range loop
269 if I not in 0..2110 then
270 Report.Failed("Medium
loop test
");
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
)");
283 TCTouch.Assert( Max_NonBinary'Succ(System_Max_NonBin_Mod_Pred) = 0,
284 "Max_NonBinary
'Succ('Last)");
286 TCTouch.Assert( Half_Max_Binary'Succ(Half_Max_Bin_Value_Pred) = 0,
287 "Half_Max_Binary'Succ('Last
)");
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
)");
298 for I in Natural range ID(222)..ID(1111) loop
299 TCTouch.Assert( Midrange'Val(I) = Medium_Minus(I), "Midrange
'Val");
304 TCTouch.Assert( Half_Max_Binary'Value("255") = 255,
305 "Half_Max_Binary
'Value" );
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" );
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
"")" );
319 Value_Fault( "bad input
" );
320 Value_Fault( "-333" );
321 Value_Fault( "9999" );
323 Value_Fault( "1e-1" );
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");