gigi.h (mark_out_of_scope): Delete.

	* gcc-interface/gigi.h (mark_out_of_scope): Delete.
	(destroy_gnat_to_gnu): Declare.
	(destroy_dummy_type): Likewise.
	* gcc-interface/decl.c (mark_out_of_scope): Delete.
	* gcc-interface/utils.c (destroy_gnat_to_gnu): New function.
	(destroy_dummy_type): Likewise.
	* gcc-interface/trans.c (gnat_validate_uc_list): New variable.
	(gigi): Call validate_unchecked_conversion on gnat_validate_uc_list
	after the translation is completed.  Call destroy_gnat_to_gnu and
	destroy_dummy_type at the end.
	(Subprogram_Body_to_gnu): Do not call mark_out_of_scope.
	(gnat_to_gnu) <N_Block_Statement>: Likewise.
	<N_Validate_Unchecked_Conversion>: Do not process the node, only push
	it onto gnat_validate_uc_list.
	(validate_unchecked_conversion): New function.

From-SVN: r186956

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 68219cc05b1515cbff7bda7723aeb079d8a8ed5e..e8421391e63c4d15dfc0b2c3022784a0d19493ab 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2012-04-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/gigi.h (mark_out_of_scope): Delete.
+       (destroy_gnat_to_gnu): Declare.
+       (destroy_dummy_type): Likewise.
+       * gcc-interface/decl.c (mark_out_of_scope): Delete.
+       * gcc-interface/utils.c (destroy_gnat_to_gnu): New function.
+       (destroy_dummy_type): Likewise.
+       * gcc-interface/trans.c (gnat_validate_uc_list): New variable.
+       (gigi): Call validate_unchecked_conversion on gnat_validate_uc_list
+       after the translation is completed.  Call destroy_gnat_to_gnu and
+       destroy_dummy_type at the end.
+       (Subprogram_Body_to_gnu): Do not call mark_out_of_scope.
+       (gnat_to_gnu) <N_Block_Statement>: Likewise.
+       <N_Validate_Unchecked_Conversion>: Do not process the node, only push
+       it onto gnat_validate_uc_list.
+       (validate_unchecked_conversion): New function.
+
 2012-04-26  Tristan Gingold  <gingold@adacore.com>
 
        * gcc-interface/Make-lang.in: Update dependencies.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index dac9942237f067e036283e0d39e280514fc8e415..6f351d3db2e3cbedac73e60c880cd7e23c8a6f8b 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -5838,44 +5838,6 @@ elaborate_entity (Entity_Id gnat_entity)
     }
 }
 \f
-/* Mark GNAT_ENTITY as going out of scope at this point.  Recursively mark
-   any entities on its entity chain similarly.  */
-
-void
-mark_out_of_scope (Entity_Id gnat_entity)
-{
-  Entity_Id gnat_sub_entity;
-  unsigned int kind = Ekind (gnat_entity);
-
-  /* If this has an entity list, process all in the list.  */
-  if (IN (kind, Class_Wide_Kind) || IN (kind, Concurrent_Kind)
-      || IN (kind, Private_Kind)
-      || kind == E_Block || kind == E_Entry || kind == E_Entry_Family
-      || kind == E_Function || kind == E_Generic_Function
-      || kind == E_Generic_Package || kind == E_Generic_Procedure
-      || kind == E_Loop || kind == E_Operator || kind == E_Package
-      || kind == E_Package_Body || kind == E_Procedure
-      || kind == E_Record_Type || kind == E_Record_Subtype
-      || kind == E_Subprogram_Body || kind == E_Subprogram_Type)
-    for (gnat_sub_entity = First_Entity (gnat_entity);
-        Present (gnat_sub_entity);
-        gnat_sub_entity = Next_Entity (gnat_sub_entity))
-      if (Scope (gnat_sub_entity) == gnat_entity
-         && gnat_sub_entity != gnat_entity)
-       mark_out_of_scope (gnat_sub_entity);
-
-  /* Now clear this if it has been defined, but only do so if it isn't
-     a subprogram or parameter.  We could refine this, but it isn't
-     worth it.  If this is statically allocated, it is supposed to
-     hang around out of cope.  */
-  if (present_gnu_tree (gnat_entity) && !Is_Statically_Allocated (gnat_entity)
-      && kind != E_Procedure && kind != E_Function && !IN (kind, Formal_Kind))
-    {
-      save_gnu_tree (gnat_entity, NULL_TREE, true);
-      save_gnu_tree (gnat_entity, error_mark_node, true);
-    }
-}
-\f
 /* Relate the alias sets of GNU_NEW_TYPE and GNU_OLD_TYPE according to OP.
    If this is a multi-dimensional array type, do this recursively.
 

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index c507615fbfd94ada4588f9bc730c0c0f9daed9b1..fb1106f793eeb0eb3e2ccb216a89f219e2912231 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -108,10 +108,6 @@ extern Entity_Id Gigi_Equivalent_Type (Entity_Id gnat_entity);
    be elaborated at the point of its definition, but do nothing else.  */
 extern void elaborate_entity (Entity_Id gnat_entity);
 
