utils.c: Include diagnostic.h.

* gcc-interface/utils.c: Include diagnostic.h.
	(gnat_write_global_declarations): Output debug information for all
	global type declarations before finalizing the compilation unit.
	* gcc-interface/Make-lang.in (ada/utils.o): Add dependency.

From-SVN: r174687

gcc/ada/ChangeLog

@@ -1,3 +1,10 @@
+2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/utils.c: Include diagnostic.h.
+	(gnat_write_global_declarations): Output debug information for all
+	global type declarations before finalizing the compilation unit.
+	* gcc-interface/Make-lang.in (ada/utils.o): Add dependency.
+
 2011-05-25  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc-interface/utils.c (def_fn_type): Remove extra va_end.

gcc/ada/gcc-interface/Make-lang.in

@@ -1237,7 +1237,7 @@ ada/trans.o : ada/gcc-interface/trans.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
 
 ada/utils.o : ada/gcc-interface/utils.c $(CONFIG_H) $(SYSTEM_H) coretypes.h \
    $(TM_H) $(TREE_H) $(FLAGS_H) toplev.h $(RTL_H) output.h debug.h convert.h \
-   $(TARGET_H) function.h langhooks.h $(CGRAPH_H) \
+   $(TARGET_H) function.h langhooks.h $(CGRAPH_H) $(DIAGNOSTIC_H) \
    $(TREE_DUMP_H) $(TREE_INLINE_H) tree-iterator.h \
    ada/gcc-interface/ada.h ada/types.h ada/atree.h ada/elists.h ada/namet.h \
    ada/nlists.h ada/stringt.h ada/uintp.h ada/fe.h ada/sinfo.h ada/einfo.h \

gcc/ada/gcc-interface/utils.c

@@ -38,6 +38,7 @@
 #include "target.h"
 #include "langhooks.h"
 #include "cgraph.h"
+#include "diagnostic.h"
 #include "tree-dump.h"
 #include "tree-inline.h"
 #include "tree-iterator.h"
@@ -4756,6 +4757,9 @@ static GTY (()) tree dummy_global;
 void
 gnat_write_global_declarations (void)
 {
+  unsigned int i;
+  tree iter;
+
   /* If we have declared types as used at the global level, insert them in
      the global hash table.  We use a dummy variable for this purpose.  */
   if (!VEC_empty (tree, types_used_by_cur_var_decl))
@@ -4773,13 +4777,28 @@ gnat_write_global_declarations (void)
 	}
     }
 
+  /* Output debug information for all global type declarations first.  This
+     ensures that global types whose compilation hasn't been finalized yet,
+     for example pointers to Taft amendment types, have their compilation
+     finalized in the right context.  */
+  FOR_EACH_VEC_ELT (tree, global_decls, i, iter)
+    if (TREE_CODE (iter) == TYPE_DECL)
+      debug_hooks->global_decl (iter);
+
   /* Proceed to optimize and emit assembly.
      FIXME: shouldn't be the front end's responsibility to call this.  */
   cgraph_finalize_compilation_unit ();
 
