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 function Length, with Display_Format parameter, will
28 -- return the minimal length of a Numeric value that will be required
29 -- to hold the largest value of type Num represented as Format.
31 -- Check that function To_Decimal will produce a decimal type Num
32 -- result that corresponds to parameter Item as represented by
35 -- Check that function To_Decimal propagates Conversion_Error when
36 -- the value represented by parameter Item is outside the range of
37 -- the Decimal_Type Num used to instantiate the package
38 -- Decimal_Conversions
40 -- Check that function To_Display returns a Numeric type result that
41 -- represents Item under the specific Display_Format.
43 -- Check that function To_Display propagates Conversion_Error when
44 -- parameter Item is negative and the specified Display_Format
45 -- parameter is Unsigned.
48 -- This test checks the results from instantiated versions of three
49 -- functions within generic package Interfaces.COBOL.Decimal_Conversions.
50 -- This generic package is instantiated twice, with decimal types having
51 -- four and ten digits representation.
52 -- The function Length is validated with the Unsigned, Leading_Separate,
53 -- and Trailing_Separate Display_Format specifiers.
54 -- The results of function To_Decimal are verified in cases where it
55 -- is given a variety of Numeric and Display_Format type parameters.
56 -- Function To_Decimal is also checked to propagate Conversion_Error
57 -- when the value represented by parameter Item is outside the range
58 -- of the type used to instantiate the package.
59 -- The results of function To_Display are verified in cases where it
60 -- is given a variety of Num and Display_Format parameters. It is also
61 -- checked to ensure that it propagates Conversion_Error if parameter
62 -- Num is negative and the Format parameter is Unsigned.
64 -- This test assumes that the following characters are all included
65 -- in the implementation defined type Interfaces.COBOL.COBOL_Character:
66 -- ' ', '0'..'9', '+', '-', and '.'.
68 -- APPLICABILITY CRITERIA:
69 -- This test is applicable to all implementations that provide
70 -- package Interfaces.COBOL. If an implementation provides
71 -- package Interfaces.COBOL, this test must compile, execute, and
76 -- 06 Feb 96 SAIC Initial release for 2.1.
77 -- 30 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
78 -- 27 Oct 96 SAIC Incorporated reviewer comments.
83 with Interfaces
.COBOL
; -- N/A => ERROR
89 Report
.Test
("CXB4004", "Check that the functions Length, To_Decimal, " &
90 "and To_Display produce correct results");
97 use type Interfaces
.COBOL
.Numeric
;
99 Number_Of_Unsigned_Items
: constant := 6;
100 Number_Of_Leading_Separate_Items
: constant := 6;
101 Number_Of_Trailing_Separate_Items
: constant := 6;
102 Number_Of_Decimal_Items
: constant := 9;
104 type Decimal_Type_1
is delta 0.01 digits 4;
105 type Decimal_Type_2
is delta 1.0 digits 10;
106 type Numeric_Access
is access COBOL
.Numeric
;
107 type Numeric_Items_Type
is array(Integer range <>) of Numeric_Access
;
109 Correct_Result
: Boolean := False;
110 TC_Num_1
: Decimal_Type_1
:= 0.0;
111 TC_Num_2
: Decimal_Type_2
:= 0.0;
113 package Package_1
is new COBOL
.Decimal_Conversions
(Decimal_Type_1
);
114 package Package_2
is new COBOL
.Decimal_Conversions
(Decimal_Type_2
);
117 Package_1_Numeric_Items
:
118 Numeric_Items_Type
(1..Number_Of_Decimal_Items
) :=
119 (new COBOL
.Numeric
'("0"),
120 new COBOL.Numeric'("591"),
121 new COBOL
.Numeric
'("6342"),
122 new COBOL.Numeric'("+0"),
123 new COBOL
.Numeric
'("-1539"),
124 new COBOL.Numeric'("+9199"),
125 new COBOL
.Numeric
'("0-"),
126 new COBOL.Numeric'("8934+"),
127 new COBOL
.Numeric
'("9949-"));
129 Package_2_Numeric_Items :
130 Numeric_Items_Type(1..Number_Of_Decimal_Items) :=
131 (new COBOL.Numeric'("3"),
132 new COBOL
.Numeric
'("105"),
133 new COBOL.Numeric'("1234567899"),
134 new COBOL
.Numeric
'("+8"),
135 new COBOL.Numeric'("-12345601"),
136 new COBOL
.Numeric
'("+9123459999"),
137 new COBOL.Numeric'("1-"),
138 new COBOL
.Numeric
'("123456781+"),
139 new COBOL.Numeric'("9499999999-"));
142 Decimal_Type_1_Items
: array (1..Number_Of_Decimal_Items
)
144 (0.0, 5.91, 63.42, 0.0, -15.39, 91.99, 0.0, 89.34, -99.49);
146 Decimal_Type_2_Items
: array (1..Number_Of_Decimal_Items
)
148 ( 3.0, 105.0, 1234567899.0,
149 8.0, -12345601.0, 9123459999.0,
150 -1.0, 123456781.0, -9499999999.0);
154 -- Check that function Length with Display_Format parameter will
155 -- return the minimal length of a Numeric value (number of
156 -- COBOL_Characters) that will be required to hold the largest
157 -- value of type Num.
159 if Package_1
.Length
(COBOL
.Unsigned
) /= 4 or
160 Package_2
.Length
(COBOL
.Unsigned
) /= 10
162 Report
.Failed
("Incorrect results from function Length when " &
163 "used with Display_Format parameter Unsigned");
166 if Package_1
.Length
(Format
=> COBOL
.Leading_Separate
) /= 5 or
167 Package_2
.Length
(Format
=> COBOL
.Leading_Separate
) /= 11
169 Report
.Failed
("Incorrect results from function Length when " &
170 "used with Display_Format parameter " &
174 if Package_1
.Length
(COBOL
.Trailing_Separate
) /= 5 or
175 Package_2
.Length
(COBOL
.Trailing_Separate
) /= 11
177 Report
.Failed
("Incorrect results from function Length when " &
178 "used with Display_Format parameter " &
179 "Trailing_Separate");
183 -- Check that function To_Decimal with Numeric and Display_Format
184 -- parameters will produce a decimal type Num result that corresponds
185 -- to parameter Item as represented by parameter Format.
187 for i
in 1..Number_Of_Decimal_Items
loop
189 when 1..3 => -- Unsigned Display_Format parameter.
191 if Package_1
.To_Decimal
(Package_1_Numeric_Items
(i
).all,
192 Format
=> COBOL
.Unsigned
) /=
193 Decimal_Type_1_Items
(i
)
196 ("Incorrect result from function To_Decimal " &
197 "from an instantiation of Decimal_Conversions " &
198 "using a four-digit Decimal type, with Format " &
199 "parameter Unsigned, subtest index: " &
203 if Package_2
.To_Decimal
(Package_2_Numeric_Items
(i
).all,
204 Format
=> COBOL
.Unsigned
) /=
205 Decimal_Type_2_Items
(i
)
208 ("Incorrect result from function To_Decimal " &
209 "from an instantiation of Decimal_Conversions " &
210 "using a ten-digit Decimal type, with Format " &
211 "parameter Unsigned, subtest index: " &
215 when 4..6 => -- Leading_Separate Display_Format parameter.
217 if Package_1
.To_Decimal
(Package_1_Numeric_Items
(i
).all,
218 Format
=> COBOL
.Leading_Separate
) /=
219 Decimal_Type_1_Items
(i
)
222 ("Incorrect result from function To_Decimal " &
223 "from an instantiation of Decimal_Conversions " &
224 "using a four-digit Decimal type, with Format " &
225 "parameter Leading_Separate, subtest index: " &
229 if Package_2
.To_Decimal
(Package_2_Numeric_Items
(i
).all,
230 Format
=> COBOL
.Leading_Separate
) /=
231 Decimal_Type_2_Items
(i
)
234 ("Incorrect result from function To_Decimal " &
235 "from an instantiation of Decimal_Conversions " &
236 "using a ten-digit Decimal type, with Format " &
237 "parameter Leading_Separate, subtest index: " &
241 when 7..9 => -- Trailing_Separate Display_Format parameter.
243 if Package_1
.To_Decimal
(Package_1_Numeric_Items
(i
).all,
244 COBOL
.Trailing_Separate
) /=
245 Decimal_Type_1_Items
(i
)
248 ("Incorrect result from function To_Decimal " &
249 "from an instantiation of Decimal_Conversions " &
250 "using a four-digit Decimal type, with Format " &
251 "parameter Trailing_Separate, subtest index: " &
255 if Package_2
.To_Decimal
(Package_2_Numeric_Items
(i
).all,
256 COBOL
.Trailing_Separate
) /=
257 Decimal_Type_2_Items
(i
)
260 ("Incorrect result from function To_Decimal " &
261 "from an instantiation of Decimal_Conversions " &
262 "using a ten-digit Decimal type, with Format " &
263 "parameter Trailing_Separate, subtest index: " &
271 -- Check that function To_Decimal propagates Conversion_Error when
272 -- the value represented by Numeric type parameter Item is outside
273 -- the range of the Decimal_Type Num used to instantiate the package
274 -- Decimal_Conversions.
277 TC_Numeric_1
: Decimal_Type_1
:= Decimal_Type_1_Items
(1);
279 -- The COBOL.Numeric type used as parameter Item represents a
280 -- Decimal value that is outside the range of the Decimal type
281 -- used to instantiate Package_1.
283 Package_1
.To_Decimal
(Item
=> Package_2_Numeric_Items
(8).all,
284 Format
=> COBOL
.Trailing_Separate
);
285 Report
.Failed
("Conversion_Error not raised by To_Decimal " &
286 "when the value represented by parameter " &
287 "Item is outside the range of the Decimal_Type " &
288 "used to instantiate the package " &
289 "Decimal_Conversions");
290 if TC_Numeric_1
= Decimal_Type_1_Items
(1) then
291 Report
.Comment
("To Guard Against Dead Assignment Elimination " &
292 "-- Should never be printed");
295 when COBOL
.Conversion_Error
=> null; -- OK, expected exception.
297 Report
.Failed
("Incorrect exception raised by To_Decimal " &
298 "when the value represented by parameter " &
299 "Item is outside the range of the Decimal_Type " &
300 "used to instantiate the package " &
301 "Decimal_Conversions");
305 -- Check that function To_Display with decimal type Num and
306 -- Display_Format parameters returns a Numeric type result that
307 -- represents Item under the specific Display_Format.
309 -- Unsigned Display_Format parameter.
311 Correct_Result
:= (Package_1
.To_Display
(TC_Num_1
, COBOL
.Unsigned
) =
313 (Package_1
.To_Display
(TC_Num_1
, COBOL
.Unsigned
) /=
315 if not Correct_Result
then
316 Report
.Failed
("Incorrect result from function To_Display with " &
317 "Unsigned Display_Format parameter - 1");
320 TC_Num_2
:= 1234567890.0;
321 Correct_Result
:= Package_2
.To_Display
(TC_Num_2
,
322 COBOL
.Unsigned
) = "1234567890";
323 if not Correct_Result
then
324 Report
.Failed
("Incorrect result from function To_Display with " &
325 "Unsigned Display_Format parameter - 2");
328 -- Leading_Separate Display_Format parameter.
330 Correct_Result
:= (Package_1
.To_Display
(TC_Num_1
,
331 COBOL
.Leading_Separate
) =
333 (Package_1
.To_Display
(TC_Num_1
,
334 COBOL
.Leading_Separate
) /=
336 if not Correct_Result
then
337 Report
.Failed
("Incorrect result from function To_Display with " &
338 "Leading_Separate Display_Format parameter - 1");
342 Correct_Result
:= Package_1
.To_Display
(TC_Num_1
,
343 COBOL
.Leading_Separate
) =
345 if not Correct_Result
then
346 Report
.Failed
("Incorrect result from function To_Display with " &
347 "Leading_Separate Display_Format parameter - 2");
350 TC_Num_2
:= 1234567890.0;
351 Correct_Result
:= Package_2
.To_Display
(TC_Num_2
,
352 COBOL
.Leading_Separate
) =
354 if not Correct_Result
then
355 Report
.Failed
("Incorrect result from function To_Display with " &
356 "Leading_Separate Display_Format parameter - 3");
359 TC_Num_2
:= -1234567890.0;
360 Correct_Result
:= Package_2
.To_Display
(TC_Num_2
,
361 COBOL
.Leading_Separate
) =
363 if not Correct_Result
then
364 Report
.Failed
("Incorrect result from function To_Display with " &
365 "Leading_Separate Display_Format parameter - 4");
368 -- Trailing_Separate Display_Format parameter.
370 Correct_Result
:= (Package_1
.To_Display
(TC_Num_1
,
371 COBOL
.Trailing_Separate
) =
373 (Package_1
.To_Display
(TC_Num_1
,
374 COBOL
.Trailing_Separate
) /=
376 if not Correct_Result
then
377 Report
.Failed
("Incorrect result from function To_Display with " &
378 "Trailing_Separate Display_Format parameter - 1");
382 Correct_Result
:= Package_1
.To_Display
(TC_Num_1
,
383 COBOL
.Trailing_Separate
) =
385 if not Correct_Result
then
386 Report
.Failed
("Incorrect result from function To_Display with " &
387 "Trailing_Separate Display_Format parameter - 2");
390 TC_Num_2
:= 1234567890.0;
391 Correct_Result
:= Package_2
.To_Display
(TC_Num_2
,
392 COBOL
.Trailing_Separate
) =
394 if not Correct_Result
then
395 Report
.Failed
("Incorrect result from function To_Display with " &
396 "Trailing_Separate Display_Format parameter - 3");
399 TC_Num_2
:= -1234567890.0;
400 Correct_Result
:= Package_2
.To_Display
(TC_Num_2
,
401 COBOL
.Trailing_Separate
) =
403 if not Correct_Result
then
404 Report
.Failed
("Incorrect result from function To_Display with " &
405 "Trailing_Separate Display_Format parameter - 4");
409 -- Check that function To_Display propagates Conversion_Error when
410 -- parameter Item is negative and the specified Display_Format
411 -- parameter is Unsigned.
414 if Package_2
.To_Display
(Item
=> Decimal_Type_2_Items
(9),
415 Format
=> COBOL
.Unsigned
) =
416 Package_2_Numeric_Items
(2).all
418 Report
.Comment
("To Guard Against Dead Assignment Elimination " &
419 "-- Should never be printed");
421 Report
.Failed
("Conversion_Error not raised by To_Display " &
422 "when the value represented by parameter " &
423 "Item is negative and the Display_Format " &
424 "parameter is Unsigned");
426 when COBOL
.Conversion_Error
=> null; -- OK, expected exception.
428 Report
.Failed
("Incorrect exception raised by To_Display " &
429 "when the value represented by parameter " &
430 "Item is negative and the Display_Format " &
431 "parameter is Unsigned");
436 when The_Error
: others =>
437 Report
.Failed
("The following exception was raised in the " &
438 "Test_Block: " & Exception_Name
(The_Error
));