From 1a7748ad4c356f37d324a36c21054735f2ca6f89 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 Mar 2020 06:58:01 -0500 Subject: [PATCH] [Ada] Remove kludge for AI05-0087 2020-06-09 Arnaud Charlet gcc/ada/ * exp_ch5.adb (Expand_N_Assignment): Remove kludge for AI05-0087. * sem_ch12.adb (Validate_Derived_Type_Instance): Implement AI05-0087 retroactively since it's a binding interpretation. --- gcc/ada/exp_ch5.adb | 25 ++++++------------------- gcc/ada/sem_ch12.adb | 30 ++++++++---------------------- 2 files changed, 14 insertions(+), 41 deletions(-) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 02e9f46d4ab..3e37f153566 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -29,7 +29,6 @@ with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; -with Errout; use Errout; with Exp_Aggr; use Exp_Aggr; with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; @@ -2664,25 +2663,13 @@ package body Exp_Ch5 is and then not Restriction_Active (No_Dispatching_Calls)) then - if Is_Limited_Type (Typ) then - - -- This can happen in an instance when the formal is an - -- extension of a limited interface, and the actual is - -- limited. This is an error according to AI05-0087, but - -- is not caught at the point of instantiation in earlier - -- versions. We also must verify that the limited type does - -- not come from source as corner cases may exist where - -- an assignment was not intended like the pathological case - -- of a raise expression within a return statement. - - -- This is wrong, error messages cannot be issued during - -- expansion, since they would be missed in -gnatc mode ??? - - if Comes_From_Source (N) then - Error_Msg_N - ("assignment not available on limited type", N); - end if; + -- We should normally not encounter any limited type here, + -- except in the corner case where an assignment was not + -- intended like the pathological case of a raise expression + -- within a return statement. + if Is_Limited_Type (Typ) then + pragma Assert (not Comes_From_Source (N)); return; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index caf423a09e5..b29c00bafc1 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13460,17 +13460,8 @@ package body Sem_Ch12 is -- explicitly so. If not declared limited, the actual cannot be -- limited (see AI05-0087). - -- Even though this AI is a binding interpretation, we enable the - -- check only in Ada 2012 mode, because this improper construct - -- shows up in user code and in existing B-tests. - - if Is_Limited_Type (Act_T) - and then not Is_Limited_Type (A_Gen_T) - and then Ada_Version >= Ada_2012 - then - if In_Instance then - null; - else + if Is_Limited_Type (Act_T) and then not Is_Limited_Type (A_Gen_T) then + if not In_Instance then Error_Msg_NE ("actual for non-limited & cannot be a limited type", Actual, Gen_T); @@ -13479,30 +13470,25 @@ package body Sem_Ch12 is end if; end if; - -- Don't check Ada_Version here (for now) because AI12-0036 is - -- a binding interpretation; this decision may be reversed if - -- the situation turns out to be similar to that of the preceding - -- Is_Limited_Type test (see preceding comment). + -- Check for AI12-0036 declare Formal_Is_Private_Extension : constant Boolean := Nkind (Parent (A_Gen_T)) = N_Private_Extension_Declaration; Actual_Is_Tagged : constant Boolean := Is_Tagged_Type (Act_T); + begin if Actual_Is_Tagged /= Formal_Is_Private_Extension then - if In_Instance then - null; - else + if not In_Instance then if Actual_Is_Tagged then Error_Msg_NE - ("actual for & cannot be a tagged type", - Actual, Gen_T); + ("actual for & cannot be a tagged type", Actual, Gen_T); else Error_Msg_NE - ("actual for & must be a tagged type", - Actual, Gen_T); + ("actual for & must be a tagged type", Actual, Gen_T); end if; + Abandon_Instantiation (Actual); end if; end if; -- 2.30.2