From a1014c8136a0d23408e83620ee7d12be0ab27831 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 22 May 2020 01:37:00 +0200 Subject: [PATCH] [Ada] Fix internal error on string type comparision with predicate gcc/ada/ * freeze.adb (Has_Decl_In_List): New predicate to check that an entity is declared in a list of nodes. (Freeze_Expression): Use it to deal with Expression_With_Actions, short-circuit expression, if- and case-expression and ensure that the freeze node is put onto their Actions list if the entity is declared locally. --- gcc/ada/freeze.adb | 87 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 71 insertions(+), 16 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 33eefb22efe..4b58b756b1c 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -7060,6 +7060,13 @@ package body Freeze is -- proc, a stream subprogram, or a renaming as body. If so, this is not -- a freezing context and the entity will be frozen at a later point. + function Has_Decl_In_List + (E : Entity_Id; + N : Node_Id; + L : List_Id) return Boolean; + -- Determines whether an entity E referenced in node N is declared in + -- the list L. + ----------------------------------------- -- Find_Aggregate_Component_Desig_Type -- ----------------------------------------- @@ -7141,6 +7148,30 @@ package body Freeze is end if; end In_Expanded_Body; + ---------------------- + -- Has_Decl_In_List -- + ---------------------- + + function Has_Decl_In_List + (E : Entity_Id; + N : Node_Id; + L : List_Id) return Boolean + is + Decl_Node : Node_Id; + + begin + -- If E is an itype, pretend that it is declared in N + + if Is_Itype (E) then + Decl_Node := N; + else + Decl_Node := Declaration_Node (E); + end if; + + return Is_List_Member (Decl_Node) + and then List_Containing (Decl_Node) = L; + end Has_Decl_In_List; + -- Local variables In_Spec_Exp : constant Boolean := In_Spec_Expression; @@ -7592,7 +7623,6 @@ package body Freeze is when N_Abortable_Part | N_Accept_Alternative - | N_And_Then | N_Case_Statement_Alternative | N_Compilation_Unit_Aux | N_Conditional_Entry_Call @@ -7603,21 +7633,50 @@ package body Freeze is | N_Extended_Return_Statement | N_Freeze_Entity | N_If_Statement - | N_Or_Else | N_Selective_Accept | N_Triggering_Alternative => exit when Is_List_Member (P); - -- Freeze nodes produced by an expression coming from the - -- Actions list of a N_Expression_With_Actions node must remain - -- within the Actions list. Inserting the freeze nodes further - -- up the tree may lead to use before declaration issues in the - -- case of array types. + -- The freeze nodes produced by an expression coming from the + -- Actions list of an N_Expression_With_Actions, short-circuit + -- expression or N_Case_Expression_Alternative node must remain + -- within the Actions list if they freeze an entity declared in + -- this list, as inserting the freeze nodes further up the tree + -- may lead to use before declaration issues for the entity. + + when N_Case_Expression_Alternative + | N_Expression_With_Actions + | N_Short_Circuit + => + exit when (Present (Nam) + and then + Has_Decl_In_List (Nam, P, Actions (Parent_P))) + or else (Present (Typ) + and then + Has_Decl_In_List (Typ, P, Actions (Parent_P))); - when N_Expression_With_Actions => - exit when Is_List_Member (P) - and then List_Containing (P) = Actions (Parent_P); + -- Likewise for an N_If_Expression and its two Actions list + + when N_If_Expression => + declare + L1 : constant List_Id := Then_Actions (Parent_P); + L2 : constant List_Id := Else_Actions (Parent_P); + + begin + exit when (Present (Nam) + and then + Has_Decl_In_List (Nam, P, L1)) + or else (Present (Typ) + and then + Has_Decl_In_List (Typ, P, L1)) + or else (Present (Nam) + and then + Has_Decl_In_List (Nam, P, L2)) + or else (Present (Typ) + and then + Has_Decl_In_List (Typ, P, L2)); + end; -- N_Loop_Statement is a special case: a type that appears in -- the source can never be frozen in a loop (this occurs only @@ -7625,13 +7684,9 @@ package body Freeze is -- going. Otherwise we terminate the search. Same is true of -- any entity which comes from source (if it has a predefined -- type, this type does not appear to come from source, but the - -- entity should not be frozen here). The reasoning can also be - -- applied to if-expressions and case-expressions. + -- entity should not be frozen here). - when N_Loop_Statement - | N_If_Expression - | N_Case_Expression - => + when N_Loop_Statement => exit when not Comes_From_Source (Etype (N)) and then (No (Nam) or else not Comes_From_Source (Nam)); -- 2.30.2