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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXB30041.AM
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 functions To_C and To_Ada map between the Ada type
28
--      Character and the C type char.
29
--
30
--      Check that the function Is_Nul_Terminated returns True if the
31
--      char_array parameter contains nul, and otherwise False.
32
--
33
--      Check that the function To_C produces a correct char_array result,
34
--      with lower bound of 0, and length dependent upon the Item and
35
--      Append_Nul parameters.
36
--
37
--      Check that the function To_Ada produces a correct string result, with
38
--      lower bound of 1, and length dependent upon the Item and Trim_Nul
39
--      parameters.
40
--
41
--      Check that the function To_Ada raises Terminator_Error if the
42
--      parameter Trim_Nul is set to True, but the actual Item parameter
43
--      does not contain the nul char.
44
--
45
-- TEST DESCRIPTION:
46
--      This test uses a variety of Character, char, String, and char_array
47
--      objects to test versions of the To_C, To_Ada, and Is_Nul_Terminated
48
--      functions.
49
--
50
--      This test assumes that the following characters are all included
51
--      in the implementation defined type Interfaces.C.char:
52
--      ' ', ',', '.', '0'..'9', 'a'..'z' and 'A'..'Z'.
53
--
54
-- APPLICABILITY CRITERIA:
55
--      This test is applicable to all implementations that provide
56
--      package Interfaces.C.  If an implementation provides
57
--      package Interfaces.C, this test must compile, execute, and
58
--      report "PASSED".
59
--
60
-- SPECIAL REQUIREMENTS:
61
--      The file CXB30040.C must be compiled with a C compiler.
62
--      Implementation dialects of C may require alteration of
63
--      the C program syntax (see individual C files).
64
--
65
--      Note that the compiled C code must be bound with the compiled Ada
66
--      code to create an executable image.  An implementation must provide
67
--      the necessary commands to accomplish this.
68
--
69
--      Note that the C code included in CXB30040.C conforms
70
--      to ANSI-C.  Modifications to these files may be required for other
71
--      C compilers.  An implementation must provide the necessary
72
--      modifications to satisfy the function requirements.
73
--
74
-- TEST FILES:
75
--      The following files comprise this test:
76
--
77
--         CXB30040.C
78
--         CXB30041.AM
79
--
80
-- CHANGE HISTORY:
81
--      30 Aug 95   SAIC    Initial prerelease version.
82
--      09 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
83
--      26 Oct 96   SAIC    Incorporated reviewer comments.
84
--      13 Sep 99   RLB     Replaced (bogus) Unchecked_Conversions with a
85
--                          C function character generator.
86
--
87
--!
88
 
89
with Report;
90
with Interfaces.C;                                            -- N/A => ERROR
91
with Ada.Characters.Latin_1;
92
with Ada.Exceptions;
93
with Ada.Strings.Fixed;
94
with Impdef;
95
 
96
procedure CXB30041 is
97
begin
98
 
99
   Report.Test ("CXB3004", "Check that the functions To_C and To_Ada " &
100
                           "produce correct results");
101
 
102
   Test_Block:
103
   declare
104
 
105
      use Interfaces, Interfaces.C;
106
      use Ada.Characters, Ada.Characters.Latin_1;
107
      use Ada.Exceptions;
108
      use Ada.Strings.Fixed;
109
 
110
      Start_Character,
111
      Stop_Character,
112
      TC_Character    : Character         := Character'First;
113
      TC_char,
114
      TC_Low_char,
115
      TC_High_char    : char              := char'First;
116
      TC_String       : String(1..8)      := (others => Latin_1.NUL);
117
      TC_char_array   : char_array(0..7)  := (others => C.nul);
118
 
119
      -- The function Char_Gen returns a character corresponding to its
120
      -- argument.
121
      --     Value   0 ..  9 ==> '0' .. '9'
122
      --     Value  10 .. 19 ==> 'A' .. 'J'
123
      --     Value  20 .. 29 ==> 'k' .. 't'
124
      --     Value  30       ==> ' '
125
      --     Value  31       ==> '.'
126
      --     Value  32       ==> ','
127
 
128
      function Char_Gen (Value   : in int) return char;
129
 
130
      -- Use the user-defined C function char_gen as a completion to the
131
      -- function specification above.
132
 
133
      pragma Import (Convention    => C,
134
                     Entity        => Char_Gen,
135
                     External_Name => Impdef.CXB30040_External_Name);
136
 
137
   begin
138
 
139
      -- Check that the functions To_C and To_Ada map between the Ada type
140
      -- Character and the C type char.
141
 
142
      if To_C(Ada.Characters.Latin_1.NUL) /= Interfaces.C.nul then
143
         Report.Failed("Incorrect result from To_C with NUL character input");
144
      end if;
145
 
146
      Start_Character := Report.Ident_Char('k');
147
      Stop_Character  := Report.Ident_Char('t');
