3 -- Grant of Unlimited Rights
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
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.
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.
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.
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.
49 ----------------------------------------------------------------- C332001_0
53 type Enumeration_Type
is ( Ah
, Gnome
, Er
, Ay
, Shun
);
55 type Integer_Type
is range 0..1023;
57 type Modular_Type
is mod 256;
59 type Floating_Type
is digits 4;
61 type Fixed_Type
is delta 0.125 range -10.0 .. 10.0;
63 type Mod_Array
is array(Modular_Type
) of Floating_Type
;
65 type Int_Array
is array(Integer_Type
) of Fixed_Type
;
67 type Record_Type
is record
68 Pinkie
: Integer_Type
;
70 Middle
: Floating_Type
;
74 Mod_Array_Object
: Mod_Array
;
75 Int_Array_Object
: Int_Array
;
77 Record_Object
: Record_Type
;
81 Nothing_New_Integer
: constant := 1;
82 Nothing_New_Real
: constant := 1.0;
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;
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
97 -- parenthetical expressions
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
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
113 -- array attributes 'First, 'Last, 'Length
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
122 -- F\T Int Mod Flt Fix
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
135 procedure Check_Values
;
139 -- The following were illegal in Ada83; they are now legal in Ada95
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
147 -- END OF TRANSITION CHECKS
151 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
154 package body C332001_0 is
156 procedure Assert( Truth : Boolean; Message: String ) is
159 Report.Failed("Assertion " & Message & " not true" );
163 procedure Check_Values is
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
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)
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
187 "ENP > MTP" ); -- 3 > 1
188 Assert( (FTS < MTL) or (FTS >= MTL), -- given FTS is impdef...
189 "(FTS < MTL) or (FTS >= MTL)" ); -- True
191 "FTS > ITS" ); -- impdef > 3
193 Assert( MAFirst = Int_Array_Object'First,
194 "MAFirst = Int_Array_Object'First" ); -- 0 = 0
195 Assert( IALast > MAFirst,
196 "IALast > MAFirst" ); -- 1023 > 0
198 "MAL < IAL" ); -- 255 < 1024
200 Assert( Mod2Flt = Flt2Fix,
201 "Mod2Flt = Flt2Fix" ); -- 2.0 = 2.0
207 ------------------------------------------------------------------- C332001
213 begin -- Main test procedure.
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" );
222 C332001_0.Check_Values;