-/* Mark GNAT_ENTITY as going out of scope at this point.  Recursively mark
-   any entities on its entity chain similarly.  */
-extern void mark_out_of_scope (Entity_Id gnat_entity);
-
 /* Get the unpadded version of a GNAT type.  */
 extern tree get_unpadded_type (Entity_Id gnat_entity);
 
@@ -504,6 +500,9 @@ extern tree convert_to_index_type (tree expr);
 /* Initialize the association of GNAT nodes to GCC trees.  */
 extern void init_gnat_to_gnu (void);
 
+/* Destroy the association of GNAT nodes to GCC trees.  */
+extern void destroy_gnat_to_gnu (void);
+
 /* GNAT_ENTITY is a GNAT tree node for a defining identifier.
    GNU_DECL is the GCC tree which is to be associated with
    GNAT_ENTITY. Such gnu tree node is always an ..._DECL node.
@@ -523,6 +522,9 @@ extern bool present_gnu_tree (Entity_Id gnat_entity);
 /* Initialize the association of GNAT nodes to GCC trees as dummies.  */
 extern void init_dummy_type (void);
 
+/* Destroy the association of GNAT nodes to GCC trees as dummies.  */
+extern void destroy_dummy_type (void);
+
 /* Make a dummy type corresponding to GNAT_TYPE.  */
 extern tree make_dummy_type (Entity_Id gnat_type);
 

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index cdcc2172275b268d255dab7da1a9306a0ed784c0..3698dcaf2a4138a360ae855ec55701606af1bb29 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -109,6 +109,12 @@ bool type_annotate_only;
 /* Current filename without path.  */
 const char *ref_filename;
 
+DEF_VEC_I(Node_Id);
+DEF_VEC_ALLOC_I(Node_Id,heap);
+
+/* List of N_Validate_Unchecked_Conversion nodes in the unit.  */
+static VEC(Node_Id,heap) *gnat_validate_uc_list;
+
 /* When not optimizing, we cache the 'First, 'Last and 'Length attributes
    of unconstrained array IN parameters to avoid emitting a great deal of
    redundant instructions to recompute them each time.  */
@@ -251,6 +257,7 @@ static bool addressable_p (tree, tree);
 static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
 static tree extract_values (tree, tree);
 static tree pos_to_constructor (Node_Id, tree, Entity_Id);
+static void validate_unchecked_conversion (Node_Id);
 static tree maybe_implicit_deref (tree);
 static void set_expr_location_from_node (tree, Node_Id);
 static bool set_end_locus_from_node (tree, Node_Id);
