1-- C450001.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 operations on modular types perform correctly. 28-- 29-- Check that loops over the range of a modular type do not over or 30-- under run the loop. 31-- 32-- TEST DESCRIPTION: 33-- Check logical and arithmetic operations. 34-- (Attributes are tested elsewhere) 35-- Checks to make sure that: 36-- for X in Mod_Type loop 37-- doesn't do something silly like infinite loop. 38-- 39-- 40-- CHANGE HISTORY: 41-- 20 SEP 95 SAIC Initial version 42-- 20 FEB 96 SAIC Added underrun cases for 2.1 43-- 44--! 45 46----------------------------------------------------------------- C450001_0 47 48package C450001_0 is 49 50 type Unsigned_8_Bit is mod 2**8; 51 52 Shy_By_One : constant := 2**8-1; 53 54 Heavy_By_Two : constant := 2**8+2; 55 56 type Unsigned_Edge_8 is mod Shy_By_One; 57 58 type Unsigned_Over_8 is mod Heavy_By_Two; 59 60 procedure Loop_Check; 61 62 -- embed some calls to Report.Ident_Int: 63 64 function ID( U8B: Unsigned_8_Bit ) return Unsigned_8_Bit; 65 function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8; 66 function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8; 67 68end C450001_0; 69 70-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 71 72with Report; 73package body C450001_0 is 74 75 procedure Loop_Check is 76 Counter_Check : Natural := 0; 77 begin 78 for Ever in Unsigned_8_Bit loop 79 Counter_Check := Report.Ident_Int(Counter_Check) + 1; 80 if Counter_Check > 2**8 then 81 Report.Failed("Unsigned_8_Bit loop overrun"); 82 exit; 83 end if; 84 end loop; 85 86 if Counter_Check < 2**8 then 87 Report.Failed("Unsigned_8_Bit loop underrun"); 88 end if; 89 90 Counter_Check := 0; 91 92 for Never in Unsigned_Edge_8 loop 93 Counter_Check := Report.Ident_Int(Counter_Check) + 1; 94 if Counter_Check > Shy_By_One then 95 Report.Failed("Unsigned_Edge_8 loop overrun"); 96 exit; 97 end if; 98 end loop; 99 100 if Counter_Check < Shy_By_One then 101 Report.Failed("Unsigned_Edge_8 loop underrun"); 102 end if; 103 104 Counter_Check := 0; 105 106 for Getful in reverse Unsigned_Over_8 loop 107 Counter_Check := Report.Ident_Int(Counter_Check) + 1; 108 if Counter_Check > Heavy_By_Two then 109 Report.Failed("Unsigned_Over_8 loop overrun"); 110 exit; 111 end if; 112 end loop; 113 114 if Counter_Check < Heavy_By_Two then 115 Report.Failed("Unsigned_Over_8 loop underrun"); 116 end if; 117 118 end Loop_Check; 119 120 function ID( U8B: Unsigned_8_Bit ) return Unsigned_8_Bit is 121 begin 122 return Unsigned_8_Bit(Report.Ident_Int(Integer(U8B))); 123 end ID; 124 125 function ID( UEB: Unsigned_Edge_8 ) return Unsigned_Edge_8 is 126 begin 127 return Unsigned_Edge_8(Report.Ident_Int(Integer(UEB))); 128 end ID; 129 130 function ID( UOB: Unsigned_Over_8 ) return Unsigned_Over_8 is 131 begin 132 return Unsigned_Over_8(Report.Ident_Int(Integer(UOB))); 133 end ID; 134 135end C450001_0; 136 137------------------------------------------------------------------- C450001 138 139with Report; 140with C450001_0; 141with TCTouch; 142procedure C450001 is 143 use C450001_0; 144 145 BR : constant String := " produced the wrong result"; 146 147 procedure Is_T(B:Boolean;S:String) renames TCTouch.Assert; 148 procedure Is_F(B:Boolean;S:String) renames TCTouch.Assert_Not; 149 150 Whole_8_A, Whole_8_B, Whole_8_C : C450001_0.Unsigned_8_Bit; 151 152 Short_8_A, Short_8_B, Short_8_C : C450001_0.Unsigned_Edge_8; 153 154 Over_8_A, Over_8_B, Over_8_C : C450001_0.Unsigned_Over_8; 155 156begin -- Main test procedure. C450001 157 158 Report.Test ("C450001", "Check that operations on modular types " & 159 "perform correctly." ); 160 161 162 -- the cases for the whole 8 bit type are pretty simple 163 164 Whole_8_A := 2#00000000#; 165 Whole_8_B := 2#11111111#; 166 167 Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00000000#,"8 bit and" & BR); 168 Is_T((ID(Whole_8_A) or ID(Whole_8_B)) = 2#11111111#,"8 bit or" & BR); 169 Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11111111#,"8 bit xor" & BR); 170 171 Whole_8_A := 2#00001111#; 172 Whole_8_B := 2#11111111#; 173 174 Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#00001111#,"8 bit and" & BR); 175 Is_T((ID(Whole_8_A) or ID(Whole_8_B)) = 2#11111111#,"8 bit or" & BR); 176 Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#11110000#,"8 bit xor" & BR); 177 178 Whole_8_A := 2#10101010#; 179 Whole_8_B := 2#11110000#; 180 181 Is_T((ID(Whole_8_A) and ID(Whole_8_B)) = 2#10100000#,"8 bit and" & BR); 182 Is_T((ID(Whole_8_A) or ID(Whole_8_B)) = 2#11111010#,"8 bit or" & BR); 183 Is_T((ID(Whole_8_A) xor ID(Whole_8_B)) = 2#01011010#,"8 bit xor" & BR); 184 185 -- the cases for the partial 8 bit type involve subtracting the modulus 186 -- from results that exceed the modulus. 187 -- hence, any of the following operations that exceed 2#11111110# must 188 -- have 2#11111111# subtracted from the result; i.e. where you would 189 -- expect to see 2#11111111# as in the above operations, the correct 190 -- result will be 2#00000000#. Note that 2#11111111# is not a legal 191 -- value of type C450001_0.Unsigned_Edge_8. 192 193 Short_8_A := 2#11100101#; 194 Short_8_B := 2#00011111#; 195 196 Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000101#,"8 short and 1" & BR); 197 Is_T((ID(Short_8_A) or ID(Short_8_B)) = 2#00000000#,"8 short or 1" & BR); 198 Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#11111010#,"8 short xor 1" & BR); 199 200 Short_8_A := 2#11110000#; 201 Short_8_B := 2#11111110#; 202 203 Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#11110000#,"8 short and 2" & BR); 204 Is_T((ID(Short_8_A) or ID(Short_8_B)) = 2#11111110#,"8 short or 2" & BR); 205 Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00001110#,"8 short xor 2" & BR); 206 207 Short_8_A := 2#10101010#; 208 Short_8_B := 2#01010101#; 209 210 Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#00000000#,"8 short and 3" & BR); 211 Is_T((ID(Short_8_A) or ID(Short_8_B)) = 2#00000000#,"8 short or 3" & BR); 212 Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#00000000#,"8 short xor 3" & BR); 213 214 Short_8_A := 2#10101010#; 215 Short_8_B := 2#11111110#; 216 217 Is_T((ID(Short_8_A) and ID(Short_8_B)) = 2#10101010#,"8 short and 4" & BR); 218 Is_T((ID(Short_8_A) or ID(Short_8_B)) = 2#11111110#,"8 short or 4" & BR); 219 Is_T((ID(Short_8_A) xor ID(Short_8_B)) = 2#01010100#,"8 short xor 4" & BR); 220 221 -- the cases for the over 8 bit type have similar issues to the short type 222 -- however the bit patterns are a little different. The rule is to subtract 223 -- the modulus (258) from any resulting value equal or greater than the 224 -- modulus -- note that 258 = 2#100000010# 225 226 Over_8_A := 2#100000000#; 227 Over_8_B := 2#011111111#; 228 229 Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000000#,"8 over and" & BR); 230 Is_T((ID(Over_8_A) or ID(Over_8_B)) = 2#011111101#,"8 over or" & BR); 231 Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111101#,"8 over xor" & BR); 232 233 Over_8_A := 2#100000001#; 234 Over_8_B := 2#011111111#; 235 236 Is_T((ID(Over_8_A) and ID(Over_8_B)) = 2#000000001#,"8 over and" & BR); 237 Is_T((ID(Over_8_A) or ID(Over_8_B)) = 2#011111101#,"8 over or" & BR); 238 Is_T((ID(Over_8_A) xor ID(Over_8_B)) = 2#011111100#,"8 over xor" & BR); 239 240 241 242 Whole_8_A := 128; 243 Whole_8_B := 255; 244 245 Is_T(ID(Whole_8_A) /= ID(Whole_8_B), "8 /=" & BR); 246 Is_F(ID(Whole_8_A) = ID(Whole_8_B), "8 =" & BR); 247 248 Is_T(ID(Whole_8_A) <= ID(Whole_8_B), "8 <=" & BR); 249 Is_T(ID(Whole_8_A) < ID(Whole_8_B), "8 < " & BR); 250 251 Is_F(ID(Whole_8_A) >= ID(Whole_8_B), "8 >=" & BR); 252 Is_T(ID(Whole_8_A) > ID(Whole_8_B + 7), "8 > " & BR); 253 254 Is_T(ID(Whole_8_A) in ID(100)..ID(200), "8 in" & BR); 255 Is_F(ID(Whole_8_A) not in ID(100)..ID(200), "8 not in" & BR); 256 257 Is_F(ID(Whole_8_A) in ID(200)..ID(250), "8 in" & BR); 258 Is_T(ID(Whole_8_A) not in ID(200)..ID(250), "8 not in" & BR); 259 260 Short_8_A := 127; 261 Short_8_B := 254; 262 263 Is_T(ID(Short_8_A) /= ID(Short_8_B), "short 8 /=" & BR); 264 Is_F(ID(Short_8_A) = ID(Short_8_B), "short 8 =" & BR); 265 266 Is_T(ID(Short_8_A) <= ID(Short_8_B), "short 8 <=" & BR); 267 Is_T(ID(Short_8_A) < ID(Short_8_B), "short 8 < " & BR); 268 269 Is_F(ID(Short_8_A) >= ID(Short_8_B), "short 8 >=" & BR); 270 Is_F(ID(Short_8_A) > ID(Short_8_B), "short 8 > " & BR); 271 272 Is_T(ID(Short_8_A) in ID(100)..ID(200), "8 in" & BR); 273 Is_F(ID(Short_8_A) not in ID(100)..ID(200), "8 not in" & BR); 274 275 Is_F(ID(Short_8_A) in ID(200)..ID(250), "8 in" & BR); 276 Is_T(ID(Short_8_A) not in ID(200)..ID(250), "8 not in" & BR); 277 278 279 Whole_8_A := 1; 280 Whole_8_B := 254; 281 Short_8_A := 1; 282 Short_8_B := 2; 283 284 Whole_8_C := ID(Whole_8_A) + ID(Whole_8_B); 285 Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 1" & BR); 286 287 Whole_8_C := Whole_8_C + ID(Whole_8_A); 288 Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'First, "8 binary + 2" & BR); 289 290 Whole_8_C := ID(Whole_8_A) - ID(Whole_8_A); 291 Is_T(Whole_8_C = 0, "8 binary -" & BR); 292 293 Whole_8_C := Whole_8_C - ID(Whole_8_A); 294 Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 binary + 3" & BR); 295 296 Short_8_C := ID(Short_8_A) + ID(C450001_0.Unsigned_Edge_8'Last); 297 Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'First, "Short binary + 1" & BR); 298 299 Short_8_C := Short_8_A + ID(Short_8_A); 300 Is_T(Short_8_C = ID(Short_8_B), "Short binary + 2" & BR); 301 302 Short_8_C := ID(Short_8_A) - ID(Short_8_A); 303 Is_T(Short_8_C = 0, "Short 8 binary -" & BR); 304 305 Short_8_C := Short_8_C - ID(Short_8_A); 306 Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short binary + 3" & BR); 307 308 309 Whole_8_C := ( + ID(Whole_8_B) ); 310 Is_T(Whole_8_C = 254, "8 unary +" & BR); 311 312 Whole_8_C := ( - ID(Whole_8_A) ); 313 Is_T(Whole_8_C = C450001_0.Unsigned_8_Bit'Last, "8 unary -" & BR); 314 315 Whole_8_C := ( - ID(0) ); 316 Is_T(Whole_8_C = 0, "8 unary -0" & BR); 317 318 Short_8_C := ( + ID(C450001_0.Unsigned_Edge_8'Last) ); 319 Is_T(Short_8_C = 254, "Short 8 unary +" & BR); 320 321 Short_8_C := ( - ID(Short_8_A) ); 322 Is_T(Short_8_C = C450001_0.Unsigned_Edge_8'Last, "Short 8 unary -" & BR); 323 324 325 Whole_8_A := 20; 326 Whole_8_B := 255; 327 328 Whole_8_C := ID(Whole_8_A) * ID(Whole_8_B); -- 5100 = 19*256 + 236 (256-20) 329 Is_T(Whole_8_C = 236, "8 *" & BR); 330 331 Short_8_A := 9; 332 Short_8_B := 254; 333 334 Short_8_C := ID(Short_8_A) * ID(Short_8_B); -- 2286 = 8*255 + 246 (255-9) 335 Is_T(Short_8_C = 246, "short 8 *" & BR); 336 337 Over_8_A := 12; 338 Over_8_B := 86; 339 340 Over_8_C := ID(Over_8_A) * ID(Over_8_B); -- 1032 = 4*258 + 0 341 Is_T(Over_8_C = 0, "over 8 *" & BR); 342 343 344 Whole_8_A := 255; 345 Whole_8_B := 4; 346 347 Whole_8_C := ID(Whole_8_A) / ID(Whole_8_B); 348 Is_T(Whole_8_C = 63, "8 /" & BR); 349 350 Short_8_A := 253; 351 Short_8_B := 127; 352 353 Short_8_C := ID(Short_8_A) / ID(Short_8_B); 354 Is_T(Short_8_C = 1, "short 8 / 1" & BR); 355 356 Short_8_C := ID(Short_8_A) / ID(126); 357 Is_T(Short_8_C = 2, "short 8 / 2" & BR); 358 359 360 Whole_8_A := 255; 361 Whole_8_B := 254; 362 363 Whole_8_C := ID(Whole_8_A) rem ID(Whole_8_B); 364 Is_T(Whole_8_C = 1, "8 rem" & BR); 365 366 Short_8_A := 222; 367 Short_8_B := 111; 368 369 Short_8_C := ID(Short_8_A) rem ID(Short_8_B); 370 Is_T(Short_8_C = 0, "short 8 rem" & BR); 371 372 373 Whole_8_A := 99; 374 Whole_8_B := 9; 375 376 Whole_8_C := ID(Whole_8_A) mod ID(Whole_8_B); 377 Is_T(Whole_8_C = 0, "8 mod" & BR); 378 379 Short_8_A := 254; 380 Short_8_B := 250; 381 382 Short_8_C := ID(Short_8_A) mod ID(Short_8_B); 383 Is_T(Short_8_C = 4, "short 8 mod" & BR); 384 385 386 Whole_8_A := 99; 387 388 Whole_8_C := abs Whole_8_A; 389 Is_T(Whole_8_C = ID(99), "8 abs" & BR); 390 391 Short_8_A := 254; 392 393 Short_8_C := ID( abs Short_8_A ); 394 Is_T(Short_8_C = 254, "short 8 abs" & BR); 395 396 397 Whole_8_B := 2#00001111#; 398 399 Whole_8_C := not Whole_8_B; 400 Is_T(Whole_8_C = ID(2#11110000#), "8 not" & BR); 401 402 Short_8_B := 2#00001111#; -- 15 403 404 Short_8_C := ID( not Short_8_B ); -- 254 - 15 405 Is_T(Short_8_C = 2#11101111#, "short 8 not" & BR); -- 239 406 407 408 Whole_8_A := 2; 409 410 Whole_8_C := Whole_8_A ** 7; 411 Is_T(Whole_8_C = ID(128), "2 ** 7, whole 8" & BR); 412 413 Whole_8_C := Whole_8_A ** 9; 414 Is_T(Whole_8_C = ID(0), "2 ** 9, whole 8" & BR); 415 416 Short_8_A := 4; 417 418 Short_8_C := ID( Short_8_A ) ** 4; 419 Is_T(Short_8_C = 1, "4 ** 4, short" & BR); 420 421 Over_8_A := 4; 422 423 Over_8_C := ID( Over_8_A ) ** 4; 424 Is_T(Over_8_C = 256, "4 ** 4, over" & BR); 425 426 Over_8_C := ID( Over_8_A ) ** 5; -- 1024 = 3*258 + 250 427 Is_T(Over_8_C = 250, "4 ** 5, over" & BR); 428 429 430 C450001_0.Loop_Check; 431 432 Report.Result; 433 434end C450001; 435