gigi.h (create_type_decl): Adjust prototype.
authorEric Botcazou <ebotcazou@adacore.com>
Sun, 26 May 2013 09:52:10 +0000 (09:52 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sun, 26 May 2013 09:52:10 +0000 (09:52 +0000)
* gcc-interface/gigi.h (create_type_decl): Adjust prototype.
(create_label_decl): Complete prototype.
(process_attributes): Declare.
* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust multiple calls to
create_type_decl throughout.
<E_Enumeration_Type>: Do the layout of the type manually and call
process_attributes on it.  Reindent.
<E_Enumeration_Subtype>: Minor tweak.
<E_Floating_Point_Subtype>: Reindent.
<E_Array_Subtype>: Call process_attributes on the array type built
for a packed array type.
<E_Record_Type>: Call process_attributes on the type.
<E_Record_Subtype>: Likewise.
<E_Access_Type>: Likewise.
<E_Subprogram_Type>: Likewise.
Likewise for all types at the end of the processing.
* gcc-interface/utils.c (make_aligning_type): Adjust call to
create_type_decl.
(maybe_pad_type): Likewise.
(create_index_type): Likewise.
(create_type_decl): Remove attr_list parameter and associated code.
(create_var_decl_1): Call process_attributes on the variable.
(process_attributes): Take a pointer to the object and add in_place
and gnat_node parameters and adjust throughout.
<ATTR_MACHINE_ATTRIBUTE>: Pass ATTR_FLAG_TYPE_IN_PLACE only on demand
and set the input location.
Zap the attribute list at the end.
(create_subprog_decl): Call process_attributes on the subprogram.
(build_unc_object_type): Adjust call to create_type_decl.
(handle_vector_type_attribute): Remove dead code.

From-SVN: r199338

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/machine_attribute.ads [new file with mode: 0644]

index 2b31a004dbd59e982dc5ea311ea8f7b898e1d0b7..9eac544c9559ff2006cc7d789cdddc96014f7ae4 100644 (file)
@@ -1,3 +1,36 @@
+2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/gigi.h (create_type_decl): Adjust prototype.
+       (create_label_decl): Complete prototype.
+       (process_attributes): Declare.
+       * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust multiple calls to
+       create_type_decl throughout.
+       <E_Enumeration_Type>: Do the layout of the type manually and call
+       process_attributes on it.  Reindent.
+       <E_Enumeration_Subtype>: Minor tweak.
+       <E_Floating_Point_Subtype>: Reindent.
+       <E_Array_Subtype>: Call process_attributes on the array type built
+       for a packed array type.
+       <E_Record_Type>: Call process_attributes on the type.
+       <E_Record_Subtype>: Likewise.
+       <E_Access_Type>: Likewise.
+       <E_Subprogram_Type>: Likewise.
+       Likewise for all types at the end of the processing.
+       * gcc-interface/utils.c (make_aligning_type): Adjust call to
+       create_type_decl.
+       (maybe_pad_type): Likewise.
+       (create_index_type): Likewise.
+       (create_type_decl): Remove attr_list parameter and associated code.
+       (create_var_decl_1): Call process_attributes on the variable.
+       (process_attributes): Take a pointer to the object and add in_place
+       and gnat_node parameters and adjust throughout.
+       <ATTR_MACHINE_ATTRIBUTE>: Pass ATTR_FLAG_TYPE_IN_PLACE only on demand
+       and set the input location.
+       Zap the attribute list at the end.
+       (create_subprog_decl): Call process_attributes on the subprogram.
+       (build_unc_object_type): Adjust call to create_type_decl.
+       (handle_vector_type_attribute): Remove dead code.
+
 2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/gigi.h (make_aligning_type): Adjust prototype.
index 2a6eb4dcb4430fcfe8473183ef90350357d5d36d..36f86444631f3954035d52c9f6c168257d2a7fb7 100644 (file)
@@ -692,7 +692,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                   never be declared otherwise.  This is necessary to ensure
                   that its subtrees are properly marked.  */
                if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
-                 create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+                 create_type_decl (TYPE_NAME (gnu_type), gnu_type, true,
                                    debug_info_p, gnat_entity);
              }
          }
@@ -940,7 +940,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               never be declared otherwise.  This is necessary to ensure
               that its subtrees are properly marked.  */
            if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
-             create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
+             create_type_decl (TYPE_NAME (gnu_type), gnu_type, true,
                                debug_info_p, gnat_entity);
          }
 