@@ -278,6 +285,7 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
       Entity_Id standard_character, Entity_Id standard_long_long_float,
       Entity_Id standard_exception_type, Int gigi_operating_mode)
 {
+  Node_Id gnat_iter;
   Entity_Id gnat_literal;
   tree long_long_float_type, exception_type, t, ftype;
   tree int64_type = gnat_type_for_size (64, 0);
@@ -648,6 +656,13 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
   /* Now translate the compilation unit proper.  */
   Compilation_Unit_to_gnu (gnat_root);
 
+  /* Then process the N_Validate_Unchecked_Conversion nodes.  We do this at
+     the very end to avoid having to second-guess the front-end when we run
+     into dummy nodes during the regular processing.  */
+  for (i = 0; VEC_iterate (Node_Id, gnat_validate_uc_list, i, gnat_iter); i++)
+    validate_unchecked_conversion (gnat_iter);
+  VEC_free (Node_Id, heap, gnat_validate_uc_list);
+
   /* Finally see if we have any elaboration procedures to deal with.  */
   for (info = elab_info_list; info; info = info->next)
     {
@@ -669,6 +684,10 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name ATTRIBUTE_UNUSED,
        }
     }
 
+  /* Destroy ourselves.  */
+  destroy_gnat_to_gnu ();
+  destroy_dummy_type ();
+
   /* We cannot track the location of errors past this point.  */
   error_gnat_node = Empty;
 }
@@ -3480,8 +3499,6 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
   /* If there is a stub associated with the function, build it now.  */
   if (DECL_FUNCTION_STUB (gnu_subprog_decl))
     build_function_stub (gnu_subprog_decl, gnat_subprog_id);
-
-  mark_out_of_scope (Defining_Unit_Name (Specification (gnat_node)));
 }
 \f
 /* Return true if GNAT_NODE requires atomic synchronization.  */
@@ -6036,9 +6053,6 @@ gnat_to_gnu (Node_Id gnat_node)
       add_stmt (gnat_to_gnu (Handled_Statement_Sequence (gnat_node)));
       gnat_poplevel ();
       gnu_result = end_stmt_group ();
-
-      if (Present (Identifier (gnat_node)))
-       mark_out_of_scope (Entity (Identifier (gnat_node)));
       break;
 
     case N_Exit_Statement:
