-- CXB3008.A -- -- 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 functions imported from the C language and -- libraries can be called from an Ada program. -- -- TEST DESCRIPTION: -- This test checks that C language functions from the and -- libraries can be used as completions of Ada subprograms. -- A pragma Import with convention identifier "C" is used to complete -- the Ada subprogram specifications. -- The three subprogram cases tested are as follows: -- 1) A C function that returns an int value (strcpy) is used as the -- completion of an Ada procedure specification. The return value -- is discarded; parameter modification is the desired effect. -- 2) A C function that returns an int value (strlen) is used as the -- completion of an Ada function specification. -- 3) A C function that returns a double value (strtod) is used as the -- completion of an Ada function specification. -- -- This test assumes that the following characters are all included -- in the implementation defined type Interfaces.C.char: -- ' ', 'a'..'z', 'A'..'Z', '0'..'9', and '$'. -- -- APPLICABILITY CRITERIA: -- This test is applicable to all implementations that provide -- packages Interfaces.C and Interfaces.C.Strings. If an -- implementation provides these packages, this test must compile, -- execute, and report "PASSED". -- -- SPECIAL REQUIREMENTS: -- The C language library functions used by this test must be -- available for importing into the test. -- -- -- CHANGE HISTORY: -- 12 Oct 95 SAIC Initial prerelease version. -- 09 May 96 SAIC Incorporated reviewer comments for ACVC 2.1. -- 01 DEC 97 EDS Replaced all references of C function atof with -- C function strtod. -- 29 JUN 98 EDS Give Ada function corresponding to strtod a -- second parameter. --! with Report; with Ada.Exceptions; with Interfaces.C; -- N/A => ERROR with Interfaces.C.Strings; -- N/A => ERROR with Interfaces.C.Pointers; procedure CXB3008 is begin Report.Test ("CXB3008", "Check that functions imported from the " & "C language predefined libraries can be " & "called from an Ada program"); Test_Block: declare package IC renames Interfaces.C; package ICS renames Interfaces.C.Strings; package ICP is new Interfaces.C.Pointers ( Index => IC.size_t, Element => IC.char, Element_Array => IC.char_array, Default_Terminator => IC.nul ); use Ada.Exceptions; use type IC.char; use type IC.char_array; use type IC.size_t; use type IC.double; -- The String_Copy procedure copies the string pointed to by Source, -- including the terminating nul char, into the char_array pointed -- to by Target. procedure String_Copy (Target : out IC.char_array; Source : in IC.char_array); -- The String_Length function returns the length of the nul-terminated -- string pointed to by The_String. The nul is not included in -- the count. function String_Length (The_String : in IC.char_array) return IC.size_t; -- The String_To_Double function converts the char_array pointed to -- by The_String into a double value returned through the function -- name. The_String must contain a valid floating-point number; if -- not, the value returned is zero. -- type Acc_ptr is access IC.char_array; function String_To_Double (The_String : in IC.char_array ; End_Ptr : ICP.Pointer := null) return IC.double; -- Use the strcpy function as a completion to the procedure -- specification. Note that the Ada interface to this C function is -- in the form of a procedure (C function return value is not used). pragma Import (C, String_Copy, "strcpy"); -- Use the strlen function as a completion to the -- String_Length function specification. pragma Import (C, String_Length, "strlen"); -- Use the strtod function as a completion to the -- String_To_Double function specification. pragma Import (C, String_To_Double, "strtod"); TC_String : constant String := "Just a Test"; Char_Source : IC.char_array(0..30); Char_Target : IC.char_array(0..30); Double_Result : IC.double; Source_Ptr, Target_Ptr : ICS.chars_ptr; begin -- Check that the imported version of C function strcpy produces -- the correct results. Char_Source(0..21) := "Test of Pragma Import" & IC.nul; String_Copy(Char_Target, Char_Source); if Char_Target(0..21) /= Char_Source(0..21) then Report.Failed("Incorrect result from the imported version of " & "strcpy - 1"); end if; if String_Length(Char_Target) /= 21 then Report.Failed("Incorrect result from the imported version of " & "strlen - 1"); end if; Char_Source(0) := IC.nul; String_Copy(Char_Target, Char_Source); if Char_Target(0) /= Char_Source(0) then Report.Failed("Incorrect result from the imported version of " & "strcpy - 2"); end if; if String_Length(Char_Target) /= 0 then Report.Failed("Incorrect result from the imported version of " & "strlen - 2"); end if; -- The following chars_ptr designates a char_array of 12 chars -- (including the terminating nul char). Source_Ptr := ICS.New_Char_Array(IC.To_C(TC_String)); String_Copy(Char_Target, ICS.Value(Source_Ptr)); Target_Ptr := ICS.New_Char_Array(Char_Target); if ICS.Value(Target_Ptr) /= TC_String then Report.Failed("Incorrect result from the imported version of " & "strcpy - 3"); end if; if String_Length(ICS.Value(Target_Ptr)) /= TC_String'Length then Report.Failed("Incorrect result from the imported version of " & "strlen - 3"); end if; Char_Source(0..9) := "100.00only"; Double_Result := String_To_Double(Char_Source); Char_Source(0..13) := "5050.00$$$$$$$"; if Double_Result + String_To_Double(Char_Source) /= 5150.00 then Report.Failed("Incorrect result returned from the imported " & "version of function strtod - 1"); end if; Char_Source(0..9) := "xxx$10.00x"; -- String doesn't contain a -- valid floating point value. if String_To_Double(Char_Source) /= 0.0 then Report.Failed("Incorrect result returned from the imported " & "version of function strtod - 2"); end if; exception when The_Error : others => Report.Failed ("The following exception was raised in the " & "Test_Block: " & Exception_Name(The_Error)); end Test_Block; Report.Result; end CXB3008;