|
111
|
1 -- CXB4002.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 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.
|
|
|
33 --
|
|
|
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.
|
|
|
37 --
|
|
|
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.
|
|
|
44 --
|
|
|
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.
|
|
|
48 --
|
|
|
49 -- TEST DESCRIPTION:
|
|
|
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.
|
|
|
52 --
|
|
|
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
|
|
|
58 -- verified.
|
|
|
59 --
|
|
|
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.
|
|
|
64 --
|
|
|
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 '#'.
|
|
|
68 --
|
|
|
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
|
|
|
73 -- report "PASSED".
|
|
|
74 --
|
|
|
75 --
|
|
|
76 -- CHANGE HISTORY:
|
|
|
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.
|
|
|
80 --
|
|
|
81 --!
|
|
|
82
|
|
|
83 with Report;
|
|
|
84 with Ada.Strings.Bounded;
|
|
|
85 with Ada.Strings.Unbounded;
|
|
|
86 with Interfaces.COBOL; -- N/A => ERROR
|
|
|
87
|
|
|
88 procedure CXB4002 is
|
|
|
89 begin
|
|
|
90
|
|
|
91 Report.Test ("CXB4002", "Check that the procedures To_COBOL and " &
|
|
|
92 "To_Ada produce correct results");
|
|
|
93
|
|
|
94 Test_Block:
|
|
|
95 declare
|
|
|
96
|
|
|
97 package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
|
|
|
98 package Unb renames Ada.Strings.Unbounded;
|
|
|
99
|
|
|
100 use Interfaces;
|
|
|
101 use Bnd, Unb;
|
|
|
102 use type Interfaces.COBOL.Alphanumeric;
|
|
|
103
|
|
|
104
|
|
|
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";
|
|
|
113
|
|
|
114 Bnd_String : Bnd.Bounded_String :=
|
|
|
115 Bnd.To_Bounded_String(" ");
|
|
|
116 TC_Bnd_String : Bounded_String :=
|
|
|
117 To_Bounded_String("$1a2b3C4D5");
|
|
|
118
|
|
|
119 Unb_String : Unb.Unbounded_String :=
|
|
|
120 Unb.To_Unbounded_String(" ");
|
|
|
121 TC_Unb_String : Unbounded_String :=
|
|
|
122 To_Unbounded_String("ab*de");
|
|
|
123
|
|
|
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";
|
|
|
130
|
|
|
131 TC_Alphanumeric : constant COBOL.Alphanumeric := ""; -- null array.
|
|
|
132 TC_String : constant String := ""; -- null string.
|
|
|
133 TC_Natural : Natural := 0;
|
|
|
134
|
|
|
135
|
|
|
136 begin
|
|
|
137
|
|
|
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.
|
|
|
144
|
|
|
145 COBOL.To_COBOL(Item => TC_String_1,
|
|
|
146 Target => Alphanumeric_1,
|
|
|
147 Last => TC_Natural);
|
|
|
148
|
|
|
149 if Alphanumeric_1 /= TC_Alphanumeric_1 or
|
|
|
150 TC_Natural /= TC_Alphanumeric_1'Length or
|
|
|
151 TC_Natural /= 1
|
|
|
152 then
|
|
|
153 Report.Failed("Incorrect result from procedure To_COBOL - 1");
|
|
|
154 end if;
|
|
|
155
|
|
|
156 COBOL.To_COBOL(To_String(TC_Unb_String),
|
|
|
157 Target => Alphanumeric_5,
|
|
|
158 Last => TC_Natural);
|
|
|
159
|
|
|
160 if Alphanumeric_5 /= TC_Alphanumeric_5 or
|
|
|
161 TC_Natural /= TC_Alphanumeric_5'Length or
|
|
|
162 TC_Natural /= 5
|
|
|
163 then
|
|
|
164 Report.Failed("Incorrect result from procedure To_COBOL - 2");
|
|
|
165 end if;
|
|
|
166
|
|
|
167 COBOL.To_COBOL(To_String(TC_Bnd_String),
|
|
|
168 Alphanumeric_10,
|
|
|
169 Last => TC_Natural);
|
|
|
170
|
|
|
171 if Alphanumeric_10 /= TC_Alphanumeric_10 or
|
|
|
172 TC_Natural /= TC_Alphanumeric_10'Length or
|
|
|
173 TC_Natural /= 10
|
|
|
174 then
|
|
|
175 Report.Failed("Incorrect result from procedure To_COBOL - 3");
|
|
|
176 end if;
|
|
|
177
|
|
|
178 COBOL.To_COBOL(TC_String_20,
|
|
|
179 Alphanumeric_20,
|
|
|
180 TC_Natural);
|
|
|
181
|
|
|
182 if Alphanumeric_20 /= TC_Alphanumeric_20 or
|
|
|
183 TC_Natural /= TC_Alphanumeric_20'Length or
|
|
|
184 TC_Natural /= 20
|
|
|
185 then
|
|
|
186 Report.Failed("Incorrect result from procedure To_COBOL - 4");
|
|
|
187 end if;
|
|
|
188
|
|
|
189 COBOL.To_COBOL(Item => TC_String, -- null string
|
|
|
190 Target => Alphanumeric_1,
|
|
|
191 Last => TC_Natural);
|
|
|
192
|
|
|
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");
|
|
|
197 end if;
|
|
|
198
|
|
|
199
|
|
|
200
|
|
|
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.
|
|
|
204
|
|
|
205 begin
|
|
|
206
|
|
|
207 COBOL.To_COBOL(Item => TC_String_20,
|
|
|
208 Target => Alphanumeric_10,
|
|
|
209 Last => TC_Natural);
|
|
|
210 Report.Failed("Constraint_Error not raised by procedure To_COBOL " &
|
|
|
211 "when Item'Length exceeds Target'Length");
|
|
|
212 exception
|
|
|
213 when Constraint_Error => null; -- OK, expected exception.
|
|
|
214 when others =>
|
|
|
215 Report.Failed("Incorrect exception raised by procedure To_COBOL " &
|
|
|
216 "when Item'Length exceeds Target'Length");
|
|
|
217 end;
|
|
|
218
|
|
|
219
|
|
|
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.
|
|
|
226
|
|
|
227 COBOL.To_Ada(Item => TC_Alphanumeric_1,
|
|
|
228 Target => String_1,
|
|
|
229 Last => TC_Natural);
|
|
|
230
|
|
|
231 if String_1 /= TC_String_1 or
|
|
|
232 TC_Natural /= TC_String_1'Length or
|
|
|
233 TC_Natural /= 1
|
|
|
234 then
|
|
|
235 Report.Failed("Incorrect result from procedure To_Ada - 1");
|
|
|
236 end if;
|
|
|
237
|
|
|
238 COBOL.To_Ada(TC_Alphanumeric_5,
|
|
|
239 Target => String_5,
|
|
|
240 Last => TC_Natural);
|
|
|
241
|
|
|
242 if String_5 /= To_String(TC_Unb_String) or
|
|
|
243 TC_Natural /= Length(TC_Unb_String) or
|
|
|
244 TC_Natural /= 5
|
|
|
245 then
|
|
|
246 Report.Failed("Incorrect result from procedure To_Ada - 2");
|
|
|
247 end if;
|
|
|
248
|
|
|
249 COBOL.To_Ada(TC_Alphanumeric_10,
|
|
|
250 String_10,
|
|
|
251 Last => TC_Natural);
|
|
|
252
|
|
|
253 if String_10 /= To_String(TC_Bnd_String) or
|
|
|
254 TC_Natural /= Length(TC_Bnd_String) or
|
|
|
255 TC_Natural /= 10
|
|
|
256 then
|
|
|
257 Report.Failed("Incorrect result from procedure To_Ada - 3");
|
|
|
258 end if;
|
|
|
259
|
|
|
260 COBOL.To_Ada(TC_Alphanumeric_20,
|
|
|
261 String_20,
|
|
|
262 TC_Natural);
|
|
|
263
|
|
|
264 if String_20 /= TC_String_20 or
|
|
|
265 TC_Natural /= TC_String_20'Length or
|
|
|
266 TC_Natural /= 20
|
|
|
267 then
|
|
|
268 Report.Failed("Incorrect result from procedure To_Ada - 4");
|
|
|
269 end if;
|
|
|
270
|
|
|
271 COBOL.To_Ada(Item => TC_Alphanumeric, -- null array.
|
|
|
272 Target => String_20,
|
|
|
273 Last => TC_Natural);
|
|
|
274
|
|
|
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");
|
|
|
279 end if;
|
|
|
280
|
|
|
281
|
|
|
282
|
|
|
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.
|
|
|
286
|
|
|
287 begin
|
|
|
288
|
|
|
289 COBOL.To_Ada(Item => TC_Alphanumeric_10,
|
|
|
290 Target => String_5,
|
|
|
291 Last => TC_Natural);
|
|
|
292 Report.Failed("Constraint_Error not raised by procedure To_Ada " &
|
|
|
293 "when Item'Length exceeds Target'Length");
|
|
|
294 exception
|
|
|
295 when Constraint_Error => null; -- OK, expected exception.
|
|
|
296 when others =>
|
|
|
297 Report.Failed("Incorrect exception raised by procedure To_Ada " &
|
|
|
298 "when Item'Length exceeds Target'Length");
|
|
|
299 end;
|
|
|
300
|
|
|
301
|
|
|
302 exception
|
|
|
303 when others => Report.Failed ("Exception raised in Test_Block");
|
|
|
304 end Test_Block;
|
|
|
305
|
|
|
306 Report.Result;
|
|
|
307
|
|
|
308 end CXB4002;
|
