This fixes an ICE on a call to a valued procedure that takes a converted
integer as actual parameter passed by reference.
Tested on x86_64-suse-linux, applied on the mainline.
2013-08-13 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/trans.c (Call_to_gnu): Deal with specific conditional
expressions for misaligned actual parameters.
2013-08-13 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/valued_proc.adb: New test.
* gnat.dg/valued_proc_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 201692)
+++ gcc-interface/trans.c (working copy)
@@ -4022,9 +4022,19 @@ Call_to_gnu (Node_Id gnat_node, tree *gn
/* Set up to move the copy back to the original if needed. */
if (!in_param)
{
- gnu_stmt = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig,
- gnu_temp);
+ /* If the original is a COND_EXPR whose first arm isn't meant to
+ be further used, just deal with the second arm. This is very
+ likely the conditional expression built for a check. */
+ if (TREE_CODE (gnu_orig) == COND_EXPR
+ && TREE_CODE (TREE_OPERAND (gnu_orig, 1)) == COMPOUND_EXPR
+ && integer_zerop
+ (TREE_OPERAND (TREE_OPERAND (gnu_orig, 1), 1)))
+ gnu_orig = TREE_OPERAND (gnu_orig, 2);
+
+ gnu_stmt
+ = build_binary_op (MODIFY_EXPR, NULL_TREE, gnu_orig, gnu_temp);
set_expr_location_from_node (gnu_stmt, gnat_node);
+
append_to_statement_list (gnu_stmt, &gnu_after_list);
}
}
-- { dg-do compile }
-- { dg-options "-gnatdm -gnatws" }
with Valued_Proc_Pkg; use Valued_Proc_Pkg;
with System; use System;
procedure Valued_Proc is
Status : UNSIGNED_LONGWORD;
Length : POSITIVE;
begin
GetMsg (Status, UNSIGNED_WORD(Length));
end;
pragma Extend_System (Aux_DEC);
with System; use System;
package Valued_Proc_Pkg is
procedure GETMSG (STATUS : out UNSIGNED_LONGWORD;
MSGLEN : out UNSIGNED_WORD);
pragma Interface (EXTERNAL, GETMSG);
pragma IMPORT_VALUED_PROCEDURE (GETMSG, "SYS$GETMSG",
(UNSIGNED_LONGWORD, UNSIGNED_WORD),
(VALUE, REFERENCE));
end Valued_Proc_Pkg;