@@ -1613,7 +1613,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     case E_Enumeration_Type:
       /* A special case: for the types Character and Wide_Character in
         Standard, we do not list all the literals.  So if the literals
-        are not specified, make this an unsigned type.  */
+        are not specified, make this an unsigned integer type.  */
       if (No (First_Literal (gnat_entity)))
        {
          gnu_type = make_unsigned_type (esize);
@@ -1623,52 +1623,54 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
             This is needed by the DWARF-2 back-end to distinguish between
             unsigned integer types and character types.  */
          TYPE_STRING_FLAG (gnu_type) = 1;
-         break;
        }
+      else
+       {
+         /* We have a list of enumeral constants in First_Literal.  We make a
+            CONST_DECL for each one and build into GNU_LITERAL_LIST the list
+            to be placed into TYPE_FIELDS.  Each node is itself a TREE_LIST
+            whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
+            value of the literal.  But when we have a regular boolean type, we
+            simplify this a little by using a BOOLEAN_TYPE.  */
+         const bool is_boolean = Is_Boolean_Type (gnat_entity)
+                                 && !Has_Non_Standard_Rep (gnat_entity);
+         const bool is_unsigned = Is_Unsigned_Type (gnat_entity);
+         tree gnu_list = NULL_TREE;
+         Entity_Id gnat_literal;
+
+         gnu_type = make_node (is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
+         TYPE_PRECISION (gnu_type) = esize;
+         TYPE_UNSIGNED (gnu_type) = is_unsigned;
+         set_min_and_max_values_for_integral_type (gnu_type, esize,
+                                                   is_unsigned);
+         process_attributes (&gnu_type, &attr_list, true, gnat_entity);
+         layout_type (gnu_type);
+
+         for (gnat_literal = First_Literal (gnat_entity);
+              Present (gnat_literal);
+              gnat_literal = Next_Literal (gnat_literal))
+           {
+             tree gnu_value
+               = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
+             tree gnu_literal
+               = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+                                  gnu_type, gnu_value, true, false, false,
+                                  false, NULL, gnat_literal);
+             /* Do not generate debug info for individual enumerators.  */
+             DECL_IGNORED_P (gnu_literal) = 1;
+             save_gnu_tree (gnat_literal, gnu_literal, false);
+             gnu_list
+               = tree_cons (DECL_NAME (gnu_literal), gnu_value, gnu_list);
+           }
 
-      {
-       /* We have a list of enumeral constants in First_Literal.  We make a
-          CONST_DECL for each one and build into GNU_LITERAL_LIST the list to
-          be placed into TYPE_FIELDS.  Each node in the list is a TREE_LIST
-          whose TREE_VALUE is the literal name and whose TREE_PURPOSE is the
-          value of the literal.  But when we have a regular boolean type, we
-          simplify this a little by using a BOOLEAN_TYPE.  */
-       bool is_boolean = Is_Boolean_Type (gnat_entity)
-                         && !Has_Non_Standard_Rep (gnat_entity);
-       tree gnu_literal_list = NULL_TREE;
-       Entity_Id gnat_literal;
-
-       if (Is_Unsigned_Type (gnat_entity))
-         gnu_type = make_unsigned_type (esize);
-       else
-         gnu_type = make_signed_type (esize);
-
-       TREE_SET_CODE (gnu_type, is_boolean ? BOOLEAN_TYPE : ENUMERAL_TYPE);
-
-       for (gnat_literal = First_Literal (gnat_entity);
-            Present (gnat_literal);
-            gnat_literal = Next_Literal (gnat_literal))
-         {
-           tree gnu_value
-             = UI_To_gnu (Enumeration_Rep (gnat_literal), gnu_type);
-           tree gnu_literal
-             = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
-                                gnu_type, gnu_value, true, false, false,
-                                false, NULL, gnat_literal);
-           /* Do not generate debug info for individual enumerators.  */
-           DECL_IGNORED_P (gnu_literal) = 1;
-           save_gnu_tree (gnat_literal, gnu_literal, false);
-           gnu_literal_list = tree_cons (DECL_NAME (gnu_literal),
-                                         gnu_value, gnu_literal_list);
-         }
-
-       if (!is_boolean)
-         TYPE_VALUES (gnu_type) = nreverse (gnu_literal_list);
+         if (!is_boolean)
+           TYPE_VALUES (gnu_type) = nreverse (gnu_list);
 
-       /* Note that the bounds are updated at the end of this function
-          to avoid an infinite recursion since they refer to the type.  */
-      }
-      goto discrete_type;
+         /* Note that the bounds are updated at the end of this function
+            to avoid an infinite recursion since they refer to the type.  */
+         goto discrete_type;
+       }
+      break;
 
     case E_Signed_Integer_Type:
     case E_Ordinary_Fixed_Point_Type:
