decl.c (make_type_from_size): Just copy TYPE_NAME.

* gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
	TYPE_NAME.
	* gcc-interface/trans.c (smaller_packable_type_p): Rename into...
	(smaller_form_type_p): ...this.  Change parameter and variable names.
	(call_to_gnu): Use the nominal type of the parameter to create the
	temporary if it's a smaller form of the actual type.
	(addressable_p): Return false if the actual type is integral and its
	size is greater than that of the expected type.

From-SVN: r158398
This commit is contained in:
Eric Botcazou 2010-04-16 06:58:43 +00:00 committed by Eric Botcazou
parent 1f24872b63
commit 169afcb99f
7 changed files with 114 additions and 32 deletions

View file

@ -1,3 +1,14 @@
2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (make_type_from_size) <INTEGER_TYPE>: Just copy
TYPE_NAME.
* gcc-interface/trans.c (smaller_packable_type_p): Rename into...
(smaller_form_type_p): ...this. Change parameter and variable names.
(call_to_gnu): Use the nominal type of the parameter to create the
temporary if it's a smaller form of the actual type.
(addressable_p): Return false if the actual type is integral and its
size is greater than that of the expected type.
2010-04-15 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/cuintp.c (UI_To_gnu): Fix long line.

View file

@ -7748,14 +7748,9 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
SET_TYPE_RM_MAX_VALUE (new_type,
convert (TREE_TYPE (new_type),
TYPE_MAX_VALUE (type)));
/* Propagate the name to avoid creating a fake subrange type. */
if (TYPE_NAME (type))
{
if (TREE_CODE (TYPE_NAME (type)) == TYPE_DECL)
TYPE_NAME (new_type) = DECL_NAME (TYPE_NAME (type));
else
TYPE_NAME (new_type) = TYPE_NAME (type);
}
/* Copy the name to show that it's essentially the same type and
not a subrange type. */
TYPE_NAME (new_type) = TYPE_NAME (type);
TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
return new_type;

View file

