From: Robert Dewar Date: Wed, 22 Jan 2014 14:24:03 +0000 (+0000) Subject: sem_ch3.adb, [...]: Minor reformatting. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=113a62d92e63e6b069f4bf764dfb71da6206c0e5;p=gcc.git sem_ch3.adb, [...]: Minor reformatting. 2014-01-22 Robert Dewar * sem_ch3.adb, errout.adb, erroutc.adb: Minor reformatting. 2014-01-22 Robert Dewar * sem_ch13.adb (Check_Pool_Size_Clash): New procedure (Analyze_Attribute_Definition_Clause, case Storage_Pool): call Check_Pool_Size_Clash (Analyze_Attribute_Definition_Clause, case Storage_Size): call Check_Pool_Size_Clash. From-SVN: r206923 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2dca6e32d00..53e59897456 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2014-01-22 Robert Dewar + + * sem_ch3.adb, errout.adb, erroutc.adb: Minor reformatting. + +2014-01-22 Robert Dewar + + * sem_ch13.adb (Check_Pool_Size_Clash): New procedure + (Analyze_Attribute_Definition_Clause, case Storage_Pool): call + Check_Pool_Size_Clash (Analyze_Attribute_Definition_Clause, + case Storage_Size): call Check_Pool_Size_Clash. + 2014-01-22 Robert Dewar * sem_ch3.adb, exp_util.adb, sem_dim.adb, sem_elab.adb, sem_ch8.adb, diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 70a770a7e4e..76cba3998d0 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1499,19 +1499,19 @@ package body Errout is Cur_Msg := No_Error_Msg; List_Pragmas.Init; - -- Initialize warnings table. As an optimization, if all warnings are - -- suppressed, we supply an initial dummy entry covering all possible - -- source locations, which avoids taking into account pragma Warnings - -- in the source. In GNATprove_Mode, this optimization is disabled, as - -- we rely on the Warnings table to be correctly filled for back-end - -- warnings. + -- Initialize warnings table Warnings.Init; Specific_Warnings.Init; - if not GNATprove_Mode - and then Warning_Mode = Suppress - then + -- As an optimization, if all warnings are suppressed, we supply an + -- initial dummy entry covering all possible source locations, which + -- avoids taking into account pragma Warnings in the source. In + -- GNATprove_Mode, this optimization is disabled, as we rely on + -- the Warnings table to be correctly filled for use of the warning + -- mechanism for gnatprove itself. + + if not GNATprove_Mode and then Warning_Mode = Suppress then Warnings.Append ((Start => Source_Ptr'First, Stop => Source_Ptr'Last)); end if; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 81a3c6d68a3..ba9b0d3b663 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -1207,20 +1207,20 @@ package body Erroutc is return; end if; - -- Nothing to do unless command line switch to suppress all warnings is - -- off or we are in GNATprove_Mode, and the last entry in the warnings - -- table covers this pragma Warnings (On), in which case adjust the end - -- point. - - if (Warnings.Last >= Warnings.First - and then Warnings.Table (Warnings.Last).Start <= Loc - and then Loc <= Warnings.Table (Warnings.Last).Stop) - and then - (Warning_Mode /= Suppress - or else - GNATprove_Mode) + -- If the last entry in the warnings table covers this pragma, then + -- we adjust the end point appropriately. + + if Warnings.Last >= Warnings.First + and then Warnings.Table (Warnings.Last).Start <= Loc + and then Loc <= Warnings.Table (Warnings.Last).Stop then - Warnings.Table (Warnings.Last).Stop := Loc; + -- We can normally skip this adjustment if we are suppressing all + -- warnings, but we do want to do it in gnatprove mode even then, + -- since we use the warning mechanism in gnatprove itself. + + if Warning_Mode /= Suppress or else GNATprove_Mode then + Warnings.Table (Warnings.Last).Stop := Loc; + end if; end if; end Set_Warnings_Mode_On; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 736a8ae44a3..dbfc215378d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -112,6 +112,10 @@ package body Sem_Ch13 is -- list is stored in Static_Predicate (Typ), and the Expr is rewritten as -- a canonicalized membership operation. + procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id); + -- Called if both Storage_Pool and Storage_Size attribute definition + -- clauses (SP and SS) are present for entity Ent. Issue error message. + procedure Freeze_Entity_Checks (N : Node_Id); -- Called from Analyze_Freeze_Entity and Analyze_Generic_Freeze Entity -- to generate appropriate semantic checks that are delayed until this @@ -1698,8 +1702,8 @@ package body Sem_Ch13 is end if; -- If the type is private, indicate that its completion - -- has a freeze node, because that is the one that will be - -- visible at freeze time. + -- has a freeze node, because that is the one that will + -- be visible at freeze time. if Is_Private_Type (E) and then Present (Full_View (E)) then Set_Has_Predicates (Full_View (E)); @@ -4629,6 +4633,20 @@ package body Sem_Ch13 is return; end if; + -- Check for Storage_Size previously given + + declare + SS : constant Node_Id := + Get_Attribute_Definition_Clause + (U_Ent, Attribute_Storage_Size); + begin + if Present (SS) then + Check_Pool_Size_Clash (U_Ent, N, SS); + end if; + end; + + -- Storage_Pool case + if Id = Attribute_Storage_Pool then Analyze_And_Resolve (Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool))); @@ -4788,10 +4806,21 @@ package body Sem_Ch13 is Analyze_And_Resolve (Expr, Any_Integer); if Is_Access_Type (U_Ent) then - if Present (Associated_Storage_Pool (U_Ent)) then - Error_Msg_N ("storage pool already given for &", Nam); - return; - end if; + + -- Check for Storage_Pool previously given + + declare + SP : constant Node_Id := + Get_Attribute_Definition_Clause + (U_Ent, Attribute_Storage_Pool); + + begin + if Present (SP) then + Check_Pool_Size_Clash (U_Ent, SP, N); + end if; + end; + + -- Special case of for x'Storage_Size use 0 if Is_OK_Static_Expression (Expr) and then Expr_Value (Expr) = 0 @@ -8307,6 +8336,33 @@ package body Sem_Ch13 is end if; end Check_Constant_Address_Clause; + --------------------------- + -- Check_Pool_Size_Clash -- + --------------------------- + + procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id) is + Post : Node_Id; + + begin + -- We need to find out which one came first. Note that in the case of + -- aspects mixed with pragmas there are cases where the processing order + -- is reversed, which is why we do the check here. + + if Sloc (SP) < Sloc (SS) then + Error_Msg_Sloc := Sloc (SP); + Post := SS; + Error_Msg_NE ("Storage_Pool previously given for&#", Post, Ent); + + else + Error_Msg_Sloc := Sloc (SS); + Post := SP; + Error_Msg_NE ("Storage_Size previously given for&#", Post, Ent); + end if; + + Error_Msg_N + ("\cannot have Storage_Size and Storage_Pool (RM 13.11(3))", Post); + end Check_Pool_Size_Clash; + ---------------------------------------- -- Check_Record_Representation_Clause -- ---------------------------------------- @@ -9580,7 +9636,6 @@ package body Sem_Ch13 is ------------------------------------- procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id) is - function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item (Rep_Item : Node_Id) return Boolean; -- This routine checks if Rep_Item is either a pragma or an aspect diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b744873f74d..74fc6639c61 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -733,7 +733,7 @@ package body Sem_Ch3 is return Empty; end if; - -- Ada 2005: for an object declaration the corresponding anonymous + -- Ada 2005: For an object declaration the corresponding anonymous -- type is declared in the current scope. -- If the access definition is the return type of another access to @@ -912,7 +912,7 @@ package body Sem_Ch3 is Set_Has_Delayed_Freeze (Current_Scope); end if; - -- Ada 2005: if the designated type is an interface that may contain + -- Ada 2005: If the designated type is an interface that may contain -- tasks, create a Master entity for the declaration. This must be done -- before expansion of the full declaration, because the declaration may -- include an expression that is an allocator, whose expansion needs the @@ -3241,11 +3241,11 @@ package body Sem_Ch3 is -- Protected objects with interrupt handlers must be at library level - -- Ada 2005: this test is not needed (and the corresponding clause + -- Ada 2005: This test is not needed (and the corresponding clause -- in the RM is removed) because accessibility checks are sufficient -- to make handlers not at the library level illegal. - -- AI05-0303: the AI is in fact a binding interpretation, and thus + -- AI05-0303: The AI is in fact a binding interpretation, and thus -- applies to the '95 version of the language as well. if Has_Interrupt_Handler (T) and then Ada_Version < Ada_95 then @@ -3637,7 +3637,7 @@ package body Sem_Ch3 is if No (E) then Act_T := Build_Default_Subtype (T, N); else - -- Ada 2005: a limited object may be initialized by means of an + -- Ada 2005: A limited object may be initialized by means of an -- aggregate. If the type has default discriminants it has an -- unconstrained nominal type, Its actual subtype will be obtained -- from the aggregate, and not from the default discriminants. @@ -11173,7 +11173,7 @@ package body Sem_Ch3 is -- from a private type) has no discriminants. (Defect Report -- 8652/0008, Technical Corrigendum 1, checked by ACATS B371001). - -- Rule updated for Ada 2005: the private type is said to have + -- Rule updated for Ada 2005: The private type is said to have -- a constrained partial view, given that objects of the type -- can be declared. Furthermore, the rule applies to all access -- types, unlike the rule concerning default discriminants (see @@ -20127,7 +20127,7 @@ package body Sem_Ch3 is Final_Storage_Only := not Is_Controlled (T); - -- Ada 2005: check whether an explicit Limited is present in a derived + -- Ada 2005: Check whether an explicit Limited is present in a derived -- type declaration. if Nkind (Parent (Def)) = N_Derived_Type_Definition