1-- CXB3008.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 functions imported from the C language <string.h> and 28-- <stdlib.h> libraries can be called from an Ada program. 29-- 30-- TEST DESCRIPTION: 31-- This test checks that C language functions from the <string.h> and 32-- <stdlib.h> libraries can be used as completions of Ada subprograms. 33-- A pragma Import with convention identifier "C" is used to complete 34-- the Ada subprogram specifications. 35-- The three subprogram cases tested are as follows: 36-- 1) A C function that returns an int value (strcpy) is used as the 37-- completion of an Ada procedure specification. The return value 38-- is discarded; parameter modification is the desired effect. 39-- 2) A C function that returns an int value (strlen) is used as the 40-- completion of an Ada function specification. 41-- 3) A C function that returns a double value (strtod) is used as the 42-- completion of an Ada function specification. 43-- 44-- This test assumes that the following characters are all included 45-- in the implementation defined type Interfaces.C.char: 46-- ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '$'. 47-- 48-- APPLICABILITY CRITERIA: 49-- This test is applicable to all implementations that provide 50-- packages Interfaces.C and Interfaces.C.Strings. If an 51-- implementation provides these packages, this test must compile, 52-- execute, and report "PASSED". 53-- 54-- SPECIAL REQUIREMENTS: 55-- The C language library functions used by this test must be 56-- available for importing into the test. 57-- 58-- 59-- CHANGE HISTORY: 60-- 12 Oct 95 SAIC Initial prerelease version. 61-- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. 62-- 01 DEC 97 EDS Replaced all references of C function atof with 63-- C function strtod. 64-- 29 JUN 98 EDS Give Ada function corresponding to strtod a 65-- second parameter. 66--! 67 68with Report; 69with Ada.Exceptions; 70with Interfaces.C; -- N/A => ERROR 71with Interfaces.C.Strings; -- N/A => ERROR 72with Interfaces.C.Pointers; 73 74procedure CXB3008 is 75begin 76 77 Report.Test ("CXB3008", "Check that functions imported from the " & 78 "C language predefined libraries can be " & 79 "called from an Ada program"); 80 81 Test_Block: 82 declare 83 84 package IC renames Interfaces.C; 85 package ICS renames Interfaces.C.Strings; 86 package ICP is new Interfaces.C.Pointers 87 ( Index => IC.size_t, 88 Element => IC.char, 89 Element_Array => IC.char_array, 90 Default_Terminator => IC.nul ); 91 use Ada.Exceptions; 92 93 use type IC.char; 94 use type IC.char_array; 95 use type IC.size_t; 96 use type IC.double; 97 98 -- The String_Copy procedure copies the string pointed to by Source, 99 -- including the terminating nul char, into the char_array pointed 100 -- to by Target. 101 102 procedure String_Copy (Target : out IC.char_array; 103 Source : in IC.char_array); 104 105 -- The String_Length function returns the length of the nul-terminated 106 -- string pointed to by The_String. The nul is not included in 107 -- the count. 108 109 function String_Length (The_String : in IC.char_array) 110 return IC.size_t; 111 112 -- The String_To_Double function converts the char_array pointed to 113 -- by The_String into a double value returned through the function 114 -- name. The_String must contain a valid floating-point number; if 115 -- not, the value returned is zero. 116 117-- type Acc_ptr is access IC.char_array; 118 function String_To_Double (The_String : in IC.char_array ; 119 End_Ptr : ICP.Pointer := null) 120 return IC.double; 121 122 123 -- Use the <string.h> strcpy function as a completion to the procedure 124 -- specification. Note that the Ada interface to this C function is 125 -- in the form of a procedure (C function return value is not used). 126 127 pragma Import (C, String_Copy, "strcpy"); 128 129 -- Use the <string.h> strlen function as a completion to the 130 -- String_Length function specification. 131 132 pragma Import (C, String_Length, "strlen"); 133 134 -- Use the <stdlib.h> strtod function as a completion to the 135 -- String_To_Double function specification. 136 137 pragma Import (C, String_To_Double, "strtod"); 138 139 140 TC_String : constant String := "Just a Test"; 141 Char_Source : IC.char_array(0..30); 142 Char_Target : IC.char_array(0..30); 143 Double_Result : IC.double; 144 Source_Ptr, 145 Target_Ptr : ICS.chars_ptr; 146 147 begin 148 149 -- Check that the imported version of C function strcpy produces 150 -- the correct results. 151 152 Char_Source(0..21) := "Test of Pragma Import" & IC.nul; 153 154 String_Copy(Char_Target, Char_Source); 155 156 if Char_Target(0..21) /= Char_Source(0..21) then 157 Report.Failed("Incorrect result from the imported version of " & 158 "strcpy - 1"); 159 end if; 160 161 if String_Length(Char_Target) /= 21 then 162 Report.Failed("Incorrect result from the imported version of " & 163 "strlen - 1"); 164 end if; 165 166 Char_Source(0) := IC.nul; 167 168 String_Copy(Char_Target, Char_Source); 169 170 if Char_Target(0) /= Char_Source(0) then 171 Report.Failed("Incorrect result from the imported version of " & 172 "strcpy - 2"); 173 end if; 174 175 if String_Length(Char_Target) /= 0 then 176 Report.Failed("Incorrect result from the imported version of " & 177 "strlen - 2"); 178 end if; 179 180 -- The following chars_ptr designates a char_array of 12 chars 181 -- (including the terminating nul char). 182 Source_Ptr := ICS.New_Char_Array(IC.To_C(TC_String)); 183 184 String_Copy(Char_Target, ICS.Value(Source_Ptr)); 185 186 Target_Ptr := ICS.New_Char_Array(Char_Target); 187 188 if ICS.Value(Target_Ptr) /= TC_String then 189 Report.Failed("Incorrect result from the imported version of " & 190 "strcpy - 3"); 191 end if; 192 193 if String_Length(ICS.Value(Target_Ptr)) /= TC_String'Length then 194 Report.Failed("Incorrect result from the imported version of " & 195 "strlen - 3"); 196 end if; 197 198 199 Char_Source(0..9) := "100.00only"; 200 201 Double_Result := String_To_Double(Char_Source); 202 203 Char_Source(0..13) := "5050.00$$$$$$$"; 204 205 if Double_Result + String_To_Double(Char_Source) /= 5150.00 then 206 Report.Failed("Incorrect result returned from the imported " & 207 "version of function strtod - 1"); 208 end if; 209 210 Char_Source(0..9) := "xxx$10.00x"; -- String doesn't contain a 211 -- valid floating point value. 212 if String_To_Double(Char_Source) /= 0.0 then 213 Report.Failed("Incorrect result returned from the imported " & 214 "version of function strtod - 2"); 215 end if; 216 217 218 exception 219 when The_Error : others => 220 Report.Failed ("The following exception was raised in the " & 221 "Test_Block: " & Exception_Name(The_Error)); 222 end Test_Block; 223 224 Report.Result; 225 226end CXB3008; 227