[Ada] Implement AI12-0036 (a new legality check for instantiations)

2019-12-12  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_ch12.adb
	(Instantiate_Type.Validate_Derived_Type_Instance): Implement the
	legality check of AI12-0036

From-SVN: r279292

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 48448b2a01951f3a83b0dc10b8d3a85a66bb0fbc..c2e4c36ab8951f62f7ba45ff60b632f17de23198 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-12-12  Steve Baird  <baird@adacore.com>
+
+       * sem_ch12.adb
+       (Instantiate_Type.Validate_Derived_Type_Instance): Implement the
+       legality check of AI12-0036
+
 2019-12-12  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch10.adb (Analyze_Subunit): Fix spurious visibility error

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 8c3559f98df91494ee694ac47d6098e838b06a53..e54e3536121ed204e03a7fb6da840e5188aa481e 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -13166,6 +13166,35 @@ package body Sem_Ch12 is
                Abandon_Instantiation (Actual);
             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).
+
+         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 Actual_Is_Tagged then
+                     Error_Msg_NE
+                       ("actual for & cannot be a tagged type",
+                        Actual, Gen_T);
+                  else
+                     Error_Msg_NE
+                       ("actual for & must be a tagged type",
+                        Actual, Gen_T);
+                  end if;
+                  Abandon_Instantiation (Actual);
+               end if;
+            end if;
+         end;
       end Validate_Derived_Type_Instance;
 
       ----------------------------------------