Commit fb159eb7 by Arnaud Charlet

[multiple changes]

2015-10-20  Steve Baird  <baird@adacore.com>

	* pprint.adb: Code clean up.

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-cfinve.ads, a-coboho.ads: Improve comments.
	* a-coboho.adb (Size_In_Storage_Elements): Improve error message
	in case of "Size is too big" exception.

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-contai.ads: Remove check names (moved to snames.ads-tmpl).
	* snames.ads-tmpl: Add check names that were previously in
	a-contai.ads, so they are now visible in configuration files.
	* types.ads: Add checks corresponding to snames.ads-tmpl.

From-SVN: r229069
parent 78cef47f
2015-10-20 Steve Baird <baird@adacore.com>
* pprint.adb: Code clean up.
2015-10-20 Bob Duff <duff@adacore.com>
* a-cfinve.ads, a-coboho.ads: Improve comments.
* a-coboho.adb (Size_In_Storage_Elements): Improve error message
in case of "Size is too big" exception.
2015-10-20 Bob Duff <duff@adacore.com>
* a-contai.ads: Remove check names (moved to snames.ads-tmpl).
* snames.ads-tmpl: Add check names that were previously in
a-contai.ads, so they are now visible in configuration files.
* types.ads: Add checks corresponding to snames.ads-tmpl.
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb (Analyze_Loop_Statement): Attach generated loop
......
......@@ -41,8 +41,12 @@ generic
type Element_Type (<>) is private;
Max_Size_In_Storage_Elements : Natural :=
Element_Type'Max_Size_In_Storage_Elements;
-- This has the same meaning as in Ada.Containers.Bounded_Holders, with the
-- same restrictions.
-- Maximum size of Vector elements in bytes. This has the same meaning as
-- in Ada.Containers.Bounded_Holders, with the same restrictions. Note that
-- setting this too small can lead to erroneous execution; see comments in
-- Ada.Containers.Bounded_Holders. If Element_Type is class-wide, it is the
-- responsibility of clients to calculate the maximum size of all types in
-- the class.
with function "=" (Left, Right : Element_Type) return Boolean is <>;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2014, Free Software Foundation, Inc. --
-- Copyright (C) 2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -26,24 +26,34 @@
------------------------------------------------------------------------------
with Unchecked_Conversion;
with Ada.Assertions; use Ada.Assertions;
package body Ada.Containers.Bounded_Holders is
pragma Annotate (CodePeer, Skip_Analysis);
function Size_In_Storage_Elements (Element : Element_Type) return Natural is
(Element'Size / System.Storage_Unit)
with Pre =>
(Element'Size mod System.Storage_Unit = 0 or else
raise Assertion_Error with "Size must be a multiple of Storage_Unit")
and then
(Element'Size / System.Storage_Unit <= Max_Size_In_Storage_Elements
or else raise Assertion_Error with "Size is too big");
function Size_In_Storage_Elements (Element : Element_Type) return Natural;
-- This returns the size of Element in storage units. It raises an
-- exception if the size is not a multiple of Storage_Unit, or if the size
-- is too big.
------------------------------
-- Size_In_Storage_Elements --
------------------------------
function Size_In_Storage_Elements (Element : Element_Type) return Natural is
Max_Size : Natural renames Max_Size_In_Storage_Elements;
begin
return S : constant Natural := Element'Size / System.Storage_Unit do
pragma Assert
(Element'Size mod System.Storage_Unit = 0,
"Size must be a multiple of Storage_Unit");
pragma Assert
(S <= Max_Size, "Size is too big:" & S'Img & " >" & Max_Size'Img);
end return;
end Size_In_Storage_Elements;
function Cast is new
Unchecked_Conversion (System.Address, Element_Access);
......@@ -65,9 +75,9 @@ package body Ada.Containers.Bounded_Holders is
return Cast (Container'Address).all;
end Get;
---------------------
-- Replace_Element --
---------------------
---------
-- Set --
---------
procedure Set (Container : in out Holder; New_Item : Element_Type) is
Storage : Storage_Array
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2014, Free Software Foundation, Inc. --
-- Copyright (C) 2015, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -51,9 +51,14 @@ package Ada.Containers.Bounded_Holders is
--
-- Each object of type Holder is allocated Max_Size_In_Storage_Elements
-- bytes. If you try to create a holder from an object of type Element_Type
-- that is too big, an exception is raised. This applies to To_Holder and
-- Replace_Element. If you pass an Element_Type object that is smaller than
-- Max_Size_In_Storage_Elements, it works fine, but some space is wasted.
-- that is too big, an exception is raised (assuming assertions are
-- enabled). This applies to To_Holder and Set. If you pass an Element_Type
-- object that is smaller than Max_Size_In_Storage_Elements, it works fine,
-- but some space is wasted.
--
-- NOTE: If assertions are disabled, and you try to use an Element that is
-- too big, execution is erroneous, and anything can happen, such as
-- overwriting arbitrary memory locations.
--
-- Element_Type must not be an unconstrained array type. It can be a
-- class-wide type or a type with non-defaulted discriminants.
......
......@@ -13,15 +13,6 @@
-- --
------------------------------------------------------------------------------
pragma Check_Name (Container_Checks);
pragma Check_Name (Tampering_Check);
-- The above checks are not in the Ada RM. They are added in order to allow
-- suppression of checks within containers packages. Suppressing
-- Tampering_Check suppresses the tampering checks and associated machinery,
-- which is very expensive. Suppressing Container_Checks suppresses
-- Tampering_Check as well as all the other (not-so-expensive) containers
-- checks.
package Ada.Containers is
pragma Pure;
......
......@@ -713,11 +713,11 @@ package body Pprint is
end loop;
declare
Scn : Source_Ptr := Original_Location (Sloc (Left));
End_Sloc : constant Source_Ptr :=
Original_Location (Sloc (Right));
Src : constant Source_Buffer_Ptr :=
Source_Text (Get_Source_File_Index (Scn));
Scn : Source_Ptr := Original_Location (Sloc (Left));
begin
if Scn > End_Sloc then
......
......@@ -1105,6 +1105,8 @@ package Snames is
Name_Storage_Check : constant Name_Id := N + $;
Name_Tag_Check : constant Name_Id := N + $;
Name_Validity_Check : constant Name_Id := N + $; -- GNAT
Name_Container_Checks : constant Name_Id := N + $; -- GNAT
Name_Tampering_Check : constant Name_Id := N + $; -- GNAT
Name_All_Checks : constant Name_Id := N + $;
Last_Check_Name : constant Name_Id := N + $;
......
......@@ -679,11 +679,13 @@ package Types is
Storage_Check : constant := 15;
Tag_Check : constant := 16;
Validity_Check : constant := 17;
Container_Checks : constant := 18;
Tampering_Check : constant := 19;
-- Values used to represent individual predefined checks (including the
-- setting of Atomic_Synchronization, which is implemented internally using
-- a "check" whose name is Atomic_Synchronization).
All_Checks : constant := 18;
All_Checks : constant := 20;
-- Value used to represent All_Checks value
subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment