This is a code clean up as part of removing all calls to Error_Msg* in
the expander.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-09 Arnaud Charlet <char...@adacore.com>
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
+++ 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;
--- gcc/ada/sem_ch12.adb
+++ 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;
