1-- CXB4005.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 function To_COBOL will convert a String
28--      parameter value into a type Alphanumeric array of
29--      COBOL_Characters, with lower bound of one, and length
30--      equal to length of the String parameter, based on the
31--      mapping Ada_to_COBOL.
32--
33--      Check that the function To_Ada will convert a type
34--      Alphanumeric parameter value into a String type result,
35--      with lower bound of one, and length equal to the length
36--      of the Alphanumeric parameter, based on the mapping
37--      COBOL_to_Ada.
38--
39--      Check that the Ada_to_COBOL and COBOL_to_Ada mapping
40--      arrays provide a mapping capability between Ada's type
41--      Character and COBOL run-time character sets.
42--
43-- TEST DESCRIPTION:
44--      This test checks that the functions To_COBOL and To_Ada produce
45--      the correct results, based on a variety of parameter input values.
46--
47--      In the first series of subtests, the results of the function
48--      To_COBOL are compared against expected Alphanumeric type results,
49--      and the length and lower bound of the alphanumeric result are
50--      also verified.  In the second series of subtests, the results of
51--      the function To_Ada are compared against expected String type
52--      results, and the length of the String result is also verified
53--      against the Alphanumeric type parameter.
54--
55--      This test also verifies that two mapping array variables defined
56--      in package Interfaces.COBOL, Ada_To_COBOL and COBOL_To_Ada, are
57--      available, and that they can be modified by a user at runtime.
58--      Finally, the effects of user modifications on these mapping
59--      variables is checked in the test.
60--
61--      This test uses Fixed, Bounded, and Unbounded_Strings in combination
62--      with the functions under validation.
63--
64--      This test assumes that the following characters are all included
65--      in the implementation defined type Interfaces.COBOL.COBOL_Character:
66--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*', ',', '.', and '$'.
67--
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
72--      report "PASSED".
73--
74--
75-- CHANGE HISTORY:
76--      11 Jan 96   SAIC    Initial prerelease version for ACVC 2.1
77--      30 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
78--      27 Oct 96   SAIC    Incorporated reviewer comments.
79--
80--!
81
82with Report;
83with Ada.Exceptions;
84with Ada.Strings.Bounded;
85with Ada.Strings.Unbounded;
86with Interfaces.COBOL;                                          -- N/A => ERROR
87
88procedure CXB4005 is
89begin
90
91   Report.Test ("CXB4005", "Check that the functions 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(5);
98      package Unb renames Ada.Strings.Unbounded;
99
100      use Ada.Exceptions;
101      use Interfaces;
102      use Bnd;
103      use type Unb.Unbounded_String;
104      use type Interfaces.COBOL.Alphanumeric;
105
106      TC_Alphanumeric_1  : Interfaces.COBOL.Alphanumeric(1..1);
107      TC_Alphanumeric_5  : Interfaces.COBOL.Alphanumeric(1..5);
108      TC_Alphanumeric_10 : Interfaces.COBOL.Alphanumeric(1..10);
109      TC_Alphanumeric_20 : Interfaces.COBOL.Alphanumeric(1..20);
110
111      Bnd_String,
112      TC_Bnd_String      : Bnd.Bounded_String   :=
113                             Bnd.To_Bounded_String("     ");
114      Unb_String,
115      TC_Unb_String      : Unb.Unbounded_String :=
116                             Unb.To_Unbounded_String("                    ");
117
118      The_String,
119      TC_String          : String(1..20) := ("                    ");
120
121   begin
122
123      -- Check that the function To_COBOL will convert a String
124      -- parameter value into a type Alphanumeric array of
125      -- COBOL_Characters, with lower bound of one, and length
126      -- equal to length of the String parameter, based on the
127      -- mapping Ada_to_COBOL.
128
129      Unb_String         := Unb.To_Unbounded_String("A");
130      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
131
132      if TC_Alphanumeric_1        /= "A"                    or
133         TC_Alphanumeric_1'Length /= Unb.Length(Unb_String) or
134         TC_Alphanumeric_1'Length /= 1                      or
135         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
136      then
137         Report.Failed("Incorrect result from function To_COBOL - 1");
138      end if;
139
140      Bnd_String         := Bnd.To_Bounded_String("abcde");
141      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
142
143      if TC_Alphanumeric_5        /= "abcde"                or
144         TC_Alphanumeric_5'Length /= Bnd.Length(Bnd_String) or
145         TC_Alphanumeric_5'Length /= 5                      or
146         COBOL.To_COBOL(Bnd.To_String(Bnd_String))'First  /= 1
147      then
148         Report.Failed("Incorrect result from function To_COBOL - 2");
149      end if;
150
151      Unb_String         := Unb.To_Unbounded_String("1A2B3c4d5F");
152      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
153
154      if TC_Alphanumeric_10        /= "1A2B3c4d5F"           or
155         TC_Alphanumeric_10'Length /= Unb.Length(Unb_String) or
156         TC_Alphanumeric_10'Length /= 10                     or
157         COBOL.To_COBOL(Unb.To_String(Unb_String))'First  /= 1
158      then
159         Report.Failed("Incorrect result from function To_COBOL - 3");
160      end if;
161
162      The_String         := "abcd  ghij" & "1234  7890";
163      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
164
165      if TC_Alphanumeric_20                /= "abcd  ghij1234  7890" or
166         TC_Alphanumeric_20'Length         /= The_String'Length      or
167         TC_Alphanumeric_20'Length         /= 20                     or
168         COBOL.To_COBOL(The_String)'First  /= 1
169      then
170         Report.Failed("Incorrect result from function To_COBOL - 4");
171      end if;
172
173
174
175      -- Check that the function To_Ada will convert a type
176      -- Alphanumeric parameter value into a String type result,
177      -- with lower bound of one, and length equal to the length
178      -- of the Alphanumeric parameter, based on the mapping
179      -- COBOL_to_Ada.
180
181      TC_Unb_String := Unb.To_Unbounded_String
182                         (COBOL.To_Ada(TC_Alphanumeric_1));
183
184      if TC_Unb_String             /= "A"                       or
185         TC_Alphanumeric_1'Length  /= Unb.Length(TC_Unb_String) or
186         Unb.Length(TC_Unb_String) /= 1                         or
187         COBOL.To_Ada(TC_Alphanumeric_1)'First /= 1
188      then
189         Report.Failed("Incorrect value returned from function To_Ada - 1");
190      end if;
191
192      TC_Bnd_String := Bnd.To_Bounded_String
193                         (COBOL.To_Ada(TC_Alphanumeric_5));
194
195      if TC_Bnd_String             /= "abcde"                   or
196         TC_Alphanumeric_5'Length  /= Bnd.Length(TC_Bnd_String) or
197         Bnd.Length(TC_Bnd_String) /= 5                         or
198         COBOL.To_Ada(TC_Alphanumeric_5)'First /= 1
199      then
200         Report.Failed("Incorrect value returned from function To_Ada - 2");
201      end if;
202
203      TC_Unb_String := Unb.To_Unbounded_String
204                         (COBOL.To_Ada(TC_Alphanumeric_10));
205
206      if TC_Unb_String             /= "1A2B3c4d5F"              or
207         TC_Alphanumeric_10'Length /= Unb.Length(TC_Unb_String) or
208         Unb.Length(TC_Unb_String) /= 10                        or
209         COBOL.To_Ada(TC_Alphanumeric_10)'First /= 1
210      then
211         Report.Failed("Incorrect value returned from function To_Ada - 3");
212      end if;
213
214      TC_String := COBOL.To_Ada(TC_Alphanumeric_20);
215
216      if TC_String                 /= "abcd  ghij1234  7890" or
217         TC_Alphanumeric_20'Length /= TC_String'Length       or
218         TC_String'Length          /= 20                     or
219         COBOL.To_Ada(TC_Alphanumeric_20)'First /= 1
220      then
221         Report.Failed("Incorrect value returned from function To_Ada - 4");
222      end if;
223
224
225      -- Check the two functions when used in combination.
226
227      if COBOL.To_COBOL(Item => COBOL.To_Ada("This is a test")) /=
228         "This is a test"                                         or
229         COBOL.To_COBOL(COBOL.To_Ada("1234567890abcdeFGHIJ"))   /=
230         "1234567890abcdeFGHIJ"
231      then
232         Report.Failed("Incorrect result returned when using the " &
233                       "functions To_Ada and To_COBOL in combination");
234      end if;
235
236
237
238      -- Check that the Ada_to_COBOL and COBOL_to_Ada mapping
239      -- arrays provide a mapping capability between Ada's type
240      -- Character and COBOL run-time character sets.
241
242      Interfaces.COBOL.Ada_To_COBOL('a') := 'A';
243      Interfaces.COBOL.Ada_To_COBOL('b') := 'B';
244      Interfaces.COBOL.Ada_To_COBOL('c') := 'C';
245      Interfaces.COBOL.Ada_To_COBOL('d') := '1';
246      Interfaces.COBOL.Ada_To_COBOL('e') := '2';
247      Interfaces.COBOL.Ada_To_COBOL('f') := '3';
248      Interfaces.COBOL.Ada_To_COBOL(' ') := '*';
249
250      Unb_String         := Unb.To_Unbounded_String("b");
251      TC_Alphanumeric_1  := COBOL.To_COBOL(Unb.To_String(Unb_String));
252
253      if TC_Alphanumeric_1 /= "B" then
254         Report.Failed("Incorrect result from function To_COBOL after " &
255                       "modification to Ada_To_COBOL mapping array - 1");
256      end if;
257
258      Bnd_String         := Bnd.To_Bounded_String("abcde");
259      TC_Alphanumeric_5  := COBOL.To_COBOL(Bnd.To_String(Bnd_String));
260
261      if TC_Alphanumeric_5 /= "ABC12" then
262         Report.Failed("Incorrect result from function To_COBOL after " &
263                       "modification to Ada_To_COBOL mapping array - 2");
264      end if;
265
266      Unb_String         := Unb.To_Unbounded_String("1a2B3c4d5e");
267      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
268
269      if TC_Alphanumeric_10 /= "1A2B3C4152" then
270         Report.Failed("Incorrect result from function To_COBOL after " &
271                       "modification to Ada_To_COBOL mapping array - 3");
272      end if;
273
274      The_String         := "abcd  ghij" & "1234  7890";
275      TC_Alphanumeric_20 := COBOL.To_COBOL(The_String);
276
277      if TC_Alphanumeric_20 /= "ABC1**ghij1234**7890" then
278         Report.Failed("Incorrect result from function To_COBOL after " &
279                       "modification to Ada_To_COBOL mapping array - 4");
280      end if;
281
282
283      -- Reset the Ada_To_COBOL mapping array to its original state.
284
285      Interfaces.COBOL.Ada_To_COBOL('a') := 'a';
286      Interfaces.COBOL.Ada_To_COBOL('b') := 'b';
287      Interfaces.COBOL.Ada_To_COBOL('c') := 'c';
288      Interfaces.COBOL.Ada_To_COBOL('d') := 'd';
289      Interfaces.COBOL.Ada_To_COBOL('e') := 'e';
290      Interfaces.COBOL.Ada_To_COBOL('f') := 'f';
291      Interfaces.COBOL.Ada_To_COBOL(' ') := ' ';
292
293      -- Modify the COBOL_To_Ada mapping array to check its effect on
294      -- the function To_Ada.
295
296      Interfaces.COBOL.COBOL_To_Ada(' ') := '*';
297      Interfaces.COBOL.COBOL_To_Ada('$') := 'F';
298      Interfaces.COBOL.COBOL_To_Ada('1') := '7';
299      Interfaces.COBOL.COBOL_To_Ada('.') := ',';
300
301      Unb_String         := Unb.To_Unbounded_String("  $$100.00");
302      TC_Alphanumeric_10 := COBOL.To_COBOL(Unb.To_String(Unb_String));
303      TC_Unb_String      := Unb.To_Unbounded_String(
304                              COBOL.To_Ada(TC_Alphanumeric_10));
305
306      if Unb.To_String(TC_Unb_String) /= "**FF700,00" then
307         Report.Failed("Incorrect result from function To_Ada after " &
308                       "modification of COBOL_To_Ada mapping array - 1");
309      end if;
310
311      Interfaces.COBOL.COBOL_To_Ada('*') := ' ';
312      Interfaces.COBOL.COBOL_To_Ada('F') := '$';
313      Interfaces.COBOL.COBOL_To_Ada('7') := '1';
314      Interfaces.COBOL.COBOL_To_Ada(',') := '.';
315
316      if COBOL.To_Ada(COBOL.To_COBOL(Unb.To_String(TC_Unb_String))) /=
317         Unb_String
318      then
319         Report.Failed("Incorrect result from function To_Ada after " &
320                       "modification of COBOL_To_Ada mapping array - 2");
321      end if;
322
323
324   exception
325      when The_Error : others =>
326         Report.Failed ("The following exception was raised in the " &
327                        "Test_Block: " & Exception_Name(The_Error));
328   end Test_Block;
329
330   Report.Result;
331
332end CXB4005;
333