sem_util.ads, [...] (Check_Dynamically_Tagged_Expression): New subprogram.

2009-07-20  Javier Miranda  <miranda@adacore.com>

	* sem_util.ads, sem_util.adb (Check_Dynamically_Tagged_Expression): New
	subprogram.
	* sem_aggr.adb (Resolve_Array_Aggregate): Check incorrect use of
	dynamically tagged expression.
	* sem_ch3.adb (Analyze_Object_Declaration): Call new routine that
	factorizes code.
	* sem_ch6.adb (Analyze_Function_Return, Process_Formals): Ditto.
	* sem_ch8.adb (Analyze_Object_Renaming): Ditto.

From-SVN: r149817

1 files changed, 16 insertions, 6 deletions

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 9de012f5db7..56a28607eb2 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -749,12 +749,13 @@ package body Sem_Ch6 is
             end if;
          end if;
 
-         if (Is_Class_Wide_Type (Etype (Expr))
-              or else Is_Dynamically_Tagged (Expr))
-           and then not Is_Class_Wide_Type (R_Type)
-         then
-            Error_Msg_N
-              ("dynamically tagged expression not allowed!", Expr);
+         --  Check incorrect use of dynamically tagged expression
+
+         if Is_Tagged_Type (R_Type) then
+            Check_Dynamically_Tagged_Expression
+              (Expr => Expr,
+               Typ  => R_Type,
+               Related_Nod => N);
          end if;
 
          --  ??? A real run-time accessibility check is needed in cases
@@ -8084,6 +8085,15 @@ package body Sem_Ch6 is
                Error_Msg_N
                  ("access to class-wide expression not allowed here", Default);
             end if;
+
+            --  Check incorrect use of dynamically tagged expressions
+
+            if Is_Tagged_Type (Formal_Type) then
+               Check_Dynamically_Tagged_Expression
+                 (Expr        => Default,
+                  Typ         => Formal_Type,
+                  Related_Nod => Default);
+            end if;
          end if;
 
          --  Ada 2005 (AI-231): Static checks