cxb3012.a

来自「linux下编程用 编译软件」· A 代码 · 共 393 行 · 第 1/2 页

-- CXB3012.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 Procedure Update modifies the value pointed to by
--      the chars_ptr parameter Item, starting at the position
--      corresponding to parameter Offset, using the chars in
--      char_array parameter Chars.
--
--      Check that the version of Procedure Update with a String parameter
--      behaves in the manner described above, but with the character
--      values in the String overwriting the char values in Item.
--
--      Check that both of the above versions of Procedure Update will
--      propagate Update_Error if Check is True, and if the length of
--      the new chars in Chars, when overlaid starting from position
--      Offset, will overwrite the first nul in Item.
--
-- TEST DESCRIPTION:
--      This test checks two versions of Procedure Update.  In the first
--      version of the procedure, the parameter Chars indicates a char_array
--      argument.  These char_array parameters are provided through the use
--      of the To_C function (with String IN parameter), both with and
--      without a terminating nul.  In the case below where a terminating nul
--      char is appended, the effect of "updating" the value pointed to by the
--      Item parameter will include its shortening, due to the insertion of
--      this additional nul in the middle of the char_array.
--
--      In the second version of Procedure Update evaluated here, the string
--      parameter Str is used to modify the char_array pointed to by Item.
--
--      Finally, both versions of the procedure are evaluated to ensure that
--      they propagate Update_Error and Dereference_Error under the proper
--      conditions.
--
--      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
--      package Interfaces.C.Strings.  If an implementation provides
--      package Interfaces.C.Strings, this test must compile, execute,
--      and report "PASSED".
--
--
-- CHANGE HISTORY:
--      05 Oct 95   SAIC    Initial prerelease version.
--      13 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      26 Oct 96   SAIC    Incorporated reviewer comments.
--      14 Sep 99   RLB     Removed incorrect and unnecessary
--                          Unchecked_Conversion. Added check for raising
--                          of Dereference_Error for Update (From Technical
--                          Corrigendum 1).
--      07 Jan 05   RLB     Modified to reflect change to Update by AI-242
--                          (which is expected to be part of Amendment 1).
--                          [This version allows either semantics.]

--!

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

procedure CXB3012 is
begin

   Report.Test ("CXB3012", "Check that both versions of Procedure Update " &
                           "produce correct results");

   Test_Block:
   declare

      package IC  renames Interfaces.C;
      package ICS renames Interfaces.C.Strings;
      use Ada.Exceptions;

      use type IC.char;
      use type IC.char_array;
      use type IC.size_t;
      use type ICS.chars_ptr;

      TC_String_1        : String(1..1)    := "J";
      TC_String_2        : String(1..2)    := "Ab";
      TC_String_3        : String(1..3)    := "xyz";
      TC_String_4        : String(1..4)    := "ACVC";
      TC_String_5        : String(1..5)    := "1a2b3";
      TC_String_6        : String(1..6)    := "---...";
      TC_String_7        : String(1..7)    := "AABBBAA";
      TC_String_8        : String(1..8)    := "aBcDeFgH";
      TC_String_9        : String(1..9)    := "JustATest";
      TC_String_10       : String(1..10)   := "0123456789";

      TC_Result_String_1 : constant String := "JXXXXXXXXX";
      TC_Result_String_2 : constant String := "XXXXXXXXAb";
      TC_Result_String_3 : constant String := "XXXxyz";
      TC_Result_String_4 : constant String := "XACVC";
      TC_Result_String_5 : constant String := "1a2b3";
      TC_Result_String_6 : constant String := "XXX---...";

      TC_Amd_Result_String_4 :
                           constant String := "XACVCXXXXX";
      TC_Amd_Result_String_5 :
                           constant String := "1a2b3XXXXX";
      TC_Amd_Result_String_6 :
                           constant String := "XXX---...X";
      TC_Amd_Result_String_9 :
                           constant String := "JustATestX";

      TC_char_array        : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
      TC_Result_char_array : IC.char_array(0..10) := IC.To_C("XXXXXXXXXX");
      TC_chars_ptr         : ICS.chars_ptr;
      TC_Length            : IC.size_t;

   begin

      -- Check that Procedure Update modifies the value pointed to by
      -- the chars_ptr parameter Item, starting at the position
      -- corresponding to parameter Offset, using the chars in
      -- char_array parameter Chars.
      -- Note: If parameter Chars contains a nul char (such as a
      --       terminating nul), the result may be the overall shortening
      --       of parameter Item.

      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);

      ICS.Update(Item   => TC_chars_ptr,
                 Offset => 0,
                 Chars  => IC.To_C(TC_String_1, False),  -- No nul char.
                 Check  => True);

      if ICS.Value(TC_chars_ptr) /= TC_Result_String_1 then
         Report.Failed("Incorrect result from Procedure Update - 1");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr,
                 Offset => ICS.Strlen(TC_chars_ptr) - 2,
                 Chars  => IC.To_C(TC_String_2, False),  -- No nul char.
                 Check  => True);

      if ICS.Value(TC_chars_ptr) /= TC_Result_String_2 then
         Report.Failed("Incorrect result from Procedure Update - 2");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr,
                 3,
                 Chars  => IC.To_C(TC_String_3),   -- Nul appended, shortens
                 Check  => False);                 -- array.

      if ICS.Value(TC_chars_ptr) /= TC_Result_String_3 then
         Report.Failed("Incorrect result from Procedure Update - 3");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr,
                 0,
                 IC.To_C(TC_String_10), -- Complete replacement of array.
                 Check  => False);

      if ICS.Value(TC_chars_ptr) /= TC_String_10 then
         Report.Failed("Incorrect result from Procedure Update - 4");
      end if;

      -- Perform a character-by-character comparison of the result of
      -- Procedure Update. Note that char_array lower bound is 0, and
      -- that the nul char is not compared with any character in the
      -- string (since the string is not nul terminated).