sem_ch6.adb (Analyze_Expression_Function): Call Check_Dynamically_Tagged_Expression.
authorBob Duff <duff@adacore.com>
Tue, 12 Sep 2017 09:09:30 +0000 (09:09 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 12 Sep 2017 09:09:30 +0000 (11:09 +0200)
2017-09-12  Bob Duff  <duff@adacore.com>

* sem_ch6.adb (Analyze_Expression_Function): Call
Check_Dynamically_Tagged_Expression.
* sem_util.adb (Check_Dynamically_Tagged_Expression): Remove
"and then Is_Tagged_Type (Typ)" because there is an earlier
"Assert (Is_Tagged_Type (Typ))".

From-SVN: r251999

gcc/ada/ChangeLog
gcc/ada/sem_ch6.adb
gcc/ada/sem_util.adb

index dbf52109e23c053d122dba26ce7b128e6e14b874..4882093bf326014a54ca2c76cd0543196e56bc26 100644 (file)
@@ -1,3 +1,11 @@
+2017-09-12  Bob Duff  <duff@adacore.com>
+
+       * sem_ch6.adb (Analyze_Expression_Function): Call
+       Check_Dynamically_Tagged_Expression.
+       * sem_util.adb (Check_Dynamically_Tagged_Expression): Remove
+       "and then Is_Tagged_Type (Typ)" because there is an earlier
+       "Assert (Is_Tagged_Type (Typ))".
+
 2017-09-12  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/Makefile.in (SPARC/Solaris): Remove obsolete stuff.
index b016193c099c3944616e76b4917f227031340966..b4232a5cfcde3291d58e1a3612448ca6c1a97811 100644 (file)
@@ -741,6 +741,21 @@ package body Sem_Ch6 is
          end;
       end if;
 
+      --  Check incorrect use of dynamically tagged expression. This doesn't
+      --  fall out automatically when analyzing the generated function body,
+      --  because Check_Dynamically_Tagged_Expression deliberately ignores
+      --  nodes that don't come from source.
+
+      if Present (Def_Id)
+        and then Nkind (Def_Id) in N_Has_Etype
+        and then Is_Tagged_Type (Etype (Def_Id))
+      then
+         Check_Dynamically_Tagged_Expression
+           (Expr => Expr,
+            Typ  => Etype (Def_Id),
+            Related_Nod => Original_Node (N));
+      end if;
+
       --  If the return expression is a static constant, we suppress warning
       --  messages on unused formals, which in most cases will be noise.
 
index 97c83a26bfc45c1c65d645d7b8d6d6d947350a21..bbf60a65bb0a234169064e19048e0c76f40a6c07 100644 (file)
@@ -2022,7 +2022,6 @@ package body Sem_Util is
            or else In_Generic_Actual (Expr))
         and then (Is_Class_Wide_Type (Etype (Expr))
                    or else Is_Dynamically_Tagged (Expr))
-        and then Is_Tagged_Type (Typ)
         and then not Is_Class_Wide_Type (Typ)
       then
          Error_Msg_N ("dynamically tagged expression not allowed!", Expr);