cxb3012.a

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

      begin
         TC_Length := ICS.Strlen(TC_chars_ptr);
         TC_Result_char_array(0..10) := ICS.Value(TC_chars_ptr);
         for i in 0..TC_Length-1 loop
            if TC_Result_char_array(i) /=
               IC.To_C(TC_String_10(Integer(i+1)))
            then
               Report.Failed("Incorrect result from the character-by-" &
                             "character evaluation of the result of "  &
                             "Procedure Update");
            end if;
         end loop;
      exception
         when others =>
           Report.Failed("Exception raised during the character-by-" &
                         "character evaluation of the result of "    &
                         "Procedure Update");
      end;
      ICS.Free(TC_chars_ptr);



      -- Check that the version of Procedure Update with a String rather
      -- than a char_array parameter behaves in the manner described above,
      -- but with the character values in the String overwriting the char
      -- values in Item.
      --
      -- Note: In Ada 95, In each of the cases below, the String parameter
      --       Str is treated as if it were nul terminated, which means that
      --       the char_array pointed to by TC_chars_ptr will be "shortened"
      --       so that it ends after the last character of the Str
      --       parameter. For Ada 2005, this rule is dropped, so the
      --       number of characters remains the same.

      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr, 1, TC_String_4, False);

      if ICS.Value(TC_chars_ptr) = TC_Result_String_4 then
         Report.Comment("Ada 95 result from Procedure Update - 5");
      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_4 then
         Report.Comment("Amendment 1 result from Procedure Update - 5");
      else
         Report.Failed("Incorrect result from Procedure Update - 5");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(Item   => TC_chars_ptr,
                 Offset => 0,
                 Str    => TC_String_5);

      if ICS.Value(TC_chars_ptr) = TC_Result_String_5 then
         Report.Comment("Ada 95 result from Procedure Update - 6");
      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_5 then
         Report.Comment("Amendment 1 result from Procedure Update - 6");
      else
         Report.Failed("Incorrect result from Procedure Update - 6");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr,
                 3,
                 Str    => TC_String_6,
                 Check  => True);

      if ICS.Value(TC_chars_ptr) = TC_Result_String_6 then
         Report.Comment("Ada 95 result from Procedure Update - 7");
      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_6 then
         Report.Comment("Amendment 1 result from Procedure Update - 7");
      else
         Report.Failed("Incorrect result from Procedure Update - 7");
      end if;
      ICS.Free(TC_chars_ptr);


      TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
      ICS.Update(TC_chars_ptr, 0, TC_String_9, True);

      if ICS.Value(TC_chars_ptr) = TC_String_9 then
         Report.Comment("Ada 95 result from Procedure Update - 8");
      elsif ICS.Value(TC_chars_ptr) = TC_Amd_Result_String_9 then
         Report.Comment("Amendment 1 result from Procedure Update - 8");
      else
         Report.Failed("Incorrect result from Procedure Update - 8");
      end if;
      ICS.Free(TC_chars_ptr);

      -- Check what happens if the string and array are the same size (this
      -- is the case that caused the change made by the Amendment).
      begin
         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
         ICS.Update(Item   => TC_chars_ptr,
                    Offset => 0,
                    Str    => TC_String_10,
                    Check  => True);
          if ICS.Value(TC_chars_ptr) = TC_String_10 then
             Report.Comment("Amendment 1 result from Procedure Update - 9");
          else
             Report.Failed("Incorrect result from Procedure Update - 9");
          end if;
      exception
         when ICS.Update_Error =>
             Report.Comment("Ada 95 exception expected from Procedure Update - 9");
         when others           =>
           Report.Failed("Incorrect exception raised by Procedure Update " &
                         "with Str parameter - 9");
      end;
      ICS.Free(TC_chars_ptr);


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

      begin
         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
         ICS.Update(Item   => TC_chars_ptr,
                    Offset => 5,
                    Chars  => IC.To_C(TC_String_7),
                    Check  => True);
         Report.Failed("Update_Error not raised by Procedure Update with " &
                       "Chars parameter");
         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
                        "optimization - should never be printed");
      exception
         when ICS.Update_Error => null;  -- OK, expected exception.
         when others           =>
           Report.Failed("Incorrect exception raised by Procedure Update " &
                         "with Chars parameter");
      end;

      ICS.Free(TC_chars_ptr);

      begin
         TC_chars_ptr := ICS.New_Char_Array(TC_char_array);
         ICS.Update(Item   => TC_chars_ptr,
                    Offset => ICS.Strlen(TC_chars_ptr),
                    Str    => TC_String_8); -- Default Check parameter value.
         Report.Failed("Update_Error not raised by Procedure Update with " &
                       "Str parameter");
         Report.Comment(ICS.Value(TC_chars_ptr) & "used here to defeat " &
                        "optimization - should never be printed");
      exception
         when ICS.Update_Error => null;  -- OK, expected exception.
         when others           =>
           Report.Failed("Incorrect exception raised by Procedure Update " &
                         "with Str parameter");
      end;

      ICS.Free(TC_chars_ptr);

      -- Check that both of the above versions of Procedure Update will
      -- propagate Dereference_Error if Item is Null_Ptr.
      -- Note: Free sets TC_chars_ptr to Null_Ptr.

      begin
         ICS.Update(Item   => TC_chars_ptr,
                    Offset => 5,
                    Chars  => IC.To_C(TC_String_7),
                    Check  => True);
         Report.Failed("Dereference_Error not raised by Procedure Update with " &
                       "Chars parameter");
      exception
         when ICS.Dereference_Error => null;  -- OK, expected exception.
         when others           =>
           Report.Failed("Incorrect exception raised by Procedure Update " &
                         "with Chars parameter");
      end;

      begin
         ICS.Update(Item   => TC_chars_ptr,
                    Offset => ICS.Strlen(TC_chars_ptr),
                    Str    => TC_String_8); -- Default Check parameter value.
         Report.Failed("Dereference_Error not raised by Procedure Update with " &
                       "Str parameter");
      exception
         when ICS.Dereference_Error => null;  -- OK, expected exception.
         when others           =>
           Report.Failed("Incorrect exception raised by Procedure Update " &
                         "with Str parameter");
      end;

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