aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog11
-rw-r--r--gcc/ada/gcc-interface/decl.c11
-rw-r--r--gcc/ada/gcc-interface/trans.c60
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gnat.dg/wide_boolean.adb26
-rw-r--r--gcc/testsuite/gnat.dg/wide_boolean_pkg.adb9
-rw-r--r--gcc/testsuite/gnat.dg/wide_boolean_pkg.ads24
7 files changed, 114 insertions, 32 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 38a5ae5..a12e7db 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 9ca27fd..44c3929 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -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;
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index e701bc0..ee8eedc 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c022447..a0ee05e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.
diff --git a/gcc/testsuite/gnat.dg/wide_boolean.adb b/gcc/testsuite/gnat.dg/wide_boolean.adb
new file mode 100644
index 0000000..6cbbcf1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wide_boolean.adb
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/wide_boolean_pkg.adb b/gcc/testsuite/gnat.dg/wide_boolean_pkg.adb
new file mode 100644
index 0000000..c61efca
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wide_boolean_pkg.adb
@@ -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;
diff --git a/gcc/testsuite/gnat.dg/wide_boolean_pkg.ads b/gcc/testsuite/gnat.dg/wide_boolean_pkg.ads
new file mode 100644
index 0000000..2dda1ab
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/wide_boolean_pkg.ads
@@ -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;
generated by cgit v1.1 at 2024-07-24 02:19:48 +0000