@@ -1776,6 +1778,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                        definition, true,
                                        Needs_Debug_Info (gnat_entity))));
 
+      TYPE_BIASED_REPRESENTATION_P (gnu_type)
+       = Has_Biased_Representation (gnat_entity);
+
+      /* Inherit our alias set from what we're a subtype of.  Subtypes
+        are not different types and a pointer can designate any instance
+        within a subtype hierarchy.  */
+      relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
+
       /* One of the above calls might have caused us to be elaborated,
         so don't blow up if so.  */
       if (present_gnu_tree (gnat_entity))
@@ -1784,18 +1794,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          break;
        }
 
-      TYPE_BIASED_REPRESENTATION_P (gnu_type)
-       = Has_Biased_Representation (gnat_entity);
-
       /* Attach the TYPE_STUB_DECL in case we have a parallel type.  */
       TYPE_STUB_DECL (gnu_type)
        = create_type_stub_decl (gnu_entity_name, gnu_type);
 
-      /* Inherit our alias set from what we're a subtype of.  Subtypes
-        are not different types and a pointer can designate any instance
-        within a subtype hierarchy.  */
-      relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
-
       /* For a packed array, make the original array type a parallel type.  */
       if (debug_info_p
          && Is_Packed_Array_Type (gnat_entity)
@@ -1836,8 +1838,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
 
          /* Create a stripped-down declaration, mainly for debugging.  */
-         create_type_decl (gnu_entity_name, gnu_type, NULL, true,
-                           debug_info_p, gnat_entity);
+         create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+                           gnat_entity);
 
          /* Now save it and build the enclosing record type.  */
          gnu_field_type = gnu_type;
@@ -1897,8 +1899,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                            UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
 
          /* Create a stripped-down declaration, mainly for debugging.  */
-         create_type_decl (gnu_entity_name, gnu_type, NULL, true,
-                           debug_info_p, gnat_entity);
+         create_type_decl (gnu_entity_name, gnu_type, true, debug_info_p,
+                           gnat_entity);
 
          /* Now save it and build the enclosing record type.  */
          gnu_field_type = gnu_type;
@@ -1954,53 +1956,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          break;
        }
 
-      {
-       if (!definition
-           && Present (Ancestor_Subtype (gnat_entity))
-           && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
-           && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
-               || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
-         gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity),
-                             gnu_expr, 0);
-
-       gnu_type = make_node (REAL_TYPE);
-       TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
-       TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
-       TYPE_GCC_MIN_VALUE (gnu_type)
-         = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
-       TYPE_GCC_MAX_VALUE (gnu_type)
-         = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
-       layout_type (gnu_type);
-
-       SET_TYPE_RM_MIN_VALUE
-         (gnu_type,
-          convert (TREE_TYPE (gnu_type),
-                   elaborate_expression (Type_Low_Bound (gnat_entity),
-                                         gnat_entity, get_identifier ("L"),
-                                         definition, true,
-                                         Needs_Debug_Info (gnat_entity))));
-
-       SET_TYPE_RM_MAX_VALUE
-         (gnu_type,
-          convert (TREE_TYPE (gnu_type),
-                   elaborate_expression (Type_High_Bound (gnat_entity),
-                                         gnat_entity, get_identifier ("U"),
-                                         definition, true,
-                                         Needs_Debug_Info (gnat_entity))));
-
-       /* One of the above calls might have caused us to be elaborated,
-          so don't blow up if so.  */
-       if (present_gnu_tree (gnat_entity))
-         {
-           maybe_present = true;
-           break;
-         }
+      /* See the E_Signed_Integer_Subtype case for the rationale.  */
+      if (!definition
+         && Present (Ancestor_Subtype (gnat_entity))
+         && !In_Extended_Main_Code_Unit (Ancestor_Subtype (gnat_entity))
+         && (!Compile_Time_Known_Value (Type_Low_Bound (gnat_entity))
+             || !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
+       gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0);
 
-       /* Inherit our alias set from what we're a subtype of, as for
-          integer subtypes.  */
-       relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
-      }
-    break;
+      gnu_type = make_node (REAL_TYPE);
+      TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
+      TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
+      TYPE_GCC_MIN_VALUE (gnu_type)
+       = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
+      TYPE_GCC_MAX_VALUE (gnu_type)
+       = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
+      layout_type (gnu_type);
+
+      SET_TYPE_RM_MIN_VALUE
+       (gnu_type,
+        convert (TREE_TYPE (gnu_type),
+                 elaborate_expression (Type_Low_Bound (gnat_entity),
+                                       gnat_entity, get_identifier ("L"),
+                                       definition, true,
+                                       Needs_Debug_Info (gnat_entity))));
+
+      SET_TYPE_RM_MAX_VALUE
+       (gnu_type,
+        convert (TREE_TYPE (gnu_type),
+                 elaborate_expression (Type_High_Bound (gnat_entity),
+                                       gnat_entity, get_identifier ("U"),
+                                       definition, true,
+                                       Needs_Debug_Info (gnat_entity))));
+
+      /* Inherit our alias set from what we're a subtype of, as for
+        integer subtypes.  */
+      relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
+
+      /* One of the above calls might have caused us to be elaborated,
+        so don't blow up if so.  */
+      maybe_present = true;
+      break;
 
       /* Array and String Types and Subtypes
 
@@ -2296,9 +2292,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                                               TYPE_SIZE_UNIT (tem));
          }
 
-       create_type_decl (create_concat_name (gnat_entity, "XUA"),
-                         tem, NULL, !Comes_From_Source (gnat_entity),
-                         debug_info_p, gnat_entity);
+       create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
+                         !Comes_From_Source (gnat_entity), debug_info_p,
+                         gnat_entity);
 
        /* Give the fat pointer type a name.  If this is a packed type, tell
           the debugger how to interpret the underlying bits.  */
