diff options
| -rw-r--r-- | gcc/ada/exp_disp.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 5 |
3 files changed, 42 insertions, 4 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 1585998..65d5b2a 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1085,12 +1085,26 @@ package body Exp_Disp is Set_Extra_Formal (Last_Formal, New_Formal); Set_Extra_Formals (Subp_Typ, New_Formal); + if Ekind (Subp) = E_Function + and then Present (Extra_Accessibility_Of_Result (Subp)) + and then Extra_Accessibility_Of_Result (Subp) = Old_Formal + then + Set_Extra_Accessibility_Of_Result (Subp_Typ, New_Formal); + end if; + Old_Formal := Extra_Formal (Old_Formal); while Present (Old_Formal) loop Set_Extra_Formal (New_Formal, New_Copy (Old_Formal)); New_Formal := Extra_Formal (New_Formal); Set_Scope (New_Formal, Subp_Typ); + if Ekind (Subp) = E_Function + and then Present (Extra_Accessibility_Of_Result (Subp)) + and then Extra_Accessibility_Of_Result (Subp) = Old_Formal + then + Set_Extra_Accessibility_Of_Result (Subp_Typ, New_Formal); + end if; + Old_Formal := Extra_Formal (Old_Formal); end loop; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 4862c7d..57b4894 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -8718,6 +8718,14 @@ package body Freeze is Has_Extra_Formals : Boolean := False; begin + -- No check required if expansion is disabled because extra + -- formals are only generated when we are generating code. + -- See Create_Extra_Formals. + + if not Expander_Active then + return True; + end if; + -- Check attribute Extra_Formal: if available it must be set only -- in the last formal of E @@ -8735,6 +8743,15 @@ package body Freeze is Next_Formal (Formal); end loop; + -- Check attribute Extra_Accessibility_Of_Result + + if Ekind_In (E, E_Function, E_Subprogram_Type) + and then Needs_Result_Accessibility_Level (E) + and then No (Extra_Accessibility_Of_Result (E)) + then + return False; + end if; + -- Check attribute Extra_Formals: if E has extra formals then this -- attribute must must point to the first extra formal of E. @@ -8897,14 +8914,16 @@ package body Freeze is -- still unset (and must be set now). if Present (Alias (E)) + and then Is_Frozen (Ultimate_Alias (E)) and then Present (Extra_Formals (Ultimate_Alias (E))) and then Last_Formal (Ultimate_Alias (E)) = Last_Formal (E) then - pragma Assert (Is_Frozen (Ultimate_Alias (E))); - pragma Assert (No (First_Formal (Ultimate_Alias (E))) - or else - Present (Extra_Formal (Last_Formal (Ultimate_Alias (E))))); Set_Extra_Formals (E, Extra_Formals (Ultimate_Alias (E))); + + if Ekind (E) = E_Function then + Set_Extra_Accessibility_Of_Result (E, + Extra_Accessibility_Of_Result (Ultimate_Alias (E))); + end if; else Create_Extra_Formals (E); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 6e0cfe2..78de388 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15563,6 +15563,11 @@ package body Sem_Ch3 is Set_Extra_Formals (New_Subp, Extra_Formals (Parent_Subp)); + if Ekind (New_Subp) = E_Function then + Set_Extra_Accessibility_Of_Result (New_Subp, + Extra_Accessibility_Of_Result (Parent_Subp)); + end if; + -- If this derivation corresponds to a tagged generic actual, then -- primitive operations rename those of the actual. Otherwise the -- primitive operations rename those of the parent type, If the parent |