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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- CXB3014.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 Function Value with Pointer and Element
28
--      parameters will return an Element_Array result of correct size
29
--      and content (up to and including the first "terminator" Element).
30
--
31
--      Check that the Function Value with Pointer and Length parameters
32
--      will return an Element_Array result of appropriate size and content
33
--      (the first Length elements pointed to by the parameter Ref).
34
--
35
--      Check that both versions of Function Value will propagate
36
--      Interfaces.C.Strings.Dereference_Error when the value of
37
--      the Ref pointer parameter is null.
38
--
39
-- TEST DESCRIPTION:
40
--      This test tests that both versions of Function Value from the
41
--      generic package Interfaces.C.Pointers are available and produce
42
--      correct results.  The generic package is instantiated with size_t,
43
--      char, char_array, and nul as actual parameters, and subtests are
44
--      performed on each of the Value functions resulting from this
45
--      instantiation.
46
--      For both function versions, a test is performed where a portion of
47
--      a char_array is to be returned as the function result.  Likewise,
48
--      a test is performed where each version of the function returns the
49
--      entire char_array referenced by the in parameter Ref.
50
--      Finally, both versions of Function Value are called with a null
51
--      pointer reference, to ensure that Dereference_Error is raised in
52
--      this case.
53
--
54
--      This test assumes that the following characters are all included
55
--      in the implementation defined type Interfaces.C.char:
56
--      ' ', 'a'..'z', and 'A'..'Z'.
57
--
58
-- APPLICABILITY CRITERIA:
59
--      This test is applicable to all implementations that provide
60
--      packages Interfaces.C.Strings and Interfaces.C.Pointers.  If an
61
--      implementation provides packages Interfaces.C.Strings and
62
--      Interfaces.C.Pointers, this test must compile, execute, and
63
--      report "PASSED".
64
--
65
--
66
-- CHANGE HISTORY:
67
--      19 Oct 95   SAIC    Initial prerelease version.
68
--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
69
--      23 Oct 96   SAIC    Incorporated reviewer comments.
70
--
71
--!
72
 
73
with Report;
74
with Interfaces.C.Strings;                                    -- N/A => ERROR
75
with Interfaces.C.Pointers;                                   -- N/A => ERROR
76
 
77
procedure CXB3014 is
78
 
79
begin
80
 
81
   Report.Test ("CXB3014", "Check that versions of the Value function "  &
82
                           "from package Interfaces.C.Pointers produce " &
83
                           "correct results");
84
 
85
   Test_Block:
86
   declare
87
 
88
      use type Interfaces.C.char, Interfaces.C.size_t;
89
 
90
      Char_a : constant Interfaces.C.char := 'a';
91
      Char_j : constant Interfaces.C.char := 'j';
92
      Char_z : constant Interfaces.C.char := 'z';
93
 
94
      subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;
95
      subtype Char_Range       is Interfaces.C.size_t range 0..26;
96
 
97
      Local_nul       : aliased Interfaces.C.char := Interfaces.C.nul;
98
      TC_Array_Size   : Interfaces.C.size_t := 20;
99
 
100
      TC_String_1     : constant String := "abcdefghij";
101
      TC_String_2     : constant String := "abcdefghijklmnopqrstuvwxyz";
102
      TC_String_3     : constant String := "abcdefghijklmnopqrst";
103
      TC_String_4     : constant String := "abcdefghijklmnopqrstuvwxyz";
104
      TC_Blank_String : constant String := "                          ";
105
 
106
      TC_Char_Array   : Interfaces.C.char_array(Char_Range) :=
107
                          Interfaces.C.To_C(TC_String_2, True);
108
 
109
      TC_Char_Array_1 : Interfaces.C.char_array(0..9);
110
      TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);
111
      TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);
112
      TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);
113
 
114
      package Char_Pointers is new
115
        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,
116
                               Element            => Interfaces.C.char,
117
                               Element_Array      => Interfaces.C.char_array,
118
                               Default_Terminator => Interfaces.C.nul);
119
 
120
      Char_Ptr : Char_Pointers.Pointer;
121
 
122
      use type Char_Pointers.Pointer;
123
 
124
   begin
125
 
126
      -- Check that the Function Value with Pointer and Terminator Element
127
      -- parameters will return an Element_Array result of appropriate size
128
      -- and content (up to and including the first "terminator" Element.)