@@ -2306,9 +2302,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          gnat_name = Packed_Array_Type (gnat_entity);
        else
          gnat_name = gnat_entity;
-       create_type_decl (create_concat_name (gnat_name, "XUP"),
-                         gnu_fat_type, NULL, !Comes_From_Source (gnat_entity),
-                         debug_info_p, gnat_entity);
+       create_type_decl (create_concat_name (gnat_name, "XUP"), gnu_fat_type,
+                         !Comes_From_Source (gnat_entity), debug_info_p,
+                         gnat_entity);
 
        /* Create the type to be designated by thin pointers: a record type for
           the array and its template.  We used to shift the fields to have the
@@ -2734,18 +2730,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
              /* First finish the type we had been making so that we output
                 debugging information for it.  */
+             process_attributes (&gnu_type, &attr_list, false, gnat_entity);
              if (Treat_As_Volatile (gnat_entity))
                gnu_type
                  = build_qualified_type (gnu_type,
                                          TYPE_QUALS (gnu_type)
                                          | TYPE_QUAL_VOLATILE);
-
              /* Make it artificial only if the base type was artificial too.
                 That's sort of "morally" true and will make it possible for
                 the debugger to look it up by name in DWARF, which is needed
                 in order to decode the packed array type.  */
              gnu_decl
-               = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+               = create_type_decl (gnu_entity_name, gnu_type,
                                    !Comes_From_Source (Etype (gnat_entity))
                                    && !Comes_From_Source (gnat_entity),
                                    debug_info_p, gnat_entity);
@@ -2965,6 +2961,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        TYPE_PACKED (gnu_type) = (packed != 0) || has_rep;
        if (Reverse_Storage_Order (gnat_entity))
          sorry ("non-default Scalar_Storage_Order");
+       process_attributes (&gnu_type, &attr_list, true, gnat_entity);
 
        if (!definition)
          {
@@ -3355,6 +3352,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              gnu_type = make_node (RECORD_TYPE);
              TYPE_NAME (gnu_type) = gnu_entity_name;
              TYPE_PACKED (gnu_type) = TYPE_PACKED (gnu_base_type);
+             process_attributes (&gnu_type, &attr_list, true, gnat_entity);
 
              /* Set the size, alignment and alias set of the new type to
                 match that of the old one, doing required substitutions.  */
@@ -3695,7 +3693,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          gnu_type
            = build_pointer_type
              (make_dummy_type (Directly_Designated_Type (gnat_entity)));
-         gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+         gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
                                       !Comes_From_Source (gnat_entity),
                                       debug_info_p, gnat_entity);
          this_made_decl = true;
@@ -3951,7 +3949,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            else
              gnu_old_desig_type = TREE_TYPE (gnu_type);
 
-           gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+           process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+           gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
                                         !Comes_From_Source (gnat_entity),
                                         debug_info_p, gnat_entity);
            this_made_decl = true;
