+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
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 <>;
-- --
-- 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- --
------------------------------------------------------------------------------
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);
return Cast (Container'Address).all;
end Get;
- ---------------------
- -- Replace_Element --
- ---------------------
+ ---------
+ -- Set --
+ ---------
procedure Set (Container : in out Holder; New_Item : Element_Type) is
Storage : Storage_Array
-- --
-- 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 --
--
-- 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.
-- --
------------------------------------------------------------------------------
-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;
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
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 + $;
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;
projects / gcc.git / commitdiff