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 procedure To_COBOL converts the character elements
28 -- of the String parameter Item into COBOL_Character elements of the
29 -- Alphanumeric type parameter Target, using the Ada_to_COBOL mapping
30 -- as the basis of conversion.
31 -- Check that the parameter Last contains the index of the last element
32 -- of parameter Target that was assigned by To_COBOL.
34 -- Check that Constraint_Error is propagated by procedure To_COBOL
35 -- when the length of String parameter Item exceeds the length of
36 -- Alphanumeric parameter Target.
38 -- Check that the procedure To_Ada converts the COBOL_Character
39 -- elements of the Alphanumeric parameter Item into Character elements
40 -- of the String parameter Target, using the COBOL_to_Ada mapping array
41 -- as the basis of conversion.
42 -- Check that the parameter Last contains the index of the last element
43 -- of parameter Target that was assigned by To_Ada.
45 -- Check that Constraint_Error is propagated by procedure To_Ada when
46 -- the length of Alphanumeric parameter Item exceeds the length of
47 -- String parameter Target.
50 -- This test checks that the procedures To_COBOL and To_Ada produce
51 -- the correct results, based on a variety of parameter input values.
53 -- In the first series of subtests, the Out parameter results of
54 -- procedure To_COBOL are compared against expected results,
55 -- which includes (in the parameter Last) the index in Target of the
56 -- last element assigned. The situation where procedure To_COBOL raises
57 -- Constraint_Error (when Item'Length exceeds Target'Length) is also
60 -- In the second series of subtests, the Out parameter results of
61 -- procedure To_Ada are verified, in a similar manner as is done for
62 -- procedure To_COBOL. The case of procedure To_Ada raising
63 -- Constraint_Error is also verified.
65 -- This test assumes that the following characters are all included
66 -- in the implementation defined type Interfaces.COBOL.COBOL_Character:
67 -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', '$', '-', '_', and '#'.
69 -- APPLICABILITY CRITERIA:
70 -- This test is applicable to all implementations that provide
71 -- package Interfaces.COBOL. If an implementation provides
72 -- package Interfaces.COBOL, this test must compile, execute, and
77 -- 12 Jan 96 SAIC Initial prerelease version.
78 -- 30 May 96 SAIC Added applicability criteria for ACVC 2.1.
79 -- 27 Oct 96 SAIC Incorporated reviewer comments.
84 with Ada
.Strings
.Bounded
;
85 with Ada
.Strings
.Unbounded
;
86 with Interfaces
.COBOL
; -- N/A => ERROR
91 Report
.Test
("CXB4002", "Check that the procedures To_COBOL and " &
92 "To_Ada produce correct results");
97 package Bnd
is new Ada
.Strings
.Bounded
.Generic_Bounded_Length
(10);
98 package Unb
renames Ada
.Strings
.Unbounded
;
102 use type Interfaces
.COBOL
.Alphanumeric
;
105 Alphanumeric_1
: COBOL
.Alphanumeric
(1..1) := " ";
106 Alphanumeric_5
: COBOL
.Alphanumeric
(1..5) := " ";
107 Alphanumeric_10
: COBOL
.Alphanumeric
(1..10) := " ";
108 Alphanumeric_20
: COBOL
.Alphanumeric
(1..20) := " ";
109 TC_Alphanumeric_1
: COBOL
.Alphanumeric
(1..1) := "A";
110 TC_Alphanumeric_5
: COBOL
.Alphanumeric
(1..5) := "ab*de";
111 TC_Alphanumeric_10
: COBOL
.Alphanumeric
(1..10) := "$1a2b3C4D5";
112 TC_Alphanumeric_20
: COBOL
.Alphanumeric
(1..20) := "1234-ABCD_6789#fghij";
114 Bnd_String
: Bnd
.Bounded_String
:=
115 Bnd
.To_Bounded_String
(" ");
116 TC_Bnd_String
: Bounded_String
:=
117 To_Bounded_String
("$1a2b3C4D5");
119 Unb_String
: Unb
.Unbounded_String
:=
120 Unb
.To_Unbounded_String
(" ");
121 TC_Unb_String
: Unbounded_String
:=
122 To_Unbounded_String
("ab*de");
124 String_1
: String(1..1) := " ";
125 String_5
: String(1..5) := " ";
126 String_10
: String(1..10) := " ";
127 String_20
: String(1..20) := " ";
128 TC_String_1
: String(1..1) := "A";
129 TC_String_20
: String(1..20) := "1234-ABCD_6789#fghij";
131 TC_Alphanumeric
: constant COBOL
.Alphanumeric
:= ""; -- null array.
132 TC_String
: constant String := ""; -- null string.
133 TC_Natural
: Natural := 0;
138 -- Check that the procedure To_COBOL converts the character elements
139 -- of the String parameter Item into COBOL_Character elements of the
140 -- Alphanumeric type parameter Target, using the Ada_to_COBOL mapping
141 -- as the basis of conversion.
142 -- Check that the parameter Last contains the index of the last element
143 -- of parameter Target that was assigned by To_COBOL.
145 COBOL
.To_COBOL
(Item
=> TC_String_1
,
146 Target
=> Alphanumeric_1
,
149 if Alphanumeric_1
/= TC_Alphanumeric_1
or
150 TC_Natural
/= TC_Alphanumeric_1
'Length or
153 Report
.Failed
("Incorrect result from procedure To_COBOL - 1");
156 COBOL
.To_COBOL
(To_String
(TC_Unb_String
),
157 Target
=> Alphanumeric_5
,
160 if Alphanumeric_5
/= TC_Alphanumeric_5
or
161 TC_Natural
/= TC_Alphanumeric_5
'Length or
164 Report
.Failed
("Incorrect result from procedure To_COBOL - 2");
167 COBOL
.To_COBOL
(To_String
(TC_Bnd_String
),
171 if Alphanumeric_10
/= TC_Alphanumeric_10
or
172 TC_Natural
/= TC_Alphanumeric_10
'Length or
175 Report
.Failed
("Incorrect result from procedure To_COBOL - 3");
178 COBOL
.To_COBOL
(TC_String_20
,
182 if Alphanumeric_20
/= TC_Alphanumeric_20
or
183 TC_Natural
/= TC_Alphanumeric_20
'Length or
186 Report
.Failed
("Incorrect result from procedure To_COBOL - 4");
189 COBOL
.To_COBOL
(Item
=> TC_String
, -- null string
190 Target
=> Alphanumeric_1
,
193 if TC_Natural
/= 0 then
194 Report
.Failed
("Incorrect result from procedure To_COBOL, value " &
195 "returned in parameter Last should be zero, since " &
196 "parameter Item is null array");
201 -- Check that Constraint_Error is propagated by procedure To_COBOL
202 -- when the length of String parameter Item exceeds the length of
203 -- Alphanumeric parameter Target.
207 COBOL
.To_COBOL
(Item
=> TC_String_20
,
208 Target
=> Alphanumeric_10
,
210 Report
.Failed
("Constraint_Error not raised by procedure To_COBOL " &
211 "when Item'Length exceeds Target'Length");
213 when Constraint_Error
=> null; -- OK, expected exception.
215 Report
.Failed
("Incorrect exception raised by procedure To_COBOL " &
216 "when Item'Length exceeds Target'Length");
220 -- Check that the procedure To_Ada converts the COBOL_Character
221 -- elements of the Alphanumeric parameter Item into Character elements
222 -- of the String parameter Target, using the COBOL_to_Ada mapping array
223 -- as the basis of conversion.
224 -- Check that the parameter Last contains the index of the last element
225 -- of parameter Target that was assigned by To_Ada.
227 COBOL
.To_Ada
(Item
=> TC_Alphanumeric_1
,
231 if String_1
/= TC_String_1
or
232 TC_Natural
/= TC_String_1
'Length or
235 Report
.Failed
("Incorrect result from procedure To_Ada - 1");
238 COBOL
.To_Ada
(TC_Alphanumeric_5
,
242 if String_5
/= To_String
(TC_Unb_String
) or
243 TC_Natural
/= Length
(TC_Unb_String
) or
246 Report
.Failed
("Incorrect result from procedure To_Ada - 2");
249 COBOL
.To_Ada
(TC_Alphanumeric_10
,
253 if String_10
/= To_String
(TC_Bnd_String
) or
254 TC_Natural
/= Length
(TC_Bnd_String
) or
257 Report
.Failed
("Incorrect result from procedure To_Ada - 3");
260 COBOL
.To_Ada
(TC_Alphanumeric_20
,
264 if String_20
/= TC_String_20
or
265 TC_Natural
/= TC_String_20
'Length or
268 Report
.Failed
("Incorrect result from procedure To_Ada - 4");
271 COBOL
.To_Ada
(Item
=> TC_Alphanumeric
, -- null array.
275 if TC_Natural
/= 0 then
276 Report
.Failed
("Incorrect result from procedure To_Ada, value " &
277 "returned in parameter Last should be zero, since " &
278 "parameter Item is null array");
283 -- Check that Constraint_Error is propagated by procedure To_Ada when
284 -- the length of Alphanumeric parameter Item exceeds the length of
285 -- String parameter Target.
289 COBOL
.To_Ada
(Item
=> TC_Alphanumeric_10
,
292 Report
.Failed
("Constraint_Error not raised by procedure To_Ada " &
293 "when Item'Length exceeds Target'Length");
295 when Constraint_Error
=> null; -- OK, expected exception.
297 Report
.Failed
("Incorrect exception raised by procedure To_Ada " &
298 "when Item'Length exceeds Target'Length");
303 when others => Report
.Failed
("Exception raised in Test_Block");