[multiple changes]

2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Entity_Of): Moved to Exp_Util.
	* exp_util.ads, exp_util.adb (Entity_Of): New routine.

2013-04-11  Robert Dewar  <dewar@adacore.com>

	* g-spipat.ads: Minor comment fix.

From-SVN: r197778

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7962be4b724dcf2cf8c46bef826a69a63e33e528..5dd4491c5d8b88ee2ea607d3018917544059298c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2013-04-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_prag.adb (Entity_Of): Moved to Exp_Util.
+       * exp_util.ads, exp_util.adb (Entity_Of): New routine.
+
+2013-04-11  Robert Dewar  <dewar@adacore.com>
+
+       * g-spipat.ads: Minor comment fix.
+
 2013-04-11  Robert Dewar  <dewar@adacore.com>
 
        * sem_prag.adb, sem_util.adb, sem_res.adb, exp_ch4.adb: Minor

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cb61a42bb65aa81363988844e0bc4e4a9f29ea85..059cd092e4887ec56f1715d3b81d04554ee5e1d3 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1774,6 +1774,35 @@ package body Exp_Util is
       end if;
    end Ensure_Defined;
 
+   ---------------
+   -- Entity_Of --
+   ---------------
+
+   function Entity_Of (N : Node_Id) return Entity_Id is
+      Id : Entity_Id;
+
+   begin
+      Id := Empty;
+
+      if Is_Entity_Name (N) then
+         Id := Entity (N);
+
+         --  Follow a possible chain of renamings to reach the root renamed
+         --  object.
+
+         while Present (Renamed_Object (Id)) loop
+            if Is_Entity_Name (Renamed_Object (Id)) then
+               Id := Entity (Renamed_Object (Id));
+            else
+               Id := Empty;
+               exit;
+            end if;
+         end loop;
+      end if;
+
+      return Id;
+   end Entity_Of;
+
    --------------------
    -- Entry_Names_OK --
    --------------------

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 67982c2c96884aff283a1dc442f8459df79328ff..68dc1882e0e8eb1297189e502b1708582db3a256 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -349,6 +349,10 @@ package Exp_Util is
    --  used to ensure that an Itype is properly defined outside a conditional
    --  construct when it is referenced in more than one branch.
 
+   function Entity_Of (N : Node_Id) return Entity_Id;
+   --  Return the entity of N or Empty. If N is a renaming, return the entity
+   --  of the root renamed object.
+
    function Entry_Names_OK return Boolean;
    --  Determine whether it is appropriate to dynamically allocate strings
    --  which represent entry [family member] names. These strings are created

diff --git a/gcc/ada/g-spipat.ads b/gcc/ada/g-spipat.ads
index 5ba0bdd811de4e5bb67f8915432ffe892456cc6c..27cd8d564e1eb1ca65fc93e138ef0c415916f29e 100644 (file)
--- a/gcc/ada/g-spipat.ads
+++ b/gcc/ada/g-spipat.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 1997-2010, AdaCore                     --
+--                     Copyright (C) 1997-2013, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -729,7 +729,7 @@ package GNAT.Spitbol.Patterns is
    function "*" (P : PString; Var : VString_Var)  return Pattern;
    function "*" (P : PChar;   Var : VString_Var)  return Pattern;
    --  Matches P, and if the match succeeds, assigns the matched substring
-   --  to the given VString variable S. This assignment happens as soon as
+   --  to the given VString variable Var. This assignment happens as soon as
    --  the substring is matched, and if the pattern P1 is matched more than
    --  once during the course of the match, then the assignment will occur
    --  more than once.

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 94ea59efa0a80c653e8fb334ab4bf12345420139..c581fc6fed9c2b5c48c49bef96eac362c9f484d0 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -8917,11 +8917,6 @@ package body Sem_Prag is
             --  Verify the legality of a single dependency clause. Flag Is_Last
             --  denotes whether Clause is the last clause in the relation.
 
