From: Arnaud Charlet <charlet@adacore.com>
Date: Mon, 2 Mar 2020 11:58:01 +0000 (-0500)
Subject: [Ada] Remove kludge for AI05-0087
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1a7748ad4c356f37d324a36c21054735f2ca6f89;p=gcc.git

[Ada] Remove kludge for AI05-0087

2020-06-09  Arnaud Charlet  <charlet@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.
---

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;