1 |
149 |
jeremybenn |
-- CXB30132.AM
|
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 imported, user-defined C language functions can be
|
28 |
|
|
-- called from an Ada program.
|
29 |
|
|
--
|
30 |
|
|
-- TEST DESCRIPTION:
|
31 |
|
|
-- This test checks that user-defined C language functions can be
|
32 |
|
|
-- imported and referenced from an Ada program. Two C language
|
33 |
|
|
-- functions are specified in files CXB30130.C and CXB30131.C.
|
34 |
|
|
-- These two functions are imported to this test program, using two
|
35 |
|
|
-- calls to Pragma Import. Each function is then called in this test,
|
36 |
|
|
-- and the results of the call are verified.
|
37 |
|
|
--
|
38 |
|
|
-- This test assumes that the following characters are all included
|
39 |
|
|
-- in the implementation defined type Interfaces.C.char:
|
40 |
|
|
-- ' ', 'a'..'z', and 'A'..'Z'.
|
41 |
|
|
--
|
42 |
|
|
-- APPLICABILITY CRITERIA:
|
43 |
|
|
-- This test is applicable to all implementations that provide
|
44 |
|
|
-- packages Interfaces.C and Interfaces.C.Strings. If an
|
45 |
|
|
-- implementation provides packages Interfaces.C and
|
46 |
|
|
-- Interfaces.C.Strings, this test must compile, execute, and
|
47 |
|
|
-- report "PASSED".
|
48 |
|
|
--
|
49 |
|
|
-- SPECIAL REQUIREMENTS:
|
50 |
|
|
-- The files CXB30130.C and CXB30131.C must be compiled with a C
|
51 |
|
|
-- compiler. Implementation dialects of C may require alteration of
|
52 |
|
|
-- the C program syntax (see individual C files).
|
53 |
|
|
--
|
54 |
|
|
-- Note that the compiled C code must be bound with the compiled Ada
|
55 |
|
|
-- code to create an executable image. An implementation must provide
|
56 |
|
|
-- the necessary commands to accomplish this.
|
57 |
|
|
--
|
58 |
|
|
-- Note that the C code included in CXB30130.C and CXB30131.C conforms
|
59 |
|
|
-- to ANSI-C. Modifications to these files may be required for other
|
60 |
|
|
-- C compilers. An implementation must provide the necessary
|
61 |
|
|
-- modifications to satisfy the function requirements.
|
62 |
|
|
--
|
63 |
|
|
-- TEST FILES:
|
64 |
|
|
-- The following files comprise this test:
|
65 |
|
|
--
|
66 |
|
|
-- CXB30130.C
|
67 |
|
|
-- CXB30131.C
|
68 |
|
|
-- CXB30132.AM
|
69 |
|
|
--
|
70 |
|
|
--
|
71 |
|
|
-- CHANGE HISTORY:
|
72 |
|
|
-- 13 Oct 95 SAIC Initial prerelease version.
|
73 |
|
|
-- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
74 |
|
|
-- 26 Oct 96 SAIC Incorporated reviewer comments.
|
75 |
|
|
--
|
76 |
|
|
--!
|
77 |
|
|
|
78 |
|
|
with Report;
|
79 |
|
|
with Impdef;
|
80 |
|
|
with Interfaces.C; -- N/A => ERROR
|
81 |
|
|
with Interfaces.C.Strings; -- N/A => ERROR
|
82 |
|
|
|
83 |
|
|
procedure CXB30132 is
|
84 |
|
|
begin
|
85 |
|
|
|
86 |
|
|
Report.Test ("CXB3013", "Check that user-defined C functions can " &
|
87 |
|
|
"be imported into an Ada program");
|
88 |
|
|
|
89 |
|
|
Test_Block:
|
90 |
|
|
declare
|
91 |
|
|
|
92 |
|
|
package IC renames Interfaces.C;
|
93 |
|
|
package ICS renames Interfaces.C.Strings;
|
94 |
|
|
|
95 |
|
|
use type IC.char_array;
|
96 |
|
|
use type IC.int;
|
97 |
|
|
use type IC.short;
|
98 |
|
|
use type IC.C_float;
|
99 |
|
|
use type IC.double;
|
100 |
|
|
|
101 |
|
|
type Short_Ptr is access all IC.short;
|
102 |
|
|
type Float_Ptr is access all IC.C_float;
|
103 |
|
|
type Double_Ptr is access all IC.double;
|
104 |
|
|
subtype Char_Array_Type is IC.char_array(0..20);
|
105 |
|
|
|
106 |
|
|
TC_Default_int : IC.int := 49;
|
107 |
|
|
TC_Default_short : IC.short := 3;
|
108 |
|
|
TC_Default_float : IC.C_float := 50.0;
|
109 |
|
|
TC_Default_double : IC.double := 1209.0;
|
110 |
|
|
|
111 |
|
|
An_Int_Value : IC.int := TC_Default_int;
|
112 |
|
|
A_Short_Value : aliased IC.short := TC_Default_short;
|
113 |
|
|
A_Float_Value : aliased IC.C_float := TC_Default_float;
|
114 |
|
|
A_Double_Value : aliased IC.double := TC_Default_double;
|
115 |
|
|
|
116 |
|
|
A_Short_Int_Pointer : Short_Ptr := A_Short_Value'access;
|
117 |
|
|
A_Float_Pointer : Float_Ptr := A_Float_Value'access;
|
118 |
|
|
A_Double_Pointer : Double_Ptr := A_Double_Value'access;
|
119 |
|
|
|
120 |
|
|
Char_Array_1 : Char_Array_Type;
|
121 |
|
|
Char_Array_2 : Char_Array_Type;
|
122 |
|
|
Char_Pointer : ICS.chars_ptr;
|
123 |
|
|
|
124 |
|
|
TC_Char_Array : constant Char_Array_Type :=
|
125 |
|
|
"Look before you leap" & IC.nul;
|
126 |
|
|
TC_Return_int : IC.int := 0;
|
127 |
|
|
|
128 |
|
|
-- The Square_It function returns the square of the value The_Int
|
129 |
|
|
-- through the function name, and returns the square of the other
|
130 |
|
|
-- parameters through the parameter list (the last three parameters
|
131 |
|
|
-- are access values).
|
132 |
|
|
|
133 |
|
|
function Square_It (The_Int : in IC.int;
|
134 |
|
|
The_Short : in Short_Ptr;
|
135 |
|
|
The_Float : in Float_Ptr;
|
136 |
|
|
The_Double : in Double_Ptr) return IC.int;
|
137 |
|
|
|
138 |
|
|
-- The Combine_Strings function returns the result of the catenation
|
139 |
|
|
-- of the two string parameters through the function name.
|
140 |
|
|
|
141 |
|
|
function Combine_Strings (First_Part : in IC.char_array;
|
142 |
|
|
Second_Part : in IC.char_array)
|
143 |
|
|
return ICS.chars_ptr;
|
144 |
|
|
|
145 |
|
|
|
146 |
|
|
-- Use the user-defined C function square_it as a completion to the
|
147 |
|
|
-- function specification above.
|
148 |
|
|
|
149 |
|
|
pragma Import (Convention => C,
|
150 |
|
|
Entity => Square_It,
|
151 |
|
|
External_Name => Impdef.CXB30130_External_Name);
|
152 |
|
|
|
153 |
|
|
-- Use the user-defined C function combine_two_strings as a completion
|
154 |
|
|
-- to the function specification above.
|
155 |
|
|
|
156 |
|
|
pragma Import (C, Combine_Strings, Impdef.CXB30131_External_Name);
|
157 |
|
|
|
158 |
|
|
|
159 |
|
|
begin
|
160 |
|
|
|
161 |
|
|
-- Check that the imported version of C function CXB30130 produces
|
162 |
|
|
-- the correct results.
|
163 |
|
|
|
164 |
|
|
TC_Return_int := Square_It (The_Int => An_Int_Value,
|
165 |
|
|
The_Short => A_Short_Int_Pointer,
|
166 |
|
|
The_Float => A_Float_Pointer,
|
167 |
|
|
The_Double => A_Double_Pointer);
|
168 |
|
|
|
169 |
|
|
-- Compare the results with the expected results. Note that in the
|
170 |
|
|
-- case of the three "pointer" parameters, the objects being pointed
|
171 |
|
|
-- to have been modified as a result of the function.
|
172 |
|
|
|
173 |
|
|
if TC_Return_int /= An_Int_Value * An_Int_Value or
|
174 |
|
|
A_Short_Int_Pointer.all /= TC_Default_short * TC_Default_Short or
|
175 |
|
|
A_Short_Value /= TC_Default_short * TC_Default_Short or
|
176 |
|
|
A_Float_Pointer.all /= TC_Default_float * TC_Default_float or
|
177 |
|
|
A_Float_Value /= TC_Default_float * TC_Default_float or
|
178 |
|
|
A_Double_Pointer.all /= TC_Default_double * TC_Default_double or
|
179 |
|
|
A_Double_Value /= TC_Default_double * TC_Default_double
|
180 |
|
|
then
|
181 |
|
|
Report.Failed("Incorrect results returned from function square_it");
|
182 |
|
|
end if;
|
183 |
|
|
|
184 |
|
|
|
185 |
|
|
-- Check that two char_array values are combined by the imported
|
186 |
|
|
-- C function CXB30131.
|
187 |
|
|
|
188 |
|
|
Char_Array_1(0..12) := "Look before " & IC.nul;
|
189 |
|
|
Char_Array_2(0..8) := "you leap" & IC.nul;
|
190 |
|
|
|
191 |
|
|
Char_Pointer := Combine_Strings (Char_Array_1, Char_Array_2);
|
192 |
|
|
|
193 |
|
|
if ICS.Value(Char_Pointer) /= TC_Char_Array then
|
194 |
|
|
Report.Failed("Incorrect value returned from imported function " &
|
195 |
|
|
"combine_two_strings");
|
196 |
|
|
end if;
|
197 |
|
|
|
198 |
|
|
|
199 |
|
|
exception
|
200 |
|
|
when others => Report.Failed ("Exception raised in Test_Block");
|
201 |
|
|
end Test_Block;
|
202 |
|
|
|
203 |
|
|
Report.Result;
|
204 |
|
|
|
205 |
|
|
end CXB30132;
|