* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@158398 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 38a5ae5..a12e7db 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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);
 }
 \f
-/* 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 (file)
--- 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 (file)
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 (file)
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 (file)
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;