-- CXB30132.AM -- -- Grant of Unlimited Rights -- -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687 and -- F08630-91-C-0015, 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;