2005-02-09 Eric Botcazou <ebotcazou@adacore.com>

	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	Fix for c330001 - PR ada/19386

	* decl.c:
	(gnat_to_gnu_field): Do not necessarily invoke make_packable_type
	on the field if Pragma Component_Alignment (Storage_Unit).
	(gnat_to_gnu_entity, case object): Do not treat a renaming that has
	side-effects as if it were a constant; also make SAVE_EXPR to protect
	side-effects.
	(gnat_to_gnu_entity, case E_Record_Subtype): If have _Parent, make a
	UNION_TYPE.
	(make_dummy_type): Set TYPE_UNCHECKED_UNION_P.
	(components_to_record): Test it.
	Fix improper usage of REFERENCE_CLASS_P.

	* utils2.c (build_binary_op, case MODIFY_EXPRP): Treat UNION_TYPE as
	RECORD_TYPE.

	* utils2.c: Minor reformatting.

	* utils.c (convert, case UNION_TYPE): Check TYPE_UNCHECKED_UNION;
	handle other cases like RECORD_TYPE.

	* utils.c (gnat_pushdecl): Set TREE_NO_WARNING.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@94812 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index 710d0f1..6edda45 100644 (file)
--- a/gcc/ada/decl.c
+++ b/gcc/ada/decl.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2004, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -748,6 +748,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              }
 
            if (const_flag
+               && !TREE_SIDE_EFFECTS (gnu_expr)
                && TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
                && TYPE_MODE (gnu_type) != BLKmode
                && Ekind (Etype (gnat_entity)) != E_Class_Wide_Type
@@ -757,8 +758,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            /* If this is a declaration or reference that we can stabilize,
               just use that declaration or reference as this entity unless
               the latter has to be materialized.  */
-           else if ((DECL_P (gnu_expr)
-                     || (REFERENCE_CLASS_P (gnu_expr) == tcc_reference))
+           else if ((DECL_P (gnu_expr) || REFERENCE_CLASS_P (gnu_expr))
                     && !Materialize_Entity (gnat_entity)
                     && (!global_bindings_p ()
                         || (staticp (gnu_expr)
@@ -793,7 +793,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
                if (!global_bindings_p ())
                  {
+                   bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
+
                    gnu_expr = gnat_stabilize_reference (gnu_expr, true);
+
+                   /* If the original expression had side effects, put a
+                      SAVE_EXPR around this whole thing.  */
+                   if (has_side_effects)
+                     gnu_expr = save_expr (gnu_expr);
+
                    add_stmt (gnu_expr);
                  }
 
@@ -2582,6 +2590,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              tree gnu_subst_list
                = substitution_list (gnat_entity, gnat_base_type, NULL_TREE,
                                     definition);
+             bool possibly_overlapping_fields = false;
              tree gnu_temp;
 
              /* If this is a derived type, we may be seeing fields from any
@@ -2598,12 +2607,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                       BIGGEST_ALIGNMENT);
 
                  if (Present (Parent_Subtype (gnat_root_type)))
-                   gnu_subst_list
-                     = substitution_list (Parent_Subtype (gnat_root_type),
-                                          Empty, gnu_subst_list, definition);
+                   {
+                     gnu_subst_list
+                       = substitution_list (Parent_Subtype (gnat_root_type),
+                                            Empty, gnu_subst_list,
+                                            definition);
+
+                     /* If there's a _Parent field, it may overlap the
+                        fields we have that appear to be in this record but
+                        actually are from the parent.  So make note of that
+                        fact and later we'll make a UNION_TYPE instead of
+                        a RECORD_TYPE, since the latter may not have
+                        overlapping fields.  */
+                     possibly_overlapping_fields = true;
+                   }
                }
 
-             gnu_type = make_node (RECORD_TYPE);
+             gnu_type = make_node (possibly_overlapping_fields
+                                   ? UNION_TYPE : RECORD_TYPE);
              TYPE_NAME (gnu_type) = gnu_entity_id;
              TYPE_STUB_DECL (gnu_type)
                = create_type_decl (NULL_TREE, gnu_type, NULL, false, false,
@@ -3163,10 +3184,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              p->next = defer_incomplete_list;
              defer_incomplete_list = p;
            }
-          else if
-            (IN (Ekind (Base_Type (Directly_Designated_Type (gnat_entity))),
-              Incomplete_Or_Private_Kind))
-            { ;}
+          else if (IN (Ekind (Base_Type
+                             (Directly_Designated_Type (gnat_entity))),
+                      Incomplete_Or_Private_Kind))
+           ;
          else
            gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
                                NULL_TREE, 0);
@@ -4372,9 +4393,13 @@ make_dummy_type (Entity_Id gnat_type)
 
   /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make
      it a VOID_TYPE.  */
-  if (Is_Record_Type (gnat_underlying))
-    gnu_type = make_node (Is_Unchecked_Union (gnat_underlying)
-                         ? UNION_TYPE : RECORD_TYPE);
+  if (Is_Unchecked_Union (gnat_underlying))
+    {
+      gnu_type = make_node (UNION_TYPE);
+      TYPE_UNCHECKED_UNION_P (gnu_type) = 1;
+    }
+  else if (Is_Record_Type (gnat_underlying))
+    gnu_type = make_node (RECORD_TYPE);
   else
     gnu_type = make_node (ENUMERAL_TYPE);
 
@@ -5098,7 +5123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
       && TYPE_MODE (gnu_field_type) == BLKmode
       && host_integerp (TYPE_SIZE (gnu_field_type), 1)
       && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
-      && (packed
+      && (packed == 1
          || (gnu_size && tree_int_cst_lt (gnu_size,
                                           TYPE_SIZE (gnu_field_type)))
          || Present (Component_Clause (gnat_field))))
@@ -5375,7 +5400,9 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
 
   /* If this is an unchecked union, each variant must have exactly one
      component, each of which becomes one component of this union.  */
-  if (TREE_CODE (gnu_record_type) == UNION_TYPE && Present (variant_part))
+  if (TREE_CODE (gnu_record_type) == UNION_TYPE
+      && TYPE_UNCHECKED_UNION_P (gnu_record_type)
+      && Present (variant_part))
     for (variant = First_Non_Pragma (Variants (variant_part));
         Present (variant);
         variant = Next_Non_Pragma (variant))

diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c
index 4d4fad4..549c093 100644 (file)
--- a/gcc/ada/utils.c
+++ b/gcc/ada/utils.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2004, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -309,7 +309,7 @@ insert_block (tree block)
 }
 \f
 /* Records a ..._DECL node DECL as belonging to the current lexical scope
-   and uses GNAT_NODE for location information.  */
+   and uses GNAT_NODE for location information and propagating flags.  */
 
 void
 gnat_pushdecl (tree decl, Node_Id gnat_node)
@@ -321,6 +321,8 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
   else
     DECL_CONTEXT (decl) = current_function_decl;
 
+  TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
+
   /* Set the location of DECL and emit a declaration for it.  */
   if (Present (gnat_node))
     Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
@@ -1182,8 +1184,8 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
       || !debug_info_p)
     DECL_IGNORED_P (type_decl) = 1;
   else if (code != ENUMERAL_TYPE && code != RECORD_TYPE
-      && !((code == POINTER_TYPE || code == REFERENCE_TYPE)
-          && TYPE_IS_DUMMY_P (TREE_TYPE (type))))
+          && !((code == POINTER_TYPE || code == REFERENCE_TYPE)
+               && TYPE_IS_DUMMY_P (TREE_TYPE (type))))
     rest_of_decl_compilation (type_decl, global_bindings_p (), 0);
 
   if (!TYPE_IS_DUMMY_P (type))
