This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Fix wrong code with discriminated types at -gnatp


This fixes a wrong code generation with -gnatp at any optimization level, a 
regression recently introduced on the mainline: we were assigning the max 
size when returning an aggregate of a discriminated record type with default 
discriminant.

Tested on x86-64-suse-linux, applied on the mainline.


2010-08-30  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (call_to_gnu): Also force the return slot opt
	for the call to a function whose return type was unconstrained.


2010-08-30  Thomas Quinot  <quinot@adacore.com>

	* gnat.dg/discr24.adb: New test.


-- 
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 163646)
+++ gcc-interface/trans.c	(working copy)
@@ -2992,6 +2992,7 @@ call_to_gnu (Node_Id gnat_node, tree *gn
       if (gnu_target)
 	{
 	  Node_Id gnat_parent = Parent (gnat_node);
+	  tree gnu_result_type = TREE_TYPE (gnu_subprog_type);
 	  enum tree_code op_code;
 
 	  /* If range check is needed, emit code to generate it.  */
@@ -3002,11 +3003,15 @@ call_to_gnu (Node_Id gnat_node, tree *gn
 
 	  /* ??? If the return type has non-constant size, then force the
 	     return slot optimization as we would not be able to generate
-	     a temporary.  That's what has been done historically.  */
-	  if (TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_subprog_type))))
-	    op_code = MODIFY_EXPR;
-	  else
+	     a temporary.  Likewise if it was unconstrained as we would
+	     copy too much data.  That's what has been done historically.  */
+	  if (!TREE_CONSTANT (TYPE_SIZE (gnu_result_type))
+	      || (TYPE_IS_PADDING_P (gnu_result_type)
+		  && CONTAINS_PLACEHOLDER_P
+		     (TYPE_SIZE (TREE_TYPE (TYPE_FIELDS (gnu_result_type))))))
 	    op_code = INIT_EXPR;
+	  else
+	    op_code = MODIFY_EXPR;
 
 	  gnu_result
 	    = build_binary_op (op_code, NULL_TREE, gnu_target, gnu_result);
-- { dg-do run }
-- { dg-options "-gnatp" }

procedure Discr24 is

   type Family_Type is (Family_Inet, Family_Inet6);
   type Port_Type is new Natural;

   subtype Inet_Addr_Comp_Type is Natural range 0 .. 255;

   type Inet_Addr_VN_Type is array (Natural range <>) of Inet_Addr_Comp_Type;

   subtype Inet_Addr_V4_Type is Inet_Addr_VN_Type (1 ..  4);
   subtype Inet_Addr_V6_Type is Inet_Addr_VN_Type (1 .. 16);

   type Inet_Addr_Type (Family : Family_Type := Family_Inet) is record
      case Family is
         when Family_Inet =>
            Sin_V4 : Inet_Addr_V4_Type := (others => 0);

         when Family_Inet6 =>
            Sin_V6 : Inet_Addr_V6_Type := (others => 0);
      end case;
   end record;

   type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record
      Addr : Inet_Addr_Type (Family);
      Port : Port_Type;
   end record;

   function F return Inet_Addr_Type is
   begin
      return Inet_Addr_Type'
        (Family => Family_Inet, Sin_V4 => (192, 168, 169, 170));
   end F;

   SA : Sock_Addr_Type;

begin
   SA.Addr.Sin_V4 := (172, 16, 17, 18);
   SA.Port := 1111;
   SA.Addr := F;
   if SA.Port /= 1111 then
     raise Program_Error;
   end if;
end;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]