Relax constraints on Machine_Attribute argument types:

        * sem_prag.adb (Check_Arg_Is_Static_Expression): Allow for
        missing type.
        (Analyze_Attribute, case Machine_Attribute): Allow any type for
        arg 3.
        * gcc-interface/decl.c (prepend_attributes): Accept static
        expressions of any type as attribute arguments, not only string
        literals.
        * gnat_rm.texi (pragma Machine_Attribute section): Adjust to
        reflect the relaxation of the restriction on the Info argument type.


Co-Authored-By: Olivier Hainque <hainque@adacore.com>

From-SVN: r148589

4 files changed, 64 insertions, 34 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c22d2a7..d9e6bcb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2009-06-16  Robert Dewar  <dewar@adacore.com>
+            Olivier Hainque  <hainque@adacore.com>
+
+	Relax constraints on Machine_Attribute argument types:
+	* sem_prag.adb (Check_Arg_Is_Static_Expression): Allow for
+	missing type.
+	(Analyze_Attribute, case Machine_Attribute): Allow any type for arg 3.
+	* gcc-interface/decl.c (prepend_attributes): Accept static
+	expressions of any type as attribute arguments, not only string
+	literals.
+	* gnat_rm.texi (pragma Machine_Attribute section): Adjust to reflect
+	the relaxation of the restriction on the Info argument type.
+	
 2009-06-13  Aldy Hernandez  <aldyh@redhat.com>
 
 	* gcc-interface/utils.c (record_builtin_type): Pass location
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 63ade27..974f6f0 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -5568,6 +5568,8 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 {
   Node_Id gnat_temp;
 
+  /* Attributes are stored as Representation Item pragmas.  */
+
   for (gnat_temp = First_Rep_Item (gnat_entity); Present (gnat_temp);
        gnat_temp = Next_Rep_Item (gnat_temp))
     if (Nkind (gnat_temp) == N_Pragma)
@@ -5576,24 +5578,8 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 	Node_Id gnat_assoc = Pragma_Argument_Associations (gnat_temp);
 	enum attr_type etype;
 
-	if (Present (gnat_assoc) && Present (First (gnat_assoc))
-	    && Present (Next (First (gnat_assoc)))
-	    && (Nkind (Expression (Next (First (gnat_assoc))))
-		== N_String_Literal))
-	  {
-	    gnu_arg0 = get_identifier (TREE_STRING_POINTER
-				       (gnat_to_gnu
-					(Expression (Next
-						     (First (gnat_assoc))))));
-	    if (Present (Next (Next (First (gnat_assoc))))
-		&& (Nkind (Expression (Next (Next (First (gnat_assoc)))))
-		    == N_String_Literal))
-	      gnu_arg1 = get_identifier (TREE_STRING_POINTER
-					 (gnat_to_gnu
-					  (Expression
-					   (Next (Next
-						  (First (gnat_assoc)))))));
-	  }
+	/* Map the kind of pragma at hand.  Skip if this is not one
+	   we know how to handle.  */
 
 	switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_temp))))
 	  {
@@ -5629,6 +5615,35 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
 	    continue;
 	  }
 
+	/* See what arguments we have and turn them into GCC trees for
+	   attribute handlers.  These expect identifier for strings.  We
+	   handle at most two arguments, static expressions only.  */
+
+	if (Present (gnat_assoc) && Present (First (gnat_assoc)))
+	  {
+	    Node_Id gnat_arg0 = Next (First (gnat_assoc));
+	    Node_Id gnat_arg1 = Empty;
+
+	    if (Present (gnat_arg0)
+		&& Is_Static_Expression (Expression (gnat_arg0)))
+	      {
+		gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0));
+
+		if (TREE_CODE (gnu_arg0) == STRING_CST)
+		  gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0));
+
+		gnat_arg1 = Next (gnat_arg0);
+	      }
+
+	    if (Present (gnat_arg1)
+		&& Is_Static_Expression (Expression (gnat_arg1)))
+	      {
+		gnu_arg1 = gnat_to_gnu (Expression (gnat_arg1));
+
+		if (TREE_CODE (gnu_arg1) == STRING_CST)
+		  gnu_arg1 = get_identifier (TREE_STRING_POINTER (gnu_arg1));
+	      }
+	  }
 
 	/* Prepend to the list now.  Make a list of the argument we might
 	   have, as GCC expects it.  */
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 2ff9c11..ba84ee1 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -3243,7 +3243,7 @@ Syntax:
 pragma Machine_Attribute (
      [Entity         =>] LOCAL_NAME,
      [Attribute_Name =>] static_string_EXPRESSION
-  [, [Info           =>] static_string_EXPRESSION] );
+  [, [Info           =>] static_EXPRESSION] );
 @end smallexample
 
 @noindent
