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/] [cxb3007.a] - Blame information for rev 294

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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