diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2010-04-16 06:58:43 +0000 |
---|---|---|
committer | Eric Botcazou <ebotcazou@gcc.gnu.org> | 2010-04-16 06:58:43 +0000 |
commit | 169afcb99f761eddccf83acad755c50d997247c8 (patch) | |
tree | 662fccb4b15738e06e8970052669564113a2ab07 /gcc | |
parent | 1f24872b632a4bfab84e21ec2ffac269a33478a7 (diff) | |
download | gcc-169afcb99f761eddccf83acad755c50d997247c8.zip gcc-169afcb99f761eddccf83acad755c50d997247c8.tar.gz gcc-169afcb99f761eddccf83acad755c50d997247c8.tar.bz2 |
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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 11 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.c | 60 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/wide_boolean.adb | 26 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/wide_boolean_pkg.adb | 9 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/wide_boolean_pkg.ads | 24 |
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; |