148
      for TC_Character in Start_Character..Stop_Character loop
149
         if To_C(Item => TC_Character) /=
150
            Char_Gen(Character'Pos(TC_Character) - Character'Pos('k') + 20) then
151
            Report.Failed("Incorrect result from To_C with lower case " &
152
                          "alphabetic character input");
153
         end if;
154
      end loop;
155
 
156
      Start_Character := Report.Ident_Char('A');
157
      Stop_Character  := Report.Ident_Char('J');
158
      for TC_Character in Start_Character..Stop_Character loop
159
         if To_C(Item => TC_Character) /=
160
            Char_Gen(Character'Pos(TC_Character) - Character'Pos('A') + 10) then
161
            Report.Failed("Incorrect result from To_C with upper case " &
162
                          "alphabetic character input");
163
         end if;
164
      end loop;
165
 
166
      Start_Character := Report.Ident_Char('0');
167
      Stop_Character  := Report.Ident_Char('9');
168
      for TC_Character in Start_Character..Stop_Character loop
169
         if To_C(Item => TC_Character) /=
170
            Char_Gen(Character'Pos(TC_Character) - Character'Pos('0')) then
171
            Report.Failed("Incorrect result from To_C with digit " &
172
                          "character input");
173
         end if;
174
      end loop;
175
      if To_C(Item => ' ') /= Char_Gen(30) then
176
         Report.Failed("Incorrect result from To_C with space " &
177
                       "character input");
178
      end if;
179
      if To_C(Item => '.') /= Char_Gen(31) then
180
         Report.Failed("Incorrect result from To_C with dot " &
181
                       "character input");
182
      end if;
183
      if To_C(Item => ',') /= Char_Gen(32) then
184
         Report.Failed("Incorrect result from To_C with comma " &
185
                       "character input");
186
      end if;
187
 
188
      if To_Ada(Interfaces.C.nul) /= Ada.Characters.Latin_1.NUL then
189
         Report.Failed("Incorrect result from To_Ada with nul char input");
190
      end if;
191
 
192
      for Code in int range
193
         int(Report.Ident_Int(20)) .. int(Report.Ident_Int(29)) loop
194
            -- 'k' .. 't'
195
         if To_Ada(Item => Char_Gen(Code)) /=
196
            Character'Val (Character'Pos('k') + (Code - 20)) then
197
            Report.Failed("Incorrect result from To_Ada with lower case " &
198
                          "alphabetic char input");
199
         end if;
200
      end loop;
201
 
202
      for Code in int range
203
         int(Report.Ident_Int(10)) .. int(Report.Ident_Int(19)) loop
204
            -- 'A' .. 'J'
205
         if To_Ada(Item => Char_Gen(Code)) /=
206
            Character'Val (Character'Pos('A') + (Code - 10)) then
207
            Report.Failed("Incorrect result from To_Ada with upper case " &
208
                          "alphabetic char input");
209
         end if;
210
      end loop;
211
 
212
      for Code in int range
213
         int(Report.Ident_Int(0)) .. int(Report.Ident_Int(9)) loop
214
            -- '0' .. '9'
215
         if To_Ada(Item => Char_Gen(Code)) /=
216
            Character'Val (Character'Pos('0') + (Code)) then
217
            Report.Failed("Incorrect result from To_Ada with digit " &
218
                          "char input");
219
         end if;
220
      end loop;
221
 
222
      if To_Ada(Item => Char_Gen(30)) /= ' ' then
223
         Report.Failed("Incorrect result from To_Ada with space " &
224
                       "char input");
225
      end if;
226
      if To_Ada(Item => Char_Gen(31)) /= '.' then
227
         Report.Failed("Incorrect result from To_Ada with dot " &
228
                       "char input");
229
      end if;
230
      if To_Ada(Item => Char_Gen(32)) /= ',' then
231
         Report.Failed("Incorrect result from To_Ada with comma " &
232
                       "char input");
233
      end if;
234
 
235
      -- Check that the function Is_Nul_Terminated produces correct results
236
      -- whether or not the char_array argument contains the
237
      -- Ada.Interfaces.C.nul character.
238
 
239
      TC_String := "abcdefgh";
240
      if Is_Nul_Terminated(Item => To_C(TC_String, Append_Nul => False)) then
241
         Report.Failed("Incorrect result from Is_Nul_Terminated when no " &
242
                       "nul char is present");
243
      end if;
244
 
245
      if not Is_Nul_Terminated(To_C(TC_String, Append_Nul => True)) then
246
         Report.Failed("Incorrect result from Is_Nul_Terminated when the " &
247
                       "nul char is present");
248
      end if;
249
 
250
 
251
      -- Now that we've tested the character/char versions of To_Ada and To_C,
252
      -- use them to test the string versions.
253
 
254
      declare
255
         i                    : size_t  := 0;
256
         j                    : integer := 1;
257
         Incorrect_Conversion : Boolean := False;
258
 