129
 
130
      Char_Ptr := TC_Char_Array(0)'Access;
131
 
132
      -- Provide a new Terminator char in the call of Function Value.
133
      -- This call should return only a portion (the first 10 chars) of
134
      -- the referenced char_array, up to and including the char 'j'.
135
 
136
      TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
137
                                             Terminator => Char_j);
138
 
139
      if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or
140
         Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)
141
      then
142
         Report.Failed("Incorrect result from Function Value with Ref " &
143
                       "and Terminator parameters, when supplied with " &
144
                       "a non-default Terminator char");
145
      end if;
146
 
147
      -- Use the default Terminator char in the call of Function Value.
148
      -- This call should return the entire char_array, including the
149
      -- terminating nul char.
150
 
151
      TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);
152
 
153
      if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or
154
         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)
155
      then
156
         Report.Failed("Incorrect result from Function Value with Ref " &
157
                       "and Terminator parameters, when using the "     &
158
                       "default Terminator char");
159
      end if;
160
 
161
 
162
 
163
      -- Check that the Function Value with Pointer and Length parameters
164
      -- will return an Element_Array result of appropriate size and content
165
      -- (the first Length elements pointed to by the parameter Ref).
166
 
167
      -- This call should return only a portion (the first 20 chars) of
168
      -- the referenced char_array.
169
 
170
      TC_Char_Array_3 :=
171
        Char_Pointers.Value(Ref    => Char_Ptr,
172
                            Length => Interfaces.C.ptrdiff_t(TC_Array_Size));
173
 
174
      -- Verify the individual chars of the result.
175
      for i in 0..TC_Array_Size-1 loop
176
         if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /=
177
            TC_String_3(Integer(i)+1)
178
         then
179
            Report.Failed("Incorrect result from Function Value with "  &
180
                          "Ref and Length parameters, when specifying " &
181
                          "a length less than the full array size");
182
            exit;
183
         end if;
184
      end loop;
185
 
186
      -- This call should return the entire char_array, including the
187
      -- terminating nul char.
188
 
189
      TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);
190
 
191
      if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or
192
         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)
193
      then
194
         Report.Failed("Incorrect result from Function Value with Ref " &
195
                       "and Length parameters, when specifying the "    &
196
                       "entire array size");
197
      end if;
198
 
199
 
200
 
201
      -- Check that both of the above versions of Function Value will
202
      -- propagate Interfaces.C.Strings.Dereference_Error when the value of
203
      -- the Ref Pointer parameter is null.
204
 
205
      Char_Ptr := null;
206
 
207
      begin
208
         TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,
209
                                                Terminator => Char_j);
210
         Report.Failed("Dereference_Error not raised by Function " &
211
                       "Value with Terminator parameter, when "    &
212
                       "provided a null reference");
213
         -- Call Report.Comment to ensure that the assignment to
214
         -- TC_Char_Array_1 is not "dead", and therefore can not be
215
         -- optimized away.
216
         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));
217
      exception
218
         when Interfaces.C.Strings.Dereference_Error =>
219
           null;  -- OK, expected exception.
220
         when others =>
221
           Report.Failed("Incorrect exception raised by Function " &
222
                         "Value with Terminator parameter, when "  &
223
                         "provided a null reference");
224
      end;
225
 
226
 
227
      begin
228
         TC_Char_Array_3 :=
229
           Char_Pointers.Value(Char_Ptr,
230
                               Interfaces.C.ptrdiff_t(TC_Array_Size));
231
         Report.Failed("Dereference_Error not raised by Function "   &
232
                       "Value with Length parameter, when provided " &
233
                       "a null reference");
234
         -- Call Report.Comment to ensure that the assignment to
235
         -- TC_Char_Array_3 is not "dead", and therefore can not be
236
         -- optimized away.
237
         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));
238
      exception
239
         when Interfaces.C.Strings.Dereference_Error =>
240
           null;  -- OK, expected exception.
241
         when others =>
242
           Report.Failed("Incorrect exception raised by Function " &
243
                         "Value with Length parameter, when "      &
244
                         "provided a null reference");
245
      end;
246
 
247
 
248
   exception
249
      when others => Report.Failed ("Exception raised in Test_Block");
250
   end Test_Block;
251
 
252
   Report.Result;
253
 
254
end CXB3014;

powered by: WebSVN 2.1.0

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