diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 38 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/gigi.h | 10 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 164 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 18 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/warn6.adb | 13 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/warn6.ads | 15 |
8 files changed, 156 insertions, 124 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 68219cc05b1..e8421391e63 100644 --- 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 dac9942237f..6f351d3db2e 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5838,44 +5838,6 @@ 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. */ - -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); - } -} - /* 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 c507615fbfd..fb1106f793e 100644 --- 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 cdcc2172275..3698dcaf2a4 100644 --- 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))); } /* 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); } +/* 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); + } + } +} + /* 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 41f83bfbe8a..123c3a5705c 100644 --- 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 532c335d926..45bda58a079 100644 --- 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 index 00000000000..0a388f14844 --- /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 index 00000000000..e7495ead101 --- /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; |