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 crash on x86-64 (2)


This is another form of
  http://gcc.gnu.org/ml/gcc-patches/2008-06/msg00774.html
with again an ad-hoc "fix".

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


2008-07-31  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity): Fix formatting.
	* gcc-interface/utils.c (create_field_decl): Avoid superfluous work.


2008-07-31  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/discr10.ad[sb]: New test.


-- 
Eric Botcazou
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 138424)
+++ gcc-interface/utils.c	(working copy)
@@ -1755,7 +1755,7 @@ create_field_decl (tree field_name, tree
      of a copy.  This is the case for true bitfields, but the DECL_BIT_FIELD
      value we have at this point is not accurate enough, so we don't account
      for this here and let finish_record_type decide.  */
-  if (!type_for_nonaliased_component_p (field_type))
+  if (!addressable && !type_for_nonaliased_component_p (field_type))
     addressable = 1;
 
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 138424)
+++ gcc-interface/decl.c	(working copy)
@@ -3062,7 +3062,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 
 			/* Discard old fields that are outside the new type.
 			   This avoids confusing code scanning it to decide
-			   how to pass it to functions on some platforms.   */
+			   how to pass it to functions on some platforms.  */
 			if (TREE_CODE (gnu_new_pos) == INTEGER_CST
 			    && TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST
 			    && !integer_zerop (gnu_size)
package body Discr10 is

   function Get (X : R) return R is
   begin
     return R'(D1 => False, D2 => False, D3 => X.D3);
   end;

end Discr10;
package Discr10 is

   subtype Index is Natural range 0 .. 150;

   type List is array (Index range <>) of Integer;

   type R (D1 : Boolean := True; D2 : Boolean := False; D3 : Index := 0) is
   record
      case D2 is
         when True =>
            L : List (1 .. D3);
            case D1 is
               when True => I : Integer;
               when False => null;
            end case;
         when False =>
            null;
      end case;
   end record;

   function Get (X : R) return R;

end Discr10;

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