[COMMITTED] ada: Crash on creation of extra formals on type extension
From: Javier Miranda Revert previous patch and fix the pending issue. gcc/ada/ * accessibility.ads (Needs_Result_Accessibility_Extra_Formal): Removed. * accessibility.adb (Needs_Result_Accessibility_Level_Param): Removed. (Needs_Result_Accessibility_Extra_Formal): Removed. (Needs_Result_Accessibility_Level): Revert previous patch. * sem_ch6.adb (Parent_Subprogram): Handle function overriding an enumeration literal. (Create_Extra_Formals): Ensure that the parent subprogram has all its extra formals. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 54 ++- gcc/ada/accessibility.ads | 9 --- gcc/ada/sem_ch6.adb | 27 3 files changed, 24 insertions(+), 66 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index 6b4ec5b9d24..bc897d1ef18 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -56,16 +56,6 @@ with Tbuild; use Tbuild; package body Accessibility is - function Needs_Result_Accessibility_Level_Param - (Func_Id : Entity_Id; - Func_Typ : Entity_Id) return Boolean; - -- Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and - -- Needs_Result_Accessibility_Level_Param. Return True if the function - -- needs an implicit parameter to identify the accessibility level of - -- the function result "determined by the point of call". Func_Typ is - -- the function return type; this function returns False if Func_Typ is - -- Empty. - --- -- Accessibility_Message -- --- @@ -1902,34 +1892,6 @@ package body Accessibility is and then Is_Explicitly_Aliased (Entity (Prefix (Exp))); end Is_Special_Aliased_Formal_Access; - - - -- Needs_Result_Accessibility_Extra_Formal -- - - - - function Needs_Result_Accessibility_Extra_Formal - (Func_Id : Entity_Id) return Boolean - is - Func_Typ : Entity_Id; - - begin - if Present (Underlying_Type (Etype (Func_Id))) then - Func_Typ := Underlying_Type (Etype (Func_Id)); - - -- Case of a function returning a private type which is not completed - -- yet. The support for this case is required because this function is - -- called to create the extra formals of dispatching primitives, and - -- they may be frozen before we see the full-view of their returned - -- private type. - - else - -- Temporarily restore previous behavior - -- Func_Typ := Etype (Func_Id); - Func_Typ := Empty; - end if; - - return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); - end Needs_Result_Accessibility_Extra_Formal; - -- -- Needs_Result_Accessibility_Level -- -- @@ -1939,18 +1901,6 @@ package body Accessibility is is Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); - begin - return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); - end Needs_Result_Accessibility_Level; - - - -- Needs_Result_Accessibility_Level_Param -- - - - function Needs_Result_Accessibility_Level_Param - (Func_Id : Entity_Id; - Func_Typ : Entity_Id) return Boolean - is function Has_Unconstrained_Access_Discriminant_Component (Comp_Typ : Entity_Id) return Boolean; -- Returns True if any component of the type has an unconstrained access @@ -2002,7 +1952,7 @@ package body Accessibility is -- Flag used to temporarily disable a "True" result for tagged types. -- See comments further below for details. - -- Start of processing for Needs_Result_Accessibility_Level_Param + -- Start of processing for Needs_Result_Accessibility_Level begin -- False if completion unavailable, which can happen when we are @@ -2078,7 +2028,7 @@ package body Accessibility is else return False; end if; - end Needs_Result_Accessibility_Level_Param; + end Needs_Result_Accessibility_Level; -- -- Prefix_With_Safe_Accessibility_Level -- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index 731fea125f4..000e9b6e1e4 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -197,15 +197,6 @@ package Accessibility is -- prefix is an aliased formal of Scop and that Scop returns an anonymous -- access type. See RM 3.10.2 for more details. - function Needs_Result_Accessibility_Extra_Formal - (Func_Id : Entity_Id) return Boolean; - -- Ada 2012 (AI05-0234): Return True if the functio
[COMMITTED] ada: Crash on creation of extra formals on type extension
From: Javier Miranda The compiler blows up processing an overriding dispatching function of a derived tagged type that returns a private tagged type that has an access type discriminant. gcc/ada/ * accessibility.ads (Needs_Result_Accessibility_Extra_Formal): New subprogram. * accessibility.adb (Needs_Result_Accessibility_Level_Param): New subprogram. (Needs_Result_Accessibility_Extra_Formal): New subprogram, temporarily keep the previous behavior of the frontend. * sem_ch6.adb (Create_Extra_Formals): Replace occurrences of function Needs_Result_Accessibility_Level_Param by calls to function Needs_Result_Accessibility_Extra_Formal. (Extra_Formals_OK): Ditto. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 54 +-- gcc/ada/accessibility.ads | 12 - gcc/ada/sem_ch6.adb | 8 +++--- 3 files changed, 67 insertions(+), 7 deletions(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index bc897d1ef18..6b4ec5b9d24 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -56,6 +56,16 @@ with Tbuild; use Tbuild; package body Accessibility is + function Needs_Result_Accessibility_Level_Param + (Func_Id : Entity_Id; + Func_Typ : Entity_Id) return Boolean; + -- Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and + -- Needs_Result_Accessibility_Level_Param. Return True if the function + -- needs an implicit parameter to identify the accessibility level of + -- the function result "determined by the point of call". Func_Typ is + -- the function return type; this function returns False if Func_Typ is + -- Empty. + --- -- Accessibility_Message -- --- @@ -1892,6 +1902,34 @@ package body Accessibility is and then Is_Explicitly_Aliased (Entity (Prefix (Exp))); end Is_Special_Aliased_Formal_Access; + - + -- Needs_Result_Accessibility_Extra_Formal -- + - + + function Needs_Result_Accessibility_Extra_Formal + (Func_Id : Entity_Id) return Boolean + is + Func_Typ : Entity_Id; + + begin + if Present (Underlying_Type (Etype (Func_Id))) then + Func_Typ := Underlying_Type (Etype (Func_Id)); + + -- Case of a function returning a private type which is not completed + -- yet. The support for this case is required because this function is + -- called to create the extra formals of dispatching primitives, and + -- they may be frozen before we see the full-view of their returned + -- private type. + + else + -- Temporarily restore previous behavior + -- Func_Typ := Etype (Func_Id); + Func_Typ := Empty; + end if; + + return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); + end Needs_Result_Accessibility_Extra_Formal; + -- -- Needs_Result_Accessibility_Level -- -- @@ -1901,6 +1939,18 @@ package body Accessibility is is Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); + begin + return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ); + end Needs_Result_Accessibility_Level; + + + -- Needs_Result_Accessibility_Level_Param -- + + + function Needs_Result_Accessibility_Level_Param + (Func_Id : Entity_Id; + Func_Typ : Entity_Id) return Boolean + is function Has_Unconstrained_Access_Discriminant_Component (Comp_Typ : Entity_Id) return Boolean; -- Returns True if any component of the type has an unconstrained access @@ -1952,7 +2002,7 @@ package body Accessibility is -- Flag used to temporarily disable a "True" result for tagged types. -- See comments further below for details. - -- Start of processing for Needs_Result_Accessibility_Level + -- Start of processing for Needs_Result_Accessibility_Level_Param begin -- False if completion unavailable, which can happen when we are @@ -2028,7 +2078,7 @@ package body Accessibility is else return False; end if; - end Needs_Result_Accessibility_Level; + end Needs_Result_Accessibility_Level_Param; -- -- Prefix_With_Safe_Accessibility_Level -- diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads index e30c90ab6a7..731fea125f4 100644 --- a/gcc/ada/accessibility.ads +++ b/gcc/ada/accessibility.ads @@ -197,11 +197,21 @@ package Accessibility is -- prefix is an aliased formal of Scop and that Scop returns an anonymous -- access type. See RM 3.10.2 for more details. +
