sem_res.adb: Minor reformatting.

2010-06-21  Thomas Quinot  <quinot@adacore.com>

	* sem_res.adb: Minor reformatting.
	* atree.adb: New debugging hook "rr" for node rewrites.

From-SVN: r161087

3 files changed, 94 insertions, 29 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6de23ae..998166f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2010-06-21  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_res.adb: Minor reformatting.
+	* atree.adb: New debugging hook "rr" for node rewrites.
+
 2010-06-21  Robert Dewar  <dewar@adacore.com>
 
 	* g-expect.ads, g-expect.adb: Minor reformatting.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 2a8b221..bed359f 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -65,6 +65,8 @@ package body Atree is
 
    --  The second method is faster
 
+   --  Similarly, rr and rrd allow breaking on rewriting of a given node.
+
    ww : Node_Id'Base := Node_Id'First - 1;
    pragma Export (Ada, ww); --  trick the optimizer
    Watch_Node : Node_Id'Base renames ww;
@@ -89,6 +91,25 @@ package body Atree is
    --  If Node = Watch_Node, this prints out the new node and calls
    --  New_Node_Breakpoint. Otherwise, does nothing.
 
+   procedure rr;
+   pragma Export (Ada, rr);
+   procedure Rewrite_Breakpoint renames rr;
+   --  This doesn't do anything interesting; it's just for setting breakpoint
+   --  on as explained above.
+
+   procedure rrd (Old_Node, New_Node : Node_Id);
+   pragma Export (Ada, rrd);
+   procedure Rewrite_Debugging_Output
+     (Old_Node, New_Node : Node_Id) renames rrd;
+   --  For debugging. If debugging is turned on, Rewrite calls this. If debug
+   --  flag N is turned on, this prints out the new node.
+   --
+   --  If Old_Node = Watch_Node, this prints out the old and new nodes and
+   --  calls Rewrite_Breakpoint. Otherwise, does nothing.
+
+   procedure Node_Debug_Output (Op : String; N : Node_Id);
+   --  Common code for nnr and rrd. Write Op followed by information about N
+
    -----------------------------
    -- Local Objects and Types --
    -----------------------------
@@ -1237,21 +1258,7 @@ package body Atree is
 
    begin
       if Debug_Flag_N or else Node_Is_Watched then
-         Write_Str ("Allocate ");
-
-         if Nkind (N) in N_Entity then
-            Write_Str ("entity");
-         else
-            Write_Str ("node");
-         end if;
-
-         Write_Str (", Id = ");
-         Write_Int (Int (N));
-         Write_Str ("  ");
-         Write_Location (Sloc (N));
-         Write_Str ("  ");
-         Write_Str (Node_Kind'Image (Nkind (N)));
-         Write_Eol;
+         Node_Debug_Output ("Allocate", N);
 
          if Node_Is_Watched then
             New_Node_Breakpoint;
@@ -1371,6 +1378,7 @@ package body Atree is
    begin
       return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9);
    end Nkind_In;
+
    --------
    -- No --
    --------
@@ -1380,6 +1388,29 @@ package body Atree is
       return N = Empty;
    end No;
 
