From fb159eb789755380ef1ec61001d0a78734400d0f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 14:21:37 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Steve Baird * pprint.adb: Code clean up. 2015-10-20 Bob Duff * 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 * 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 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/a-cfinve.ads | 8 ++++++-- gcc/ada/a-coboho.adb | 36 +++++++++++++++++++++++------------- gcc/ada/a-coboho.ads | 13 +++++++++---- gcc/ada/a-contai.ads | 9 --------- gcc/ada/pprint.adb | 2 +- gcc/ada/snames.ads-tmpl | 2 ++ gcc/ada/types.ads | 4 +++- 8 files changed, 61 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aa6d6ee6fa5..ea3417e9e1b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2015-10-20 Steve Baird + + * pprint.adb: Code clean up. + +2015-10-20 Bob Duff + + * 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 + + * 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 * sem_ch5.adb (Analyze_Loop_Statement): Attach generated loop diff --git a/gcc/ada/a-cfinve.ads b/gcc/ada/a-cfinve.ads index 2fef4af7856..17f6f7c22d0 100644 --- a/gcc/ada/a-cfinve.ads +++ b/gcc/ada/a-cfinve.ads @@ -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 <>; diff --git a/gcc/ada/a-coboho.adb b/gcc/ada/a-coboho.adb index 4ea0fa047aa..590e807dd32 100644 --- a/gcc/ada/a-coboho.adb +++ b/gcc/ada/a-coboho.adb @@ -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 diff --git a/gcc/ada/a-coboho.ads b/gcc/ada/a-coboho.ads index 7e6933e22de..8764410d407 100644 --- a/gcc/ada/a-coboho.ads +++ b/gcc/ada/a-coboho.ads @@ -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. diff --git a/gcc/ada/a-contai.ads b/gcc/ada/a-contai.ads index 5ae53ff875d..be8a808747b 100644 --- a/gcc/ada/a-contai.ads +++ b/gcc/ada/a-contai.ads @@ -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; diff --git a/gcc/ada/pprint.adb b/gcc/ada/pprint.adb index 102611fa371..cc0bfe5f970 100644 --- a/gcc/ada/pprint.adb +++ b/gcc/ada/pprint.adb @@ -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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 881f36589f8..c0860e48544 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -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 + $; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index af772fa70fc..8b21b10ca4d 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -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; -- 2.30.2