[Ada] Dynamically tagged expr of expr function is illegal

[Ada] Dynamically tagged expr of expr function is illegal

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 555 bytes --]

It is illegal to return a dynamically tagged expression
from an expression function that returns a specific type. See
RM-3.9.2(9). This patch fixes a bug that caused the compiler
to fail to detect this illegality.

Tested on x86_64-pc-linux-gnu, committed on trunk

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))".


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1459 bytes --]

Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 251998)
+++ sem_util.adb	(working copy)
@@ -2022,7 +2022,6 @@
            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);
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 251998)
+++ sem_ch6.adb	(working copy)
@@ -741,6 +741,21 @@
          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.