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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 294 jeremybenn
-- CXB3011.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 version of Function Value with a chars_ptr parameter
28
--      that returns a String result returns an Ada string containing the
29
--      characters pointed to by the chars_ptr parameter, up to (but not
30
--      including) the terminating nul.
31
--
32
--      Check that the version of Function Value with a chars_ptr parameter
33
--      and a size_t parameter that returns a String result returns the
34
--      shorter of:
35
--        1) a String of the first size_t number of characters, or
36
--        2) a String of characters up to (but not including) the
37
--           terminating nul.
38
--
39
--      Check that the Function Strlen returns a size_t result that
40
--      corresponds to the number of chars in the array pointed to by Item,
41
--      up to but not including the terminating nul.
42
--
43
--      Check that both of the above versions of Function Value and
44
--      Function Strlen propagate Dereference_Error if the Item parameter
45
--      is Null_Ptr.
46
--
47
-- TEST DESCRIPTION:
48
--      This test validates two versions of Function Value, and the Function
49
--      Strlen.  A series of char_ptr values are provided as input, and
50
--      results are compared for length or content.
51
--
52
--      This test assumes that the following characters are all included
53
--      in the implementation defined type Interfaces.C.char:
54
--      ' ', 'a'..'z', 'A'..'Z', '0'..'9', '*' and '.'.
55
--
56
-- APPLICABILITY CRITERIA:
57
--      This test is applicable to all implementations that provide
58
--      package Interfaces.C.Strings.  If an implementation provides
59
--      package Interfaces.C.Strings, this test must compile, execute,
60
--      and report "PASSED".
61
--
62
--
63
-- CHANGE HISTORY:
64
--      28 Sep 95   SAIC    Initial prerelease version.
65
--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
66
--      26 Oct 96   SAIC    Incorporated reviewer comments.
67
--
68
--!
69
 
70
with Report;
71
with Ada.Characters.Latin_1;
72
with Interfaces.C.Strings;                                    -- N/A => ERROR
73
 
74
procedure CXB3011 is
75
begin
76
 
77
   Report.Test ("CXB3011", "Check that the two versions of Function Value " &
78
                           "returning a String result, and the Function "   &
79
                           "Strlen, produce correct results");
80
 
81
   Test_Block:
82
   declare
83
 
84
      package IC   renames Interfaces.C;
85
      package ICS  renames Interfaces.C.Strings;
86
      package ACL1 renames Ada.Characters.Latin_1;
87
 
88
      use type IC.char_array;
89
      use type IC.size_t;
90
      use type ICS.chars_ptr;
91
 
92
      Null_Char_Array_Access : constant ICS.char_array_access := null;
93
 
94
      TC_String              : String(1..5)          := (others => 'X');
95
      TC_String_1            : constant String       := "*.3*0";
96
      TC_String_2            : constant String       := "Two";
97
      TC_String_3            : constant String       := "Five5";
98
      TC_Blank_String        : constant String(1..5) := (others => ' ');
99
 
100
      TC_char_array          : IC.char_array :=
101
                                 IC.To_C(TC_Blank_String, True);
102
      TC_char_array_1        : constant IC.char_array :=
103
                                 IC.To_C(TC_String_1, True);
104
      TC_char_array_2        : constant IC.char_array :=
105
                                 IC.To_C(TC_String_2, True);
106
      TC_char_array_3        : constant IC.char_array :=
107
                                 IC.To_C(TC_String_3, True);
108
      TC_Blank_char_array    : constant IC.char_array :=
109
                                 IC.To_C(TC_Blank_String, True);
110
 
111
      TC_chars_ptr           : ICS.chars_ptr :=
112
                                 ICS.New_Char_Array(TC_Blank_char_array);
113
 
114
      TC_size_t              : IC.size_t := IC.size_t'First;
115
 
116
 
117
   begin
118
 
119
      -- Check that the version of Function Value with a chars_ptr parameter
120
      -- that returns a String result returns an Ada string containing the
121
      -- characters pointed to by the chars_ptr parameter, up to (but not
122
      -- including) the terminating nul.
123
 
124
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_1);
125
      TC_String    := ICS.Value(Item => TC_chars_ptr);
126
 
127
      if TC_String                 /= TC_String_1 or
128
         TC_String(TC_String'Last)  = ACL1.NUL
129
      then
130
         Report.Failed("Incorrect result from Function Value - 1");
131
      end if;
132
 
133
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
134
 
135
      if ICS.Value(Item => TC_chars_ptr) /=
136
         IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
137
      then
138
         Report.Failed("Incorrect result from Function Value - 2");
139
      end if;
140
 
141
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
142
      TC_String    := ICS.Value(TC_chars_ptr);
143
 
144
      if TC_String                 /= TC_String_3 or
145
         TC_String(TC_String'Last)  = ACL1.NUL
146
      then
147
         Report.Failed("Incorrect result from Function Value - 3");
148
      end if;
149
 
150
 
151
      -- Check that the version of Function Value with a chars_ptr parameter
152
      -- and a size_t parameter that returns a String result returns the
153
      -- shorter of:
154
      --   1) a String of the first size_t number of characters, or
155
      --   2) a String of characters up to (but not including) the
156
      --      terminating nul.
157
      --
158
 
