cxb30132.am

来自「linux下编程用 编译软件」· AM 代码 · 共 206 行

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