@@ -4288,8 +4287,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                if (gnu_return_type != orig_type
                    && !DECL_P (TYPE_NAME (gnu_return_type)))
                  create_type_decl (TYPE_NAME (gnu_return_type),
-                                   gnu_return_type, NULL, true,
-                                   debug_info_p, gnat_entity);
+                                   gnu_return_type, true, debug_info_p,
+                                   gnat_entity);
 
                return_by_invisi_ref_p = true;
              }
@@ -4670,9 +4669,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          }
 
        else if (kind == E_Subprogram_Type)
-         gnu_decl
-           = create_type_decl (gnu_entity_name, gnu_type, attr_list,
-                               artificial_flag, debug_info_p, gnat_entity);
+         {
+           process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+           gnu_decl
+             = create_type_decl (gnu_entity_name, gnu_type, artificial_flag,
+                                 debug_info_p, gnat_entity);
+         }
        else
          {
            if (has_stub)
@@ -4824,6 +4826,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
      handling alignment and possible padding.  */
   if (is_type && (!gnu_decl || this_made_decl))
     {
+      /* Process the attributes, if not already done.  Note that the type is
+        already defined so we cannot pass True for IN_PLACE here.  */
+      process_attributes (&gnu_type, &attr_list, false, gnat_entity);
+
       /* Tell the middle-end that objects of tagged types are guaranteed to
         be properly aligned.  This is necessary because conversions to the
         class-wide type are translated into conversions to the root type,
@@ -5068,7 +5074,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
        TYPE_UNIVERSAL_ALIASING_P (TYPE_MAIN_VARIANT (gnu_type)) = 1;
 
       if (!gnu_decl)
-       gnu_decl = create_type_decl (gnu_entity_name, gnu_type, attr_list,
+       gnu_decl = create_type_decl (gnu_entity_name, gnu_type,
                                     !Comes_From_Source (gnat_entity),
                                     debug_info_p, gnat_entity);
       else
@@ -5608,8 +5614,8 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
         declared otherwise.  This is necessary to ensure that its subtrees
         are properly marked.  */
       if (gnu_type != orig_type && !DECL_P (TYPE_NAME (gnu_type)))
-       create_type_decl (TYPE_NAME (gnu_type), gnu_type, NULL, true,
-                         debug_info_p, gnat_array);
+       create_type_decl (TYPE_NAME (gnu_type), gnu_type, true, debug_info_p,
+                         gnat_array);
     }
 
   if (Has_Volatile_Components (gnat_array))
@@ -6691,8 +6697,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
         are properly marked.  */
       if (gnu_field_type != orig_field_type
          && !DECL_P (TYPE_NAME (gnu_field_type)))
-       create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, NULL,
-                         true, debug_info_p, gnat_field);
+       create_type_decl (TYPE_NAME (gnu_field_type), gnu_field_type, true,
+                         debug_info_p, gnat_field);
     }
 
   /* Otherwise (or if there was an error), don't specify a position.  */
@@ -7092,7 +7098,7 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
                 the fields associated with these empty variants.  */
              rest_of_record_type_compilation (gnu_variant_type);
              create_type_decl (TYPE_NAME (gnu_variant_type), gnu_variant_type,
-                               NULL, true, debug_info, gnat_component_list);
+                               true, debug_info, gnat_component_list);
 
              gnu_field
                = create_field_decl (gnu_inner_name, gnu_variant_type,
@@ -7138,8 +7144,8 @@ components_to_record (tree gnu_record_type, Node_Id gnat_component_list,
              return;
            }
 
-         create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type,
-                           NULL, true, debug_info, gnat_component_list);
+         create_type_decl (TYPE_NAME (gnu_union_type), gnu_union_type, true,
+                           debug_info, gnat_component_list);
 
          /* Deal with packedness like in gnat_to_gnu_field.  */
          if (union_field_needs_strict_alignment)
