1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
-- CXB30132.AM
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- These rights include rights to use, duplicate, release or disclose the
-- released technical data and computer software in whole or in part, in
-- any manner and for any purpose whatsoever, and to have or permit others
-- to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
-- Check that imported, user-defined C language functions can be
-- called from an Ada program.
--
-- TEST DESCRIPTION:
-- This test checks that user-defined C language functions can be
-- imported and referenced from an Ada program. Two C language
-- functions are specified in files CXB30130.C and CXB30131.C.
-- These two functions are imported to this test program, using two
-- calls to Pragma Import. Each function is then called in this test,
-- and the results of the call are verified.
--
-- This test assumes that the following characters are all included
-- in the implementation defined type Interfaces.C.char:
-- ' ', 'a'..'z', and 'A'..'Z'.
--
-- APPLICABILITY CRITERIA:
-- This test is applicable to all implementations that provide
-- packages Interfaces.C and Interfaces.C.Strings. If an
-- implementation provides packages Interfaces.C and
-- Interfaces.C.Strings, this test must compile, execute, and
-- report "PASSED".
--
-- SPECIAL REQUIREMENTS:
-- The files CXB30130.C and CXB30131.C must be compiled with a C
-- compiler. Implementation dialects of C may require alteration of
-- the C program syntax (see individual C files).
--
-- Note that the compiled C code must be bound with the compiled Ada
-- code to create an executable image. An implementation must provide
-- the necessary commands to accomplish this.
--
-- Note that the C code included in CXB30130.C and CXB30131.C conforms
-- to ANSI-C. Modifications to these files may be required for other
-- C compilers. An implementation must provide the necessary
-- modifications to satisfy the function requirements.
--
-- TEST FILES:
-- The following files comprise this test:
--
-- CXB30130.C
-- CXB30131.C
-- CXB30132.AM
--
--
-- CHANGE HISTORY:
-- 13 Oct 95 SAIC Initial prerelease version.
-- 13 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
-- 26 Oct 96 SAIC Incorporated reviewer comments.
--
--!
with Report;
with Impdef;
with Interfaces.C; -- N/A => ERROR
with Interfaces.C.Strings; -- N/A => ERROR
procedure CXB30132 is
begin
Report.Test ("CXB3013", "Check that user-defined C functions can " &
"be imported into an Ada program");
Test_Block:
declare
package IC renames Interfaces.C;
package ICS renames Interfaces.C.Strings;
use type IC.char_array;
use type IC.int;
use type IC.short;
use type IC.C_float;
use type IC.double;
type Short_Ptr is access all IC.short;
type Float_Ptr is access all IC.C_float;
type Double_Ptr is access all IC.double;
subtype Char_Array_Type is IC.char_array(0..20);
TC_Default_int : IC.int := 49;
TC_Default_short : IC.short := 3;
TC_Default_float : IC.C_float := 50.0;
TC_Default_double : IC.double := 1209.0;
An_Int_Value : IC.int := TC_Default_int;
A_Short_Value : aliased IC.short := TC_Default_short;
A_Float_Value : aliased IC.C_float := TC_Default_float;
A_Double_Value : aliased IC.double := TC_Default_double;
A_Short_Int_Pointer : Short_Ptr := A_Short_Value'access;
A_Float_Pointer : Float_Ptr := A_Float_Value'access;
A_Double_Pointer : Double_Ptr := A_Double_Value'access;
Char_Array_1 : Char_Array_Type;
Char_Array_2 : Char_Array_Type;
Char_Pointer : ICS.chars_ptr;
TC_Char_Array : constant Char_Array_Type :=
"Look before you leap" & IC.nul;
TC_Return_int : IC.int := 0;
-- The Square_It function returns the square of the value The_Int
-- through the function name, and returns the square of the other
-- parameters through the parameter list (the last three parameters
-- are access values).
function Square_It (The_Int : in IC.int;
The_Short : in Short_Ptr;
The_Float : in Float_Ptr;
The_Double : in Double_Ptr) return IC.int;
-- The Combine_Strings function returns the result of the catenation
-- of the two string parameters through the function name.
function Combine_Strings (First_Part : in IC.char_array;
Second_Part : in IC.char_array)
return ICS.chars_ptr;
-- Use the user-defined C function square_it as a completion to the
-- function specification above.
pragma Import (Convention => C,
Entity => Square_It,
External_Name => Impdef.CXB30130_External_Name);
-- Use the user-defined C function combine_two_strings as a completion
-- to the function specification above.
pragma Import (C, Combine_Strings, Impdef.CXB30131_External_Name);
begin
-- Check that the imported version of C function CXB30130 produces
-- the correct results.
TC_Return_int := Square_It (The_Int => An_Int_Value,
The_Short => A_Short_Int_Pointer,
The_Float => A_Float_Pointer,
The_Double => A_Double_Pointer);
-- Compare the results with the expected results. Note that in the
-- case of the three "pointer" parameters, the objects being pointed
-- to have been modified as a result of the function.
if TC_Return_int /= An_Int_Value * An_Int_Value or
A_Short_Int_Pointer.all /= TC_Default_short * TC_Default_Short or
A_Short_Value /= TC_Default_short * TC_Default_Short or
A_Float_Pointer.all /= TC_Default_float * TC_Default_float or
A_Float_Value /= TC_Default_float * TC_Default_float or
A_Double_Pointer.all /= TC_Default_double * TC_Default_double or
A_Double_Value /= TC_Default_double * TC_Default_double
then
Report.Failed("Incorrect results returned from function square_it");
end if;
-- Check that two char_array values are combined by the imported
-- C function CXB30131.
Char_Array_1(0..12) := "Look before " & IC.nul;
Char_Array_2(0..8) := "you leap" & IC.nul;
Char_Pointer := Combine_Strings (Char_Array_1, Char_Array_2);
if ICS.Value(Char_Pointer) /= TC_Char_Array then
Report.Failed("Incorrect value returned from imported function " &
"combine_two_strings");
end if;
exception
when others => Report.Failed ("Exception raised in Test_Block");
end Test_Block;
Report.Result;
end CXB30132;
|
