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

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;