259
         TC_No_nul       : constant char_array := To_C(TC_String, False);
260
         TC_nul_Appended : constant char_array := To_C(TC_String, True);
261
      begin
262
 
263
         -- Check that the function To_C produces a char_array result with
264
         -- lower bound of 0, and length dependent upon the Item and
265
         -- Append_Nul parameters (if Append_Nul is True, length is
266
         -- Item'Length + 1; if False, length is Item'Length).
267
 
268
         if TC_No_nul'First /= 0 or TC_nul_Appended'First /= 0 then
269
            Report.Failed("Incorrect lower bound from Function To_C");
270
         end if;
271
 
272
         if TC_No_nul'Length /= TC_String'Length then
273
            Report.Failed("Incorrect length returned from Function To_C " &
274
                          "when Append_Nul => False");
275
         end if;
276
 
277
         for TC_char in Report.Ident_Char('a')..Report.Ident_Char('h') loop
278
            if TC_No_nul(i)       /= To_C(TC_char) or -- Single character To_C.
279
               TC_nul_Appended(i) /= To_C(TC_char) then
280
               Incorrect_Conversion := True;
281
            end if;
282
            i := i + 1;
283
         end loop;
284
 
285
         if Incorrect_Conversion then
286
            Report.Failed("Incorrect result from To_C with string input " &
287
                          "and char_array result");
288
         end if;
289
 
290
 
291
         if TC_nul_Appended'Length /= TC_String'Length + 1 then
292
            Report.Failed("Incorrect length returned from Function To_C " &
293
                          "when Append_Nul => True");
294
         end if;
295
 
296
         if not Is_Nul_Terminated(TC_nul_Appended) then
297
            Report.Failed("No nul appended to the string parameter during " &
298
                          "conversion to char_array by function To_C");
299
         end if;
300
 
301
 
302
         -- Check that the function To_Ada produces a string result with
303
         -- lower bound of 1, and length dependent upon the Item and
304
         -- Trim_Nul parameters (if Trim_Nul is False, length is Item'Length;
305
         -- if True, length will be the length of the slice of Item prior to
306
         -- the first nul).
307
 
308
         declare
309
            TC_No_NUL_String       : constant String :=
310
                                       To_Ada(Item     => TC_nul_Appended,
311
                                              Trim_Nul => True);
312
            TC_NUL_Appended_String : constant String :=
313
                                       To_Ada(TC_nul_Appended, False);
314
         begin
315
 
316
            if TC_No_NUL_String'First       /= 1 or
317
               TC_NUL_Appended_String'First /= 1
318
            then
319
               Report.Failed("Incorrect lower bound from Function To_Ada");
320
            end if;
321
 
322
            if TC_No_NUL_String'Length /= TC_String'Length then
323
               Report.Failed("Incorrect length returned from Function " &
324
                             "To_Ada when Trim_Nul => True");
325
            end if;
326
 
327
            if TC_NUL_Appended_String'Length /= TC_String'Length + 1 then
328
               Report.Failed("Incorrect length returned from Function " &
329
                             "To_Ada when Trim_Nul => False");
330
            end if;
331
 
332
            Start_Character := Report.Ident_Char('a');
333
            Stop_Character  := Report.Ident_Char('h');
334
            for TC_Character in Start_Character..Stop_Character loop
335
               if TC_No_NUL_String(j)       /= TC_Character or
336
                  TC_NUL_Appended_String(j) /= TC_Character
337
               then
338
                  Report.Failed("Incorrect result from To_Ada with " &
339
                                "char_array input, index = "         &
340
                                Integer'Image(j));
341
               end if;
342
               j := j + 1;
343
            end loop;
344
 
345
         end;
346
 
347
 
348
         -- Check that the function To_Ada raises Terminator_Error if the
349
         -- parameter Trim_Nul is set to True, but the actual Item parameter
350
         -- does not contain the nul char.
351
 
352
         begin
353
            TC_String := To_Ada(TC_No_nul, Trim_Nul => True);
354
            Report.Failed("Terminator_Error not raised when Item "    &
355
                          "parameter of To_Ada does not contain the " &
356
                          "nul char, but parameter Trim_Nul => True");
357
            Report.Comment(TC_String & " printed to defeat optimization");
358
         exception
359
            when Terminator_Error => null;  -- OK, expected exception.
360
            when others           =>
361
               Report.Failed("Incorrect exception raised by function "  &
362
                             "To_Ada when the Item parameter does not " &
363
                             "contain the nul char, but parameter "     &
364
                             "Trim_Nul => True");
365
         end;
366
 
367
      end;
368
 
369
   exception
370
      when The_Error : others =>
371
         Report.Failed ("The following exception was raised in the " &
372
                        "Test_Block: " & Exception_Name(The_Error));
373
   end Test_Block;
374
 
375
   Report.Result;
376
 
377
end CXB30041;

powered by: WebSVN 2.1.0

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