This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix ICE with packed array declared as private (2)
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Wed, 25 Nov 2009 22:59:59 +0100
- Subject: [Ada] Fix ICE with packed array declared as private (2)
This is a variant of
http://gcc.gnu.org/ml/gcc-patches/2009-04/msg01581.html
where the extra conversion is inserted around an OUT actual parameter in a
function call. Fixed by adjusting the above change to this new case.
Tested on i586-suse-linux, applied on the mainline.
2009-11-25 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (unchecked_conversion_lhs_nop): Rename into...
(unchecked_conversion_nop): ...this. Handle actual parameters.
(gnat_to_gnu): Adjust for above renaming.
2009-11-25 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/pack6.ads: New test.
* gnat.dg/specs/pack6_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 154515)
+++ gcc-interface/trans.c (working copy)
@@ -3432,19 +3432,21 @@ Compilation_Unit_to_gnu (Node_Id gnat_no
invalidate_global_renaming_pointers ();
}
-/* Return whether GNAT_NODE, an unchecked type conversion, is on the LHS
- of an assignment and a no-op as far as gigi is concerned. */
+/* Return true if GNAT_NODE, an unchecked type conversion, is a no-op as far
+ as gigi is concerned. This is used to avoid conversions on the LHS. */
static bool
-unchecked_conversion_lhs_nop (Node_Id gnat_node)
+unchecked_conversion_nop (Node_Id gnat_node)
{
Entity_Id from_type, to_type;
- /* The conversion must be on the LHS of an assignment. Otherwise, even
- if the conversion was essentially a no-op, it could de facto ensure
- type consistency and this should be preserved. */
+ /* The conversion must be on the LHS of an assignment or an actual parameter
+ of a call. Otherwise, even if the conversion was essentially a no-op, it
+ could de facto ensure type consistency and this should be preserved. */
if (!(Nkind (Parent (gnat_node)) == N_Assignment_Statement
- && Name (Parent (gnat_node)) == gnat_node))
+ && Name (Parent (gnat_node)) == gnat_node)
+ && !(Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
+ && Name (Parent (gnat_node)) != gnat_node))
return false;
from_type = Etype (Expression (gnat_node));
@@ -4156,7 +4158,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_result = gnat_to_gnu (Expression (gnat_node));
/* Skip further processing if the conversion is deemed a no-op. */
- if (unchecked_conversion_lhs_nop (gnat_node))
+ if (unchecked_conversion_nop (gnat_node))
{
gnu_result_type = TREE_TYPE (gnu_result);
break;
@@ -5409,7 +5411,7 @@ gnat_to_gnu (Node_Id gnat_node)
&& ((Nkind (Parent (gnat_node)) == N_Assignment_Statement
&& Name (Parent (gnat_node)) == gnat_node)
|| (Nkind (Parent (gnat_node)) == N_Unchecked_Type_Conversion
- && unchecked_conversion_lhs_nop (Parent (gnat_node)))
+ && unchecked_conversion_nop (Parent (gnat_node)))
|| (Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
&& Name (Parent (gnat_node)) != gnat_node)
|| Nkind (Parent (gnat_node)) == N_Parameter_Association
-- { dg-do compile }
with Ada.Finalization;
with Pack6_Pkg;
package Pack6 is
package Eight_Bits is new Pack6_Pkg (8);
type Some_Data is record
Byte_1 : Eight_Bits.Object;
Byte_2 : Eight_Bits.Object;
end record;
for Some_Data use record
Byte_1 at 0 range 0 .. 7;
Byte_2 at 1 range 0 .. 7;
end record;
type Top_Object is new Ada.Finalization.Controlled with record
Data : Some_Data;
end record;
end Pack6;
generic
Size : Positive;
package Pack6_Pkg is
type Object is private;
private
type Bit is range 0 .. 1;
for Bit'Size use 1;
type Object is array (1 .. Size) of Bit;
pragma Pack (Object);
end Pack6_Pkg;