1-- 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 78with Report; 79with Impdef; 80with Interfaces.C; -- N/A => ERROR 81with Interfaces.C.Strings; -- N/A => ERROR 82 83procedure CXB30132 is 84begin 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 205end CXB30132; 206