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 ICE with private discriminated record type


This is a regression recently exposed but caused by unchecked conversions 
generated by the front-end because a type is declared as private.  We now 
have a circuitry to overcome them (unchecked_conversion_nop), it just needs 
to be extended a little.

Tested on x86_64-suse-linux, applied on the mainline.


2010-04-16  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/trans.c (unchecked_conversion_nop): Handle function
	calls.  Return true for conversion from a record subtype to its type.


2010-04-16  Olivier Hainque  <hainque@adacore.com>

	* gnat.dg/specs/discr_private.ads: New test.


-- 
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 158411)
+++ gcc-interface/trans.c	(working copy)
@@ -3670,7 +3670,8 @@ unchecked_conversion_nop (Node_Id gnat_n
      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)
-      && !(Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
+      && !((Nkind (Parent (gnat_node)) == N_Procedure_Call_Statement
+	    || Nkind (Parent (gnat_node)) == N_Function_Call)
 	   && Name (Parent (gnat_node)) != gnat_node))
     return false;
 
@@ -3688,11 +3689,16 @@ unchecked_conversion_nop (Node_Id gnat_n
   if (to_type == from_type)
     return true;
 
-  /* For an array type, the conversion to the PAT is a no-op.  */
+  /* For an array subtype, the conversion to the PAT is a no-op.  */
   if (Ekind (from_type) == E_Array_Subtype
       && to_type == Packed_Array_Type (from_type))
     return true;
 
+  /* For a record subtype, the conversion to the type is a no-op.  */
+  if (Ekind (from_type) == E_Record_Subtype
+      && to_type == Etype (from_type))
+    return true;
+
   return false;
 }
 
-- { dg-do compile }
-- { dg-options "-gnatws" }

package Discr_Private is

   package Dec is
      type T_DECIMAL (Prec : Integer := 1) is private;
   private
      type T_DECIMAL (Prec : Integer := 1) is record
         case Prec is
            when  1 .. 2 => Value : Integer;
            when others => null;
         end case;
      end record;
   end;

   type Value_T is record
      Bits  : Dec.T_DECIMAL(1);
   end record;
   for Value_T'size use 88;

   type Value_Entry_T is record
      Index : Integer;
      Value : Value_T;
   end record;

   type Value_Mode is (QI, HI, SI, DI, XI);
   for Value_Mode'size use 8;

   type Valid_Modes_T is array (Value_Mode) of Boolean;

   type Register_T is record
      Ventry : Value_Entry_T;
      Vmodes : Valid_Modes_T;
   end record;

   type Regid_T is (Latch, Acc);
   for Regid_T use (Latch => 0, Acc => 2);
   for Regid_T'Size use 8;

   type Regarray_T is array (Regid_T) of Register_T;

   type Machine_T (Up : Boolean := True) is record
      case Up is
         when True  => Regs : Regarray_T;
         when False => null;
       end case;
   end record;

end Discr_Private;

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