-  /* Emit debug info for all global declarations.  */
-  emit_debug_global_declarations (VEC_address (tree, global_decls),
-				  VEC_length (tree, global_decls));
+  /* After cgraph has had a chance to emit everything that's going to
+     be emitted, output debug information for the rest of globals.  */
+  if (!seen_error ())
+    {
+      timevar_push (TV_SYMOUT);
+      FOR_EACH_VEC_ELT (tree, global_decls, i, iter)
+	if (TREE_CODE (iter) != TYPE_DECL)
+	  debug_hooks->global_decl (iter);
+      timevar_pop (TV_SYMOUT);
+    }
 }
 
 /* ************************************************************************

gcc/testsuite/ChangeLog

@@ -1,3 +1,16 @@
+2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/test_tamdt.adb: Rename to...
+	* gnat.dg/taft_type1.adb: ...this.
+	* gnat.dg/tamdt.ad[sb]: Rename to...
+	* gnat.dg/taft_type1_pkg1.ad[sb]: ...this.
+	* gnat.dg/tamdt_aux.ads: Rename to...
+	* gnat.dg/taft_type1_pkg2.ads: ...this.
+	* gnat.dg/taft_type2.ad[sb]: New test.
+	* gnat.dg/taft_type2_pkg.ads: New helper.
+	* gnat.dg/taft_type3.adb: New test.
+	* gnat.dg/taft_type3_pkg.ads: New helper.
+
 2011-06-05  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/49255

gcc/testsuite/gnat.dg/taft_type1.adb

@@ -0,0 +1,8 @@
+-- { dg-do run }
+
+with Taft_Type1_Pkg1;
+
+procedure Taft_Type1 is
+begin
+   Taft_Type1_Pkg1.Check;
+end;

gcc/testsuite/gnat.dg/taft_type1_pkg1.adb

@@ -1,9 +1,8 @@
+with Taft_Type1_Pkg2;
 
-with Tamdt_Aux;
-
-package body TAMDT is
-   type TAMT1 is new Tamdt_Aux.Priv (X => 1);
-   type TAMT2 is new Tamdt_Aux.Priv;
+package body Taft_Type1_Pkg1 is
+   type TAMT1 is new Taft_Type1_Pkg2.Priv (X => 1);
+   type TAMT2 is new Taft_Type1_Pkg2.Priv;
 
    procedure Check is
       Ptr1 : TAMT1_Access := new TAMT1;
@@ -16,4 +15,4 @@ package body TAMDT is
          raise Program_Error;
       end if;
    end;
-end;
+end Taft_Type1_Pkg1;

gcc/testsuite/gnat.dg/taft_type1_pkg1.ads

@@ -1,5 +1,4 @@
-
-package TAMDT is
+package Taft_Type1_Pkg1 is
    procedure Check;
 private
    type TAMT1;
@@ -7,4 +6,4 @@ private
 
    type TAMT2;
    type TAMT2_Access is access TAMT2;
-end;
+end Taft_Type1_Pkg1;

gcc/testsuite/gnat.dg/taft_type1_pkg2.ads

@@ -1,9 +1,5 @@
-
-package Tamdt_Aux is
+package Taft_Type1_Pkg2 is
    type Priv (X : Integer) is private;
 private
    type Priv (X : Integer) is null record;
-end;
-
-
-
+end Taft_Type1_Pkg2;

gcc/testsuite/gnat.dg/taft_type2.adb

@@ -0,0 +1,22 @@
+-- { dg-do compile }
+-- { dg-options "-g" }
+
+with Taft_Type2_Pkg; use Taft_Type2_Pkg;
+
+package body Taft_Type2 is
+
+   procedure Proc is
+      A : T;
+
+      function F return T is
+         My_T : T;
+      begin
+         My_T := Open;
+         return My_T;
+      end;
+
+   begin
+      A := F;
+   end;
+
+end Taft_Type2;

gcc/testsuite/gnat.dg/taft_type2.ads

@@ -0,0 +1,5 @@
+package Taft_Type2 is
+
+   procedure Proc;
+
+end Taft_Type2;

gcc/testsuite/gnat.dg/taft_type2_pkg.ads

@@ -0,0 +1,12 @@
+package Taft_Type2_Pkg  is
+
+   type T is private;
+
+   function Open return T;
+
+private
+
+   type Buffer_T;
+   type T is access Buffer_T;
+
+end Taft_Type2_Pkg;

gcc/testsuite/gnat.dg/taft_type3.adb

@@ -0,0 +1,29 @@
+-- { dg-do compile }
+-- { dg-options "-g" }
+
+with Taft_Type3_Pkg; use Taft_Type3_Pkg;
+
+procedure Taft_Type3 is
+
+  subtype S is String (1..32);
+
+  Empty : constant S := (others => ' ');
+
+  procedure Proc (Data : in out T) is begin null; end;
+
+  task type Task_T is
+    entry Send (Data : in out T);
+  end;
+
+  task body Task_T is
+    type List_T is array (1 .. 4) of S;
+    L : List_T := (others => Empty);
+  begin
+    accept Send (Data : in out T) do
+      Proc (Data);
+    end;
+  end;
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/taft_type3_pkg.ads

@@ -0,0 +1,10 @@
+package Taft_Type3_Pkg is
+
+  type T is private;
+
+private
+
+  type Buffer_T;
+  type T is access Buffer_T;
+
+end Taft_Type3_Pkg;

gcc/testsuite/gnat.dg/test_tamdt.adb

@@ -1,8 +0,0 @@
--- { dg-do run }
-
-with Tamdt;
-
-procedure Test_Tamdt is
-begin
-   Tamdt.Check;
-end;