| Message ID | 20130206102430.GA25518@adacore.com |
|---|---|
| State | New |
| Headers | show |
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
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 <miranda@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.