+   -----------------------
+   -- Node_Debug_Output --
+   -----------------------
+
+   procedure Node_Debug_Output (Op : String; N : Node_Id) is
+   begin
+      Write_Str (Op);
+
+      if Nkind (N) in N_Entity then
+         Write_Str (" entity");
+      else
+         Write_Str (" node");
+      end if;
+
+      Write_Str (" Id = ");
+      Write_Int (Int (N));
+      Write_Str ("  ");
+      Write_Location (Sloc (N));
+      Write_Str ("  ");
+      Write_Str (Node_Kind'Image (Nkind (N)));
+      Write_Eol;
+   end Node_Debug_Output;
+
    -------------------
    -- Nodes_Address --
    -------------------
@@ -1564,6 +1595,7 @@ package body Atree is
         (not Has_Extension (Old_Node)
            and not Has_Extension (New_Node)
            and not Nodes.Table (New_Node).In_List);
+      pragma Debug (Rewrite_Debugging_Output (Old_Node, New_Node));
 
       if Nkind (Old_Node) in N_Subexpr then
          Old_Paren_Count     := Paren_Count (Old_Node);
@@ -1598,6 +1630,36 @@ package body Atree is
       Fix_Parents (Ref_Node => New_Node, Fix_Node => Old_Node);
    end Rewrite;
 
+   -------------------------
+   -- Rewrite_Breakpoint --
+   -------------------------
+
+   procedure rr is -- Rewrite_Breakpoint
+   begin
+      Write_Str ("Watched node ");
+      Write_Int (Int (Watch_Node));
+      Write_Str (" rewritten");
+      Write_Eol;
+   end rr;
+
+   ------------------------------
+   -- Rewrite_Debugging_Output --
+   ------------------------------
+
+   procedure rrd (Old_Node, New_Node : Node_Id) is -- Rewrite_Debugging_Output
+      Node_Is_Watched : constant Boolean := Old_Node = Watch_Node;
+
+   begin
+      if Debug_Flag_N or else Node_Is_Watched then
+         Node_Debug_Output ("Rewrite", Old_Node);
+         Node_Debug_Output ("into",    New_Node);
+
+         if Node_Is_Watched then
+            Rewrite_Breakpoint;
+         end if;
+      end if;
+   end rrd;
+
    ------------------
    -- Set_Analyzed --
    ------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 03ab23f..e45dbe2 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -1151,7 +1151,7 @@ package body Sem_Res is
 
       function Operand_Type_In_Scope (S : Entity_Id) return Boolean;
       --  If the operand is not universal, and the operator is given by a
-      --  expanded name,  verify that the operand has an interpretation with
+      --  expanded name, verify that the operand has an interpretation with
       --  a type defined in the given scope of the operator.
 
       function Type_In_P (Test : Kind_Test) return Entity_Id;
@@ -1292,16 +1292,15 @@ package body Sem_Res is
       --  you courtesy of b33302a. The type itself must be frozen, so we must
       --  find the type of the proper class in the given scope.
 
-      --  A final wrinkle is the multiplication operator for fixed point
-      --  types, which is defined in Standard only, and not in the scope of
-      --  the fixed_point type itself.
+      --  A final wrinkle is the multiplication operator for fixed point types,
+      --  which is defined in Standard only, and not in the scope of the
+      --  fixed_point type itself.
 
       if Nkind (Name (N)) = N_Expanded_Name then
          Pack := Entity (Prefix (Name (N)));
 
-         --  If the entity being called is defined in the given package,
-         --  it is a renaming of a predefined operator, and known to be
-         --  legal.
+         --  If the entity being called is defined in the given package, it is
+         --  a renaming of a predefined operator, and known to be legal.
 
          if Scope (Entity (Name (N))) = Pack
             and then Pack /= Standard_Standard
@@ -1315,8 +1314,7 @@ package body Sem_Res is
          elsif In_Instance then
             null;
 
-         elsif (Op_Name =  Name_Op_Multiply
-              or else Op_Name = Name_Op_Divide)
+         elsif (Op_Name =  Name_Op_Multiply or else Op_Name = Name_Op_Divide)
            and then Is_Fixed_Point_Type (Etype (Left_Opnd  (Op_Node)))
            and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node)))
          then
@@ -1324,8 +1322,8 @@ package body Sem_Res is
                Error := True;
             end if;
 
-         --  Ada 2005, AI-420:  Predefined equality on Universal_Access
-         --  is available.
+         --  Ada 2005, AI-420: Predefined equality on Universal_Access is
+         --  available.
 
          elsif Ada_Version >= Ada_05
            and then (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne)
@@ -1356,7 +1354,7 @@ package body Sem_Res is
                if Pack /= Standard_Standard then
 
                   if Opnd_Type = Universal_Integer then
-                     Orig_Type :=  Type_In_P (Is_Integer_Type'Access);
+                     Orig_Type := Type_In_P (Is_Integer_Type'Access);
 
                   elsif Opnd_Type = Universal_Real then
                      Orig_Type := Type_In_P (Is_Real_Type'Access);
@@ -1365,7 +1363,7 @@ package body Sem_Res is
                      Orig_Type := Type_In_P (Is_String_Type'Access);
 
                   elsif Opnd_Type = Any_Access then
-                     Orig_Type :=  Type_In_P (Is_Definite_Access_Type'Access);
+                     Orig_Type := Type_In_P (Is_Definite_Access_Type'Access);
 
                   elsif Opnd_Type = Any_Composite then
                      Orig_Type := Type_In_P (Is_Composite_Type'Access);