-            function Entity_Of (N : Node_Id) return Entity_Id;
-            --  Return the entity of N or Empty. If N is a renaming, find the
-            --  entity of the root renamed object.
-            --  Surely this should not be buried here??? exp_util???
-
             procedure Normalize_Clause (Clause : Node_Id);
             --  Remove a self-dependency "+" from the input list of a clause.
             --  Depending on the contents of the relation, either split the
@@ -9202,34 +9197,6 @@ package body Sem_Prag is
                Analyze_Input_List (Inputs);
             end Analyze_Dependency_Clause;
 
-            ---------------
-            -- Entity_Of --
-            ---------------
-
-            function Entity_Of (N : Node_Id) return Entity_Id is
-               Id : Entity_Id;
-
-            begin
-               --  Follow a possible chain of renamings to reach the root
-               --  renamed object.
-
-               Id := Entity (N);
-               while Present (Renamed_Object (Id)) loop
-                  if Is_Entity_Name (Renamed_Object (Id)) then
-                     Id := Entity (Renamed_Object (Id));
-
-                  --  The root of the renaming is not an entire object or
-                  --  variable, return Empty.
-
-                  else
-                     Id := Empty;
-                     exit;
-                  end if;
-               end loop;
-
-               return Id;
-            end Entity_Of;
-
             ----------------------
             -- Normalize_Clause --
             ----------------------
@@ -9279,26 +9246,26 @@ package body Sem_Prag is
                     (Output : Node_Id;
                      Inputs : Node_Id)
                   is
-                     function Contains
-                       (List : List_Id;
-                        Id   : Entity_Id) return Boolean;
-                     --  Determine whether List contains element Id
-                     --  Surely this should not be buried here??? exp_Util???
-
-                     --------------
-                     -- Contains --
-                     --------------
-
-                     function Contains
-                       (List : List_Id;
-                        Id   : Entity_Id) return Boolean
+                     function In_Input_List
+                       (Item   : Entity_Id;
+                        Inputs : List_Id) return Boolean;
+                     --  Determine whether a particulat item appears in the
+                     --  input list of a clause.
+
+                     -------------------
+                     -- In_Input_List --
+                     -------------------
+
+                     function In_Input_List
+                       (Item   : Entity_Id;
+                        Inputs : List_Id) return Boolean
                      is
                         Elmt : Node_Id;
 
                      begin
-                        Elmt := First (List);
+                        Elmt := First (Inputs);
                         while Present (Elmt) loop
-                           if Entity_Of (Elmt) = Id then
+                           if Entity_Of (Elmt) = Item then
                               return True;
                            end if;
 
@@ -9306,11 +9273,12 @@ package body Sem_Prag is
                         end loop;
 
                         return False;
-                     end Contains;
+                     end In_Input_List;
 
                      --  Local variables
 
-                     Grouped : List_Id;
+                     Output_Id : constant Entity_Id := Entity_Of (Output);
+                     Grouped   : List_Id;
 
                   --  Start of processing for Propagate_Output
 
@@ -9340,7 +9308,10 @@ package body Sem_Prag is
                      elsif Nkind (Inputs) = N_Aggregate then
                         Grouped := Expressions (Inputs);
 
-                        if not Contains (Grouped, Entity_Of (Output)) then
+                        if not In_Input_List
+                                 (Item   => Output_Id,
+                                  Inputs => Grouped)
+                        then
                            Prepend_To (Grouped, New_Copy_Tree (Output));
                         end if;
 
@@ -9353,7 +9324,7 @@ package body Sem_Prag is
 
                      --    (Output => (Output, Input))
 
-                     elsif Entity_Of (Output) /= Entity_Of (Inputs) then
+                     elsif Entity_Of (Inputs) /= Output_Id then
                         Rewrite (Inputs,
                           Make_Aggregate (Loc,
                             Expressions => New_List (