Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxb/cxb5002.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 -- CXB5002.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 To_Fortran with a Character parameter will
28 -- return the corresponding Fortran Character_Set value.
29 --
30 -- Check that the Function To_Ada with a Character_Set parameter will
31 -- return the corresponding Ada Character value.
32 --
33 -- Check that the Function To_Fortran with a String parameter will
34 -- return the corresponding Fortran_Character value.
35 --
36 -- Check that the Function To_Ada with a Fortran_Character parameter
37 -- will return the corresponding Ada String value.
38 --
39 -- TEST DESCRIPTION:
40 -- This test checks that the functions To_Fortran and To_Ada produce
41 -- the correct results, based on a variety of parameter input values.
42 --
43 -- In the first series of subtests, the results of the function
44 -- To_Fortran are compared against expected Character_Set type results.
45 -- In the second series of subtests, the results of the function To_Ada
46 -- are compared against expected String type results, and the length of
47 -- the String result is also verified against the Fortran_Character type
48 -- parameter.
49 --
50 -- This test uses Fixed, Bounded, and Unbounded_Strings in combination
51 -- with the functions under validation.
52 --
53 -- This test assumes that the following characters are all included
54 -- in the implementation defined type Interfaces.Fortran.Character_Set:
55 -- ' ', 'a'..'z', 'A'..'Z', '1'..'9', '-', '_', '$', '#', and '*'.
56 --
57 -- APPLICABILITY CRITERIA:
58 -- This test is applicable to all implementations that provide
59 -- package Interfaces.Fortran. If an implementation provides
60 -- package Interfaces.Fortran, this test must compile, execute, and
61 -- report "PASSED".
62 --
63 -- This test does not apply to an implementation in which the Fortran
64 -- character set ranges are not contiguous (e.g., EBCDIC).
65 --
66 --
67 --
68 -- CHANGE HISTORY:
69 -- 11 Mar 96 SAIC Initial release for 2.1.
70 -- 10 Jun 96 SAIC Incorporated reviewer comments for ACVC 2.1.
71 -- 27 Oct 96 SAIC Incorporated reviewer comments.
72 --
73 --!
74
75 with Ada.Characters.Latin_1;
76 with Ada.Exceptions;
77 with Ada.Strings.Bounded;
78 with Ada.Strings.Unbounded;
79 with Ada.Unchecked_Conversion;
80 with Interfaces.Fortran; -- N/A => ERROR
81 with Report;
82
83 procedure CXB5002 is
84 begin
85
86 Report.Test ("CXB5002", "Check that functions To_Fortran and To_Ada " &
87 "produce correct results");
88
89 Test_Block:
90 declare
91
92 package ACL renames Ada.Characters.Latin_1;
93 package Bnd is new Ada.Strings.Bounded.Generic_Bounded_Length(10);
94 package Unb renames Ada.Strings.Unbounded;
95
96 use Bnd, Unb;
97 use Interfaces.Fortran;
98 use Ada.Exceptions;
99
100 Null_Fortran_Character : constant Fortran_Character := "";
101 Fortran_Character_1 : Fortran_Character(1..1) := " ";
102 Fortran_Character_5 : Fortran_Character(1..5) := " ";
103 Fortran_Character_10 : Fortran_Character(1..10) := " ";
104 Fortran_Character_20 : Fortran_Character(1..20) :=
105 " ";
106 TC_Fortran_Character_1 : Fortran_Character(1..1) := "A";
107 TC_Fortran_Character_5 : Fortran_Character(1..5) := "ab*de";
108 TC_Fortran_Character_10 : Fortran_Character(1..10) := "$1a2b3C4D5";
109 TC_Fortran_Character_20 : Fortran_Character(1..20) :=
110 "1234-ABCD_6789#fghij";
111
112 Bnd_String : Bnd.Bounded_String :=
113 Bnd.To_Bounded_String(" ");
114 TC_Bnd_String : Bounded_String :=
115 To_Bounded_String("$1a2b3C4D5");
116
117 Unb_String : Unb.Unbounded_String :=
118 Unb.To_Unbounded_String(" ");
119 TC_Unb_String : Unbounded_String :=
120 To_Unbounded_String("ab*de");
121
122 String_1 : String(1..1) := " ";
123 String_5 : String(1..5) := " ";
124 String_10 : String(1..10) := " ";
125 String_20 : String(1..20) := " ";
126 TC_String_1 : String(1..1) := "A";
127 TC_String_20 : String(1..20) := "1234-ABCD_6789#fghij";
128 Null_String : constant String := "";
129
130 Null_Character : constant Character := ACL.Nul;
131 Character_A : constant Character := Character'Val(65);
132 Character_Z : constant Character := Character'Val(90);
133 TC_Character : Character := Character'First;
134
135 Null_Character_Set : Character_Set := To_Fortran(ACL.Nul);
136 TC_Character_Set,
137 TC_Low_Character_Set,
138 TC_High_Character_Set : Character_Set := Character_Set'First;
139
140
141 -- The following procedure checks the results of function To_Ada.
142
143 procedure Check_Length (Str : in String;
144 Ftn : in Fortran_Character;
145 Num : in Natural) is
146 begin
147 if Str'Length /= Ftn'Length or
148 Str'Length /= Num
149 then
150 Report.Failed("Incorrect result from Function To_Ada " &
151 "with string length " & Integer'Image(Num));
152 end if;
153 end Check_Length;
154
155 -- To facilitate the conversion of Character-Character_Set data, the
156 -- following functions have been instantiated.
157
158 function Character_to_Character_Set is
159 new Ada.Unchecked_Conversion(Character, Character_Set);
160
161 function Character_Set_to_Character is
162 new Ada.Unchecked_Conversion(Character_Set, Character);
163
164 begin
165
166 -- Check that the Function To_Fortran with a Character parameter
167 -- will return the corresponding Fortran Character_Set value.
168
169 for TC_Character in ACL.LC_A..ACL.LC_Z loop
170 if To_Fortran(Item => TC_Character) /=
171 Character_to_Character_Set(TC_Character)
172 then
173 Report.Failed("Incorrect result from To_Fortran with lower " &
174 "case alphabetic character input");
175 end if;
176 end loop;
177
178 for TC_Character in Character_A..Character_Z loop
179 if To_Fortran(TC_Character) /=
180 Character_to_Character_Set(TC_Character)
181 then
182 Report.Failed("Incorrect result from To_Fortran with upper " &
183 "case alphabetic character input");
184 end if;
185 end loop;
186
187 if To_Fortran(Null_Character) /=
188 Character_to_Character_Set(Null_Character)
189 then
190 Report.Failed
191 ("Incorrect result from To_Fortran with null character input");
192 end if;
193
194
195 -- Check that the Function To_Ada with a Character_Set parameter
196 -- will return the corresponding Ada Character value.
197
198 TC_Low_Character_Set := Character_to_Character_Set('a');
199 TC_High_Character_Set := Character_to_Character_Set('z');
200 for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
201 if To_Ada(Item => TC_Character_Set) /=
202 Character_Set_to_Character(TC_Character_Set)
203 then
204 Report.Failed("Incorrect result from To_Ada with lower case " &
205 "alphabetic Character_Set input");
206 end if;
207 end loop;
208
209 TC_Low_Character_Set := Character_to_Character_Set('A');
210 TC_High_Character_Set := Character_to_Character_Set('Z');
211 for TC_Character_Set in TC_Low_Character_Set..TC_High_Character_Set loop
212 if To_Ada(TC_Character_Set) /=
213 Character_Set_to_Character(TC_Character_Set)
214 then
215 Report.Failed("Incorrect result from To_Ada with upper case " &
216 "alphabetic Character_Set input");
217 end if;
218 end loop;
219
220 if To_Ada(Character_to_Character_Set(Null_Character)) /=
221 Null_Character
222 then
223 Report.Failed("Incorrect result from To_Ada with a null " &
224 "Character_Set input");
225 end if;
226
227
228 -- Check that the Function To_Fortran with a String parameter
229 -- will return the corresponding Fortran_Character value.
230 -- Note: The type Fortran_Character is a character array type that
231 -- corresponds to Ada type String.
232
233 Fortran_Character_1 := To_Fortran(Item => TC_String_1);
234
235 if Fortran_Character_1 /= TC_Fortran_Character_1 then
236 Report.Failed("Incorrect result from procedure To_Fortran - 1");
237 end if;
238
239 Fortran_Character_5 := To_Fortran(To_String(TC_Unb_String));
240
241 if Fortran_Character_5 /= TC_Fortran_Character_5 then
242 Report.Failed("Incorrect result from procedure To_Fortran - 2");
243 end if;
244
245 Fortran_Character_10 := To_Fortran(To_String(TC_Bnd_String));
246
247 if Fortran_Character_10 /= TC_Fortran_Character_10 then
248 Report.Failed("Incorrect result from procedure To_Fortran - 3");
249 end if;
250
251 Fortran_Character_20 := To_Fortran(Item => TC_String_20);
252
253 if Fortran_Character_20 /= TC_Fortran_Character_20 then
254 Report.Failed("Incorrect result from procedure To_Fortran - 4");
255 end if;
256
257 if To_Fortran(Null_String) /= Null_Fortran_Character then
258 Report.Failed("Incorrect result from procedure To_Fortran - 5");
259 end if;
260
261
262 -- Check that the Function To_Ada with a Fortran_Character parameter
263 -- will return the corresponding Ada String value.
264
265 String_1 := To_Ada(TC_Fortran_Character_1);
266
267 if String_1 /= TC_String_1 then
268 Report.Failed("Incorrect value returned from function To_Ada - 1");
269 end if;
270
271 Check_Length(To_Ada(TC_Fortran_Character_1),
272 TC_Fortran_Character_1,
273 Num => 1);
274
275
276 Unb_String := Unb.To_Unbounded_String(To_Ada(TC_Fortran_Character_5));
277
278 if Unb_String /= TC_Unb_String then
279 Report.Failed("Incorrect value returned from function To_Ada - 2");
280 end if;
281
282 Check_Length(To_Ada(TC_Fortran_Character_5),
283 TC_Fortran_Character_5,
284 Num => 5);
285
286
287 Bnd_String := Bnd.To_Bounded_String
288 (To_Ada(TC_Fortran_Character_10));
289
290 if Bnd_String /= TC_Bnd_String then
291 Report.Failed("Incorrect value returned from function To_Ada - 3");
292 end if;
293
294 Check_Length(To_Ada(TC_Fortran_Character_10),
295 TC_Fortran_Character_10,
296 Num => 10);
297
298
299 String_20 := To_Ada(TC_Fortran_Character_20);
300
301 if String_20 /= TC_String_20 then
302 Report.Failed("Incorrect value returned from function To_Ada - 4");
303 end if;
304
305 Check_Length(To_Ada(TC_Fortran_Character_20),
306 TC_Fortran_Character_20,
307 Num => 20);
308
309 if To_Ada(Null_Character_Set) /= Null_Character then
310 Report.Failed("Incorrect value returned from function To_Ada - 5");
311 end if;
312
313
314 -- Check the two functions when used in combination.
315
316 if To_Ada(Item => To_Fortran("This is a test")) /=
317 "This is a test" or
318 To_Ada(To_Fortran("1234567890abcdeFGHIJ")) /=
319 Report.Ident_Str("1234567890abcdeFGHIJ")
320 then
321 Report.Failed("Incorrect result returned when using the " &
322 "functions To_Ada and To_Fortran in combination");
323 end if;
324
325
326 exception
327 when The_Error : others =>
328 Report.Failed("The following exception was raised in the " &
329 "Test_Block: " & Exception_Name(The_Error));
330 end Test_Block;
331
332 Report.Result;
333
334 end CXB5002;