1-- C332001.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 the static expression given for a number declaration may be 28-- of any numeric type. Check that the type of a named number is 29-- universal_integer or universal_real regardless of the type of the 30-- static expression that provides its value. 31-- 32-- TEST DESCRIPTION: 33-- This test defines a large cross section of mixed type named numbers. 34-- Well, obviously the named numbers don't have types (other than 35-- universal_integer and universal_real) associated with them. 36-- This test uses typed static values in the definition of several named 37-- numbers, and then mixes the named numbers to ensure that their typed 38-- origins do not interfere with the use of their values. 39-- 40-- 41-- CHANGE HISTORY: 42-- 10 OCT 95 SAIC Initial version 43-- 11 APR 96 SAIC Fixed a few arithmetic errors for 2.1 44-- 24 NOV 98 RLB Removed decimal types to insure that this 45-- test is applicable to all implementations. 46-- 47--! 48 49----------------------------------------------------------------- C332001_0 50 51package C332001_0 is 52 53 type Enumeration_Type is ( Ah, Gnome, Er, Ay, Shun ); 54 55 type Integer_Type is range 0..1023; 56 57 type Modular_Type is mod 256; 58 59 type Floating_Type is digits 4; 60 61 type Fixed_Type is delta 0.125 range -10.0 .. 10.0; 62 63 type Mod_Array is array(Modular_Type) of Floating_Type; 64 65 type Int_Array is array(Integer_Type) of Fixed_Type; 66 67 type Record_Type is record 68 Pinkie : Integer_Type; 69 Ring : Modular_Type; 70 Middle : Floating_Type; 71 Index : Fixed_Type; 72 end record; 73 74 Mod_Array_Object : Mod_Array; 75 Int_Array_Object : Int_Array; 76 77 Record_Object : Record_Type; 78 79 -- numeric_literals 80 81 Nothing_New_Integer : constant := 1; 82 Nothing_New_Real : constant := 1.0; 83 84 -- static constants 85 86 Integ : constant Integer_Type := 2; 87 Modul : constant Modular_Type := 2; 88 Float : constant Floating_Type := 2.0; -- bad practice, good test 89 Fixed : constant Fixed_Type := 2.0; 90 91 Named_Integer : constant := Integ; -- 2 92 Named_Modular : constant := Modul; -- 2 93 Named_Float : constant := Float; -- 2.0 94 Named_Fixed : constant := Fixed; -- 2.0 95 96 -- function calls 97 -- parenthetical expressions 98 99 Fn_Integer : constant := Integer_Type'Min(Integ * 2, 8); -- 4 100 Fn_Modular : constant := Modular_Type'Max(Modul + 2, Modular_Type'First);--4 101 Fn_Float : constant := (Float ** 2); -- 4.0 102 Fn_Fixed : constant := - Fixed; -- -2.0 103 -- attributes 104 105 ITF : constant := Integer_Type'First; -- 0 106 MTL : constant := Modular_Type'Last; -- 255 107 MTM : constant := Modular_Type'Modulus; -- 256 108 ENP : constant := Enumeration_Type'Pos(Ay); -- 3 109 MTP : constant := Modular_Type'Pred(Modul); -- 1 110 FTS : constant := Fixed_Type'Size; -- # impdef 111 ITS : constant := Integer_Type'Succ(Integ); -- 3 112 113 -- array attributes 'First, 'Last, 'Length 114 115 MAFirst : constant := Mod_Array_Object'First; -- 0 116 IALast : constant := Int_Array_Object'Last; -- 1023 117 MAL : constant := Mod_Array_Object'Length; -- 255 118 IAL : constant := Int_Array_Object'Length; -- 1024 119 120 -- type conversions 121 -- 122 -- F\T Int Mod Flt Fix 123 -- Int . X O X 124 -- Mod O . X O 125 -- Flt X O . X 126 -- Fix O X O . 127 128 Int2Mod : constant := Modular_Type (Integ); -- 2 129 Int2Fix : constant := Fixed_Type (Integ); -- 2.0 130 Mod2Flt : constant := Floating_Type (Modul); -- 2.0 131 Flt2Int : constant := Integer_Type(Float); -- 2 132 Flt2Fix : constant := Fixed_Type (Float); -- 2.0 133 Fix2Mod : constant := Modular_Type (Fixed); -- 2 134 135 procedure Check_Values; 136 137 -- TRANSITION CHECKS 138 -- 139 -- The following were illegal in Ada83; they are now legal in Ada95 140 -- 141 142 Int_Base_First : constant := Integer'Base'First; -- # impdef 143 Int_First : constant := Integer'First; -- # impdef 144 Int_Last : constant := Integer'Last; -- # impdef 145 Int_Val : constant := Integer'Val(17); -- 17 146 147 -- END OF TRANSITION CHECKS 148 149end C332001_0; 150 151-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 152 153with Report; 154package body C332001_0 is 155 156 procedure Assert( Truth : Boolean; Message: String ) is 157 begin 158 if not Truth then 159 Report.Failed("Assertion " & Message & " not true" ); 160 end if; 161 end Assert; 162 163 procedure Check_Values is 164 begin 165 166 Assert( Nothing_New_Integer * Named_Integer = Named_Modular, 167 "Nothing_New_Integer * Named_Integer = Named_Modular" ); -- 1*2 = 2 168 Assert( Nothing_New_Real * Named_Float = Named_Fixed, 169 "Nothing_New_Real * Named_Float = Named_Fixed" );-- 1.0*2.0 = 2.0 170 171 Assert( Fn_Integer = Int2Mod + Flt2Int, 172 "Fn_Integer = Int2Mod + Flt2Int" ); -- 4 = 2+2 173 Assert( Fn_Modular = Flt2Int * 2, 174 "Fn_Modular = Flt2Int * 2" ); -- 4 = 2*2 175 Assert( Fn_Float = Mod2Flt ** Fix2Mod, 176 "Fn_Float = Mod2Flt ** Fix2Mod" ); -- 4.0 = 2.0**2 177 Assert( Fn_Fixed = (- Mod2Flt), 178 "Fn_Fixed = (- Mod2Flt)" ); -- -2.0 = (-2.0) 179 180 Assert( ITF = Modular_Type'First, 181 "ITF = Modular_Type'First" ); -- 0 = 0 182 Assert( MTL < Integer_Type'Last, 183 "MTL < Integer_Type'Last" ); -- 255 < 1023 184 Assert( MTM < Integer_Type'Last, 185 "MTM < Integer_Type'Last" ); -- 256 < 1023 186 Assert( ENP > MTP, 187 "ENP > MTP" ); -- 3 > 1 188 Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef... 189 "(FTS < MTL) or (FTS >= MTL)" ); -- True 190 Assert( FTS > ITS, 191 "FTS > ITS" ); -- impdef > 3 192 193 Assert( MAFirst = Int_Array_Object'First, 194 "MAFirst = Int_Array_Object'First" ); -- 0 = 0 195 Assert( IALast > MAFirst, 196 "IALast > MAFirst" ); -- 1023 > 0 197 Assert( MAL < IAL, 198 "MAL < IAL" ); -- 255 < 1024 199 200 Assert( Mod2Flt = Flt2Fix, 201 "Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0 202 203 end Check_Values; 204 205end C332001_0; 206 207------------------------------------------------------------------- C332001 208 209with Report; 210with C332001_0; 211procedure C332001 is 212 213begin -- Main test procedure. 214 215 Report.Test ("C332001", "Check that the static expression given for a " & 216 "number declaration may be of any numeric type. " & 217 "Check that the type of the named number is " & 218 "universal_integer of universal_real regardless " & 219 "of the type of the static expression that " & 220 "provides its value" ); 221 222 C332001_0.Check_Values; 223 224 Report.Result; 225 226end C332001; 227