@@ -2905,21 +2907,29 @@ convert (tree type, tree expr)
       return unchecked_convert (type, expr, false);
 
     case UNION_TYPE:
-      /* Just validate that the type is indeed that of a field
-        of the type.  Then make the simple conversion.  */
-      for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem))
+      /* For unchecked unions, just validate that the type is indeed that of
+        a field of the type.  Then make the simple conversion.  */
+      if (TYPE_UNCHECKED_UNION_P (type))
        {
-         if (TREE_TYPE (tem) == etype)
-           return build1 (CONVERT_EXPR, type, expr);
-         else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
-                  && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
-                      || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
-                  && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
-           return build1 (CONVERT_EXPR, type,
-                          convert (TREE_TYPE (tem), expr));
-       }
+         for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem))
+           {
+             if (TREE_TYPE (tem) == etype)
+               return build1 (CONVERT_EXPR, type, expr);
+             else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
+                      && (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
+                          || TYPE_IS_PADDING_P (TREE_TYPE (tem)))
+                      && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
+               return build1 (CONVERT_EXPR, type,
+                              convert (TREE_TYPE (tem), expr));
+           }
 
-      gcc_unreachable ();
+         gcc_unreachable ();
+       }
+      else
+       /* Otherwise, this is a conversion between a tagged type and some
+          subtype, which we have to mark as a UNION_TYPE because of
+          overlapping fields.  */
+       return unchecked_convert (type, expr, false);
 
     case UNCONSTRAINED_ARRAY_TYPE:
       /* If EXPR is a constrained array, take its address, convert it to a
@@ -3214,6 +3224,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 /* Search the chain of currently reachable declarations for a builtin
    FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE).
    Return the first node found, if any, or NULL_TREE otherwise.  */