159
      -- Case 1 : Length parameter specifies a length shorter than total
160
      --          length.
161
 
162
      TC_chars_ptr    := ICS.New_Char_Array(TC_char_array_1);
163
      TC_String       := "XXXXX";  -- Reinitialize all characters in string.
164
      TC_String(1..5) := ICS.Value(Item => TC_chars_ptr, Length => 6);
165
 
166
      if TC_String(1..4)           /= TC_String_1(1..4) or
167
         TC_String(TC_String'Last)  = ACL1.NUL
168
      then
169
         Report.Failed("Incorrect result from Function Value - 4");
170
      end if;
171
 
172
      -- Case 2 : Length parameter specifies total length.
173
 
174
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
175
 
176
      if ICS.Value(TC_chars_ptr, Length => 5) /=
177
         IC.To_Ada(ICS.Value(TC_chars_ptr), Trim_Nul => True)
178
      then
179
         Report.Failed("Incorrect result from Function Value - 5");
180
      end if;
181
 
182
      -- Case 3 : Length parameter specifies a length longer than total
183
      --          length.
184
 
185
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_3);
186
      TC_String    := "XXXXX";  -- Reinitialize all characters in string.
187
      TC_String    := ICS.Value(TC_chars_ptr, 7);
188
 
189
      if TC_String                 /= TC_String_3 or
190
         TC_String(TC_String'Last)  = ACL1.NUL
191
      then
192
         Report.Failed("Incorrect result from Function Value - 6");
193
      end if;
194
 
195
 
196
      -- Check that the Function Strlen returns a size_t result that
197
      -- corresponds to the number of chars in the array pointed to by
198
      -- parameter Item, up to but not including the terminating nul.
199
 
200
      TC_chars_ptr := ICS.New_Char_Array(IC.To_C("A longer string value"));
201
      TC_size_t    := ICS.Strlen(TC_chars_ptr);
202
 
203
      if TC_size_t /= 21 then
204
         Report.Failed("Incorrect result from Function Strlen - 1");
205
      end if;
206
 
207
      TC_chars_ptr := ICS.New_Char_Array(TC_char_array_2);
208
      TC_size_t    := ICS.Strlen(TC_chars_ptr);
209
 
210
      if TC_size_t /= 3 then  -- Nul not included in length.
211
         Report.Failed("Incorrect result from Function Strlen - 2");
212
      end if;
213
 
214
      TC_chars_ptr := ICS.New_Char_Array(IC.To_C(""));
215
      TC_size_t    := ICS.Strlen(TC_chars_ptr);
216
 
217
      if TC_size_t /= 0 then
218
         Report.Failed("Incorrect result from Function Strlen - 3");
219
      end if;
220
 
221
 
222
      -- Check that both of the above versions of Function Value and
223
      -- function Strlen propagate Dereference_Error if the Item parameter
224
      -- is Null_Ptr.
225
 
226
      begin
227
         TC_chars_ptr := ICS.Null_Ptr;
228
         TC_String    := ICS.Value(Item => TC_chars_ptr);
229
         Report.Failed("Function Value (without Length parameter) did not " &
230
                       "raise Dereference_Error when provided a null Item " &
231
                       "parameter input value");
232
         if TC_String(1) = '1' then   -- Defeat optimization.
233
            Report.Comment("Should never be printed");
234
         end if;
235
      exception
236
         when ICS.Dereference_Error => null;  -- OK, expected exception.
237
         when others                =>
238
           Report.Failed("Incorrect exception raised by Function Value " &
239
                         "with Item parameter, when the Item parameter " &
240
                         "is Null_Ptr");
241
      end;
242
 
243
      begin
244
         TC_chars_ptr := ICS.Null_Ptr;
245
         TC_String    := ICS.Value(Item => TC_chars_ptr, Length => 4);
246
         Report.Failed("Function Value (with Length parameter) did not "    &
247
                       "raise Dereference_Error when provided a null Item " &
248
                       "parameter input value");
249
         if TC_String(1) = '1' then   -- Defeat optimization.
250
            Report.Comment("Should never be printed");
251
         end if;
252
      exception
253
         when ICS.Dereference_Error => null;  -- OK, expected exception.
254
         when others                =>
255
           Report.Failed("Incorrect exception raised by Function Value " &
256
                         "with both Item and Length parameters, when "   &
257
                         "the Item parameter is Null_Ptr");
258
      end;
259
 
260
      begin
261
         TC_chars_ptr := ICS.Null_Ptr;
262
         TC_size_t    := ICS.Strlen(Item => TC_chars_ptr);
263
         Report.Failed("Function Strlen did not raise Dereference_Error" &
264
                       "when provided a null Item parameter input value");
265
         if TC_size_t = 35 then   -- Defeat optimization.
266
            Report.Comment("Should never be printed");
267
         end if;
268
      exception
269
         when ICS.Dereference_Error => null;  -- OK, expected exception.
270
         when others                =>
271
           Report.Failed("Incorrect exception raised by Function Strlen " &
272
                         "when the Item parameter is Null_Ptr");
273
      end;
274
 
275
 
276
   exception
277
      when others => Report.Failed ("Exception raised in Test_Block");
278
   end Test_Block;
279
 
280
   Report.Result;
281
 
282
end CXB3011;

powered by: WebSVN 2.1.0

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