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;