Subversion Repositories openrisc

-- CXB3014.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 the Function Value with Pointer and Element

--      parameters will return an Element_Array result of correct size

--      and content (up to and including the first "terminator" Element).

--

--      Check that the Function Value with Pointer and Length parameters

--      will return an Element_Array result of appropriate size and content

--      (the first Length elements pointed to by the parameter Ref).

--

--      Check that both versions of Function Value will propagate

--      Interfaces.C.Strings.Dereference_Error when the value of

--      the Ref pointer parameter is null.

--

-- TEST DESCRIPTION:

--      This test tests that both versions of Function Value from the

--      generic package Interfaces.C.Pointers are available and produce

--      correct results.  The generic package is instantiated with size_t,

--      char, char_array, and nul as actual parameters, and subtests are

--      performed on each of the Value functions resulting from this

--      instantiation.

--      For both function versions, a test is performed where a portion of

--      a char_array is to be returned as the function result.  Likewise,

--      a test is performed where each version of the function returns the

--      entire char_array referenced by the in parameter Ref.

--      Finally, both versions of Function Value are called with a null

--      pointer reference, to ensure that Dereference_Error is raised in

--      this case.

--

--      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.Strings and Interfaces.C.Pointers.  If an

--      implementation provides packages Interfaces.C.Strings and

--      Interfaces.C.Pointers, this test must compile, execute, and

--      report "PASSED".

--

--

-- CHANGE HISTORY:

--      19 Oct 95   SAIC    Initial prerelease version.

--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.

--      23 Oct 96   SAIC    Incorporated reviewer comments.

--

--!

with Report;

with Interfaces.C.Strings;                                    -- N/A => ERROR

with Interfaces.C.Pointers;                                   -- N/A => ERROR

procedure CXB3014 is

