3 -- Grant of Unlimited Rights
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
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.
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.
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.
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.
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.
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.
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)
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.
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 '*'.
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
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.
82 with Ada
.Strings
.Bounded
;
83 with Ada
.Strings
.Unbounded
;
84 with Interfaces
.Fortran
; -- N/A => ERROR
90 Report
.Test
("CXB5003", "Check that procedures To_Fortran and To_Ada " &
91 "produce correct results");
96 package Bnd
is new Ada
.Strings
.Bounded
.Generic_Bounded_Length
(10);
97 package Unb
renames Ada
.Strings
.Unbounded
;
100 use Interfaces
.Fortran
;
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) :=
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";
114 Bnd_String
: Bnd
.Bounded_String
:=
115 Bnd
.To_Bounded_String
(" ");
116 TC_Bnd_String
: Bounded_String
:=
117 To_Bounded_String
("$1a2b3C4D5");
119 Unb_String
: Unb
.Unbounded_String
:=
120 Unb
.To_Unbounded_String
(" ");
121 TC_Unb_String
: Unbounded_String
:=
122 To_Unbounded_String
("ab*de");
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";
131 TC_Fortran_Character
: constant Fortran_Character
:= "";
132 TC_String
: constant String := "";
133 TC_Natural
: Natural := 0;
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.
144 To_Fortran
(Item
=> TC_String_1
,
145 Target
=> Fortran_Character_1
,
148 if Fortran_Character_1
/= TC_Fortran_Character_1
or
149 TC_Natural
/= TC_Fortran_Character_1
'Length
151 Report
.Failed
("Incorrect result from procedure To_Fortran - 1");
154 To_Fortran
(To_String
(TC_Unb_String
),
155 Target
=> Fortran_Character_5
,
158 if Fortran_Character_5
/= TC_Fortran_Character_5
or
159 TC_Natural
/= TC_Fortran_Character_5
'Length
161 Report
.Failed
("Incorrect result from procedure To_Fortran - 2");
164 To_Fortran
(To_String
(TC_Bnd_String
),
165 Fortran_Character_10
,
168 if Fortran_Character_10
/= TC_Fortran_Character_10
or
169 TC_Natural
/= TC_Fortran_Character_10
'Length
171 Report
.Failed
("Incorrect result from procedure To_Fortran - 3");
174 To_Fortran
(TC_String_20
, Fortran_Character_20
, TC_Natural
);
176 if Fortran_Character_20
/= TC_Fortran_Character_20
or
177 TC_Natural
/= TC_Fortran_Character_20
'Length
179 Report
.Failed
("Incorrect result from procedure To_Fortran - 4");
182 To_Fortran
(Item
=> TC_String
, -- null string
183 Target
=> Fortran_Character_1
,
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");
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.
199 To_Fortran
(Item
=> TC_String_20
,
200 Target
=> Fortran_Character_10
,
202 Report
.Failed
("Constraint_Error not raised by procedure " &
203 "To_Fortran when Item'Length exceeds Target'Length");
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
));
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.
219 To_Ada
(Item
=> TC_Fortran_Character_1
,
223 if String_1
/= TC_String_1
or
224 TC_Natural
/= TC_String_1
'Length
226 Report
.Failed
("Incorrect result from procedure To_Ada - 1");
229 To_Ada
(TC_Fortran_Character_5
,
233 if String_5
/= To_String
(TC_Unb_String
) or
234 TC_Natural
/= Length
(TC_Unb_String
)
236 Report
.Failed
("Incorrect result from procedure To_Ada - 2");
239 To_Ada
(TC_Fortran_Character_10
,
243 if String_10
/= To_String
(TC_Bnd_String
) or
244 TC_Natural
/= Length
(TC_Bnd_String
)
246 Report
.Failed
("Incorrect result from procedure To_Ada - 3");
249 To_Ada
(TC_Fortran_Character_20
, String_20
, TC_Natural
);
251 if String_20
/= TC_String_20
or
252 TC_Natural
/= TC_String_20
'Length
254 Report
.Failed
("Incorrect result from procedure To_Ada - 4");
257 To_Ada
(Item
=> TC_Fortran_Character
, -- null array.
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");
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.
274 To_Ada
(Item
=> TC_Fortran_Character_10
,
277 Report
.Failed
("Constraint_Error not raised by procedure To_Ada " &
278 "when Item'Length exceeds Target'Length");
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");
288 when The_Error
: others =>
289 Report
.Failed
("The following exception was raised in the " &
290 "Test_Block: " & Exception_Name
(The_Error
));