[Ada] Runtime check on assignment to tagged types

[Arnaud Charlet]

On assignments to tagged types the compiler unconditionally generates
the runtime check of the tag (even when compiling with -gnatp). After
this patch such extra runtime check is not generated.

package Test is
   type Tagged_Simple_Record is tagged
      record
         Field1 : Integer;
      end record;
   function F1 (This : Tagged_Simple_Record)
     return Tagged_Simple_Record;

   Global_SR : Tagged_Simple_Record;

   procedure Call_Dispatching_Ops
     (Class_Obj1 : Tagged_Simple_Record'Class;
      Class_Obj2 : out Tagged_Simple_Record'Class);
end Test;

package body Test is

   function F1 (This : Tagged_Simple_Record)
     return Tagged_Simple_Record is
   begin
      return This;
   end F1;

   procedure Call_Dispatching_Ops
     (Class_Obj1 : Tagged_Simple_Record'Class;
      Class_Obj2 : out Tagged_Simple_Record'Class) is
   begin
      Class_Obj2 := F1 (Class_Obj1);
   end Call_Dispatching_Ops;

end Test;

Command:
  gcc -c -gnatp -gnatD test.adb
  grep -i "tag check" test.adb.dg

Output:
  none

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

2013-02-06  Javier Miranda  <mira...@adacore.com>

        * exp_ch5.adb (Expand_N_Assignment_Statement): Do not generate the
        runtime check on assignment to tagged types if compiling with checks
        suppressed.


Index: exp_ch5.adb
===================================================================
--- exp_ch5.adb (revision 195792)
+++ exp_ch5.adb (working copy)
@@ -2476,7 +2476,8 @@
                   --  the assignment we generate run-time check to ensure that
                   --  the tags of source and target match.
 
-                  if Is_Class_Wide_Type (Typ)
+                  if not Tag_Checks_Suppressed (Typ)
+                    and then Is_Class_Wide_Type (Typ)
                     and then Is_Tagged_Type (Typ)
                     and then Is_Tagged_Type (Underlying_Type (Etype (Rhs)))
                   then