From 8df2e9022925c06ab369d74a301bcf081ddc417e Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 1 Aug 2008 12:39:57 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): Remove dead code. MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2008-08-01  Eric Botcazou   * gcc-interface/decl.c (gnat_to_gnu_entity) : Remove dead code.  Do not get full definition of deferred constants with address clause for a use.  Do not ignore deferred constant definitions with address clause.  Ignore constant definitions already marked with the error node. : Remove obsolete comment.  For a deferred constant with address clause, get the initializer from the full view. * gcc-interface/trans.c (gnat_to_gnu) : Rework and remove obsolete comment. : For a deferred constant with address clause, mark the full view with the error node. *  gcc-interface/utils.c (convert_to_fat_pointer): Rework and fix formatting nits. From-SVN: r138513 --- gcc/ada/ChangeLog | 16 +++++++ gcc/ada/gcc-interface/decl.c | 62 ++++++++++++++++----------- gcc/ada/gcc-interface/trans.c | 32 +++++++++----- gcc/ada/gcc-interface/utils.c | 49 ++++++++++----------- gcc/testsuite/ChangeLog | 8 ++++ gcc/testsuite/gnat.dg/deferred_const1.adb | 12 ++++++ gcc/testsuite/gnat.dg/deferred_const2.adb | 11 +++++ gcc/testsuite/gnat.dg/deferred_const2_pkg.adb | 11 +++++ gcc/testsuite/gnat.dg/deferred_const2_pkg.ads | 12 ++++++ gcc/testsuite/gnat.dg/deferred_const3.adb | 19 ++++++++ gcc/testsuite/gnat.dg/deferred_const3_pkg.adb | 19 ++++++++ gcc/testsuite/gnat.dg/deferred_const3_pkg.ads | 21 +++++++++ 12 files changed, 213 insertions(+), 59 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/deferred_const1.adb create mode 100644 gcc/testsuite/gnat.dg/deferred_const2.adb create mode 100644 gcc/testsuite/gnat.dg/deferred_const2_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/deferred_const2_pkg.ads create mode 100644 gcc/testsuite/gnat.dg/deferred_const3.adb create mode 100644 gcc/testsuite/gnat.dg/deferred_const3_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/deferred_const3_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dc260b7..223723f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2008-08-01 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Remove dead + code. Do not get full definition of deferred constants with address + clause for a use. Do not ignore deferred constant definitions with + address clause. Ignore constant definitions already marked with the + error node. + : Remove obsolete comment. For a deferred constant with + address clause, get the initializer from the full view. + * gcc-interface/trans.c (gnat_to_gnu) : + Rework and remove obsolete comment. + : For a deferred constant with address clause, + mark the full view with the error node. + * gcc-interface/utils.c (convert_to_fat_pointer): Rework and fix + formatting nits. + 2008-08-01 Hristian Kirtchev * rtsfind.ads: Add block IO versions of stream routines for Strings. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 89621db..bc17235 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -367,12 +367,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) switch (kind) { case E_Constant: - /* If this is a use of a deferred constant, get its full - declaration. */ - if (!definition && Present (Full_View (gnat_entity))) + /* If this is a use of a deferred constant without address clause, + get its full definition. */ + if (!definition + && No (Address_Clause (gnat_entity)) + && Present (Full_View (gnat_entity))) { - gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity), - gnu_expr, 0); + gnu_decl + = gnat_to_gnu_entity (Full_View (gnat_entity), gnu_expr, 0); saved = true; break; } @@ -391,12 +393,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) != N_Allocator)) gnu_expr = gnat_to_gnu (Expression (Declaration_Node (gnat_entity))); - /* Ignore deferred constant definitions; they are processed fully in the - front-end. For deferred constant references get the full definition. - On the other hand, constants that are renamings are handled like - variable renamings. If No_Initialization is set, this is not a - deferred constant but a constant whose value is built manually. */ - if (definition && !gnu_expr + /* Ignore deferred constant definitions without address clause since + they are processed fully in the front-end. If No_Initialization + is set, this is not a deferred constant but a constant whose value + is built manually. And constants that are renamings are handled + like variables. */ + if (definition + && !gnu_expr + && No (Address_Clause (gnat_entity)) && !No_Initialization (Declaration_Node (gnat_entity)) && No (Renamed_Object (gnat_entity))) { @@ -404,12 +408,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) saved = true; break; } - else if (!definition && IN (kind, Incomplete_Or_Private_Kind) - && Present (Full_View (gnat_entity))) + + /* Ignore constant definitions already marked with the error node. See + the N_Object_Declaration case of gnat_to_gnu for the rationale. */ + if (definition + && gnu_expr + && present_gnu_tree (gnat_entity) + && get_gnu_tree (gnat_entity) == error_mark_node) { - gnu_decl = gnat_to_gnu_entity (Full_View (gnat_entity), - NULL_TREE, 0); - saved = true; + maybe_present = true; break; } @@ -1037,17 +1044,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !Is_Imported (gnat_entity) && !gnu_expr) gnu_expr = integer_zero_node; - /* If we are defining the object and it has an Address clause we must - get the address expression from the saved GCC tree for the - object if the object has a Freeze_Node. Otherwise, we elaborate - the address expression here since the front-end has guaranteed - in that case that the elaboration has no effects. Note that - only the latter mechanism is currently in use. */ + /* If we are defining the object and it has an Address clause, we must + either get the address expression from the saved GCC tree for the + object if it has a Freeze node, or elaborate the address expression + here since the front-end has guaranteed that the elaboration has no + effects in this case. */ if (definition && Present (Address_Clause (gnat_entity))) { tree gnu_address - = (present_gnu_tree (gnat_entity) ? get_gnu_tree (gnat_entity) - : gnat_to_gnu (Expression (Address_Clause (gnat_entity)))); + = present_gnu_tree (gnat_entity) + ? get_gnu_tree (gnat_entity) + : gnat_to_gnu (Expression (Address_Clause (gnat_entity))); save_gnu_tree (gnat_entity, NULL_TREE, false); @@ -1064,6 +1071,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || compile_time_known_address_p (Expression (Address_Clause (gnat_entity))); + /* If this is a deferred constant, the initializer is attached to + the full view. */ + if (kind == E_Constant && Present (Full_View (gnat_entity))) + gnu_expr + = gnat_to_gnu + (Expression (Declaration_Node (Full_View (gnat_entity)))); + /* If we don't have an initializing expression for the underlying variable, the initializing expression for the pointer is the specified address. Otherwise, we have to make a COMPOUND_EXPR diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 677ec01..43e6afb 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3397,6 +3397,15 @@ gnat_to_gnu (Node_Id gnat_node) if (type_annotate_only && gnu_expr && TREE_CODE (gnu_expr) == ERROR_MARK) gnu_expr = NULL_TREE; + /* If this is a deferred constant with an address clause, we ignore the + full view since the clause is on the partial view and we cannot have + 2 different GCC trees for the object. The only bits of the full view + we will use is the initializer, but it will be directly fetched. */ + if (Ekind(gnat_temp) == E_Constant + && Present (Address_Clause (gnat_temp)) + && Present (Full_View (gnat_temp))) + save_gnu_tree (Full_View (gnat_temp), error_mark_node, true); + if (No (Freeze_Node (gnat_temp))) gnat_to_gnu_entity (gnat_temp, gnu_expr, 1); break; @@ -4541,21 +4550,22 @@ gnat_to_gnu (Node_Id gnat_node) /***************************************************/ case N_Attribute_Definition_Clause: - gnu_result = alloc_stmt_list (); - /* The only one we need deal with is for 'Address. For the others, SEM - puts the information elsewhere. We need only deal with 'Address - if the object has a Freeze_Node (which it never will currently). */ - if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address - || No (Freeze_Node (Entity (Name (gnat_node))))) + /* The only one we need to deal with is 'Address since, for the others, + the front-end puts the information elsewhere. */ + if (Get_Attribute_Id (Chars (gnat_node)) != Attr_Address) + break; + + /* And we only deal with 'Address if the object has a Freeze node. */ + gnat_temp = Entity (Name (gnat_node)); + if (No (Freeze_Node (gnat_temp))) break; - /* Get the value to use as the address and save it as the - equivalent for GNAT_TEMP. When the object is frozen, - gnat_to_gnu_entity will do the right thing. */ - save_gnu_tree (Entity (Name (gnat_node)), - gnat_to_gnu (Expression (gnat_node)), true); + /* Get the value to use as the address and save it as the equivalent + for the object. When it is frozen, gnat_to_gnu_entity will do the + right thing. */ + save_gnu_tree (gnat_temp, gnat_to_gnu (Expression (gnat_node)), true); break; case N_Enumeration_Representation_Clause: diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 9978ebc..dcf0558 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -3869,31 +3869,31 @@ update_pointer_to (tree old_type, tree new_type) } } -/* Convert a pointer to a constrained array into a pointer to a fat - pointer. This involves making or finding a template. */ +/* Convert EXPR, a pointer to a constrained array, into a pointer to an + unconstrained one. This involves making or finding a template. */ static tree convert_to_fat_pointer (tree type, tree expr) { tree template_type = TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type)))); - tree template, template_addr; + tree p_array_type = TREE_TYPE (TYPE_FIELDS (type)); tree etype = TREE_TYPE (expr); + tree template; - /* If EXPR is a constant of zero, we make a fat pointer that has a null - pointer to the template and array. */ + /* If EXPR is null, make a fat pointer that contains null pointers to the + template and array. */ if (integer_zerop (expr)) return gnat_build_constructor (type, tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE (TYPE_FIELDS (type)), expr), + convert (p_array_type, expr), tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), convert (build_pointer_type (template_type), expr), NULL_TREE))); - /* If EXPR is a thin pointer, make the template and data from the record. */ - + /* If EXPR is a thin pointer, make template and data from the record.. */ else if (TYPE_THIN_POINTER_P (etype)) { tree fields = TYPE_FIELDS (TREE_TYPE (etype)); @@ -3909,30 +3909,31 @@ convert_to_fat_pointer (tree type, tree expr) build_component_ref (expr, NULL_TREE, TREE_CHAIN (fields), false)); } + + /* Otherwise, build the constructor for the template. */ else - /* Otherwise, build the constructor for the template. */ template = build_template (template_type, TREE_TYPE (etype), expr); - template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); - - /* The result is a CONSTRUCTOR for the fat pointer. + /* The final result is a constructor for the fat pointer. - If expr is an argument of a foreign convention subprogram, the type it - points to is directly the component type. In this case, the expression + If EXPR is an argument of a foreign convention subprogram, the type it + points to is directly the component type. In this case, the expression type may not match the corresponding FIELD_DECL type at this point, so we - call "convert" here to fix that up if necessary. This type consistency is + call "convert" here to fix that up if necessary. This type consistency is required, for instance because it ensures that possible later folding of - component_refs against this constructor always yields something of the + COMPONENT_REFs against this constructor always yields something of the same type as the initial reference. - Note that the call to "build_template" above is still fine, because it - will only refer to the provided template_type in this case. */ - return - gnat_build_constructor - (type, tree_cons (TYPE_FIELDS (type), - convert (TREE_TYPE (TYPE_FIELDS (type)), expr), - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - template_addr, NULL_TREE))); + Note that the call to "build_template" above is still fine because it + will only refer to the provided TEMPLATE_TYPE in this case. */ + return + gnat_build_constructor + (type, + tree_cons (TYPE_FIELDS (type), + convert (p_array_type, expr), + tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), + build_unary_op (ADDR_EXPR, NULL_TREE, template), + NULL_TREE))); } /* Convert to a thin pointer type, TYPE. The only thing we know how to convert diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 78287a7..cde9a26 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-08-01 Eric Botcazou + + * gnat.dg/deferred_const1.adb: New test. + * gnat.dg/deferred_const2.adb: Likewise. + * gnat.dg/deferred_const2_pkg.ad[sb]: New helper. + * gnat.dg/deferred_const3.adb: New test. + * gnat.dg/deferred_const3_pkg.ad[sb]: New helper. + 2008-08-01 Richard Guenther PR tree-optimization/36988 diff --git a/gcc/testsuite/gnat.dg/deferred_const1.adb b/gcc/testsuite/gnat.dg/deferred_const1.adb new file mode 100644 index 0000000..79b9f4a --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const1.adb @@ -0,0 +1,12 @@ +-- { dg-do compile } + +with Text_IO; use Text_IO; + +procedure Deferred_Const1 is + I : Integer := 16#20_3A_2D_28#; + S : constant string(1..4); + for S'address use I'address; -- { dg-warning "constant overlays a variable" } + pragma Import (Ada, S); +begin + Put_Line (S); +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const2.adb b/gcc/testsuite/gnat.dg/deferred_const2.adb new file mode 100644 index 0000000..ee06db7 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2.adb @@ -0,0 +1,11 @@ +-- { dg-do run } + +with System; use System; +with Deferred_Const2_Pkg; use Deferred_Const2_Pkg; + +procedure Deferred_Const2 is +begin + if I'Address /= S'Address then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb new file mode 100644 index 0000000..b81d448 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.adb @@ -0,0 +1,11 @@ +with System; use System; + +package body Deferred_Const2_Pkg is + + procedure Dummy is begin null; end; + +begin + if S'Address /= I'Address then + raise Program_Error; + end if; +end Deferred_Const2_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads new file mode 100644 index 0000000..c76e5fd --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const2_pkg.ads @@ -0,0 +1,12 @@ +package Deferred_Const2_Pkg is + + I : Integer := 16#20_3A_2D_28#; + + pragma Warnings (Off); + S : constant string(1..4); + for S'address use I'address; + pragma Import (Ada, S); + + procedure Dummy; + +end Deferred_Const2_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const3.adb b/gcc/testsuite/gnat.dg/deferred_const3.adb new file mode 100644 index 0000000..84554d3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3.adb @@ -0,0 +1,19 @@ +-- { dg-do run } + +with System; use System; +with Deferred_Const3_Pkg; use Deferred_Const3_Pkg; + +procedure Deferred_Const3 is +begin + if C1'Address /= C'Address then + raise Program_Error; + end if; + + if C2'Address /= C'Address then + raise Program_Error; + end if; + + if C3'Address /= C'Address then + raise Program_Error; + end if; +end; diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb new file mode 100644 index 0000000..e865494 --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.adb @@ -0,0 +1,19 @@ +with System; use System; + +package body Deferred_Const3_Pkg is + + procedure Dummy is begin null; end; + +begin + if C1'Address /= C'Address then + raise Program_Error; + end if; + + if C2'Address /= C'Address then + raise Program_Error; + end if; + + if C3'Address /= C'Address then + raise Program_Error; + end if; +end Deferred_Const3_Pkg; diff --git a/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads new file mode 100644 index 0000000..de6af3d --- /dev/null +++ b/gcc/testsuite/gnat.dg/deferred_const3_pkg.ads @@ -0,0 +1,21 @@ +package Deferred_Const3_Pkg is + + C : constant Natural := 1; + + C1 : constant Natural := 1; + for C1'Address use C'Address; + + C2 : constant Natural; + for C2'Address use C'Address; + + C3 : constant Natural; + + procedure Dummy; + +private + C2 : constant Natural := 1; + + C3 : constant Natural := 1; + for C3'Address use C'Address; + +end Deferred_Const3_Pkg; -- 2.7.4