@@ -6760,83 +6774,10 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Validate_Unchecked_Conversion:
-      {
-       Entity_Id gnat_target_type = Target_Type (gnat_node);
-       tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
-       tree gnu_target_type = gnat_to_gnu_type (gnat_target_type);
-
-       /* No need for any warning in this case.  */
-       if (!flag_strict_aliasing)
-         ;
-
-       /* If the result is a pointer type, see if we are either converting
-          from a non-pointer or from a pointer to a type with a different
-          alias set and warn if so.  If the result is defined in the same
-          unit as this unchecked conversion, we can allow this because we
-          can know to make the pointer type behave properly.  */
-       else if (POINTER_TYPE_P (gnu_target_type)
-                && !In_Same_Source_Unit (gnat_target_type, gnat_node)
-                && !No_Strict_Aliasing (Underlying_Type (gnat_target_type)))
-         {
-           tree gnu_source_desig_type = POINTER_TYPE_P (gnu_source_type)
-                                        ? TREE_TYPE (gnu_source_type)
-                                        : NULL_TREE;
-           tree gnu_target_desig_type = TREE_TYPE (gnu_target_type);
-
-           if ((TYPE_IS_DUMMY_P (gnu_target_desig_type)
-                || get_alias_set (gnu_target_desig_type) != 0)
-               && (!POINTER_TYPE_P (gnu_source_type)
-                   || (TYPE_IS_DUMMY_P (gnu_source_desig_type)
-                       != TYPE_IS_DUMMY_P (gnu_target_desig_type))
-                   || (TYPE_IS_DUMMY_P (gnu_source_desig_type)
-                       && gnu_source_desig_type != gnu_target_desig_type)
-                   || !alias_sets_conflict_p
-                       (get_alias_set (gnu_source_desig_type),
-                        get_alias_set (gnu_target_desig_type))))
-             {
-               post_error_ne
-                 ("?possible aliasing problem for type&",
-                  gnat_node, Target_Type (gnat_node));
-               post_error
-                 ("\\?use -fno-strict-aliasing switch for references",
-                  gnat_node);
-               post_error_ne
-                 ("\\?or use `pragma No_Strict_Aliasing (&);`",
-                  gnat_node, Target_Type (gnat_node));
-             }
-         }
-
-       /* But if the result is a fat pointer type, we have no mechanism to
-          do that, so we unconditionally warn in problematic cases.  */
-       else if (TYPE_IS_FAT_POINTER_P (gnu_target_type))
-         {
-           tree gnu_source_array_type
-             = TYPE_IS_FAT_POINTER_P (gnu_source_type)
-               ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type)))
-               : NULL_TREE;
-           tree gnu_target_array_type
-             = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
-
-           if ((TYPE_IS_DUMMY_P (gnu_target_array_type)
-                || get_alias_set (gnu_target_array_type) != 0)
-               && (!TYPE_IS_FAT_POINTER_P (gnu_source_type)
-                   || (TYPE_IS_DUMMY_P (gnu_source_array_type)
-                       != TYPE_IS_DUMMY_P (gnu_target_array_type))
-                   || (TYPE_IS_DUMMY_P (gnu_source_array_type)
-                       && gnu_source_array_type != gnu_target_array_type)
-                   || !alias_sets_conflict_p
-                       (get_alias_set (gnu_source_array_type),
-                        get_alias_set (gnu_target_array_type))))
-             {
-               post_error_ne
-                 ("?possible aliasing problem for type&",
-                  gnat_node, Target_Type (gnat_node));
-               post_error
-                 ("\\?use -fno-strict-aliasing switch for references",
-                  gnat_node);
-             }
-         }
-      }
+      /* The only validation we currently do on an unchecked conversion is
+        that of aliasing assumptions.  */
+      if (flag_strict_aliasing)
+       VEC_safe_push (Node_Id, heap, gnat_validate_uc_list, gnat_node);
       gnu_result = alloc_stmt_list ();
       break;
 
@@ -8723,6 +8664,65 @@ extract_values (tree values, tree record_type)
   return gnat_build_constructor (record_type, v);
 }
 \f
+/* Process a N_Validate_Unchecked_Conversion node.  */
+
+static void
+validate_unchecked_conversion (Node_Id gnat_node)
+{
+  tree gnu_source_type = gnat_to_gnu_type (Source_Type (gnat_node));
+  tree gnu_target_type = gnat_to_gnu_type (Target_Type (gnat_node));
+
+  /* If the target is a pointer type, see if we are either converting from a
+     non-pointer or from a pointer to a type with a different alias set and
+     warn if so, unless the pointer has been marked to alias everything.  */
+  if (POINTER_TYPE_P (gnu_target_type)
+      && !TYPE_REF_CAN_ALIAS_ALL (gnu_target_type))
+    {
+      tree gnu_source_desig_type = POINTER_TYPE_P (gnu_source_type)
+                                  ? TREE_TYPE (gnu_source_type)
+                                  : NULL_TREE;
+      tree gnu_target_desig_type = TREE_TYPE (gnu_target_type);
+      alias_set_type target_alias_set = get_alias_set (gnu_target_desig_type);
+
+      if (target_alias_set != 0
+         && (!POINTER_TYPE_P (gnu_source_type)
+             || !alias_sets_conflict_p (get_alias_set (gnu_source_desig_type),
+                                        target_alias_set)))
+       {
+         post_error_ne ("?possible aliasing problem for type&",
+                        gnat_node, Target_Type (gnat_node));
+         post_error ("\\?use -fno-strict-aliasing switch for references",
+                     gnat_node);
+         post_error_ne ("\\?or use `pragma No_Strict_Aliasing (&);`",
+                        gnat_node, Target_Type (gnat_node));
+       }
+    }
+
+  /* Likewise if the target is a fat pointer type, but we have no mechanism to
+     mitigate the problem in this case, so we unconditionally warn.  */
+  else if (TYPE_IS_FAT_POINTER_P (gnu_target_type))
+    {
+      tree gnu_source_desig_type
+       = TYPE_IS_FAT_POINTER_P (gnu_source_type)
+         ? TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_source_type)))
+         : NULL_TREE;
+      tree gnu_target_desig_type
+       = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (gnu_target_type)));
+      alias_set_type target_alias_set = get_alias_set (gnu_target_desig_type);
+
+      if (target_alias_set != 0
+         && (!TYPE_IS_FAT_POINTER_P (gnu_source_type)
+             || !alias_sets_conflict_p (get_alias_set (gnu_source_desig_type),
+                                        target_alias_set)))
+       {
+         post_error_ne ("?possible aliasing problem for type&",
+                        gnat_node, Target_Type (gnat_node));
+         post_error ("\\?use -fno-strict-aliasing switch for references",
+                     gnat_node);
+       }
+    }
+}
+\f
 /* EXP is to be treated as an array or record.  Handle the cases when it is
    an access object and perform the required dereferences.  */
 

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 41f83bfbe8a134d9738256d3c8caeb4286e308dd..123c3a5705c3a6ea6b7c36bcab524a898cb24292 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -231,6 +231,15 @@ init_gnat_to_gnu (void)
   associate_gnat_to_gnu = ggc_alloc_cleared_vec_tree (max_gnat_nodes);
 }
 