begin

   Report.Test ("CXB3014", "Check that versions of the Value function "  &

                           "from package Interfaces.C.Pointers produce " &

                           "correct results");

   Test_Block:

   declare

      use type Interfaces.C.char, Interfaces.C.size_t;

      Char_a : constant Interfaces.C.char := 'a';

      Char_j : constant Interfaces.C.char := 'j';

      Char_z : constant Interfaces.C.char := 'z';

      subtype Lower_Case_chars is Interfaces.C.char range Char_a..Char_z;

      subtype Char_Range       is Interfaces.C.size_t range 0..26;

      Local_nul       : aliased Interfaces.C.char := Interfaces.C.nul;

      TC_Array_Size   : Interfaces.C.size_t := 20;

      TC_String_1     : constant String := "abcdefghij";

      TC_String_2     : constant String := "abcdefghijklmnopqrstuvwxyz";

      TC_String_3     : constant String := "abcdefghijklmnopqrst";

      TC_String_4     : constant String := "abcdefghijklmnopqrstuvwxyz";

      TC_Blank_String : constant String := "                          ";

      TC_Char_Array   : Interfaces.C.char_array(Char_Range) :=

                          Interfaces.C.To_C(TC_String_2, True);

      TC_Char_Array_1 : Interfaces.C.char_array(0..9);

      TC_Char_Array_2 : Interfaces.C.char_array(Char_Range);

      TC_Char_Array_3 : Interfaces.C.char_array(0..TC_Array_Size-1);

      TC_Char_Array_4 : Interfaces.C.char_array(Char_Range);

      package Char_Pointers is new

        Interfaces.C.Pointers (Index              => Interfaces.C.size_t,

                               Element            => Interfaces.C.char,

                               Element_Array      => Interfaces.C.char_array,

                               Default_Terminator => Interfaces.C.nul);

      Char_Ptr : Char_Pointers.Pointer;

      use type Char_Pointers.Pointer;

   begin

      -- Check that the Function Value with Pointer and Terminator Element

      -- parameters will return an Element_Array result of appropriate size

      -- and content (up to and including the first "terminator" Element.)

      Char_Ptr := TC_Char_Array(0)'Access;

      -- Provide a new Terminator char in the call of Function Value.

      -- This call should return only a portion (the first 10 chars) of

      -- the referenced char_array, up to and including the char 'j'.

      TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,

                                             Terminator => Char_j);

      if Interfaces.C.To_Ada(TC_Char_Array_1, False) /= TC_String_1 or

         Interfaces.C.Is_Nul_Terminated(TC_Char_Array_1)

      then

         Report.Failed("Incorrect result from Function Value with Ref " &

                       "and Terminator parameters, when supplied with " &

                       "a non-default Terminator char");

      end if;

      -- Use the default Terminator char in the call of Function Value.

      -- This call should return the entire char_array, including the

      -- terminating nul char.

      TC_Char_Array_2 := Char_Pointers.Value(Char_Ptr);

      if Interfaces.C.To_Ada(TC_Char_Array_2, True) /= TC_String_2 or

         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_2)

      then

         Report.Failed("Incorrect result from Function Value with Ref " &

                       "and Terminator parameters, when using the "     &

                       "default Terminator char");

      end if;

      -- Check that the Function Value with Pointer and Length parameters

      -- will return an Element_Array result of appropriate size and content

      -- (the first Length elements pointed to by the parameter Ref).

      -- This call should return only a portion (the first 20 chars) of

      -- the referenced char_array.

      TC_Char_Array_3 :=

        Char_Pointers.Value(Ref    => Char_Ptr,

                            Length => Interfaces.C.ptrdiff_t(TC_Array_Size));

      -- Verify the individual chars of the result.

      for i in 0..TC_Array_Size-1 loop

         if Interfaces.C.To_Ada(TC_Char_Array_3(i)) /=

            TC_String_3(Integer(i)+1)

         then

            Report.Failed("Incorrect result from Function Value with "  &

                          "Ref and Length parameters, when specifying " &

                          "a length less than the full array size");

            exit;

         end if;

      end loop;

      -- This call should return the entire char_array, including the

      -- terminating nul char.

      TC_Char_Array_4 := Char_Pointers.Value(Char_Ptr, 27);

      if Interfaces.C.To_Ada(TC_Char_Array_4, True) /= TC_String_4 or

         not Interfaces.C.Is_Nul_Terminated(TC_Char_Array_4)

      then

         Report.Failed("Incorrect result from Function Value with Ref " &

                       "and Length parameters, when specifying the "    &

                       "entire array size");

      end if;

      -- Check that both of the above versions of Function Value will

      -- propagate Interfaces.C.Strings.Dereference_Error when the value of

      -- the Ref Pointer parameter is null.

      Char_Ptr := null;

      begin

         TC_Char_Array_1 := Char_Pointers.Value(Ref        => Char_Ptr,

                                                Terminator => Char_j);

         Report.Failed("Dereference_Error not raised by Function " &

                       "Value with Terminator parameter, when "    &

                       "provided a null reference");

         -- Call Report.Comment to ensure that the assignment to

         -- TC_Char_Array_1 is not "dead", and therefore can not be

         -- optimized away.

         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_1, False));

      exception

         when Interfaces.C.Strings.Dereference_Error =>

           null;  -- OK, expected exception.

         when others =>

           Report.Failed("Incorrect exception raised by Function " &

                         "Value with Terminator parameter, when "  &

                         "provided a null reference");

      end;

      begin

         TC_Char_Array_3 :=

           Char_Pointers.Value(Char_Ptr,

                               Interfaces.C.ptrdiff_t(TC_Array_Size));

         Report.Failed("Dereference_Error not raised by Function "   &

                       "Value with Length parameter, when provided " &

                       "a null reference");

         -- Call Report.Comment to ensure that the assignment to

         -- TC_Char_Array_3 is not "dead", and therefore can not be

         -- optimized away.

         Report.Comment(Interfaces.C.To_Ada(TC_Char_Array_3, False));

      exception

         when Interfaces.C.Strings.Dereference_Error =>

           null;  -- OK, expected exception.

         when others =>

           Report.Failed("Incorrect exception raised by Function " &

                         "Value with Length parameter, when "      &

                         "provided a null reference");

      end;

   exception

      when others => Report.Failed ("Exception raised in Test_Block");

   end Test_Block;

   Report.Result;

end CXB3014;