From 10e4d0563e0862eaf29529134cc7b6495fecaa51 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 6 Jun 2011 10:00:32 +0000 Subject: [PATCH] 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 | 7 +++++ gcc/ada/gcc-interface/Make-lang.in | 2 +- gcc/ada/gcc-interface/utils.c | 25 ++++++++++++++-- gcc/testsuite/ChangeLog | 13 +++++++++ gcc/testsuite/gnat.dg/taft_type1.adb | 8 +++++ .../{tamdt.adb => taft_type1_pkg1.adb} | 11 ++++--- .../{tamdt.ads => taft_type1_pkg1.ads} | 5 ++-- .../{tamdt_aux.ads => taft_type1_pkg2.ads} | 8 ++--- gcc/testsuite/gnat.dg/taft_type2.adb | 22 ++++++++++++++ gcc/testsuite/gnat.dg/taft_type2.ads | 5 ++++ gcc/testsuite/gnat.dg/taft_type2_pkg.ads | 12 ++++++++ gcc/testsuite/gnat.dg/taft_type3.adb | 29 +++++++++++++++++++ gcc/testsuite/gnat.dg/taft_type3_pkg.ads | 10 +++++++ gcc/testsuite/gnat.dg/test_tamdt.adb | 8 ----- 14 files changed, 138 insertions(+), 27 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/taft_type1.adb rename gcc/testsuite/gnat.dg/{tamdt.adb => taft_type1_pkg1.adb} (62%) rename gcc/testsuite/gnat.dg/{tamdt.ads => taft_type1_pkg1.ads} (73%) rename gcc/testsuite/gnat.dg/{tamdt_aux.ads => taft_type1_pkg2.ads} (65%) create mode 100644 gcc/testsuite/gnat.dg/taft_type2.adb create mode 100644 gcc/testsuite/gnat.dg/taft_type2.ads create mode 100644 gcc/testsuite/gnat.dg/taft_type2_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/taft_type3.adb create mode 100644 gcc/testsuite/gnat.dg/taft_type3_pkg.ads delete mode 100644 gcc/testsuite/gnat.dg/test_tamdt.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0af991dd8ba..1ea386b3912 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2011-06-06 Eric Botcazou + + * 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 * gcc-interface/utils.c (def_fn_type): Remove extra va_end. diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index dbd1f08b7e1..53f9f8d3f1a 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/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 \ diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index ad2ff2ad790..0f2a331f809 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/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); + } } /* ************************************************************************ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 99732725421..749949f810f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2011-06-06 Eric Botcazou + + * 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 PR fortran/49255 diff --git a/gcc/testsuite/gnat.dg/taft_type1.adb b/gcc/testsuite/gnat.dg/taft_type1.adb new file mode 100644 index 00000000000..3f3cc3a3e81 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/tamdt.adb b/gcc/testsuite/gnat.dg/taft_type1_pkg1.adb similarity index 62% rename from gcc/testsuite/gnat.dg/tamdt.adb rename to gcc/testsuite/gnat.dg/taft_type1_pkg1.adb index 81af6ade283..7e456709971 100644 --- a/gcc/testsuite/gnat.dg/tamdt.adb +++ b/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; diff --git a/gcc/testsuite/gnat.dg/tamdt.ads b/gcc/testsuite/gnat.dg/taft_type1_pkg1.ads similarity index 73% rename from gcc/testsuite/gnat.dg/tamdt.ads rename to gcc/testsuite/gnat.dg/taft_type1_pkg1.ads index 09d9388ee1d..da656f88ec9 100644 --- a/gcc/testsuite/gnat.dg/tamdt.ads +++ b/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; diff --git a/gcc/testsuite/gnat.dg/tamdt_aux.ads b/gcc/testsuite/gnat.dg/taft_type1_pkg2.ads similarity index 65% rename from gcc/testsuite/gnat.dg/tamdt_aux.ads rename to gcc/testsuite/gnat.dg/taft_type1_pkg2.ads index d5cca103fb4..4761840a5f2 100644 --- a/gcc/testsuite/gnat.dg/tamdt_aux.ads +++ b/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; diff --git a/gcc/testsuite/gnat.dg/taft_type2.adb b/gcc/testsuite/gnat.dg/taft_type2.adb new file mode 100644 index 00000000000..c855ab6e967 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/taft_type2.ads b/gcc/testsuite/gnat.dg/taft_type2.ads new file mode 100644 index 00000000000..539c1069875 --- /dev/null +++ b/gcc/testsuite/gnat.dg/taft_type2.ads @@ -0,0 +1,5 @@ +package Taft_Type2 is + + procedure Proc; + +end Taft_Type2; diff --git a/gcc/testsuite/gnat.dg/taft_type2_pkg.ads b/gcc/testsuite/gnat.dg/taft_type2_pkg.ads new file mode 100644 index 00000000000..689b3f1a6a8 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/taft_type3.adb b/gcc/testsuite/gnat.dg/taft_type3.adb new file mode 100644 index 00000000000..56931221492 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/taft_type3_pkg.ads b/gcc/testsuite/gnat.dg/taft_type3_pkg.ads new file mode 100644 index 00000000000..578c51894b3 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/test_tamdt.adb b/gcc/testsuite/gnat.dg/test_tamdt.adb deleted file mode 100644 index d0658ecc4a2..00000000000 --- a/gcc/testsuite/gnat.dg/test_tamdt.adb +++ /dev/null @@ -1,8 +0,0 @@ --- { dg-do run } - -with Tamdt; - -procedure Test_Tamdt is -begin - Tamdt.Check; -end; -- 2.30.2