Subversion Repositories openrisc

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