Subversion Repositories openrisc_me

-- 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;