Commit 928dfa4b by Eric Botcazou

gigi.h (build_unc_object_type): Add DEBUG_INFO_P param.

	* gcc-interface/gigi.h (build_unc_object_type): Add DEBUG_INFO_P param.
	(build_unc_object_type_from_ptr): Likewise.
	* gcc-interface/utils.c (build_unc_object_type): Add DEBUG_INFO_P param
	and pass it to create_type_decl.  Declare the type.  Simplify.
	(build_unc_object_type_from_ptr): Add DEBUG_INFO_P parameter and pass
	it to build_unc_object_type.
	* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust to above change.
	* gcc-interface/trans.c (Attribute_to_gnu): Likewise.
	(gnat_to_gnu): Likewise.
	* gcc-interface/utils2.c (build_allocator): Likewise.

From-SVN: r159180
parent d5a8e96f
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (build_unc_object_type): Add DEBUG_INFO_P param.
(build_unc_object_type_from_ptr): Likewise.
* gcc-interface/utils.c (build_unc_object_type): Add DEBUG_INFO_P param
and pass it to create_type_decl. Declare the type. Simplify.
(build_unc_object_type_from_ptr): Add DEBUG_INFO_P parameter and pass
it to build_unc_object_type.
* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust to above change.
* gcc-interface/trans.c (Attribute_to_gnu): Likewise.
(gnat_to_gnu): Likewise.
* gcc-interface/utils2.c (build_allocator): Likewise.
2010-05-07 Eric Botcazou <ebotcazou@adacore.com> 2010-05-07 Eric Botcazou <ebotcazou@adacore.com>
PR 40989 PR 40989
......
...@@ -807,7 +807,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -807,7 +807,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type gnu_type
= build_unc_object_type_from_ptr (gnu_fat, gnu_type, = build_unc_object_type_from_ptr (gnu_fat, gnu_type,
concat_name (gnu_entity_name, concat_name (gnu_entity_name,
"UNC")); "UNC"),
debug_info_p);
} }
#ifdef MINIMUM_ATOMIC_ALIGNMENT #ifdef MINIMUM_ATOMIC_ALIGNMENT
...@@ -2066,7 +2067,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2066,7 +2067,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
a record type for the object and its template with the fields a record type for the object and its template with the fields
shifted to have the template at a negative offset. */ shifted to have the template at a negative offset. */
tem = build_unc_object_type (gnu_template_type, tem, tem = build_unc_object_type (gnu_template_type, tem,
create_concat_name (gnat_name, "XUT")); create_concat_name (gnat_name, "XUT"),
debug_info_p);
shift_unc_components_for_thin_pointers (tem); shift_unc_components_for_thin_pointers (tem);
SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type); SET_TYPE_UNCONSTRAINED_ARRAY (tem, gnu_type);
......
...@@ -658,19 +658,20 @@ extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech, ...@@ -658,19 +658,20 @@ extern tree build_vms_descriptor32 (tree type, Mechanism_Type mech,
and the GNAT node GNAT_SUBPROG. */ and the GNAT node GNAT_SUBPROG. */
extern void build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog); extern void build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog);
/* Build a type to be used to represent an aliased object whose nominal /* Build a type to be used to represent an aliased object whose nominal type
type is an unconstrained array. This consists of a RECORD_TYPE containing is an unconstrained array. This consists of a RECORD_TYPE containing a
a field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an ARRAY_TYPE.
ARRAY_TYPE. If ARRAY_TYPE is that of the unconstrained array, this If ARRAY_TYPE is that of an unconstrained array, this is used to represent
is used to represent an arbitrary unconstrained object. Use NAME an arbitrary unconstrained object. Use NAME as the name of the record.
as the name of the record. */ DEBUG_INFO_P is true if we need to write debug information for the type. */
extern tree build_unc_object_type (tree template_type, tree object_type, extern tree build_unc_object_type (tree template_type, tree object_type,
tree name); tree name, bool debug_info_p);
/* Same as build_unc_object_type, but taking a thin or fat pointer type /* Same as build_unc_object_type, but taking a thin or fat pointer type
instead of the template type. */ instead of the template type. */
extern tree build_unc_object_type_from_ptr (tree thin_fat_ptr_type, extern tree build_unc_object_type_from_ptr (tree thin_fat_ptr_type,
tree object_type, tree name); tree object_type, tree name,
bool debug_info_p);
/* Shift the component offsets within an unconstrained object TYPE to make it /* Shift the component offsets within an unconstrained object TYPE to make it
suitable for use as a designated type for thin pointers. */ suitable for use as a designated type for thin pointers. */
......
...@@ -1446,7 +1446,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) ...@@ -1446,7 +1446,8 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
gnu_type gnu_type
= build_unc_object_type_from_ptr (gnu_ptr_type, = build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type, gnu_actual_obj_type,
get_identifier ("SIZE")); get_identifier ("SIZE"),
false);
} }
gnu_result = TYPE_SIZE (gnu_type); gnu_result = TYPE_SIZE (gnu_type);
...@@ -5386,8 +5387,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -5386,8 +5387,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_actual_obj_type gnu_actual_obj_type
= build_unc_object_type_from_ptr (gnu_ptr_type, = build_unc_object_type_from_ptr (gnu_ptr_type,
gnu_actual_obj_type, gnu_actual_obj_type,
get_identifier get_identifier ("DEALLOC"),
("DEALLOC")); false);
} }
else else
gnu_actual_obj_type = gnu_obj_type; gnu_actual_obj_type = gnu_obj_type;
......
...@@ -3299,15 +3299,16 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog) ...@@ -3299,15 +3299,16 @@ build_function_stub (tree gnu_subprog, Entity_Id gnat_subprog)
end_subprog_body (gnu_body); end_subprog_body (gnu_body);
} }
/* Build a type to be used to represent an aliased object whose nominal /* Build a type to be used to represent an aliased object whose nominal type
type is an unconstrained array. This consists of a RECORD_TYPE containing is an unconstrained array. This consists of a RECORD_TYPE containing a
a field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an field of TEMPLATE_TYPE and a field of OBJECT_TYPE, which is an ARRAY_TYPE.
ARRAY_TYPE. If ARRAY_TYPE is that of the unconstrained array, this If ARRAY_TYPE is that of an unconstrained array, this is used to represent
is used to represent an arbitrary unconstrained object. Use NAME an arbitrary unconstrained object. Use NAME as the name of the record.
as the name of the record. */ DEBUG_INFO_P is true if we need to write debug information for the type. */
tree tree
build_unc_object_type (tree template_type, tree object_type, tree name) build_unc_object_type (tree template_type, tree object_type, tree name,
bool debug_info_p)
{ {
tree type = make_node (RECORD_TYPE); tree type = make_node (RECORD_TYPE);
tree template_field = create_field_decl (get_identifier ("BOUNDS"), tree template_field = create_field_decl (get_identifier ("BOUNDS"),
...@@ -3317,10 +3318,12 @@ build_unc_object_type (tree template_type, tree object_type, tree name) ...@@ -3317,10 +3318,12 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
TYPE_NAME (type) = name; TYPE_NAME (type) = name;
TYPE_CONTAINS_TEMPLATE_P (type) = 1; TYPE_CONTAINS_TEMPLATE_P (type) = 1;
finish_record_type (type, TREE_CHAIN (template_field) = array_field;
chainon (chainon (NULL_TREE, template_field), finish_record_type (type, template_field, 0, true);
array_field),
0, true); /* Declare it now since it will never be declared otherwise. This is
necessary to ensure that its subtrees are properly marked. */
create_type_decl (name, type, NULL, true, debug_info_p, Empty);
return type; return type;
} }
...@@ -3329,7 +3332,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name) ...@@ -3329,7 +3332,7 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
tree tree
build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
tree name) tree name, bool debug_info_p)
{ {
tree template_type; tree template_type;
...@@ -3339,7 +3342,9 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, ...@@ -3339,7 +3342,9 @@ build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
= (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type) = (TYPE_IS_FAT_POINTER_P (thin_fat_ptr_type)
? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type)))) ? TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (thin_fat_ptr_type))))
: TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type)))); : TREE_TYPE (TYPE_FIELDS (TREE_TYPE (thin_fat_ptr_type))));
return build_unc_object_type (template_type, object_type, name);
return
build_unc_object_type (template_type, object_type, name, debug_info_p);
} }
/* Shift the component offsets within an unconstrained object TYPE to make it /* Shift the component offsets within an unconstrained object TYPE to make it
......
...@@ -1984,7 +1984,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, ...@@ -1984,7 +1984,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
{ {
tree storage_type tree storage_type
= build_unc_object_type_from_ptr (result_type, type, = build_unc_object_type_from_ptr (result_type, type,
get_identifier ("ALLOC")); get_identifier ("ALLOC"), false);
tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type)); tree template_type = TREE_TYPE (TYPE_FIELDS (storage_type));
tree storage_ptr_type = build_pointer_type (storage_type); tree storage_ptr_type = build_pointer_type (storage_type);
tree storage; tree storage;
......
2010-05-08 Quentin Ochem <ochem@adacore.com>
* gnat.dg/sizetype3.ad[sb]: New test.
* gnat.dg/sizetype3_pkg.ads: New helper.
2010-05-07 Fabien Chêne <fabien.chene@gmail.com> 2010-05-07 Fabien Chêne <fabien.chene@gmail.com>
PR c++/43951 PR c++/43951
......
-- { dg-do compile }
-- { dg-options "-O" }
with Sizetype3_Pkg; use Sizetype3_Pkg;
package body Sizetype3 is
procedure Handle_Enum_Values is
Values : constant List := F;
L : Values_Array_Access;
begin
L := new Values_Array (1 .. Values'Length);
end Handle_Enum_Values;
procedure Simplify_Type_Of is
begin
Handle_Enum_Values;
end Simplify_Type_Of;
end Sizetype3;
package Sizetype3 is
type Values_Array is array (Positive range <>) of Integer;
type Values_Array_Access is access all Values_Array;
procedure Simplify_Type_Of;
end Sizetype3;
package Sizetype3_Pkg is
type List is array (Integer range <>) of Integer;
function F return List;
end Sizetype3_Pkg;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment