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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxb/] [cxb3005.a] - Blame information for rev 294

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXB3005.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_C converts the character elements of
28
--      a string parameter into char elements of the char_array parameter
29
--      Target, with nul termination if parameter Append_Nul is true.
30
--
31
--      Check that the out parameter Count of procedure To_C is set to the
32
--      appropriate value for both the nul/no nul terminated cases.
33
--
34
--      Check that Constraint_Error is propagated by procedure To_C if the
35
--      length of the char_array parameter Target is not sufficient to
36
--      hold the converted string value.
37
--
38
--      Check that the Procedure To_Ada converts char elements of the
39
--      char_array parameter Item to the corresponding character elements
40
--      of string out parameter Target.
41
--
42
--      Check that Constraint_Error is propagated by Procedure To_Ada if the
43
--      length of string parameter Target is not long enough to hold the
44
--      converted char_array value.
45
--
46
--      Check that Terminator_Error is propagated by Procedure To_Ada if the
47
--      parameter Trim_Nul is set to True, but the actual Item parameter
48
--      contains no nul char.
49
--
50
-- TEST DESCRIPTION:
51
--      This test uses a variety of String, and char_array objects to test
52
--      versions of the To_C and To_Ada procedures.
53
--
54
--      This test assumes that the following characters are all included
55
--      in the implementation defined type Interfaces.C.char:
56
--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '-'.
57
--
58
-- APPLICABILITY CRITERIA:
59
--      This test is applicable to all implementations that provide
60
--      package Interfaces.C.  If an implementation provides
61
--      package Interfaces.C, this test must compile, execute, and
62
--      report "PASSED".
63
--
64
-- CHANGE HISTORY:
65
--      01 Sep 95   SAIC    Initial prerelease version.
66
--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
67
--      26 Oct 96   SAIC    Incorporated reviewer comments.
68
--      14 Sep 99   RLB     Removed incorrect and unnecessary
69
--                          Unchecked_Conversion.
70
--
71
--!
72
 
73
with Report;
74
with Interfaces.C;                                            -- N/A => ERROR
75
with Ada.Characters.Latin_1;
76
with Ada.Exceptions;
77
with Ada.Strings.Fixed;
78
 
79
procedure CXB3005 is
80
begin
81
 
82
   Report.Test ("CXB3005", "Check that the procedures To_C and To_Ada " &
83
                           "produce correct results");
84
   Test_Block:
85
   declare
86
 
87
      use Interfaces, Interfaces.C;
88
      use Ada.Characters;
89
      use Ada.Exceptions;
90
      use Ada.Strings.Fixed;
91
 
92
      TC_Short_String  : String(1..4)     := (others => 'x');
93
      TC_String        : String(1..8)     := (others => 'y');
94
      TC_char_array    : char_array(0..7) := (others => char'Last);
95
      TC_size_t_Count  : size_t           := size_t'First;
96
      TC_Natural_Count : Natural          := Natural'First;
97
 
98
 
99
      -- We can use the character forms of To_Ada and To_C here to check
100
      -- the results; they were tested in CXB3004. We give them different
101
      -- names to avoid confusion below.
102
 
103
      function Character_to_char (Source : in Character) return char
104
          renames To_C;
105
      function char_to_Character (Source : in char) return Character
106
          renames To_Ada;
107
 
108
   begin
109
 
110
      -- Check that the procedure To_C converts the character elements of
111
      -- a string parameter into char elements of char_array out parameter
112
      -- Target.
113
      --
114
      -- Case of nul termination.
115
 
116
      TC_String(1..6) := "abcdef";
117
 
118
      To_C (Item       => TC_String(1..6),  -- Source slice of length 6.
119
            Target     => TC_char_array,    -- Length 8 will accommodate nul.
120
            Count      => TC_size_t_Count,
121
            Append_Nul => True);
122
 
123
      -- Check that the out parameter Count is set to the appropriate value
124
      -- for the nul terminated case.
125
 
126
      if TC_size_t_Count /= 7 then
127
         Report.Failed("Incorrect setting of out parameter Count by " &
128
                       "Procedure To_C when Append_Nul => True");
129
      end if;
130
 
131
      for i in 1..TC_size_t_Count-1 loop
132
         if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
133
         then
134
            Report.Failed("Incorrect result from Procedure To_C when " &
135
                          "checking individual char values, case of "  &
136
                          "Append_Nul => True; "                       &
137
                          "char position = " & Integer'Image(Integer(i)));
138
         end if;
139
      end loop;
140
 
141
      if not Is_Nul_Terminated(TC_char_array) then
142
         Report.Failed("No nul char appended to the char_array result " &
143
                       "from Procedure To_C when Append_Nul => True");
144
      end if;
145
 
146
      if TC_char_array(0..6) /= To_C("abcdef", True) then
147
         Report.Failed("Incorrect result from Procedure To_C when "   &
148
                       "directly comparing char_array results, case " &
149
                       "of Append_Nul => True");
150
      end if;
151
 
152
 
153
      -- Check Procedure To_C with no nul termination.
154
 
155
      TC_char_array   := (others => Character_to_char('M')); -- Reinitialize.
156
      TC_String(1..4) := "WXYZ";
157
 
158
      To_C (Item       => TC_String(1..4),  -- Source slice of length 4.
159
            Target     => TC_char_array,
160
            Count      => TC_size_t_Count,
161
            Append_Nul => False);
162
 
163
      -- Check that the out parameter Count is set to the appropriate value
164
      -- for the non-nul terminated case.
165
 
166
      if TC_size_t_Count /= 4 then
167
         Report.Failed("Incorrect setting of out parameter Count by " &
168
                       "Procedure To_C when Append_Nul => False");
169
      end if;
170
 
171
      for i in 1..TC_size_t_Count loop
172
         if char_to_Character(TC_char_array(i-1)) /= TC_String(Integer(i))
173
         then
174
            Report.Failed("Incorrect result from Procedure To_C when " &
175
                          "checking individual char values, case of "  &
176
                          "Append_Nul => False; "                      &
177
                          "char position = " & Integer'Image(Integer(i)));
178
         end if;
179
      end loop;
180
 
181
      if Is_Nul_Terminated(TC_char_array) then
182
         Report.Failed("The nul char was appended to the char_array " &
183
                       "result of Procedure To_C when Append_Nul => False");
184
      end if;
185
 
186
      if TC_char_array(0..3) /= To_C("WXYZ", False) then
187
         Report.Failed("Incorrect result from Procedure To_C when "   &
188
                       "directly comparing char_array results, case " &
189
                       "of Append_Nul => False");
190
      end if;
191
 
192
 
193
 
194
      -- Check that Constraint_Error is raised by procedure To_C if the
195
      -- length of the target char_array parameter is not sufficient to
196
      -- hold the converted string value (plus nul if Append_Nul is True).
197
 
198
      begin
199
         To_C("A string too long",
200
              TC_char_array,
201
              TC_size_t_Count,
202
              Append_Nul => True);
203
 
204
         Report.Failed("Constraint_Error not raised when the Target " &
205
                       "parameter of Procedure To_C is not long enough " &
206
                       "to hold the converted string");
207
         Report.Comment(char_to_Character(TC_char_array(0)) &
208
                        " printed to defeat optimization");
209
      exception
210
         when Constraint_Error => null;  -- OK, expected exception.
211
         when others           =>
212
            Report.Failed("Incorrect exception raised by Procedure "    &
213
                          "To_C when the Target parameter is not long " &
214
                          "enough to contain the char_array result");
215
      end;
216
 
217
 
218
 
219
      -- Check that the procedure To_Ada converts char elements of the
220
      -- char_array parameter Item to the corresponding character elements
221
      -- of string out parameter Target, with result string length based on
222
      -- the Trim_Nul parameter.
223
      --
224
      -- Case of appended nul char on the char_array In parameter.
225
 
226
      TC_char_array := To_C ("ACVC-95", Append_Nul => True); -- 8 total chars.
227
      TC_String     := (others => '*');                      -- Reinitialize.
228
 
229
      To_Ada (Item     => TC_char_array,
230
              Target   => TC_String,
231
              Count    => TC_Natural_Count,
232
              Trim_Nul => False);
233
 
234
      if TC_Natural_Count /= 8 then
235
         Report.Failed("Incorrect value returned in out parameter Count " &
236
                       "by Procedure To_Ada, case of Trim_Nul => False");
237
      end if;
238
 
239
      for i in 1..TC_Natural_Count loop
240
         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
241
         then
242
            Report.Failed("Incorrect result from Procedure To_Ada when " &
243
                          "checking individual char values, case of "    &
244
                          "Trim_Nul => False, when a nul is present in " &
245
                          "the char_array input parameter; "             &
246
                          "position = " & Integer'Image(Integer(i)));
247
         end if;
248
      end loop;
249
 
250
      if TC_String(TC_Natural_Count) /= Latin_1.Nul then
251
         Report.Failed("Last character of String result of Procedure "     &
252
                       "To_Ada is not Nul, even though a nul was present " &
253
                       "in the char_array argument, and the Trim_Nul "     &
254
                       "parameter was set to False");
255
      end if;
256
 
257
 
258
      TC_char_array(0..3) := To_C ("XYz", Append_Nul => True); -- 4 chars.
259
      TC_String           := (others => '*');                  -- Reinit.
260
 
261
      To_Ada (Item     => TC_char_array,
262
              Target   => TC_String,
263
              Count    => TC_Natural_Count,
264
              Trim_Nul => True);
265
 
266
      if TC_Natural_Count /= 3 then
267
         Report.Failed("Incorrect value returned in out parameter Count " &
268
                       "by Procedure To_Ada, case of Trim_Nul => True");
269
      end if;
270
 
271
      for i in 1..TC_Natural_Count loop
272
         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
273
         then
274
            Report.Failed("Incorrect result from Procedure To_Ada when " &
275
                          "checking individual char values, case of "    &
276
                          "Trim_Nul => True, when a nul is present in "  &
277
                          "the char_array input parameter; "             &
278
                          "position = " & Integer'Image(Integer(i)));
279
         end if;
280
      end loop;
281
 
282
      if TC_String(TC_Natural_Count) = Latin_1.Nul then
283
         Report.Failed("Last character of String result of Procedure " &
284
                       "To_Ada is  Nul, even though the Trim_Nul "     &
285
                       "parameter was set to True");
286
      end if;
287
 
288
      -- Check that TC_String(TC_Natural_Count+1) is unchanged by procedure
289
      -- To_Ada.
290
 
291
      if TC_String(TC_Natural_Count+1) /= '*' then
292
         Report.Failed("Incorrect modification to TC_String at position " &
293
                       Integer'Image(TC_Natural_Count+1) & " expected = " &
294
                       "*, found = " & TC_String(TC_Natural_Count+1));
295
      end if;
296
 
297
 
298
      -- Case of no nul char being present in the char_array argument.
299
 
300
      TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
301
      TC_String     := (others => '*');                  -- Reinitialize.
302
 
303
      To_Ada (Item     => TC_char_array,
304
              Target   => TC_String,
305
              Count    => TC_Natural_Count,
306
              Trim_Nul => False);
307
 
308
      if TC_Natural_Count /= 8 then
309
         Report.Failed("Incorrect value returned in out parameter Count " &
310
                       "by Procedure To_Ada, case of Trim_Nul => False, " &
311
                       "with no nul char present in the parameter Item");
312
      end if;
313
 
314
      for i in 1..TC_Natural_Count loop
315
         if Character_to_char(TC_String(i)) /= TC_char_array(size_t(i-1))
316
         then
317
            Report.Failed("Incorrect result from Procedure To_Ada when "  &
318
                          "checking individual char values, case of "     &
319
                          "Trim_Nul => False, when a nul is not present " &
320
                          "in the char_array input parameter; "           &
321
                          "position = " & Integer'Image(Integer(i)));
322
         end if;
323
      end loop;
324
 
325
      if TC_String(TC_Natural_Count) = Latin_1.Nul then
326
         Report.Failed("Last character of String result of Procedure " &
327
                       "To_Ada is Nul, even though the nul char was "  &
328
                       "not present in the parameter Item, with the "  &
329
                       "parameter Trim_Nul => False");
330
      end if;
331
 
332
 
333
 
334
      -- Check that the Procedure To_Ada raises Terminator_Error if the
335
      -- parameter Trim_Nul is set to True, but the actual Item parameter
336
      -- does not contain the nul char.
337
 
338
      begin
339
         TC_char_array := To_C ("ABCDWXYZ", Append_Nul => False);
340
         TC_String     := (others => '*');
341
 
342
         To_Ada(TC_char_array,
343
                TC_String,
344
                Count    => TC_Natural_Count,
345
                Trim_Nul => True);
346
 
347
         Report.Failed("Terminator_Error not raised when Item "    &
348
                       "parameter of To_Ada does not contain the " &
349
                       "nul char, but parameter Trim_Nul => True");
350
         Report.Comment(TC_String & " printed to defeat optimization");
351
      exception
352
         when Terminator_Error => null;  -- OK, expected exception.
353
         when others           =>
354
            Report.Failed("Incorrect exception raised by Procedure " &
355
                          "To_Ada when the Item parameter does not " &
356
                          "contain the nul char, but parameter "     &
357
                          "Trim_Nul => True");
358
      end;
359
 
360
 
361
 
362
      -- Check that Constraint_Error is propagated by procedure To_Ada if the
363
      -- length of string parameter Target is not long enough to hold the
364
      -- converted char_array value (plus nul if Trim_Nul is False).
365
 
366
      begin
367
         TC_char_array(0..4) := To_C ("ABCD", Append_Nul => True);
368
 
369
         To_Ada(TC_char_array(0..4),   -- 4 chars plus nul char.
370
                TC_Short_String,       -- Length of 4.
371
                Count    => TC_Natural_Count,
372
                Trim_Nul => False);
373
 
374
         Report.Failed("Constraint_Error not raised when string "     &
375
                       "parameter Target of Procedure To_Ada is not " &
376
                       "long enough to hold the converted chars");
377
         Report.Comment(TC_Short_String & " printed to defeat optimization");
378
      exception
379
         when Constraint_Error => null;  -- OK, expected exception.
380
         when others           =>
381
            Report.Failed("Incorrect exception raised by Procedure " &
382
                          "To_Ada when string parameter Target is "  &
383
                          "not long enough to hold the converted chars");
384
      end;
385
 
386
 
387
 
388
   exception
389
      when The_Error : others =>
390
         Report.Failed ("The following exception was raised in the " &
391
                        "Test_Block: " & Exception_Name(The_Error));
392
   end Test_Block;
393
 
394
   Report.Result;
395
 
396
end CXB3005;

powered by: WebSVN 2.1.0

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