@@ -8458,8 +8464,8 @@ create_variant_part_from (tree old_variant_part,
         info thanks to the XVS type.  */
       finish_record_type (new_variant, nreverse (field_list), 2, false);
       compute_record_mode (new_variant);
-      create_type_decl (TYPE_NAME (new_variant), new_variant, NULL,
-                       true, false, Empty);
+      create_type_decl (TYPE_NAME (new_variant), new_variant, true, false,
+                       Empty);
 
       new_field
        = create_field_decl_from (old_field, new_variant, new_union_type,
@@ -8476,8 +8482,8 @@ create_variant_part_from (tree old_variant_part,
      because VARIANT_LIST has been traversed in reverse order.  */
   finish_record_type (new_union_type, union_field_list, 2, false);
   compute_record_mode (new_union_type);
-  create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
-                   true, false, Empty);
+  create_type_decl (TYPE_NAME (new_union_type), new_union_type, true, false,
+                   Empty);
 
   new_variant_part
     = create_field_decl_from (old_variant_part, new_union_type, record_type,
index a95b867eb8d46148ffac29dfd82510fc201c079b..799f61db264278b965912331734f2379b7cc922c 100644 (file)
@@ -653,10 +653,8 @@ extern tree create_type_stub_decl (tree type_name, tree type);
    is a declaration that was generated by the compiler.  DEBUG_INFO_P is
    true if we need to write debug information about this type.  GNAT_NODE
    is used for the position of the decl.  */
-extern tree create_type_decl (tree type_name, tree type,
-                              struct attrib *attr_list,
-                              bool artificial_p, bool debug_info_p,
-                             Node_Id gnat_node);
+extern tree create_type_decl (tree type_name, tree type, bool artificial_p,
+                             bool debug_info_p, Node_Id gnat_node);
 
 /* Return a VAR_DECL or CONST_DECL node.
 
@@ -729,7 +727,7 @@ extern tree create_param_decl (tree param_name, tree param_type,
 
 /* Return a LABEL_DECL with LABEL_NAME.  GNAT_NODE is used for the position
    of the decl.  */
-extern tree create_label_decl (tree, Node_Id);
+extern tree create_label_decl (tree label_name, Node_Id gnat_node);
 
 /* Return a FUNCTION_DECL node.  SUBPROG_NAME is the name of the subprogram,
    ASM_NAME is its assembler name, SUBPROG_TYPE is its type (a FUNCTION_TYPE
@@ -746,6 +744,12 @@ extern tree create_subprog_decl (tree subprog_name, tree asm_name,
                                 bool artificial_flag,
                                 struct attrib *attr_list, Node_Id gnat_node);
 
+/* Process the attributes in ATTR_LIST for NODE, which is either a DECL or
+   a TYPE.  If IN_PLACE is true, the tree pointed to by NODE should not be
+   changed.  GNAT_NODE is used for the position of error messages.  */
+extern void process_attributes (tree *node, struct attrib **attr_list,
+                               bool in_place, Node_Id gnat_node);
+
 /* Set up the framework for generating code for SUBPROG_DECL, a subprogram
    body. This routine needs to be invoked before processing the declarations
    appearing in the subprogram.  */
index eb63257ec369df5ad360c1c08bb08d1b0ce5f6d4..857905e2c1b8ddade79d10d74080cce6d6d04a30 100644 (file)
@@ -233,7 +233,6 @@ static tree split_plus (tree, tree *);
 static tree float_type_for_precision (int, enum machine_mode);
 static tree convert_to_fat_pointer (tree, tree);
 static bool potential_alignment_gap (tree, tree, tree);
-static void process_attributes (tree, struct attrib *);
 \f
 /* Initialize data structures of the utils.c module.  */
 
@@ -740,7 +739,7 @@ make_aligning_type (tree type, unsigned int align, tree size,
 
   /* Declare it now since it will never be declared otherwise.  This is
      necessary to ensure that its subtrees are properly marked.  */
-  create_type_decl (name, record_type, NULL, true, false, gnat_node);
+  create_type_decl (name, record_type, true, false, gnat_node);
 
   return record_type;
 }
@@ -1075,7 +1074,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   /* If requested, complete the original type and give it a name.  */
   if (is_user_type)
     create_type_decl (get_entity_name (gnat_entity), type,
-                     NULL, !Comes_From_Source (gnat_entity),
+                     !Comes_From_Source (gnat_entity),
                      !(TYPE_NAME (type)
                        && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL
                        && DECL_IGNORED_P (TYPE_NAME (type))),
@@ -2025,7 +2024,7 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
 
   /* Then set the index type.  */
   SET_TYPE_INDEX_TYPE (type, index);
-  create_type_decl (NULL_TREE, type, NULL, true, false, gnat_node);
+  create_type_decl (NULL_TREE, type, true, false, gnat_node);
 
   return type;
 }
@@ -2076,8 +2075,8 @@ create_type_stub_decl (tree type_name, tree type)
    is used for the position of the decl.  */
 
 tree
-create_type_decl (tree type_name, tree type, struct attrib *attr_list,
-                 bool artificial_p, bool debug_info_p, Node_Id gnat_node)
+create_type_decl (tree type_name, tree type, bool artificial_p,
+                 bool debug_info_p, Node_Id gnat_node)
 {
   enum tree_code code = TREE_CODE (type);
   bool named = TYPE_NAME (type) && TREE_CODE (TYPE_NAME (type)) == TYPE_DECL;
@@ -2094,8 +2093,7 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
       DECL_NAME (type_decl) = type_name;
     }
   else
-    type_decl = build_decl (input_location,
-                           TYPE_DECL, type_name, type);
+    type_decl = build_decl (input_location, TYPE_DECL, type_name, type);
 
   DECL_ARTIFICIAL (type_decl) = artificial_p;
   TYPE_ARTIFICIAL (type) = artificial_p;
@@ -2103,8 +2101,6 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (type_decl, gnat_node);
 
-  process_attributes (type_decl, attr_list);
-
   /* If we're naming the type, equate the TYPE_STUB_DECL to the name.
      This causes the name to be also viewed as a "tag" by the debug
      back-end, with the advantage that no DW_TAG_typedef is emitted
@@ -2225,17 +2221,21 @@ create_var_decl_1 (tree var_name, tree asm_name, tree type, tree var_init,
           != null_pointer_node)
     DECL_IGNORED_P (var_decl) = 1;
 
-  /* Add this decl to the current binding level.  */
-  gnat_pushdecl (var_decl, gnat_node);
-
   if (TREE_SIDE_EFFECTS (var_decl))
     TREE_ADDRESSABLE (var_decl) = 1;
 
+  /* ??? Some attributes cannot be applied to CONST_DECLs.  */
+  if (TREE_CODE (var_decl) == VAR_DECL)
+    process_attributes (&var_decl, &attr_list, true, gnat_node);
+
+  /* Add this decl to the current binding level.  */
+  gnat_pushdecl (var_decl, gnat_node);
+
   if (TREE_CODE (var_decl) == VAR_DECL)
     {
       if (asm_name)
        SET_DECL_ASSEMBLER_NAME (var_decl, asm_name);
-      process_attributes (var_decl, attr_list);
+
       if (global_bindings_p ())
        rest_of_decl_compilation (var_decl, true, 0);
     }
@@ -2451,65 +2451,71 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
   return param_decl;
 }
 \f
-/* Given a DECL and ATTR_LIST, process the listed attributes.  */
+/* Process the attributes in ATTR_LIST for NODE, which is either a DECL or
+   a TYPE.  If IN_PLACE is true, the tree pointed to by NODE should not be
+   changed.  GNAT_NODE is used for the position of error messages.  */
 
-static void
-process_attributes (tree decl, struct attrib *attr_list)
+void
+process_attributes (tree *node, struct attrib **attr_list, bool in_place,
+                   Node_Id gnat_node)
 {
-  for (; attr_list; attr_list = attr_list->next)
-    switch (attr_list->type)
+  struct attrib *attr;
+
+  for (attr = *attr_list; attr; attr = attr->next)
+    switch (attr->type)
       {
       case ATTR_MACHINE_ATTRIBUTE:
-       input_location = DECL_SOURCE_LOCATION (decl);
-       decl_attributes (&decl, tree_cons (attr_list->name, attr_list->args,
-                                          NULL_TREE),
-                        ATTR_FLAG_TYPE_IN_PLACE);
+       Sloc_to_locus (Sloc (gnat_node), &input_location);
+       decl_attributes (node, tree_cons (attr->name, attr->args, NULL_TREE),
+                        in_place ? ATTR_FLAG_TYPE_IN_PLACE : 0);
        break;
 
       case ATTR_LINK_ALIAS:
-        if (! DECL_EXTERNAL (decl))
+        if (!DECL_EXTERNAL (*node))
          {
-           TREE_STATIC (decl) = 1;
-           assemble_alias (decl, attr_list->name);
+           TREE_STATIC (*node) = 1;
+           assemble_alias (*node, attr->name);
          }
        break;
 
       case ATTR_WEAK_EXTERNAL:
        if (SUPPORTS_WEAK)
-         declare_weak (decl);
+         declare_weak (*node);
        else
          post_error ("?weak declarations not supported on this target",
-                     attr_list->error_point);
+                     attr->error_point);
        break;
 
       case ATTR_LINK_SECTION:
        if (targetm_common.have_named_sections)
          {
-           DECL_SECTION_NAME (decl)
-             = build_string (IDENTIFIER_LENGTH (attr_list->name),
-                             IDENTIFIER_POINTER (attr_list->name));
-           DECL_COMMON (decl) = 0;
+           DECL_SECTION_NAME (*node)
+             = build_string (IDENTIFIER_LENGTH (attr->name),
+                             IDENTIFIER_POINTER (attr->name));
+           DECL_COMMON (*node) = 0;
          }
        else
          post_error ("?section attributes are not supported for this target",
-                     attr_list->error_point);
+                     attr->error_point);
        break;
 
       case ATTR_LINK_CONSTRUCTOR:
-       DECL_STATIC_CONSTRUCTOR (decl) = 1;
-       TREE_USED (decl) = 1;
+       DECL_STATIC_CONSTRUCTOR (*node) = 1;
+       TREE_USED (*node) = 1;
        break;
 
       case ATTR_LINK_DESTRUCTOR:
-       DECL_STATIC_DESTRUCTOR (decl) = 1;
-       TREE_USED (decl) = 1;
+       DECL_STATIC_DESTRUCTOR (*node) = 1;
+       TREE_USED (*node) = 1;
        break;
 
       case ATTR_THREAD_LOCAL_STORAGE:
-       DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
-       DECL_COMMON (decl) = 0;
+       DECL_TLS_MODEL (*node) = decl_default_tls_model (*node);
+       DECL_COMMON (*node) = 0;
        break;
       }
+
+  *attr_list = NULL;
 }
 \f
 /* Record DECL as a global renaming pointer.  */
