From: Eric Botcazou Date: Wed, 9 Mar 2022 19:47:00 +0000 (+0100) Subject: [Ada] Fix internal error on predicate aspect with iterator X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=861b78a946b0d0936baed97fb17fe3c7b300a8c5;p=platform%2Fupstream%2Fgcc.git [Ada] Fix internal error on predicate aspect with iterator The semantic analysis of predicates involves a fair amount of tree copying because of both semantic and implementation considerations, and there is a difficulty with quantified expressions since they declare a new entity that cannot be shared between the various copies of the tree. This change implements a specific processing for it in New_Copy_Tree that subsumes a couple of fixes made earlier for variants of the issue. gcc/ada/ * sem_util.ads (Is_Entity_Of_Quantified_Expression): Declare. * sem_util.adb (Is_Entity_Of_Quantified_Expression): New predicate. (New_Copy_Tree): Deal with all entities of quantified expressions. * sem_ch13.adb (Build_Predicate_Functions): Get rid of superfluous tree copying and remove obsolete code. * sem_ch6.adb (Fully_Conformant_Expressions): Deal with all entities of quantified expressions. --- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 61f7ba7..f597024 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10231,16 +10231,13 @@ package body Sem_Ch13 is Set_SCO_Pragma_Enabled (Sloc (Prag)); - -- Extract the arguments of the pragma. The expression itself - -- is copied for use in the predicate function, to preserve the - -- original version for ASIS use. - -- Is this still needed??? + -- Extract the arguments of the pragma Arg1 := First (Pragma_Argument_Associations (Prag)); Arg2 := Next (Arg1); Arg1 := Get_Pragma_Arg (Arg1); - Arg2 := New_Copy_Tree (Get_Pragma_Arg (Arg2)); + Arg2 := Get_Pragma_Arg (Arg2); -- When the predicate pragma applies to the current type or its -- full view, replace all occurrences of the subtype name with @@ -10455,45 +10452,12 @@ package body Sem_Ch13 is if Raise_Expression_Present then declare - function Reset_Loop_Variable - (N : Node_Id) return Traverse_Result; - - procedure Reset_Loop_Variables is - new Traverse_Proc (Reset_Loop_Variable); - - ------------------------ - -- Reset_Loop_Variable -- - ------------------------ - - function Reset_Loop_Variable - (N : Node_Id) return Traverse_Result - is - begin - if Nkind (N) = N_Iterator_Specification then - Set_Defining_Identifier (N, - Make_Defining_Identifier - (Sloc (N), Chars (Defining_Identifier (N)))); - end if; - - return OK; - end Reset_Loop_Variable; - - -- Local variables - Map : constant Elist_Id := New_Elmt_List; begin Append_Elmt (Object_Entity, Map); Append_Elmt (Object_Entity_M, Map); Expr_M := New_Copy_Tree (Expr, Map => Map); - - -- The unanalyzed expression will be copied and appear in - -- both functions. Normally expressions do not declare new - -- entities, but quantified expressions do, so we need to - -- create new entities for their bound variables, to prevent - -- multiple definitions in gigi. - - Reset_Loop_Variables (Expr_M); end; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index dbcb255..38ed14f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10106,14 +10106,13 @@ package body Sem_Ch6 is and then Discriminal_Link (Entity (E1)) = Discriminal_Link (Entity (E2))) - -- AI12-050: The loop variables of quantified expressions match - -- if they have the same identifier, even though they may have - -- different entities. + -- AI12-050: The entities of quantified expressions match if they + -- have the same identifier, even if they may be distinct nodes. or else (Chars (Entity (E1)) = Chars (Entity (E2)) - and then Ekind (Entity (E1)) = E_Loop_Parameter - and then Ekind (Entity (E2)) = E_Loop_Parameter) + and then Is_Entity_Of_Quantified_Expression (Entity (E1)) + and then Is_Entity_Of_Quantified_Expression (Entity (E2))) -- A call to an instantiation of Unchecked_Conversion is -- rewritten with the name of the generated function created for diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1ea9fd9..225d761 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -17624,6 +17624,21 @@ package body Sem_Util is end if; end Is_Effectively_Volatile_Object_Shared; + ---------------------------------------- + -- Is_Entity_Of_Quantified_Expression -- + ---------------------------------------- + + function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean + is + Par : constant Node_Id := Parent (Id); + + begin + return (Nkind (Par) = N_Loop_Parameter_Specification + or else Nkind (Par) = N_Iterator_Specification) + and then Defining_Identifier (Par) = Id + and then Nkind (Parent (Par)) = N_Quantified_Expression; + end Is_Entity_Of_Quantified_Expression; + ------------------- -- Is_Entry_Body -- ------------------- @@ -24622,22 +24637,20 @@ package body Sem_Util is -- ??? this list is flaky, and may hide dormant bugs -- Should functions be included??? - -- Loop parameters appear within quantified expressions and contain - -- an entity declaration that must be replaced when the expander is - -- active if the expression has been preanalyzed or analyzed. + -- Quantified expressions contain an entity declaration that must + -- always be replaced when the expander is active, even if it has + -- not been analyzed yet like e.g. in predicates. - elsif Ekind (Id) not in - E_Block | E_Constant | E_Label | E_Loop_Parameter | - E_Procedure | E_Variable + elsif Ekind (Id) not in E_Block + | E_Constant + | E_Label + | E_Procedure + | E_Variable + and then not Is_Entity_Of_Quantified_Expression (Id) and then not Is_Type (Id) then return; - elsif Ekind (Id) = E_Loop_Parameter - and then No (Etype (Condition (Parent (Parent (Id))))) - then - return; - -- Nothing to do when the entity was already visited elsif NCT_Tables_In_Use @@ -24661,9 +24674,12 @@ package body Sem_Util is New_Id := New_Copy (Id); -- Create a new name for the new entity because the back end needs - -- distinct names for debugging purposes. + -- distinct names for debugging purposes, provided that the entity + -- has already been analyzed. - Set_Chars (New_Id, New_Internal_Name ('T')); + if Ekind (Id) /= E_Void then + Set_Chars (New_Id, New_Internal_Name ('T')); + end if; -- Update the Comes_From_Source and Sloc attributes of the entity in -- case the caller has supplied new values. diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 323f43f..3ce2233 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2055,6 +2055,9 @@ package Sem_Util is -- Determine whether an arbitrary node denotes an effectively volatile -- object for reading (SPARK RM 7.1.2). + function Is_Entity_Of_Quantified_Expression (Id : Entity_Id) return Boolean; + -- Determine whether entity Id is the entity of a quantified expression + function Is_Entry_Body (Id : Entity_Id) return Boolean; -- Determine whether entity Id is the body entity of an entry [family]