2011-08-03 Gary Dismukes <dismukes@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Test the Derive_Subps formal
	as a condition for the delayed call to Derived_Subprograms done for the
	case of the rewriting of a derived type that constrains the
	discriminants of its parent type.
	Avoids redundant subprogram derivations for private subtype derivations.

2011-08-03  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Init_Hidden_Discriminants): New subprogram of
	Build_Record_Aggr_Code.
	(Build_Record_Aggr_Code): Add missing support to initialize hidden
	discriminants in extension aggregates.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-pp.adb (Print): also output project qualifiers, since in
	particular "aggregate" is mandatory in an aggregate project.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

	* prj-part.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb:
	(Debug_Output): new function.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177240 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 75 insertions, 1 deletions

diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 2ad07b13e1e..0b9d4ff932a 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2011, 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- --
@@ -48,6 +48,9 @@ package body Prj is
 
    The_Empty_String : Name_Id := No_Name;
 
+   Debug_Level : Integer := 0;
+   --  Current indentation level for debug traces.
+
    type Cst_String_Access is access constant String;
 
    All_Lower_Case_Image : aliased constant String := "lowercase";
@@ -1300,6 +1303,77 @@ package body Prj is
       return Count;
    end Length;
 
+   ------------------
+   -- Debug_Output --
+   ------------------
+
+   procedure Debug_Output (Str : String) is
+   begin
+      if Current_Verbosity > Default then
+         Write_Line ((1 .. Debug_Level * 2 => ' ') & Str);
+      end if;
+   end Debug_Output;
+
+   ------------------
+   -- Debug_Indent --
+   ------------------
+
+   procedure Debug_Indent is
+   begin
+      if Current_Verbosity = High then
+         Write_Str ((1 .. Debug_Level * 2 => ' '));
+      end if;
+   end Debug_Indent;
+
+   ------------------
+   -- Debug_Output --
+   ------------------
+
+   procedure Debug_Output (Str : String; Str2 : Name_Id) is
+   begin
+      if Current_Verbosity = High then
+         Debug_Indent;
+         Write_Str (Str);
+
+         if Str2 = No_Name then
+            Write_Line (" <no_name>");
+         else
+            Write_Line (" """ & Get_Name_String (Str2) & '"');
+         end if;
+      end if;
+   end Debug_Output;
+
+   ---------------------------
+   -- Debug_Increase_Indent --
+   ---------------------------
+
+   procedure Debug_Increase_Indent
+     (Str : String := ""; Str2 : Name_Id := No_Name)
+   is
+   begin
+      if Str2 /= No_Name then
+         Debug_Output (Str, Str2);
+      else
+         Debug_Output (Str);
+      end if;
+      Debug_Level := Debug_Level + 1;
+   end Debug_Increase_Indent;
+
+   ---------------------------
+   -- Debug_Decrease_Indent --
+   ---------------------------
+
+   procedure Debug_Decrease_Indent (Str : String := "") is
+   begin
+      if Debug_Level > 0 then
+         Debug_Level := Debug_Level - 1;
+      end if;
+
+      if Str /= "" then
+         Debug_Output (Str);
+      end if;
+   end Debug_Decrease_Indent;
+
 begin
    --  Make sure that the standard config and user project file extensions are
    --  compatible with canonical case file naming.