@@ -3252,15 +3252,12 @@ declarations.  This pragma is semantically equivalent to
 @code{__attribute__((@var{attribute_name}))} (if @var{info} is not
 specified) or @code{__attribute__((@var{attribute_name}(@var{info})))}
 in GNU C, where @code{@var{attribute_name}} is recognized by the
-target macro @code{TARGET_ATTRIBUTE_TABLE} which is defined for each
-machine.  The optional parameter @var{info} is transformed into an
-identifier, which may make this pragma unusable for some attributes
-(parameter of some attributes must be a number or a string).
-@xref{Target Attributes,, Defining target-specific uses of
-@code{__attribute__}, gccint, GNU Compiler Colletion (GCC) Internals},
-further information.  It is not possible to specify
-attributes defined by other languages, only attributes defined by the
-machine the code is intended to run on.
+compiler middle-end or the @code{TARGET_ATTRIBUTE_TABLE} machine
+specific macro.  A string literal for the optional parameter @var{info}
+is transformed into an identifier, which may make this pragma unusable
+for some attributes.  @xref{Target Attributes,, Defining target-specific
+uses of @code{__attribute__}, gccint, GNU Compiler Collection (GCC)
+Internals}, further information.
 
 @node Pragma Main
 @unnumberedsec Pragma Main
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 505fbea..f69fcda 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -368,11 +368,12 @@ package body Sem_Prag is
 
       procedure Check_Arg_Is_Static_Expression
         (Arg : Node_Id;
-         Typ : Entity_Id);
+         Typ : Entity_Id := Empty);
       --  Check the specified argument Arg to make sure that it is a static
       --  expression of the given type (i.e. it will be analyzed and resolved
       --  using this type, which can be any valid argument to Resolve, e.g.
-      --  Any_Integer is OK). If not, given error and raise Pragma_Exit.
+      --  Any_Integer is OK). If not, given error and raise Pragma_Exit. If
+      --  Typ is left Empty, then any static expression is allowed.
 
       procedure Check_Arg_Is_String_Literal (Arg : Node_Id);
       --  Check the specified argument Arg to make sure that it is a string
@@ -966,12 +967,16 @@ package body Sem_Prag is
 
       procedure Check_Arg_Is_Static_Expression
         (Arg : Node_Id;
-         Typ : Entity_Id)
+         Typ : Entity_Id := Empty)
       is
          Argx : constant Node_Id := Get_Pragma_Arg (Arg);
 
       begin
-         Analyze_And_Resolve (Argx, Typ);
+         if Present (Typ) then
+            Analyze_And_Resolve (Argx, Typ);
+         else
+            Analyze_And_Resolve (Argx);
+         end if;
 
          if Is_OK_Static_Expression (Argx) then
             return;
@@ -8819,7 +8824,7 @@ package body Sem_Prag is
          --  pragma Machine_Attribute (
          --       [Entity         =>] LOCAL_NAME,
          --       [Attribute_Name =>] static_string_EXPRESSION
-         --    [, [Info           =>] static_string_EXPRESSION] );
+         --    [, [Info           =>] static_EXPRESSION] );
 
          when Pragma_Machine_Attribute => Machine_Attribute : declare
             Def_Id : Entity_Id;
@@ -8830,7 +8835,7 @@ package body Sem_Prag is
 
             if Arg_Count = 3 then
                Check_Optional_Identifier (Arg3, Name_Info);
-               Check_Arg_Is_Static_Expression (Arg3, Standard_String);
+               Check_Arg_Is_Static_Expression (Arg3);
             else
                Check_Arg_Count (2);
             end if;