https://gcc.gnu.org/g:e67b47d8752a0a38fdecac0d5b1c5525352697d2
commit r17-1648-ge67b47d8752a0a38fdecac0d5b1c5525352697d2 Author: Eric Botcazou <[email protected]> Date: Wed Jun 3 23:16:41 2026 +0200 ada: Remove obsolete two-pronged implementation of static accessibility checks For type conversions in instance bodies. It's barely maintainable and the raise statements are directly inserted for these checks in other contexts. gcc/ada/ChangeLog: * exp_ch4.adb (Expand_N_Type_Conversion): Do not apply again static accessibility checks in instance bodies. * sem_res.adb (Valid_Conversion): Insert the raise statements for the failure of static accessibility checks in instance bodies. Diff: --- gcc/ada/exp_ch4.adb | 85 ----------------------------------------------------- gcc/ada/sem_res.adb | 17 +++++++---- 2 files changed, 12 insertions(+), 90 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 9b36c1cc06d0..52826388282d 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11501,21 +11501,9 @@ package body Exp_Ch4 is -- assignment to temporary. If there is no change of representation, -- then the conversion node is unchanged. - procedure Raise_Accessibility_Error; - -- Called when we know that an accessibility check will fail. Rewrites - -- node N to an appropriate raise statement and outputs warning msgs. - -- The Etype of the raise node is set to Target_Type. Note that in this - -- case the rest of the processing should be skipped (i.e. the call to - -- this procedure will be followed by "goto Done"). - procedure Real_Range_Check; -- Handles generation of range check for real target value - function Statically_Deeper_Relation_Applies (Targ_Typ : Entity_Id) - return Boolean; - -- Given a target type for a conversion, determine whether the - -- statically deeper accessibility rules apply to it. - -------------------------- -- Discrete_Range_Check -- -------------------------- @@ -11755,22 +11743,6 @@ package body Exp_Ch4 is end if; end Handle_Changed_Representation; - ------------------------------- - -- Raise_Accessibility_Error -- - ------------------------------- - - procedure Raise_Accessibility_Error is - begin - Error_Msg_Warn := SPARK_Mode /= On; - Rewrite (N, - Make_Raise_Program_Error (Sloc (N), - Reason => PE_Accessibility_Check_Failed)); - Set_Etype (N, Target_Type); - - Error_Msg_N ("accessibility check failure<<", N); - Error_Msg_N ("\Program_Error [<<", N); - end Raise_Accessibility_Error; - ---------------------- -- Real_Range_Check -- ---------------------- @@ -12023,25 +11995,6 @@ package body Exp_Ch4 is Rewrite (Expr, New_Occurrence_Of (Tnn, Loc)); end Real_Range_Check; - ---------------------------------------- - -- Statically_Deeper_Relation_Applies -- - ---------------------------------------- - - function Statically_Deeper_Relation_Applies (Targ_Typ : Entity_Id) - return Boolean - is - begin - -- The case where the target type is an anonymous access type is - -- ignored since they have different semantics and get covered by - -- various runtime checks depending on context. - - -- Note, the current implementation of this predicate is incomplete - -- and doesn't fully reflect the rules given in RM 3.10.2 (19) and - -- (19.1) ??? - - return Ekind (Targ_Typ) /= E_Anonymous_Access_Type; - end Statically_Deeper_Relation_Applies; - -- Start of processing for Expand_N_Type_Conversion begin @@ -12321,44 +12274,6 @@ package body Exp_Ch4 is Apply_Accessibility_Check_For_Conversion (Operand, Target_Type, Insert_Node => Operand); end if; - - -- If the level of the operand type is statically deeper than the - -- level of the target type, then force Program_Error. Note that this - -- can only occur for cases where the attribute is within the body of - -- an instantiation, otherwise the conversion will already have been - -- rejected as illegal. - - -- Note: warnings are issued by the analyzer for the instance cases, - -- and, since we are late in expansion, a check is performed to - -- verify that neither the target type nor the operand type are - -- internally generated - as this can lead to spurious errors when, - -- for example, the operand type is a result of BIP expansion. - - elsif In_Instance_Body - and then Statically_Deeper_Relation_Applies (Target_Type) - and then not Is_Internal (Target_Type) - and then not Is_Internal (Operand_Type) - and then - Type_Access_Level (Operand_Type) > Type_Access_Level (Target_Type) - then - Raise_Accessibility_Error; - goto Done; - - -- When the operand is a selected access discriminant the check needs - -- to be made against the level of the object denoted by the prefix - -- of the selected name. Force Program_Error for this case as well - -- (this accessibility violation can only happen if within the body - -- of an instantiation). - - elsif In_Instance_Body - and then Ekind (Operand_Type) = E_Anonymous_Access_Type - and then Nkind (Operand) = N_Selected_Component - and then Ekind (Entity (Selector_Name (Operand))) = E_Discriminant - and then Static_Accessibility_Level (Operand, Zero_On_Dynamic_Level) - > Type_Access_Level (Target_Type) - then - Raise_Accessibility_Error; - goto Done; end if; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 1fd511c47d98..c91ae4e476bb 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -14464,8 +14464,7 @@ package body Sem_Res is = N_Component_Declaration) then -- In an instance, this is a run-time check, but one we know - -- will fail, so generate an appropriate warning. The raise - -- will be generated by Expand_N_Type_Conversion. + -- will fail, so generate an appropriate warning. if In_Instance_Body then Error_Msg_Warn := SPARK_Mode /= On; @@ -14473,6 +14472,11 @@ package body Sem_Res is ("cannot convert local pointer to non-local access type<<", Operand, Report_Errs); Report_Error_N ("\Program_Error [<<", Operand, Report_Errs); + Rewrite (N, + Make_Raise_Program_Error (Sloc (N), + Reason => PE_Accessibility_Check_Failed)); + Set_Etype (N, Target_Type); + return False; -- If not in an instance body, this is a real error @@ -14484,7 +14488,6 @@ package body Sem_Res is ("cannot convert local pointer to non-local access type", Operand, Report_Errs); end if; - return False; end if; @@ -14505,8 +14508,7 @@ package body Sem_Res is > Deepest_Type_Access_Level (Target_Type) then -- In an instance, this is a run-time check, but one we know - -- will fail, so generate an appropriate warning. The raise - -- will be generated by Expand_N_Type_Conversion. + -- will fail, so generate an appropriate warning. if In_Instance_Body then Error_Msg_Warn := SPARK_Mode /= On; @@ -14515,6 +14517,11 @@ package body Sem_Res is & "access type<<", Operand, Report_Errs); Report_Error_N ("\Program_Error [<<", Operand, Report_Errs); + Rewrite (N, + Make_Raise_Program_Error (Sloc (N), + Reason => PE_Accessibility_Check_Failed)); + Set_Etype (N, Target_Type); + return False; -- If not in an instance body, this is a real error
