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
83with Report;
84with Ada.Strings.Bounded;
85with Ada.Strings.Unbounded;
86with Interfaces.COBOL;                                          -- N/A => ERROR
87
88procedure CXB4002 is
89begin
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
308end CXB4002;
309