diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/accessibility.adb | 54 | ||||
| -rw-r--r-- | gcc/ada/accessibility.ads | 9 | ||||
| -rw-r--r-- | 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 6b4ec5b..bc897d1 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 731fea1..000e9b6 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 function needs an implicit - -- parameter to identify the accessibility level of the function result. - -- If the type of the function result is a private type and its completion - -- is unavailable, which can happen when we are analyzing an abstract - -- subprogram, determines its result using the returned private type. This - -- function is used by Create_Extra_Formals. - function Needs_Result_Accessibility_Level (Func_Id : Entity_Id) return Boolean; -- Ada 2012 (AI05-0234): Return True if the function needs an implicit diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 612a9e9..a0dad86 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8766,7 +8766,12 @@ package body Sem_Ch6 is Ovr_Alias : Entity_Id; begin - if Present (Ovr_E) then + if Present (Ovr_E) + and then Ekind (Ovr_E) = E_Enumeration_Literal + then + Ovr_E := Empty; + + elsif Present (Ovr_E) then Ovr_Alias := Ultimate_Alias (Ovr_E); -- There is no real overridden subprogram if there is a mutual @@ -8992,6 +8997,18 @@ package body Sem_Ch6 is -- for extra formals. if Present (Parent_Subp) then + + -- Ensure that the parent subprogram has all its extra formals. + -- Required because its return type may have been a private or + -- an incomplete type, and the extra formals were not added. We + -- protect this call against the weird cases where the parent subp + -- renames this primitive (documented in the body of the local + -- function Parent_Subprogram). + + if Ultimate_Alias (Parent_Subp) /= Ref_E then + Create_Extra_Formals (Parent_Subp); + end if; + Parent_Formal := First_Formal (Parent_Subp); -- For concurrent types, the controlling argument of a dispatching @@ -9140,13 +9157,13 @@ package body Sem_Ch6 is begin Ada_Version := Ada_2022; - if Needs_Result_Accessibility_Extra_Formal (Ref_E) + if Needs_Result_Accessibility_Level (Ref_E) or else (Present (Parent_Subp) - and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp)) + and then Needs_Result_Accessibility_Level (Parent_Subp)) or else (Present (Alias_Subp) - and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp)) + and then Needs_Result_Accessibility_Level (Alias_Subp)) then Set_Extra_Accessibility_Of_Result (E, Add_Extra_Formal (E, Standard_Natural, E, "L")); @@ -9695,7 +9712,7 @@ package body Sem_Ch6 is -- Check attribute Extra_Accessibility_Of_Result if Ekind (E) in E_Function | E_Subprogram_Type - and then Needs_Result_Accessibility_Extra_Formal (E) + and then Needs_Result_Accessibility_Level (E) and then No (Extra_Accessibility_Of_Result (E)) then return False; |