@ -207,7 +207,7 @@ static tree emit_check (tree, tree, int, Node_Id);
static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
static bool smaller_packable_type_p (tree, tree);
static bool smaller_form_type_p (tree, tree);
static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree extract_values (tree, tree);
@ -2639,17 +2639,21 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
(TREE_TYPE (TREE_OPERAND (gnu_name, 0))))
gnu_orig = gnu_name = TREE_OPERAND (gnu_name, 0);
/* Otherwise convert to the nominal type of the object if it's
a record type. There are several cases in which we need to
make the temporary using this type instead of the actual type
of the object if they are distinct, because the expectations
of the callee would otherwise not be met:
/* Otherwise convert to the nominal type of the object if needed.
There are several cases in which we need to make the temporary
using this type instead of the actual type of the object when
they are distinct, because the expectations of the callee would
otherwise not be met:
- if it's a justified modular type,
- if the actual type is a smaller packable version of it. */
else if (TREE_CODE (gnu_name_type) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
|| smaller_packable_type_p (TREE_TYPE (gnu_name),
gnu_name_type)))
- if the actual type is a smaller form of it,
- if it's a smaller form of the actual type. */
else if ((TREE_CODE (gnu_name_type) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (gnu_name_type)
|| smaller_form_type_p (TREE_TYPE (gnu_name),
gnu_name_type)))
|| (INTEGRAL_TYPE_P (gnu_name_type)
&& smaller_form_type_p (gnu_name_type,
TREE_TYPE (gnu_name))))
gnu_name = convert (gnu_name_type, gnu_name);
/* Create an explicit temporary holding the copy. This ensures that
@ -6873,28 +6877,28 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
return convert (gnu_type, gnu_result);
}
/* Return true if TYPE is a smaller packable version of RECORD_TYPE. */
/* Return true if TYPE is a smaller form of ORIG_TYPE. */
static bool
smaller_packable_type_p (tree type, tree record_type)
smaller_form_type_p (tree type, tree orig_type)
{
tree size, rsize;
tree size, osize;
/* We're not interested in variants here. */
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (record_type))
if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (orig_type))
return false;
/* Like a variant, a packable version keeps the original TYPE_NAME. */
if (TYPE_NAME (type) != TYPE_NAME (record_type))
if (TYPE_NAME (type) != TYPE_NAME (orig_type))
return false;
size = TYPE_SIZE (type);
rsize = TYPE_SIZE (record_type);
osize = TYPE_SIZE (orig_type);
if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (rsize) == INTEGER_CST))
if (!(TREE_CODE (size) == INTEGER_CST && TREE_CODE (osize) == INTEGER_CST))
return false;
return tree_int_cst_lt (size, rsize) != 0;
return tree_int_cst_lt (size, osize) != 0;
}
/* Return true if GNU_EXPR can be directly addressed. This is the case
@ -6959,13 +6963,21 @@ smaller_packable_type_p (tree type, tree record_type)
static bool
addressable_p (tree gnu_expr, tree gnu_type)
{
/* The size of the real type of the object must not be smaller than
that of the expected type, otherwise an indirect access in the
latter type would be larger than the object. Only records need
to be considered in practice. */
/* For an integral type, the size of the actual type of the object may not
be greater than that of the expected type, otherwise an indirect access
in the latter type wouldn't correctly set all the bits of the object. */
if (gnu_type
&& INTEGRAL_TYPE_P (gnu_type)
&& smaller_form_type_p (gnu_type, TREE_TYPE (gnu_expr)))
return false;
/* The size of the actual type of the object may not be smaller than that
of the expected type, otherwise an indirect access in the latter type
would be larger than the object. But only record types need to be
considered in practice for this case. */
if (gnu_type
&& TREE_CODE (gnu_type) == RECORD_TYPE
&& smaller_packable_type_p (TREE_TYPE (gnu_expr), gnu_type))
&& smaller_form_type_p (TREE_TYPE (gnu_expr), gnu_type))
return false;
switch (TREE_CODE (gnu_expr))

View file

@ -1,3 +1,8 @@
2010-04-16 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/wide_boolean.adb: New test.
* gnat.dg/wide_boolean_pkg.ad[sb]: New helper.
2010-04-15 Richard Guenther <rguenther@suse.de>
* gcc.dg/ipa/ipa-pta-1.c: New testcase.

View file

@ -0,0 +1,26 @@
-- { dg-do run }
with Wide_Boolean_Pkg; use Wide_Boolean_Pkg;
procedure Wide_Boolean is
R : TREC;
LB_TEST_BOOL : TBOOL;
begin
R.B := FALSE;
LB_TEST_BOOL := FALSE;
Modify (R.H, R.B);
if (R.B /= TRUE) then
raise Program_Error;
end if;
Modify (R.H, LB_TEST_BOOL);
R.B := LB_TEST_BOOL;
if (R.B /= TRUE) then
raise Program_Error;
end if;
end;

View file

@ -0,0 +1,9 @@
package body Wide_Boolean_Pkg is
procedure Modify (LH : in out TUINT32; LB : in out TBOOL) is
begin
LH := 16#12345678#;
LB := TRUE;
end;
end Wide_Boolean_Pkg;

View file

@ -0,0 +1,24 @@
package Wide_Boolean_Pkg is
type TBOOL is new BOOLEAN;
for TBOOL use (FALSE => 0, TRUE => 1);
for TBOOL'SIZE use 8;
type TUINT32 is mod (2 ** 32);
for TUINT32'SIZE use 32;
type TREC is
record
H : TUINT32;
B : TBOOL;
end record;
for TREC use
record
H at 0 range 0..31;
B at 4 range 0..31;
end record;
procedure Modify (LH : in out TUINT32; LB : in out TBOOL);
pragma export(C, Modify, "Modify");
end Wide_Boolean_Pkg;