+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Constant>: 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.
+ <object>: Remove obsolete comment. For a deferred constant with
+ address clause, get the initializer from the full view.
+ * gcc-interface/trans.c (gnat_to_gnu) <N_Attribute_Definition_Clause>:
+ Rework and remove obsolete comment.
+ <N_Object_Declaration>: 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 <kirtchev@adacore.com>
* rtsfind.ads: Add block IO versions of stream routines for Strings.
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;
}
!= 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)))
{
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;
}
&& !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);
|| 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
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;
/***************************************************/
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:
}
}
\f
-/* 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));
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)));
}
\f
/* Convert to a thin pointer type, TYPE. The only thing we know how to convert
+2008-08-01 Eric Botcazou <ebotcazou@adacore.com>
+
+ * 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 <rguenther@suse.de>
PR tree-optimization/36988
--- /dev/null
+-- { 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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+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;
projects / platform / upstream / gcc.git / commitdiff