Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb5003.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 -- CXB5003.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_Fortran converts the character elements
28 -- of the String parameter Item into Character_Set elements of the
29 -- Fortran_Character type parameter Target. Check that the parameter
30 -- Last contains the index of the last element of parameter Target
31 -- that was assigned by To_Fortran.
32 --
33 -- Check that Constraint_Error is propagated by procedure To_Fortran
34 -- when the length of String parameter Item exceeds the length of
35 -- Fortran_Character parameter Target.
36 --
37 -- Check that the procedure To_Ada converts the Character_Set
38 -- elements of the Fortran_Character parameter Item into Character
39 -- elements of the String parameter Target. Check that the parameter
40 -- Last contains the index of the last element of parameter Target
41 -- that was assigned by To_Ada.
42 --
43 -- Check that Constraint_Error is propagated by procedure To_Ada when
44 -- the length of Fortran_Character parameter Item exceeds the length of
45 -- String parameter Target.
46 --
47 -- TEST DESCRIPTION:
48 -- This test checks that the procedures To_Fortran and To_Ada produce
49 -- the correct results, based on a variety of parameter input values.
50 --
51 -- In the first series of subtests, the Out parameter results of
52 -- procedure To_Fortran are compared against expected results,
53 -- which includes (in the parameter Last) the index in Target of the
54 -- last element assigned. The situation where procedure To_Fortran
55 -- raises Constraint_Error (when Item'Length exceeds Target'Length)
56 -- is also verified.
57 --
58 -- In the second series of subtests, the Out parameter results of
59 -- procedure To_Ada are verified, in a similar manner as is done for
60 -- procedure To_Fortran. The case of procedure To_Ada raising
61 -- Constraint_Error is also verified.
62 --
63 -- This test assumes that the following characters are all included
64 -- in the implementation defined type Interfaces.Fortran.Character_Set:
65 -- ' ', 'a'..'j', 'A'..'D', '1'..'9', '-', '_', '$', '#', and '*'.
66 --
67 -- APPLICABILITY CRITERIA:
68 -- This test is applicable to all implementations that provide
69 -- package Interfaces.Fortran. If an implementation provides
70 -- package Interfaces.Fortran, this test must compile, execute, and
71 -- report "PASSED".
72 --
73 --
74 -- CHANGE HISTORY:
75 -- 14 Mar 96 SAIC Initial release for 2.1.
76 -- 10 Jun 96 SAIC Incorporated reviewer comments for ACVC 2.1.
77 -- 27 Oct 96 SAIC Incorporated reviewer comments.
78 --
79 --!
80
81 with Ada.Exceptions;
82 with Ada.Strings.Bounded;
83 with Ada.Strings.Unbounded;
84 with Interfaces.Fortran; -- N/A => ERROR
85 with Report;
86
87 procedure CXB5003 is
88 begin
89
90 Report.Test ("CXB5003", "Check that procedures To_Fortran and To_Ada " &
91 "produce correct results");
92
93 Test_Block:
94 declare
95
96 package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
97 package Unb renames Ada.Strings.Unbounded;
98
99 use Bnd, Unb;
100 use Interfaces.Fortran;
101 use Ada.Exceptions;
102
103 Fortran_Character_1 : Fortran_Character(1..1) := " ";
104 Fortran_Character_5 : Fortran_Character(1..5) := " ";
105 Fortran_Character_10 : Fortran_Character(1..10) := " ";
106 Fortran_Character_20 : Fortran_Character(1..20) :=
107 " ";
108 TC_Fortran_Character_1 : Fortran_Character(1..1) := "A";
109 TC_Fortran_Character_5 : Fortran_Character(1..5) := "ab*de";
110 TC_Fortran_Character_10 : Fortran_Character(1..10) := "$1a2b3C4D5";
111 TC_Fortran_Character_20 : Fortran_Character(1..20) :=
112 "1234-ABCD_6789#fghij";
113
114 Bnd_String : Bnd.Bounded_String :=
115 Bnd.To_Bounded_String(" ");
116 TC_Bnd_String : Bounded_String :=
117 To_Bounded_String("$1a2b3C4D5");
118
119 Unb_String : Unb.Unbounded_String :=
120 Unb.To_Unbounded_String(" ");
121 TC_Unb_String : Unbounded_String :=
122 To_Unbounded_String("ab*de");
123
124 String_1 : String(1..1) := " ";
125 String_5 : String(1..5) := " ";
126 String_10 : String(1..10) := " ";
127 String_20 : String(1..20) := " ";
128 TC_String_1 : String(1..1) := "A";
129 TC_String_20 : String(1..20) := "1234-ABCD_6789#fghij";
130
131 TC_Fortran_Character : constant Fortran_Character := "";
132 TC_String : constant String := "";
133 TC_Natural : Natural := 0;
134
135
136 begin
137
138 -- Check that the procedure To_Fortran converts the character elements
139 -- of the String parameter Item into Character_Set elements of the
140 -- Fortran_Character type parameter Target.
141 -- Check that the parameter Last contains the index of the last element
142 -- of parameter Target that was assigned by To_Fortran.
143
144 To_Fortran(Item => TC_String_1,
145 Target => Fortran_Character_1,
146 Last => TC_Natural);
147
148 if Fortran_Character_1 /= TC_Fortran_Character_1 or
149 TC_Natural /= TC_Fortran_Character_1'Length
150 then
151 Report.Failed("Incorrect result from procedure To_Fortran - 1");
152 end if;
153
154 To_Fortran(To_String(TC_Unb_String),
155 Target => Fortran_Character_5,
156 Last => TC_Natural);
157
158 if Fortran_Character_5 /= TC_Fortran_Character_5 or
159 TC_Natural /= TC_Fortran_Character_5'Length
160 then
161 Report.Failed("Incorrect result from procedure To_Fortran - 2");
162 end if;
163
164 To_Fortran(To_String(TC_Bnd_String),
165 Fortran_Character_10,
166 Last => TC_Natural);
167
168 if Fortran_Character_10 /= TC_Fortran_Character_10 or
169 TC_Natural /= TC_Fortran_Character_10'Length
170 then
171 Report.Failed("Incorrect result from procedure To_Fortran - 3");
172 end if;
173
174 To_Fortran(TC_String_20, Fortran_Character_20, TC_Natural);
175
176 if Fortran_Character_20 /= TC_Fortran_Character_20 or
177 TC_Natural /= TC_Fortran_Character_20'Length
178 then
179 Report.Failed("Incorrect result from procedure To_Fortran - 4");
180 end if;
181
182 To_Fortran(Item => TC_String, -- null string
183 Target => Fortran_Character_1,
184 Last => TC_Natural);
185
186 if TC_Natural /= 0 then
187 Report.Failed("Incorrect result from procedure To_Fortran, value " &
188 "returned in parameter Last should be zero, since " &
189 "parameter Item is null array");
190 end if;
191
192
193 -- Check that Constraint_Error is propagated by procedure To_Fortran
194 -- when the length of String parameter Item exceeds the length of
195 -- Fortran_Character parameter Target.
196
197 begin
198
199 To_Fortran(Item => TC_String_20,
200 Target => Fortran_Character_10,
201 Last => TC_Natural);
202 Report.Failed("Constraint_Error not raised by procedure " &
203 "To_Fortran when Item'Length exceeds Target'Length");
204 exception
205 when Constraint_Error => null; -- OK, expected exception.
206 when The_Error : others =>
207 Report.Failed("The following exception was raised by procedure " &
208 "To_Fortran when Item'Length exceeds " &
209 "Target'Length: " & Exception_Name(The_Error));
210 end;
211
212
213 -- Check that the procedure To_Ada converts the Character_Set
214 -- elements of the Fortran_Character parameter Item into Character
215 -- elements of the String parameter Target.
216 -- Check that the parameter Last contains the index of the last
217 -- element of parameter Target that was assigned by To_Ada.
218
219 To_Ada(Item => TC_Fortran_Character_1,
220 Target => String_1,
221 Last => TC_Natural);
222
223 if String_1 /= TC_String_1 or
224 TC_Natural /= TC_String_1'Length
225 then
226 Report.Failed("Incorrect result from procedure To_Ada - 1");
227 end if;
228
229 To_Ada(TC_Fortran_Character_5,
230 Target => String_5,
231 Last => TC_Natural);
232
233 if String_5 /= To_String(TC_Unb_String) or
234 TC_Natural /= Length(TC_Unb_String)
235 then
236 Report.Failed("Incorrect result from procedure To_Ada - 2");
237 end if;
238
239 To_Ada(TC_Fortran_Character_10,
240 String_10,
241 Last => TC_Natural);
242
243 if String_10 /= To_String(TC_Bnd_String) or
244 TC_Natural /= Length(TC_Bnd_String)
245 then
246 Report.Failed("Incorrect result from procedure To_Ada - 3");
247 end if;
248
249 To_Ada(TC_Fortran_Character_20, String_20, TC_Natural);
250
251 if String_20 /= TC_String_20 or
252 TC_Natural /= TC_String_20'Length
253 then
254 Report.Failed("Incorrect result from procedure To_Ada - 4");
255 end if;
256
257 To_Ada(Item => TC_Fortran_Character, -- null array.
258 Target => String_20,
259 Last => TC_Natural);
260
261 if TC_Natural /= 0 then
262 Report.Failed("Incorrect result from procedure To_Ada, value " &
263 "returned in parameter Last should be zero, since " &
264 "parameter Item is null array");
265 end if;
266
267
268 -- Check that Constraint_Error is propagated by procedure To_Ada
269 -- when the length of Fortran_Character parameter Item exceeds the
270 -- length of String parameter Target.
271
272 begin
273
274 To_Ada(Item => TC_Fortran_Character_10,
275 Target => String_5,
276 Last => TC_Natural);
277 Report.Failed("Constraint_Error not raised by procedure To_Ada " &
278 "when Item'Length exceeds Target'Length");
279 exception
280 when Constraint_Error => null; -- OK, expected exception.
281 when The_Error : others =>
282 Report.Failed("Incorrect exception raised by procedure To_Ada " &
283 "when Item'Length exceeds Target'Length");
284 end;
285
286
287 exception
288 when The_Error : others =>
289 Report.Failed("The following exception was raised in the " &
290 "Test_Block: " & Exception_Name(The_Error));
291 end Test_Block;
292
293 Report.Result;
294
295 end CXB5003;