+/* Destroy the association of GNAT nodes to GCC trees.  */
+
+void
+destroy_gnat_to_gnu (void)
+{
+  ggc_free (associate_gnat_to_gnu);
+  associate_gnat_to_gnu = NULL;
+}
+
 /* GNAT_ENTITY is a GNAT tree node for an entity.  Associate GNU_DECL, a GCC
    tree node, with GNAT_ENTITY.  If GNU_DECL is not a ..._DECL node, abort.
    If NO_CHECK is true, the latter check is suppressed.
@@ -280,6 +289,15 @@ init_dummy_type (void)
   dummy_node_table = ggc_alloc_cleared_vec_tree (max_gnat_nodes);
 }
 
+/* Destroy the association of GNAT nodes to GCC trees as dummies.  */
+
+void
+destroy_dummy_type (void)
+{
+  ggc_free (dummy_node_table);
+  dummy_node_table = NULL;
+}
+
 /* Make a dummy type corresponding to GNAT_TYPE.  */
 
 tree

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 532c335d9263afe46cbc7c54b74ff7a1ca3172ce..45bda58a0792204b549e19e4fdd12dafc18e5036 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2012-04-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/warn6.ad[sb]: New test.
+
 2012-04-29  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
        PR 53149

diff --git a/gcc/testsuite/gnat.dg/warn6.adb b/gcc/testsuite/gnat.dg/warn6.adb
new file mode 100644 (file)
index 0000000..0a388f1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn6.adb
@@ -0,0 +1,13 @@
+-- { dg-do compile }
+-- { dg-options "-O2" }
+
+with Unchecked_Conversion;
+with System;
+
+package body Warn6 is
+
+  function Conv is new Unchecked_Conversion (System.Address, Q_T);
+
+  procedure Dummy is begin null; end;
+
+end Warn6;

diff --git a/gcc/testsuite/gnat.dg/warn6.ads b/gcc/testsuite/gnat.dg/warn6.ads
new file mode 100644 (file)
index 0000000..e7495ea
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/warn6.ads
@@ -0,0 +1,15 @@
+package Warn6 is
+
+  package Q is
+    type T is private; -- this is the trigger
+  private
+    type T is access Integer;
+    pragma No_Strict_Aliasing (T);
+
+  end Q;
+
+  subtype Q_T is Q.T;
+
+  procedure Dummy;
+
+end Warn6;