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 conversion to a modular type raises Constraint_Error
28 -- when the operand value is outside the base range of the modular type.
31 -- Test conversion from integer, float, fixed and decimal types to
32 -- modular types. Test conversion to mod 255, mod 256 and mod 258
33 -- to test the boundaries of 8 bit (+/-) unsigned numbers.
34 -- Test operand values that are negative, the value of the mod,
35 -- and greater than the value of the mod.
36 -- Declare a generic test procedure and instantiate it for each of the
37 -- unsigned types for each operand type.
41 -- 04 OCT 95 SAIC Initial version
42 -- 15 MAY 96 SAIC Revised for 2.1
43 -- 24 NOV 98 RLB Moved decimal cases into new test, C460011, to
44 -- prevent this test from being inapplicable to
45 -- implementations not supporting decimal types.
49 ------------------------------------------------------------------- C460008
55 Shy_By_One
: constant := 2**8-1;
56 Heavy_By_Two
: constant := 2**8+2;
58 type Unsigned_Edge_8
is mod Shy_By_One
;
59 type Unsigned_8_Bit
is mod 2**8;
60 type Unsigned_Over_8
is mod Heavy_By_Two
;
62 NPC
: constant String := " not properly converted";
64 procedure Assert
( Truth
: Boolean; Message
: String ) is
67 Report
.Failed
(Message
);
71 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
74 type Source
is range <>;
75 type Target
is mod <>;
76 procedure Integer_Conversion_Check
( For_The_Value
: Source
;
79 procedure Integer_Conversion_Check
( For_The_Value
: Source
;
85 Item
:= Target
( For_The_Value
);
86 Report
.Failed
("Int expected Constraint_Error " & Message
);
87 -- the call to Comment is to make the otherwise dead assignment to
89 -- To avoid invoking C_E on a call to 'Image in Report.Failed that
90 -- could cause a false pass
91 Report
.Comment
("Value of" & Target
'Image(Item
) & NPC
);
93 when Constraint_Error
=> null; -- expected case
94 when others => Report
.Failed
("Int Raised wrong exception " & Message
);
95 end Integer_Conversion_Check
;
97 procedure Int_To_Short
is
98 new Integer_Conversion_Check
( Integer, Unsigned_Edge_8
);
100 procedure Int_To_Eight
is
101 new Integer_Conversion_Check
( Integer, Unsigned_8_Bit
);
103 procedure Int_To_Wide
is
104 new Integer_Conversion_Check
( Integer, Unsigned_Over_8
);
106 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
109 type Source
is digits <>;
110 type Target
is mod <>;
111 procedure Float_Conversion_Check
( For_The_Value
: Source
;
114 procedure Float_Conversion_Check
( For_The_Value
: Source
;
115 Message
: String ) is
120 Item
:= Target
( For_The_Value
);
121 Report
.Failed
("Flt expected Constraint_Error " & Message
);
122 Report
.Comment
("Value of" & Target
'Image(Item
) & NPC
);
124 when Constraint_Error
=> null; -- expected case
125 when others => Report
.Failed
("Flt raised wrong exception " & Message
);
126 end Float_Conversion_Check
;
128 procedure Float_To_Short
is
129 new Float_Conversion_Check
( Float, Unsigned_Edge_8
);
131 procedure Float_To_Eight
is
132 new Float_Conversion_Check
( Float, Unsigned_8_Bit
);
134 procedure Float_To_Wide
is
135 new Float_Conversion_Check
( Float, Unsigned_Over_8
);
137 function Identity
( Root_Beer
: Float ) return Float is
138 -- a knockoff of Report.Ident_Int for type Float
139 Nothing
: constant Float := 0.0;
141 if Report
.Ident_Bool
( Root_Beer
= Nothing
) then
148 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
151 type Source
is delta <>;
152 type Target
is mod <>;
153 procedure Fixed_Conversion_Check
( For_The_Value
: Source
;
156 procedure Fixed_Conversion_Check
( For_The_Value
: Source
;
157 Message
: String ) is
162 Item
:= Target
( For_The_Value
);
163 Report
.Failed
("Fix expected Constraint_Error " & Message
);
164 Report
.Comment
("Value of" & Target
'Image(Item
) & NPC
);
166 when Constraint_Error
=> null; -- expected case
167 when others => Report
.Failed
("Fix raised wrong exception " & Message
);
168 end Fixed_Conversion_Check
;
170 procedure Fixed_To_Short
is
171 new Fixed_Conversion_Check
( Duration, Unsigned_Edge_8
);
173 procedure Fixed_To_Eight
is
174 new Fixed_Conversion_Check
( Duration, Unsigned_8_Bit
);
176 procedure Fixed_To_Wide
is
177 new Fixed_Conversion_Check
( Duration, Unsigned_Over_8
);
179 function Identity
( A_Stitch
: Duration ) return Duration is
180 Threadbare
: constant Duration := 0.0;
182 if Report
.Ident_Bool
( A_Stitch
= Threadbare
) then
189 -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
191 begin -- Main test procedure.
193 Report
.Test
("C460008", "Check that conversion to " &
194 "a modular type raises Constraint_Error when " &
195 "the operand value is outside the base range " &
196 "of the modular type" );
199 -- Integer Error cases
201 Int_To_Short
( Report
.Ident_Int
( -1 ), "I2S Dynamic, Negative" );
202 Int_To_Short
( Report
.Ident_Int
( Shy_By_One
), "I2S Dynamic, At_Mod" );
203 Int_To_Short
( Report
.Ident_Int
( Heavy_By_Two
+1 ), "I2S Dynamic, Over_Mod" );
205 Int_To_Eight
( -Shy_By_One
, "I28 Static, Negative" );
206 Int_To_Eight
( 2**8, "I28 Static, At_Mod" );
207 Int_To_Eight
( Heavy_By_Two
+1, "I28 Static, Over_Mod" );
209 Int_To_Wide
( Report
.Ident_Int
( -(Heavy_By_Two
*2) ),
210 "I2W Dynamic, Negative" );
211 Int_To_Wide
( Heavy_By_Two
, "I2W Static, At_Mod" );
212 Int_To_Wide
( Report
.Ident_Int
( Heavy_By_Two
*2 ), "I2W Dynamic, Over_Mod" );
216 Float_To_Short
( -13.31, "F2S Static, Negative" );
217 Float_To_Short
( Identity
( Float(Shy_By_One
)), "F2S Dynamic, At_Mod" );
218 Float_To_Short
( 6378.388, "F2S Static, Over_Mod" );
220 Float_To_Eight
( Identity
( -99.3574 ), "F28 Dynamic, Negative" );
221 Float_To_Eight
( 2.0**8, "F28 Static, At_Mod" );
222 Float_To_Eight
( 2.0**9, "F28 Static, Over_Mod" );
224 Float_To_Wide
( -0.54953_93129_81644
, "FTW Static, Negative" );
225 Float_To_Wide
( Identity
( 2.0**8 +2.0 ), "FTW Dynamic, At_Mod" );
226 Float_To_Wide
( Identity
( 2.0**8 +2.5001 ), "FTW Dynamic, Over_Mod" );
227 Float_To_Wide
( Identity
( Float'Last ), "FTW Dynamic, Over_Mod" );
231 Fixed_To_Short
( Identity
( -5.00 ), "D2S Dynamic, Negative" );
232 Fixed_To_Short
( Shy_By_One
* 1.0, "D2S Static, At_Mod" );
233 Fixed_To_Short
( 1995.9, "D2S Static, Over_Mod" );
235 Fixed_To_Eight
( -0.5, "D28 Static, Negative" );
236 Fixed_To_Eight
( 2.0*128, "D28 Static, At_Mod" );
237 Fixed_To_Eight
( Identity
( 2001.2 ), "D28 Dynamic, Over_Mod" );
239 Fixed_To_Wide
( Duration'First, "D2W Static, Negative" );
240 Fixed_To_Wide
( Identity
( 2*128.0 +2.0 ), "D2W Dynamic, At_Mod" );
241 Fixed_To_Wide
( Duration'Last, "D2W Static, Over_Mod" );
243 -- having made it this far, the rest is downhill...
244 -- check a few, correct, edge cases, and we're done
247 A_Float
: Float := 0.0;
248 Your_Time
: Duration := 0.0;
249 Number
: Integer := 0;
251 Little
: Unsigned_Edge_8
;
252 Moderate
: Unsigned_8_Bit
;
253 Big
: Unsigned_Over_8
;
256 Little
:= Unsigned_Edge_8
(A_Float
);
257 Assert
( Little
= 0, "Float => Little, 0");
260 Moderate
:= Unsigned_8_Bit
(Your_Time
);
261 Assert
( Moderate
= 0, "Your_Time => Moderate, 0");
263 Big
:= Unsigned_Over_8
(Number
);
264 Assert
( Big
= 0, "Number => Big, 0");
266 A_Float
:= 2.0**8-2.0;
267 Your_Time
:= 2.0*128-2.0;
270 Little
:= Unsigned_Edge_8
(A_Float
);
271 Assert
( Little
= 254, "Float => Little, 254");
273 Little
:= Unsigned_Edge_8
(Your_Time
);
274 Assert
( Little
= 254, "Your_Time => Little, 254");
276 Big
:= Unsigned_Over_8
(A_Float
+ 2.0);
277 Assert
( Big
= 256, "Sense => Big, 256");
279 Big
:= Unsigned_Over_8
(Number
);
280 Assert
( Big
= 256, "Number => Big, 256");