cxb3014.a

linux下编程用 编译软件

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