|
111
|
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
|
|
|
51 package 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
|
|
|
149 end C332001_0;
|
|
|
150
|
|
|
151 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
|
|
|
152
|
|
|
153 with Report;
|
|
|
154 package 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
|
|
|
205 end C332001_0;
|
|
|
206
|
|
|
207 ------------------------------------------------------------------- C332001
|
|
|
208
|
|
|
209 with Report;
|
|
|
210 with C332001_0;
|
|
|
211 procedure C332001 is
|
|
|
212
|
|
|
213 begin -- 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
|
|
|
226 end C332001;
|
