OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxb/] [cxb4002.a] - Blame information for rev 816

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.