From 5e127570e2871666c51d6c27a05cc3297030a823 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 6 Jan 2017 12:22:32 +0100 Subject: [PATCH] [multiple changes] 2017-01-06 Justin Squirek * sem_attr.adb (Analyze_Attribute): Modify semantic checks for Finalization_Size to allow a prefix of any non-class-wide type. * sem_attr.ads Modify comment for Finalization_Size to include definite type use case. 2017-01-06 Ed Schonberg * einfo.ads, einfo.adb (Is_Entry_Wrapper): New flag, defined on procedures that are wrappers created for entries that have preconditions. * sem_ch6.adb (Analyze_Subrogram_Body_Helper): If the subprogram body is an entry_wrapper, compile it in the context of the synchronized type, because a precondition may refer to funtions of the type. * exp_ch9.adb (Build_Contract_Wrapper): Set Is_Entry_Wrapper on body entity. * exp_ch6.adb (Expand_Protected_Subprogram_Call): if the call is within an Entry_Wrapper this is an external call whose target is the synchronized object that is the actual in the call to the wrapper. From-SVN: r244138 --- gcc/ada/ChangeLog | 23 +++++++++++++++++++++++ gcc/ada/einfo.adb | 12 +++++++++++- gcc/ada/einfo.ads | 9 +++++++++ gcc/ada/exp_ch6.adb | 13 +++++++++++++ gcc/ada/exp_ch9.adb | 1 + gcc/ada/sem_attr.adb | 23 +++++++++++++++++++++-- gcc/ada/sem_attr.ads | 8 ++++---- gcc/ada/sem_ch6.adb | 24 ++++++++++++++++++++++++ 8 files changed, 106 insertions(+), 7 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e2fe43ef684..71f2ada9ef2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2017-01-06 Justin Squirek + + * sem_attr.adb (Analyze_Attribute): Modify semantic checks for + Finalization_Size to allow a prefix of any non-class-wide type. + * sem_attr.ads Modify comment for Finalization_Size to include + definite type use case. + +2017-01-06 Ed Schonberg + + * einfo.ads, einfo.adb (Is_Entry_Wrapper): New flag, defined + on procedures that are wrappers created for entries that have + preconditions. + * sem_ch6.adb (Analyze_Subrogram_Body_Helper): If the subprogram + body is an entry_wrapper, compile it in the context of the + synchronized type, because a precondition may refer to funtions + of the type. + * exp_ch9.adb (Build_Contract_Wrapper): Set Is_Entry_Wrapper on + body entity. + * exp_ch6.adb (Expand_Protected_Subprogram_Call): if the call is + within an Entry_Wrapper this is an external call whose target + is the synchronized object that is the actual in the call to + the wrapper. + 2017-01-06 Yannick Moy * sem_attr.adb (Analyze_Attribute/Attribute_Loop_Entry): Analyze node diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 4b78eca25e5..f2023c0e81a 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -613,8 +613,8 @@ package body Einfo is -- Has_Pragma_Unused Flag294 -- Is_Ignored_Transient Flag295 -- Has_Partial_Visible_Refinement Flag296 + -- Is_Entry_Wrapper Flag297 - -- (unused) Flag297 -- (unused) Flag298 -- (unused) Flag299 -- (unused) Flag300 @@ -2197,6 +2197,11 @@ package body Einfo is return Flag52 (Id); end Is_Entry_Formal; + function Is_Entry_Wrapper (Id : E) return B is + begin + return Flag297 (Id); + end Is_Entry_Wrapper; + function Is_Exception_Handler (Id : E) return B is begin pragma Assert (Ekind (Id) = E_Block); @@ -5287,6 +5292,11 @@ package body Einfo is Set_Flag52 (Id, V); end Set_Is_Entry_Formal; + procedure Set_Is_Entry_Wrapper (Id : E; V : B := True) is + begin + Set_Flag297 (Id, V); + end Set_Is_Entry_Wrapper; + procedure Set_Is_Exception_Handler (Id : E; V : B := True) is begin pragma Assert (Ekind (Id) = E_Block); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e5ab85aef42..b1c817f7484 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2483,6 +2483,10 @@ package Einfo is -- be in, in-out or out parameters). This flag is used to speed up the -- test for the need to replace references in Exp_Ch2. +-- Is_Entry_Wrapper (Flag297) +-- Defined on wrappers that are created for entries that have pre- +-- condition aspects. + -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes @@ -5893,6 +5897,7 @@ package Einfo is -- Sec_Stack_Needed_For_Return (Flag167) -- Has_Expanded_Contract (Flag240) -- SPARK_Pragma_Inherited (Flag265) (protected kind) + -- Is_Entry_Wrapper (Flag297) -- Address_Clause (synth) -- Entry_Index_Type (synth) -- First_Formal (synth) @@ -7102,6 +7107,7 @@ package Einfo is function Is_Dispatching_Operation (Id : E) return B; function Is_Eliminated (Id : E) return B; function Is_Entry_Formal (Id : E) return B; + function Is_Entry_Wrapper (Id : E) return B; function Is_Exception_Handler (Id : E) return B; function Is_Exported (Id : E) return B; function Is_Finalized_Transient (Id : E) return B; @@ -7781,6 +7787,7 @@ package Einfo is procedure Set_Is_Dispatching_Operation (Id : E; V : B := True); procedure Set_Is_Eliminated (Id : E; V : B := True); procedure Set_Is_Entry_Formal (Id : E; V : B := True); + procedure Set_Is_Entry_Wrapper (Id : E; V : B := True); procedure Set_Is_Exception_Handler (Id : E; V : B := True); procedure Set_Is_Exported (Id : E; V : B := True); procedure Set_Is_Finalized_Transient (Id : E; V : B := True); @@ -8591,6 +8598,7 @@ package Einfo is pragma Inline (Is_Eliminated); pragma Inline (Is_Entry); pragma Inline (Is_Entry_Formal); + pragma Inline (Is_Entry_Wrapper); pragma Inline (Is_Enumeration_Type); pragma Inline (Is_Exception_Handler); pragma Inline (Is_Exported); @@ -9091,6 +9099,7 @@ package Einfo is pragma Inline (Set_Is_Dispatching_Operation); pragma Inline (Set_Is_Eliminated); pragma Inline (Set_Is_Entry_Formal); + pragma Inline (Set_Is_Entry_Wrapper); pragma Inline (Set_Is_Exception_Handler); pragma Inline (Set_Is_Exported); pragma Inline (Set_Is_Finalized_Transient); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index fa18400c12e..2a0dac730d8 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6014,6 +6014,19 @@ package body Exp_Ch6 is elsif Nkind (Name (N)) = N_Indexed_Component then Rec := Prefix (Prefix (Name (N))); + -- If this is a call within an entry wrapper, it appears within a + -- precondition that calls another primitive of the synchronized + -- type. The target object of the call is the first actual on the + -- wrapper. Note that this is an external call, because the wrapper + -- is called outside of the synchronized object. This means that + -- an entry call to an entry with preconditions involves two + -- synchronized operations. + + elsif Ekind (Current_Scope) = E_Procedure + and then Is_Entry_Wrapper (Current_Scope) + then + Rec := New_Occurrence_Of (First_Entity (Current_Scope), Sloc (N)); + else -- If the context is the initialization procedure for a protected -- type, the call is legal because the called entity must be a diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index b2e821ca119..18a56aeb463 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1495,6 +1495,7 @@ package body Exp_Ch9 is Wrapper_Id := Make_Defining_Identifier (Loc, New_External_Name (Chars (E), 'E')); Set_Contract_Wrapper (E, Wrapper_Id); + Set_Is_Entry_Wrapper (Wrapper_Id); -- The wrapper body is analyzed when the enclosing type is frozen diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 188872e483f..8d883383d54 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3839,8 +3839,27 @@ package body Sem_Attr is when Attribute_Finalization_Size => Check_E0; - Analyze_And_Resolve (P); - Check_Object_Reference (P); + + if Is_Object_Reference (P) then + Analyze_And_Resolve (P); + Check_Object_Reference (P); + + -- Redundant type verification for accurate error output + + elsif not Is_Entity_Name (P) + or else not Is_Type (Entity (P)) + then + Error_Attr_P ("prefix of % attribute must be a definite type or" & + " an object"); + else + Check_Type; + Check_Not_Incomplete_Type; + if Is_Class_Wide_Type (Etype (P)) then + Error_Attr_P ("prefix of % attribute cannot be applied to " & + "a class-wide type"); + end if; + end if; + Set_Etype (N, Universal_Integer); ----------- diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index cd11b526e2c..c68ce0de954 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -247,10 +247,10 @@ package Sem_Attr is ----------------------- Attribute_Finalization_Size => True, - -- For every object, Finalization_Size returns the size of the hidden - -- header used for finalization purposes as if the object was allocated - -- on the heap. The size of the header does take into account any extra - -- padding due to alignment issues. + -- For every object or non-class-wide-type, Finalization_Size returns + -- the size of the hidden header used for finalization purposes as if + -- the object or type was allocated on the heap. The size of the header + -- does take into account any extra padding due to alignment issues. ----------------- -- Fixed_Value -- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3122552e971..21790c35f79 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -62,6 +62,7 @@ with Sem_Ch3; use Sem_Ch3; with Sem_Ch4; use Sem_Ch4; with Sem_Ch5; use Sem_Ch5; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch9; use Sem_Ch9; with Sem_Ch10; use Sem_Ch10; with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; @@ -3640,6 +3641,21 @@ package body Sem_Ch6 is Generate_Definition (Body_Id); Generate_Reference (Body_Id, Body_Id, 'b', Set_Ref => False, Force => True); + + -- If the body is an entry wrapper created for an entry with + -- preconditions, it must compiled in the context of the + -- enclosing synchronized object, because it may mention other + -- operations of the type. + + if Is_Entry_Wrapper (Body_Id) then + declare + Prot : constant Entity_Id := Etype (First_Entity (Body_Id)); + begin + Push_Scope (Prot); + Install_Declarations (Prot); + end; + end if; + Install_Formals (Body_Id); Push_Scope (Body_Id); @@ -4000,6 +4016,14 @@ package body Sem_Ch6 is Process_End_Label (HSS, 't', Current_Scope); End_Scope; + + -- If we are compiling an entry wrapper, remove the enclosing + -- syncrhonized object from the stack. + + if Is_Entry_Wrapper (Body_Id) then + End_Scope; + end if; + Check_Subprogram_Order (N); Set_Analyzed (Body_Id); -- 2.30.2