1-- CXB4003.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 function Valid, with the Display_Format parameter 28-- set to Unsigned, will return True if Numeric parameter Item 29-- comprises one or more decimal digit characters; check that it 30-- returns False if the parameter Item is otherwise comprised. 31-- 32-- Check that function Valid, with Display_Format parameter set to 33-- Leading_Separate, will return True if Numeric parameter Item 34-- comprises a single occurrence of a Plus_Sign or Minus_Sign 35-- character, and then by one or more decimal digit characters; 36-- check that it returns False if the parameter Item is otherwise 37-- comprised. 38-- 39-- Check that function Valid, with Display_Format parameter set to 40-- Trailing_Separate, will return True if Numeric parameter Item 41-- comprises one or more decimal digit characters, and then by a 42-- single occurrence of the Plus_Sign or Minus_Sign character; 43-- check that it returns False if the parameter Item is otherwise 44-- comprised. 45-- 46-- TEST DESCRIPTION: 47-- This test checks that a version of function Valid, from an instance 48-- of the generic package Decimal_Conversions, will produce correct 49-- results based on the particular Numeric and Display_Format 50-- parameters provided. Arrays of both valid and invalid Numeric 51-- data items have been created to correspond to a particular 52-- value of Display_Format. The result of the function is compared 53-- against the expected result for each appropriate combination of 54-- Numeric and Display_Format parameter. 55-- This test assumes that the following characters are all included 56-- in the implementation defined type Interfaces.COBOL.COBOL_Character: 57-- ' ', 'A'..'Z', '+', '-', '.', '$'. 58-- 59-- APPLICABILITY CRITERIA: 60-- This test is applicable to all implementations that provide 61-- package Interfaces.COBOL. If an implementation provides 62-- package Interfaces.COBOL, this test must compile, execute, and 63-- report "PASSED". 64-- 65-- 66-- 67-- CHANGE HISTORY: 68-- 18 Jan 96 SAIC Initial version for 2.1. 69-- 30 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. 70-- 27 Oct 96 SAIC Incorporated reviewer comments. 71-- 72--! 73 74with Report; 75with Ada.Exceptions; 76with Interfaces.COBOL; -- N/A => ERROR 77 78procedure CXB4003 is 79begin 80 81 Report.Test ("CXB4003", "Check that function Valid, with various " & 82 "Display_Format parameters, produces correct " & 83 "results"); 84 85 Test_Block: 86 declare 87 88 use Interfaces; 89 use Ada.Exceptions; 90 91 type A_Numeric_Type is delta 0.01 digits 16; 92 type Numeric_Access is access COBOL.Numeric; 93 type Numeric_Items_Type is array(Integer range <>) of Numeric_Access; 94 95 package Display_Format is 96 new COBOL.Decimal_Conversions(Num => A_Numeric_Type); 97 98 99 Number_Of_Valid_Unsigned_Items : constant := 5; 100 Number_Of_Invalid_Unsigned_Items : constant := 21; 101 Number_Of_Valid_Leading_Separate_Items : constant := 5; 102 Number_Of_Invalid_Leading_Separate_Items : constant := 23; 103 Number_Of_Valid_Trailing_Separate_Items : constant := 5; 104 Number_Of_Invalid_Trailing_Separate_Items : constant := 22; 105 106 Valid_Unsigned_Items : 107 Numeric_Items_Type(1..Number_Of_Valid_Unsigned_Items) := 108 (new COBOL.Numeric'("0"), 109 new COBOL.Numeric'("1"), 110 new COBOL.Numeric'("0000000001"), 111 new COBOL.Numeric'("1234567890123456"), 112 new COBOL.Numeric'("0000")); 113 114 Invalid_Unsigned_Items : 115 Numeric_Items_Type(1..Number_Of_Invalid_Unsigned_Items) := 116 (new COBOL.Numeric'(" 12345"), 117 new COBOL.Numeric'(" 12345"), 118 new COBOL.Numeric'("1234567890 "), 119 new COBOL.Numeric'("1234567890 "), 120 new COBOL.Numeric'("1.01"), 121 new COBOL.Numeric'(".0000000001"), 122 new COBOL.Numeric'("12345 6"), 123 new COBOL.Numeric'("MCXVIII"), 124 new COBOL.Numeric'("15F"), 125 new COBOL.Numeric'("+12345"), 126 new COBOL.Numeric'("$12.30"), 127 new COBOL.Numeric'("1234-"), 128 new COBOL.Numeric'("12--"), 129 new COBOL.Numeric'("+12-"), 130 new COBOL.Numeric'("++99--"), 131 new COBOL.Numeric'("-1.01"), 132 new COBOL.Numeric'("(1.01)"), 133 new COBOL.Numeric'("123,456"), 134 new COBOL.Numeric'("101."), 135 new COBOL.Numeric'(""), 136 new COBOL.Numeric'("1.0000")); 137 138 Valid_Leading_Separate_Items : 139 Numeric_Items_Type(1..Number_Of_Valid_Leading_Separate_Items) := 140 (new COBOL.Numeric'("+1000"), 141 new COBOL.Numeric'("-1"), 142 new COBOL.Numeric'("-0000000001"), 143 new COBOL.Numeric'("+1234567890123456"), 144 new COBOL.Numeric'("-0000")); 145 146 Invalid_Leading_Separate_Items : 147 Numeric_Items_Type(1..Number_Of_Invalid_Leading_Separate_Items) := 148 (new COBOL.Numeric'("123456"), 149 new COBOL.Numeric'(" +12345"), 150 new COBOL.Numeric'(" +12345"), 151 new COBOL.Numeric'("- 0000000001"), 152 new COBOL.Numeric'("1234567890- "), 153 new COBOL.Numeric'("1234567890+ "), 154 new COBOL.Numeric'("123-456"), 155 new COBOL.Numeric'("+15F"), 156 new COBOL.Numeric'("++123"), 157 new COBOL.Numeric'("12--"), 158 new COBOL.Numeric'("+12-"), 159 new COBOL.Numeric'("+/-12"), 160 new COBOL.Numeric'("++99--"), 161 new COBOL.Numeric'("1.01"), 162 new COBOL.Numeric'("(1.01)"), 163 new COBOL.Numeric'("+123,456"), 164 new COBOL.Numeric'("+15FF"), 165 new COBOL.Numeric'("- 123"), 166 new COBOL.Numeric'("+$123"), 167 new COBOL.Numeric'(""), 168 new COBOL.Numeric'("-"), 169 new COBOL.Numeric'("-1.01"), 170 new COBOL.Numeric'("1.0000+")); 171 172 Valid_Trailing_Separate_Items : 173 Numeric_Items_Type(1..Number_Of_Valid_Trailing_Separate_Items) := 174 (new COBOL.Numeric'("1001-"), 175 new COBOL.Numeric'("1+"), 176 new COBOL.Numeric'("0000000001+"), 177 new COBOL.Numeric'("1234567890123456-"), 178 new COBOL.Numeric'("0000-")); 179 180 Invalid_Trailing_Separate_Items : 181 Numeric_Items_Type(1..Number_Of_Invalid_Trailing_Separate_Items) := 182 (new COBOL.Numeric'("123456"), 183 new COBOL.Numeric'("+12345"), 184 new COBOL.Numeric'("12345 "), 185 new COBOL.Numeric'("123- "), 186 new COBOL.Numeric'("123- "), 187 new COBOL.Numeric'("12345 +"), 188 new COBOL.Numeric'("12345+ "), 189 new COBOL.Numeric'("-0000000001"), 190 new COBOL.Numeric'("123-456"), 191 new COBOL.Numeric'("12--"), 192 new COBOL.Numeric'("+12-"), 193 new COBOL.Numeric'("99+-"), 194 new COBOL.Numeric'("12+/-"), 195 new COBOL.Numeric'("12.01-"), 196 new COBOL.Numeric'("$12.01+"), 197 new COBOL.Numeric'("(1.01)"), 198 new COBOL.Numeric'("DM12-"), 199 new COBOL.Numeric'("123,456+"), 200 new COBOL.Numeric'(""), 201 new COBOL.Numeric'("-"), 202 new COBOL.Numeric'("1.01-"), 203 new COBOL.Numeric'("+1.0000")); 204 205 begin 206 207 -- Check that function Valid, with the Display_Format parameter 208 -- set to Unsigned, will return True if Numeric parameter Item 209 -- comprises one or more decimal digit characters; check that it 210 -- returns False if the parameter Item is otherwise comprised. 211 212 for i in 1..Number_of_Valid_Unsigned_Items loop 213 -- Fail if the Item parameter is _NOT_ considered Valid. 214 if not Display_Format.Valid(Item => Valid_Unsigned_Items(i).all, 215 Format => COBOL.Unsigned) 216 then 217 Report.Failed("Incorrect result from function Valid, with " & 218 "Format parameter set to Unsigned, for valid " & 219 "format item number " & Integer'Image(i)); 220 end if; 221 end loop; 222 223 224 for i in 1..Number_of_Invalid_Unsigned_Items loop 225 -- Fail if the Item parameter _IS_ considered Valid. 226 if Display_Format.Valid(Item => Invalid_Unsigned_Items(i).all, 227 Format => COBOL.Unsigned) 228 then 229 Report.Failed("Incorrect result from function Valid, with " & 230 "Format parameter set to Unsigned, for invalid " & 231 "format item number " & Integer'Image(i)); 232 end if; 233 end loop; 234 235 236 237 -- Check that function Valid, with Display_Format parameter set to 238 -- Leading_Separate, will return True if Numeric parameter Item 239 -- comprises a single occurrence of a Plus_Sign or Minus_Sign 240 -- character, and then by one or more decimal digit characters; 241 -- check that it returns False if the parameter Item is otherwise 242 -- comprised. 243 244 for i in 1..Number_of_Valid_Leading_Separate_Items loop 245 -- Fail if the Item parameter is _NOT_ considered Valid. 246 if not Display_Format.Valid(Valid_Leading_Separate_Items(i).all, 247 Format => COBOL.Leading_Separate) 248 then 249 Report.Failed("Incorrect result from function Valid, with " & 250 "Format parameter set to Leading_Separate, " & 251 "for valid format item number " & Integer'Image(i)); 252 end if; 253 end loop; 254 255 256 for i in 1..Number_of_Invalid_Leading_Separate_Items loop 257 -- Fail if the Item parameter _IS_ considered Valid. 258 if Display_Format.Valid(Invalid_Leading_Separate_Items(i).all, 259 Format => COBOL.Leading_Separate) 260 then 261 Report.Failed("Incorrect result from function Valid, with " & 262 "Format parameter set to Leading_Separate, " & 263 "for invalid format item number " & 264 Integer'Image(i)); 265 end if; 266 end loop; 267 268 269 270 -- Check that function Valid, with Display_Format parameter set to 271 -- Trailing_Separate, will return True if Numeric parameter Item 272 -- comprises one or more decimal digit characters, and then by a 273 -- single occurrence of the Plus_Sign or Minus_Sign character; 274 -- check that it returns False if the parameter Item is otherwise 275 -- comprised. 276 277 for i in 1..Number_of_Valid_Trailing_Separate_Items loop 278 -- Fail if the Item parameter is _NOT_ considered Valid. 279 if not Display_Format.Valid(Valid_Trailing_Separate_Items(i).all, 280 COBOL.Trailing_Separate) 281 then 282 Report.Failed("Incorrect result from function Valid, with " & 283 "Format parameter set to Trailing_Separate, " & 284 "for valid format item number " & Integer'Image(i)); 285 end if; 286 end loop; 287 288 289 for i in 1..Number_of_Invalid_Trailing_Separate_Items loop 290 -- Fail if the Item parameter _IS_ considered Valid. 291 if Display_Format.Valid(Invalid_Trailing_Separate_Items(i).all, 292 COBOL.Trailing_Separate) 293 then 294 Report.Failed("Incorrect result from function Valid, with " & 295 "Format parameter set to Trailing_Separate, " & 296 "for invalid format item number " & 297 Integer'Image(i)); 298 end if; 299 end loop; 300 301 302 exception 303 when The_Error : others => 304 Report.Failed ("The following exception was raised in the " & 305 "Test_Block: " & Exception_Name(The_Error)); 306 end Test_Block; 307 308 Report.Result; 309 310end CXB4003; 311