ada: Optimize interface objects initialized with function calls

This optimizes the implementation of (class-wide) interface objects that are
initialized with function calls, by avoiding an unnecessary copy operation.
This also removes useless access checks generated by the expansion of return
statements involving class-wide types.

gcc/ada/

	* exp_ch3.adb (Expand_N_Object_Declaration): Factor out conditions
	needed for an initializating expression that is a function call to
	be renamable into the Is_Renamable_Function_Call predicate.
	Use it to implement the renaming in the case of class-wide interface
	objects.  Remove an interface conversion on all paths, separate and
	optimize the renaming path in the special expansion for interfaces.
	(Is_Renamable_Function_Call): New predicate.
	(Make_Allocator_For_Return): Put back an interface conversion.
	* exp_ch6.adb (Apply_CW_Accessibility_Check): Remove useless access
	checks on RE_Tag_Ptr.

1 files changed, 16 insertions, 14 deletions

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 7a309e8..503fdc1 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -687,7 +687,11 @@ package body Exp_Ch6 is
       Loc : constant Source_Ptr := Sloc (Exp);
 
    begin
+       --  CodePeer does not do anything useful on Ada.Tags.Type_Specific_Data
+       --  components.
+
       if Ada_Version >= Ada_2005
+        and then not CodePeer_Mode
         and then Tagged_Type_Expansion
         and then not Scope_Suppress.Suppress (Accessibility_Check)
         and then
@@ -770,20 +774,18 @@ package body Exp_Ch6 is
                    Attribute_Name => Name_Tag);
             end if;
 
-            --  CodePeer does not do anything useful with
-            --  Ada.Tags.Type_Specific_Data components.
-
-            if not CodePeer_Mode then
-               Insert_Action (Exp,
-                 Make_Raise_Program_Error (Loc,
-                   Condition =>
-                     Make_Op_Gt (Loc,
-                       Left_Opnd  => Build_Get_Access_Level (Loc, Tag_Node),
-                       Right_Opnd =>
-                         Make_Integer_Literal (Loc,
-                           Scope_Depth (Enclosing_Dynamic_Scope (Func)))),
-                   Reason    => PE_Accessibility_Check_Failed));
-            end if;
+            --  Suppress junk access chacks on RE_Tag_Ptr
+
+            Insert_Action (Exp,
+              Make_Raise_Program_Error (Loc,
+                Condition =>
+                  Make_Op_Gt (Loc,
+                    Left_Opnd  => Build_Get_Access_Level (Loc, Tag_Node),
+                    Right_Opnd =>
+                      Make_Integer_Literal (Loc,
+                        Scope_Depth (Enclosing_Dynamic_Scope (Func)))),
+                Reason    => PE_Accessibility_Check_Failed),
+              Suppress => Access_Check);
          end;
       end if;
    end Apply_CW_Accessibility_Check;