sem_res.adb (Static_Concatenation): An N_Op_Concat with static operands is static only if...

2009-04-29  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb (Static_Concatenation): An N_Op_Concat with static
	operands is static only if it is a predefined concatenation operator.

	* sem_util.adb: Minor reformatting

	* sem_ch12.adb (Save_References): When propagating semantic information
	from generic copy back to generic template, for the case of an
	identifier that has been rewritten to an explicit dereference whose
	prefix is either an object name or a parameterless funcion call
	denoting a global object or function, properly capture the denoted
	global entity: perform the corresponding rewriting in the template,
	and point the rewritten identifier to the correct global entity (not
	to the associated identifier in the generic copy).

From-SVN: r146936

gcc/ada/ChangeLog

+2009-04-29  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb (Static_Concatenation): An N_Op_Concat with static
+	operands is static only if it is a predefined concatenation operator.
+
+	* sem_util.adb: Minor reformatting
+
+	* sem_ch12.adb (Save_References): When propagating semantic information
+	from generic copy back to generic template, for the case of an
+	identifier that has been rewritten to an explicit dereference whose
+	prefix is either an object name or a parameterless funcion call
+	denoting a global object or function, properly capture the denoted
+	global entity: perform the corresponding rewriting in the template,
+	and point the rewritten identifier to the correct global entity (not
+	to the associated identifier in the generic copy).
+
 2009-04-29  Robert Dewar  <dewar@adacore.com>
 
 	* rtsfind.adb, prj-env.adb: Minor reformatting

gcc/ada/sem_ch12.adb

@@ -5740,9 +5740,9 @@ package body Sem_Ch12 is
       then
          if not Instantiating then
 
-            --  Link both nodes in order to assign subsequently the
-            --  entity of the copy to the original node, in case this
-            --  is a global reference.
+            --  Link both nodes in order to assign subsequently the entity of
+            --  the copy to the original node, in case this is a global
+            --  reference.
 
             Set_Associated_Node (N, New_N);
 
@@ -11877,6 +11877,7 @@ package body Sem_Ch12 is
       --  transformation is propagated to the generic unit.
 
       procedure Save_References (N : Node_Id) is
+         Loc : constant Source_Ptr := Sloc (N);
       begin
          if N = Empty then
             null;
@@ -12018,10 +12019,8 @@ package body Sem_Ch12 is
 
                elsif Nkind (N2) = N_Explicit_Dereference then
 
-                  --  An identifier is rewritten as a dereference if it is
-                  --  the prefix in a selected component, and it denotes an
-                  --  access to a composite type, or a parameterless function
-                  --  call that returns an access type.
+                  --  An identifier is rewritten as a dereference if it is the
+                  --  prefix in an implicit dereference.
 
                   --  Check whether corresponding entity in prefix is global
 
@@ -12030,23 +12029,18 @@ package body Sem_Ch12 is
                     and then Is_Global (Entity (Prefix (N2)))
                   then
                      Rewrite (N,
-                       Make_Explicit_Dereference (Sloc (N),
-                          Prefix => Make_Identifier (Sloc (N),
-                            Chars => Chars (N))));
-                     Set_Associated_Node (Prefix (N), Prefix (N2));
-
+                       Make_Explicit_Dereference (Loc,
+                          Prefix =>
+                            New_Occurrence_Of (Entity (Prefix (N2)), Loc)));
                   elsif Nkind (Prefix (N2)) = N_Function_Call
                     and then Is_Global (Entity (Name (Prefix (N2))))
                   then
                      Rewrite (N,
-                       Make_Explicit_Dereference (Sloc (N),
-                          Prefix => Make_Function_Call (Sloc (N),
-                            Name  =>
-                              Make_Identifier (Sloc (N),
-                              Chars => Chars (N)))));
-
-                     Set_Associated_Node
-                      (Name (Prefix (N)), Name (Prefix (N2)));
+                       Make_Explicit_Dereference (Loc,
+                          Prefix => Make_Function_Call (Loc,
+                            Name =>
+                              New_Occurrence_Of (Entity (Name (Prefix (N2))),
+                                                 Loc))));
 
                   else
                      Set_Associated_Node (N, Empty);
@@ -12073,7 +12067,6 @@ package body Sem_Ch12 is
 
          else
             declare
-               Loc  : constant Source_Ptr := Sloc (N);
                Qual : Node_Id := Empty;
                Typ  : Entity_Id := Empty;
                Nam  : Node_Id;

gcc/ada/sem_res.adb

@@ -3031,7 +3031,12 @@ package body Sem_Res is
                return True;
 
             when N_Op_Concat      =>
-               return Static_Concatenation (Left_Opnd (N))
+               --  Concatenation is static when both operands are static
+               --  and the concatenation operator is a predefined one.
+
+               return Scope (Entity (N)) = Standard_Standard
+                        and then
+                      Static_Concatenation (Left_Opnd (N))
                         and then
                       Static_Concatenation (Right_Opnd (N));
 

gcc/ada/sem_util.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -5161,9 +5161,7 @@ package body Sem_Util is
 
    begin
       Save_Interps (N, New_Prefix);
-      Rewrite (N,
-        Make_Explicit_Dereference (Sloc (N),
-          Prefix => New_Prefix));
+      Rewrite (N, Make_Explicit_Dereference (Sloc (N), Prefix => New_Prefix));
 
       Set_Etype (N, Designated_Type (Etype (New_Prefix)));