+
 tree
 builtin_decl_for (tree name __attribute__ ((unused)))
 {

diff --git a/gcc/ada/utils2.c b/gcc/ada/utils2.c
index 04ab0cb..008ac6e 100644 (file)
--- a/gcc/ada/utils2.c
+++ b/gcc/ada/utils2.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2004, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2005, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -660,13 +660,16 @@ build_binary_op (enum tree_code op_code, tree result_type,
         might indicate a conversion between a root type and a class-wide
         type, which we must not remove.  */
       while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR
-            && ((TREE_CODE (right_type) == RECORD_TYPE
+            && (((TREE_CODE (right_type) == RECORD_TYPE
+                  || TREE_CODE (right_type) == UNION_TYPE)
                  && !TYPE_JUSTIFIED_MODULAR_P (right_type)
                  && !TYPE_ALIGN_OK (right_type)
                  && !TYPE_IS_FAT_POINTER_P (right_type))
                 || TREE_CODE (right_type) == ARRAY_TYPE)
-            && (((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
-                  == RECORD_TYPE)
+            && ((((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
+                   == RECORD_TYPE)
+                  || (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
+                      == UNION_TYPE))
                  && !(TYPE_JUSTIFIED_MODULAR_P
                       (TREE_TYPE (TREE_OPERAND (right_operand, 0))))
                  && !(TYPE_ALIGN_OK
@@ -695,7 +698,9 @@ build_binary_op (enum tree_code op_code, tree result_type,
        operation_type = best_type;
 
       /* If a class-wide type may be involved, force use of the RHS type.  */
-      if (TREE_CODE (right_type) == RECORD_TYPE && TYPE_ALIGN_OK (right_type))
+      if ((TREE_CODE (right_type) == RECORD_TYPE
+          || TREE_CODE (right_type) == UNION_TYPE)
+         && TYPE_ALIGN_OK (right_type))
        operation_type = right_type;
 
       /* Ensure everything on the LHS is valid.  If we have a field reference,
@@ -1087,7 +1092,8 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
              int unsignedp, volatilep;
 
              inner = get_inner_reference (operand, &bitsize, &bitpos, &offset,
-                                          &mode, &unsignedp, &volatilep, false);
+                                          &mode, &unsignedp, &volatilep,
+                                          false);
 
              /* If INNER is a padding type whose field has a self-referential
                 size, convert to that inner type.  We know the offset is zero