1-- C460011.A 2-- 3-- Grant of Unlimited Rights 4-- 5-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and 6-- F08630-91-C-0015, the U.S. Government obtained unlimited rights in the 7-- software and documentation contained herein. Unlimited rights are 8-- defined in DFAR 252.227-7013(a)(19). By making this public release, 9-- the Government intends to confer upon all recipients unlimited rights 10-- equal to those held by the Government. These rights include rights to 11-- use, duplicate, release or disclose the released technical data and 12-- computer software in whole or in part, in any manner and for any purpose 13-- whatsoever, and to have or permit others to do so. 14-- 15-- DISCLAIMER 16-- 17-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR 18-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 19-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE 20-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 21-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A 22-- PARTICULAR PURPOSE OF SAID MATERIAL. 23--* 24-- 25-- OBJECTIVE: 26-- Check that conversion of a decimal type to a modular type raises 27-- Constraint_Error when the operand value is outside the base range 28-- of the modular type. 29-- Check that a conversion of a decimal type to an integer type 30-- rounds correctly. 31-- 32-- TEST DESCRIPTION: 33-- Test conversion from decimal types to modular types. Test 34-- conversion to mod 255, mod 256 and mod 258 to test the boundaries 35-- of 8 bit (+/-) unsigned numbers. 36-- Test operand values that are negative, the value of the mod, 37-- and greater than the value of the mod. 38-- Declare a generic test procedure and instantiate it for each of the 39-- unsigned types for each operand type. 40-- Check that the operand is properly rounded during the conversion. 41-- 42-- APPLICABILITY CRITERIA: 43-- This test is applicable to all implementations which support 44-- decimal types. 45-- 46-- CHANGE HISTORY: 47-- 24 NOV 98 RLB Split decimal cases from C460008 into this 48-- test, added conversions to integer types. 49-- 18 JAN 99 RLB Repaired errors in test. 50-- 51--! 52 53------------------------------------------------------------------- C460011 54 55with Report; 56 57procedure C460011 is 58 59 Shy_By_One : constant := 2**8-1; 60 Heavy_By_Two : constant := 2**8+2; 61 62 type Unsigned_Edge_8 is mod Shy_By_One; 63 type Unsigned_8_Bit is mod 2**8; 64 type Unsigned_Over_8 is mod Heavy_By_Two; 65 66 type Signed_8_Bit is range -128 .. 127; 67 type Signed_Over_8 is range -200 .. 200; 68 69 NPC : constant String := " not properly converted"; 70 71 procedure Assert( Truth: Boolean; Message: String ) is 72 begin 73 if not Truth then 74 Report.Failed(Message); 75 end if; 76 end Assert; 77 78-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 79 80 type Decim is delta 0.1 digits 5; -- N/A => ERROR. 81 82 generic 83 type Source is delta <> digits <>; 84 type Target is mod <>; 85 procedure Decimal_Conversion_Check( For_The_Value : Source; 86 Message : String ); 87 88 procedure Decimal_Conversion_Check( For_The_Value : Source; 89 Message : String ) is 90 91 Item : Target; 92 93 begin 94 Item := Target( For_The_Value ); 95 Report.Failed("Deci expected Constraint_Error " & Message); 96 Report.Comment("Value of" & Target'Image(Item) & NPC); 97 exception 98 when Constraint_Error => null; -- expected case 99 when others => Report.Failed("Deci raised wrong exception " & Message); 100 end Decimal_Conversion_Check; 101 102 procedure Decim_To_Short is 103 new Decimal_Conversion_Check( Decim, Unsigned_Edge_8 ); 104 105 procedure Decim_To_Eight is 106 new Decimal_Conversion_Check( Decim, Unsigned_8_Bit ); 107 108 procedure Decim_To_Wide is 109 new Decimal_Conversion_Check( Decim, Unsigned_Over_8 ); 110 111 function Identity( Launder: Decim ) return Decim is 112 Flat_Broke : constant Decim := 0.0; 113 begin 114 if Report.Ident_Bool( Launder = Flat_Broke ) then 115 return Flat_Broke; 116 else 117 return Launder; 118 end if; 119 end Identity; 120 121-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 122 123begin -- Main test procedure. 124 125 Report.Test ("C460011", "Check that conversion to " & 126 "a modular type raises Constraint_Error when " & 127 "the operand value is outside the base range " & 128 "of the modular type" ); 129 130 -- Decimal Error cases 131 132 Decim_To_Short( Identity( -5.00 ), "M2S Dynamic, Negative" ); 133 Decim_To_Short( Shy_By_One * 1.0, "M2S Static, At_Mod" ); 134 Decim_To_Short( 1995.9, "M2S Static, Over_Mod" ); 135 136 Decim_To_Eight( -0.5, "M28 Static, Negative" ); 137 Decim_To_Eight( 2.0*128, "M28 Static, At_Mod" ); 138 Decim_To_Eight( Identity( 2001.2 ), "M28 Dynamic, Over_Mod" ); 139 140 Decim_To_Wide ( Decim'First, "M2W Static, Negative" ); 141 Decim_To_Wide ( Identity( 2*128.0 +2.0 ), "M2W Dynamic, At_Mod" ); 142 Decim_To_Wide ( Decim'Last, "M2W Static, Over_Mod" ); 143 144 -- Check a few, correct, edge cases, for modular types. 145 146 Eye_Dew: declare 147 Sense : Decim := 0.00; 148 149 Little : Unsigned_Edge_8; 150 Moderate : Unsigned_8_Bit; 151 Big : Unsigned_Over_8; 152 153 begin 154 Moderate := Unsigned_8_Bit (Sense); 155 Assert( Moderate = 0, "Sense => Moderate, 0"); 156 157 Sense := 2*128.0; 158 159 Big := Unsigned_Over_8 (Sense); 160 Assert( Big = 256, "Sense => Big, 256"); 161 162 end Eye_Dew; 163 164 Rounding: declare 165 Easy : Decim := Identity ( 2.0); 166 Simple : Decim := Identity ( 2.1); 167 Halfway : Decim := Identity ( 2.5); 168 Upward : Decim := Identity ( 2.8); 169 Chop : Decim := Identity (-2.2); 170 Neg_Half : Decim := Identity (-2.5); 171 Downward : Decim := Identity (-2.7); 172 173 Little : Unsigned_Edge_8; 174 Moderate : Unsigned_8_Bit; 175 Big : Unsigned_Over_8; 176 177 Also_Little:Signed_8_Bit; 178 Also_Big : Signed_Over_8; 179 180 begin 181 Little := Unsigned_Edge_8 (Easy); 182 Assert( Little = 2, "Easy => Little, 2"); 183 184 Moderate := Unsigned_8_Bit (Simple); 185 Assert( Moderate = 2, "Simple => Moderate, 2"); 186 187 Big := Unsigned_Over_8 (Halfway); -- Rounds up by 4.6(33). 188 Assert( Big = 3, "Halfway => Big, 3"); 189 190 Little := Unsigned_Edge_8 (Upward); 191 Assert( Little = 3, "Upward => Little, 3"); 192 193 Also_Big := Signed_Over_8 (Halfway); -- Rounds up by 4.6(33). 194 Assert( Also_Big = 3, "Halfway => Also_Big, 3"); 195 196 Also_Little := Signed_8_Bit (Chop); 197 Assert( Also_Little = -2, "Chop => Also_Little, -2"); 198 199 Also_Big := Signed_Over_8 (Neg_Half); -- Rounds down by 4.6(33). 200 Assert( Also_Big = -3, "Halfway => Also_Big, -3"); 201 202 Also_Little := Signed_8_Bit (Downward); 203 Assert( Also_Little = -3, "Downward => Also_Little, -3"); 204 205 end Rounding; 206 207 208 Report.Result; 209 210end C460011; 211