@@ -2695,11 +2701,11 @@ create_subprog_decl (tree subprog_name, tree asm_name, tree subprog_type,
        DECL_NAME (subprog_decl) = main_identifier_node;
     }
 
+  process_attributes (&subprog_decl, &attr_list, true, gnat_node);
+
   /* Add this decl to the current binding level.  */
   gnat_pushdecl (subprog_decl, gnat_node);
 
-  process_attributes (subprog_decl, attr_list);
-
   /* Output the assembler code and/or RTL for the declaration.  */
   rest_of_decl_compilation (subprog_decl, global_bindings_p (), 0);
 
@@ -4170,7 +4176,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name,
 
   /* Declare it now since it will never be declared otherwise.  This is
      necessary to ensure that its subtrees are properly marked.  */
-  create_type_decl (name, type, NULL, true, debug_info_p, Empty);
+  create_type_decl (name, type, true, debug_info_p, Empty);
 
   return type;
 }
@@ -6358,7 +6364,6 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   /* Vector representative type and size.  */
   tree rep_type = *node;
   tree rep_size = TYPE_SIZE_UNIT (rep_type);
-  tree rep_name;
 
   /* Vector size in bytes and number of units.  */
   unsigned HOST_WIDE_INT vec_bytes, vec_units;
@@ -6369,12 +6374,6 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
 
   *no_add_attrs = true;
 
