From 0e3a687f8c5351a52f48c4062c2cf88cdc7d4424 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 12 Dec 2019 10:02:19 +0000 Subject: [PATCH] [Ada] Compiler crash on prefix call in generic body 2019-12-12 Bob Duff gcc/ada/ * sem_ch4.adb (Transform_Object_Operation): Deal properly with prefix notation in instances. From-SVN: r279285 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/sem_ch4.adb | 91 ++++++++++++++++++++++----------------------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 99b142c1428..150ee567785 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Bob Duff + + * sem_ch4.adb (Transform_Object_Operation): Deal properly with + prefix notation in instances. + 2019-12-12 Claire Dross * libgnat/a-cofove.adb, libgnat/a-cfinve.adb (Find_Index): Use diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 08905393795..03c74408f94 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8574,7 +8574,7 @@ package body Sem_Ch4 is procedure Transform_Object_Operation (Call_Node : out Node_Id; Node_To_Replace : out Node_Id); - -- Transform Obj.Operation (X, Y,,) into Operation (Obj, X, Y ..) + -- Transform Obj.Operation (X, Y, ...) into Operation (Obj, X, Y ...). -- Call_Node is the resulting subprogram call, Node_To_Replace is -- either N or the parent of N, and Subprog is a reference to the -- subprogram we are trying to match. @@ -9299,7 +9299,7 @@ package body Sem_Ch4 is -- Prefix notation can also be used on operations that are not -- primitives of the type, but are declared in the same immediate -- declarative part, which can only mean the corresponding package - -- body (See RM 4.1.3 (9.2/3)). If we are in that body we extend the + -- body (see RM 4.1.3 (9.2/3)). If we are in that body we extend the -- list of primitives with body operations with the same name that -- may be candidates, so that Try_Primitive_Operations can examine -- them if no real primitive is found. @@ -9425,56 +9425,55 @@ package body Sem_Ch4 is function Extended_Primitive_Ops (T : Entity_Id) return Elist_Id is Type_Scope : constant Entity_Id := Scope (T); - - Body_Decls : List_Id; - Op_Found : Boolean; - Op : Entity_Id; - Op_List : Elist_Id; - + Op_List : Elist_Id := Primitive_Operations (T); begin - Op_List := Primitive_Operations (T); - - if Ekind (Type_Scope) = E_Package - and then In_Package_Body (Type_Scope) - and then In_Open_Scopes (Type_Scope) + if Ekind_In (Type_Scope, E_Package, E_Generic_Package) + and then ((In_Package_Body (Type_Scope) + and then In_Open_Scopes (Type_Scope)) or else In_Instance_Body) then - -- Retrieve list of declarations of package body. - - Body_Decls := - Declarations - (Unit_Declaration_Node - (Corresponding_Body - (Unit_Declaration_Node (Type_Scope)))); - - Op := Current_Entity (Subprog); - Op_Found := False; - while Present (Op) loop - if Comes_From_Source (Op) - and then Is_Overloadable (Op) - - -- Exclude overriding primitive operations of a type - -- extension declared in the package body, to prevent - -- duplicates in extended list. - - and then not Is_Primitive (Op) - and then Is_List_Member (Unit_Declaration_Node (Op)) - and then List_Containing (Unit_Declaration_Node (Op)) = - Body_Decls - then - if not Op_Found then + -- Retrieve list of declarations of package body if possible - -- Copy list of primitives so it is not affected for - -- other uses. + declare + The_Body : constant Node_Id := + Corresponding_Body (Unit_Declaration_Node (Type_Scope)); + begin + if Present (The_Body) then + declare + Body_Decls : constant List_Id := + Declarations (Unit_Declaration_Node (The_Body)); + Op_Found : Boolean := False; + Op : Entity_Id := Current_Entity (Subprog); + begin + while Present (Op) loop + if Comes_From_Source (Op) + and then Is_Overloadable (Op) + + -- Exclude overriding primitive operations of a + -- type extension declared in the package body, + -- to prevent duplicates in extended list. + + and then not Is_Primitive (Op) + and then Is_List_Member + (Unit_Declaration_Node (Op)) + and then List_Containing + (Unit_Declaration_Node (Op)) = Body_Decls + then + if not Op_Found then + -- Copy list of primitives so it is not + -- affected for other uses. - Op_List := New_Copy_Elist (Op_List); - Op_Found := True; - end if; + Op_List := New_Copy_Elist (Op_List); + Op_Found := True; + end if; - Append_Elmt (Op, Op_List); - end if; + Append_Elmt (Op, Op_List); + end if; - Op := Homonym (Op); - end loop; + Op := Homonym (Op); + end loop; + end; + end if; + end; end if; return Op_List; -- 2.30.2