+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.
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 \
#include "target.h"
#include "langhooks.h"
#include "cgraph.h"
+#include "diagnostic.h"
#include "tree-dump.h"
#include "tree-inline.h"
#include "tree-iterator.h"
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))
}
}
+ /* 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);
+ }
}
/* ************************************************************************
+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
--- /dev/null
+-- { dg-do run }
+
+with Taft_Type1_Pkg1;
+
+procedure Taft_Type1 is
+begin
+ Taft_Type1_Pkg1.Check;
+end;
+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;
raise Program_Error;
end if;
end;
-end;
+end Taft_Type1_Pkg1;
-
-package TAMDT is
+package Taft_Type1_Pkg1 is
procedure Check;
private
type TAMT1;
type TAMT2;
type TAMT2_Access is access TAMT2;
-end;
+end Taft_Type1_Pkg1;
-
-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;
--- /dev/null
+-- { dg-do compile }\r
+-- { dg-options "-g" }\r
+\r
+with Taft_Type2_Pkg; use Taft_Type2_Pkg;\r
+\r
+package body Taft_Type2 is\r
+\r
+ procedure Proc is\r
+ A : T;\r
+\r
+ function F return T is\r
+ My_T : T;\r
+ begin\r
+ My_T := Open;\r
+ return My_T;\r
+ end;\r
+\r
+ begin\r
+ A := F;\r
+ end;\r
+\r
+end Taft_Type2;\r
--- /dev/null
+package Taft_Type2 is\r
+\r
+ procedure Proc;\r
+\r
+end Taft_Type2;\r
--- /dev/null
+package Taft_Type2_Pkg is\r
+\r
+ type T is private;\r
+\r
+ function Open return T;\r
+\r
+private\r
+\r
+ type Buffer_T;\r
+ type T is access Buffer_T;\r
+\r
+end Taft_Type2_Pkg;\r
--- /dev/null
+-- { 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;
--- /dev/null
+package Taft_Type3_Pkg is
+
+ type T is private;
+
+private
+
+ type Buffer_T;
+ type T is access Buffer_T;
+
+end Taft_Type3_Pkg;
+++ /dev/null
--- { dg-do run }
-
-with Tamdt;
-
-procedure Test_Tamdt is
-begin
- Tamdt.Check;
-end;
OSDN Git Service
