cxb3008.a

来自「Mac OS X 10.4.9 for x86 Source Code gcc」· A 代码 · 共 227 行

-- 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 <string.h> and
--      <stdlib.h> libraries can be called from an Ada program.
--      
-- TEST DESCRIPTION:
--      This test checks that C language functions from the <string.h> and
--      <stdlib.h> 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 <string.h> 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 <string.h> strlen function as a completion to the
      -- String_Length function specification.

      pragma Import (C, String_Length, "strlen");

      -- Use the <stdlib.h> 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;