[Ada] Accept concatentation arguments to pragma Annotate

In cases where pragma Annotate accepts a string literal as an argument,
we now also accept a concatenation of string literals.

2019-09-19  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_prag.adb (Preferred_String_Type): A new function. Given an
	expression, determines whether the preference rules defined for
	the third-and-later arguments of pragma Annotate suffice to
	determine the type of the expression. If so, then the preferred
	type is returned; if not then Empty is returned. Handles
	concatenations.
	(Analyze_Pragma): Replace previous code, which dealt only with
	string literals, with calls to the new Preferred_String_Type
	function, which also handles concatenations.
	* doc/gnat_rm/implementation_defined_pragmas.rst: Update
	documentation for pragma Annotate.
	* gnat_rm.texi: Regenerate.

gcc/testsuite/

	* gnat.dg/annotation1.adb: New testcase.

From-SVN: r275957

6 files changed, 87 insertions, 14 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5808008..4208f95 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2019-09-19  Steve Baird  <baird@adacore.com>
+
+	* sem_prag.adb (Preferred_String_Type): A new function. Given an
+	expression, determines whether the preference rules defined for
+	the third-and-later arguments of pragma Annotate suffice to
+	determine the type of the expression. If so, then the preferred
+	type is returned; if not then Empty is returned. Handles
+	concatenations.
+	(Analyze_Pragma): Replace previous code, which dealt only with
+	string literals, with calls to the new Preferred_String_Type
+	function, which also handles concatenations.
+	* doc/gnat_rm/implementation_defined_pragmas.rst: Update
+	documentation for pragma Annotate.
+	* gnat_rm.texi: Regenerate.
+
 2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* exp_util.adb (Is_Possibly_Unaligned_Slice): Do not return true
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 126aaf8..bf0a9d4 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -455,7 +455,8 @@ not otherwise analyze it. The second optional identifier is also left
 unanalyzed, and by convention is used to control the action of the tool to
 which the annotation is addressed.  The remaining ARG arguments
 can be either string literals or more generally expressions.
-String literals are assumed to be either of type
+String literals (and concatenations of string literals) are assumed to be
+either of type
 ``Standard.String`` or else ``Wide_String`` or ``Wide_Wide_String``
 depending on the character literals they contain.
 All other kinds of arguments are analyzed as expressions, and must be
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 1f5616f..2a4ad37 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1836,7 +1836,8 @@ not otherwise analyze it. The second optional identifier is also left
 unanalyzed, and by convention is used to control the action of the tool to
 which the annotation is addressed.  The remaining ARG arguments
 can be either string literals or more generally expressions.
-String literals are assumed to be either of type
+String literals (and concatenations of string literals) are assumed to be
+either of type
 @code{Standard.String} or else @code{Wide_String} or @code{Wide_Wide_String}
 depending on the character literals they contain.
 All other kinds of arguments are analyzed as expressions, and must be
@@ -7706,7 +7707,8 @@ usually supplied automatically by the project manager. A pragma
 Source_File_Name cannot appear after a @ref{ec,,Pragma Source_File_Name_Project}.
 
 For more details on the use of the @code{Source_File_Name} pragma, see the
-sections on @code{Using Other File Names} and @cite{Alternative File Naming Schemes' in the :title:`GNAT User's Guide}.
+sections on @cite{Using Other File Names} and @cite{Alternative File Naming Schemes}
+in the @cite{GNAT User's Guide}.
 
 @node Pragma Source_File_Name_Project,Pragma Source_Reference,Pragma Source_File_Name,Implementation Defined Pragmas
 @anchor{gnat_rm/implementation_defined_pragmas pragma-source-file-name-project}@anchor{ec}@anchor{gnat_rm/implementation_defined_pragmas id41}@anchor{ed}
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index b54604d..5f7e6e5 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -13085,6 +13085,56 @@ package body Sem_Prag is
             Expr    : Node_Id;
             Nam_Arg : Node_Id;
 
+            --------------------------
+            -- Inferred_String_Type --
+            --------------------------
+
+            function Preferred_String_Type (Expr : Node_Id) return Entity_Id;
+            --  Infer the type to use for a string literal or a concatentation
+            --  of operands whose types can be inferred. For such expressions,
+            --  returns the "narrowest" of the three predefined string types
+            --  that can represent the characters occuring in the expression.
+            --  For other expressions, returns Empty.
+
+            function Preferred_String_Type (Expr : Node_Id) return Entity_Id is
+            begin
+               case Nkind (Expr) is
+                  when N_String_Literal =>
+                     if Has_Wide_Wide_Character (Expr) then
+                        return Standard_Wide_Wide_String;
+                     elsif Has_Wide_Character (Expr) then
+                        return Standard_Wide_String;
+                     else
+                        return Standard_String;
+                     end if;
+
+                  when N_Op_Concat =>
+                     declare
+                        L_Type : constant Entity_Id
+                          := Preferred_String_Type (Left_Opnd (Expr));
+                        R_Type : constant Entity_Id
+                          := Preferred_String_Type (Right_Opnd (Expr));
+
+                        Type_Table : constant array (1 .. 4) of Entity_Id
+                          := (Empty,
+                              Standard_Wide_Wide_String,
+                              Standard_Wide_String,
+                              Standard_String);
+                     begin
+                        for Idx in Type_Table'Range loop
+                           if (L_Type = Type_Table (Idx)) or
+                              (R_Type = Type_Table (Idx))
+                           then
+                              return Type_Table (Idx);
+                           end if;
+                        end loop;
+                        raise Program_Error;
+                     end;
+
+                  when others =>
+                     return Empty;
+               end case;
+            end Preferred_String_Type;
          begin
             GNAT_Pragma;
             Check_At_Least_N_Arguments (1);
@@ -13144,18 +13194,12 @@ package body Sem_Prag is
                   if Is_Entity_Name (Expr) then
                      null;
 
-                  --  For string literals, we assume Standard_String as the
-                  --  type, unless the string contains wide or wide_wide
-                  --  characters.
+                  --  For string literals and concatenations of string literals
+                  --  we assume Standard_String as the type, unless the string
+                  --  contains wide or wide_wide characters.
 
-                  elsif Nkind (Expr) = N_String_Literal then
-                     if Has_Wide_Wide_Character (Expr) then
-                        Resolve (Expr, Standard_Wide_Wide_String);
-                     elsif Has_Wide_Character (Expr) then
-                        Resolve (Expr, Standard_Wide_String);
-                     else
-                        Resolve (Expr, Standard_String);
-                     end if;
+                  elsif Present (Preferred_String_Type (Expr)) then
+                     Resolve (Expr, Preferred_String_Type (Expr));
 
                   elsif Is_Overloaded (Expr) then
                      Error_Pragma_Arg ("ambiguous argument for pragma%", Expr);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c8eea78..cac70e2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-09-19  Steve Baird  <baird@adacore.com>
+
+	* gnat.dg/annotation1.adb: New testcase.
+
 2019-09-19  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/inline21.adb, gnat.dg/inline21_g.ads,
diff --git a/gcc/testsuite/gnat.dg/annotation1.adb b/gcc/testsuite/gnat.dg/annotation1.adb
new file mode 100644
index 0000000..6ed14da
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/annotation1.adb
@@ -0,0 +1,7 @@
+--  { dg-do compile }
+
+procedure Annotation1 is
+   pragma Annotate (Some_Tool, Some_Action, "abc" & "def");
+begin
+   null;
+end Annotation1;
\ No newline at end of file