-  /* Get the representative array type, possibly nested within a
-     padding record e.g. for alignment purposes.  */
-
-  if (TYPE_IS_PADDING_P (rep_type))
-    rep_type = TREE_TYPE (TYPE_FIELDS (rep_type));
-
   if (TREE_CODE (rep_type) != ARRAY_TYPE)
     {
       error ("attribute %qs applies to array types only",
@@ -6435,10 +6434,6 @@ handle_vector_type_attribute (tree *node, tree name, tree ARG_UNUSED (args),
   /* Build the vector type and replace.  */
 
   *node = build_vector_type (elem_type, vec_units);
-  rep_name = TYPE_NAME (rep_type);
-  if (TREE_CODE (rep_name) == TYPE_DECL)
-    rep_name = DECL_NAME (rep_name);
-  TYPE_NAME (*node) = rep_name;
   TYPE_REPRESENTATIVE_ARRAY (*node) = rep_type;
 
   return NULL_TREE;
index f60cfe17b703a5f69145d0cdb8426e62d7d0df14..b6bb1b7ed3aeca40256b7b75c9130fb5a9a92e11 100644 (file)
@@ -1,3 +1,7 @@
+2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/machine_attribute.ads: New test.
+
 2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/incomplete3.ad[sb]: New test.
diff --git a/gcc/testsuite/gnat.dg/specs/machine_attribute.ads b/gcc/testsuite/gnat.dg/specs/machine_attribute.ads
new file mode 100644 (file)
index 0000000..b38ed64
--- /dev/null
@@ -0,0 +1,8 @@
+-- { dg-do compile }
+
+package Machine_Attribute is
+
+  type R is null record;
+  pragma Machine_Attribute (R, "may_alias");
+
+end Machine_Attribute;