This is a regression present on the mainline only, for a pathological case 
where an empty array is passed as Out parameter to a procedure, but the code 
is actually never executed because it's inside an empty loop...

Tested on x86-64/Linux, applied on the mainline.


2015-12-10  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/trans.c (Call_to_gnu): Remove guard for NULL_EXPR.
        * gcc-interface/utils2.c (gnat_rewrite_reference) <ERROR_MARK>: Return
        the reference unmodified.
        <NULL_EXPR>: New case.  Likewise.


2015-12-10  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/array25.adb: New test.
        * gnat.dg/array25_pkg.ad[sb]: New helper.


-- 
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 231498)
+++ gcc-interface/trans.c	(working copy)
@@ -4407,9 +4407,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
       /* If it's possible we may need to use this expression twice, make sure
 	 that any side-effects are handled via SAVE_EXPRs; likewise if we need
 	 to force side-effects before the call.  */
-      if (Ekind (gnat_formal) != E_In_Parameter
-	  && !is_by_ref_formal_parm
-	  && TREE_CODE (gnu_name) != NULL_EXPR)
+      if (Ekind (gnat_formal) != E_In_Parameter && !is_by_ref_formal_parm)
 	{
 	  tree init = NULL_TREE;
 	  gnu_name = gnat_stabilize_reference (gnu_name, true, &init);
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 231498)
+++ gcc-interface/utils2.c	(working copy)
@@ -2733,7 +2733,8 @@ gnat_rewrite_reference (tree ref, rewrit
       break;
 
     case ERROR_MARK:
-      return error_mark_node;
+    case NULL_EXPR:
+      return ref;
 
     default:
       gcc_unreachable ();
-- { dg-do compile }

with Array25_Pkg;

procedure Array25 is

   package My_Pkg is new Array25_Pkg (0, 0);

begin
   null;
end;
package body Array25_Pkg is

   procedure Get_Inner (A : out Arr1) is
   begin
      null;
   end;

   procedure Get (A : out Arr2) is
   begin
      for I in Arr2'Range loop
         Get_Inner (A (I).Data);
      end loop;
   end;

end Array25_Pkg;
generic

   UB1 : Natural;

   UB2 : Natural;

package Array25_Pkg is

   type Arr1 is array (1 .. UB1) of Integer;

   type Rec is record
      Data : Arr1;
   end record;

   type Arr2  is array (1 .. UB2) of Rec;

   procedure Get (A : out Arr2);

end Array25_Pkg;

Reply via email to