re PR ada/44892 (internal error on gnat.dg/unchecked_convert5.adb)

	PR ada/44892
	* gcc-interface/utils.c (convert): Fix thinko in test.
	(unchecked_convert): When converting from a scalar type to a type with
	a different size, pad to have the same size on both sides.

From-SVN: r162425

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c80be7241a34e580f53cdeeee0db60412e6b8f38..f631f84bd8b0e9f5573618698a38b2aec4be9c74 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2010-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       PR ada/44892
+       * gcc-interface/utils.c (convert): Fix thinko in test.
+       (unchecked_convert): When converting from a scalar type to a type with
+       a different size, pad to have the same size on both sides.
+
 2010-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/utils.c (gnat_types_compatible_p): Don't require strict

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index eb65b7d2d4ddb989cd26734d38d2ccc463bc6f2d..541f7bb3f919a2bb2861d681de3335d8de709ce0 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3702,9 +3702,10 @@ convert (tree type, tree expr)
       if (ecode == RECORD_TYPE
          && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type))))
        {
-         if (TREE_CONSTANT (TYPE_SIZE (etype)))
+         if (TREE_CODE (TYPE_SIZE (etype)) == INTEGER_CST)
            expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
-                           false, false, false, true), expr);
+                                           false, false, false, true),
+                           expr);
          return unchecked_convert (type, expr, false);
        }
 
@@ -4353,6 +4354,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   tree etype = TREE_TYPE (expr);
   enum tree_code ecode = TREE_CODE (etype);
   enum tree_code code = TREE_CODE (type);
+  int c;
 
   /* If the expression is already of the right type, we are done.  */
   if (etype == type)
@@ -4393,7 +4395,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
   /* If we are converting to an integral type whose precision is not equal
      to its size, first unchecked convert to a record that contains an
      object of the output type.  Then extract the field. */
-  else if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type)
+  else if (INTEGRAL_TYPE_P (type)
+          && TYPE_RM_SIZE (type)
           && 0 != compare_tree_int (TYPE_RM_SIZE (type),
                                     GET_MODE_BITSIZE (TYPE_MODE (type))))
     {
@@ -4410,9 +4413,10 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
   /* Similarly if we are converting from an integral type whose precision
      is not equal to its size.  */
-  else if (INTEGRAL_TYPE_P (etype) && TYPE_RM_SIZE (etype)
-      && 0 != compare_tree_int (TYPE_RM_SIZE (etype),
-                               GET_MODE_BITSIZE (TYPE_MODE (etype))))
+  else if (INTEGRAL_TYPE_P (etype)
+          && TYPE_RM_SIZE (etype)
+          && 0 != compare_tree_int (TYPE_RM_SIZE (etype),
+                                    GET_MODE_BITSIZE (TYPE_MODE (etype))))
     {
       tree rec_type = make_node (RECORD_TYPE);
       tree field = create_field_decl (get_identifier ("OBJ"), etype, rec_type,
@@ -4427,6 +4431,38 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       expr = unchecked_convert (type, expr, notrunc_p);
     }
 
+  /* If we are converting from a scalar type to a type with a different size,
+     we need to pad to have the same size on both sides.
+
+     ??? We cannot do it unconditionally because unchecked conversions are
+     used liberally by the front-end to implement polymorphism, e.g. in:
+
+       S191s : constant ada__tags__addr_ptr := ada__tags__addr_ptr!(S190s);
+       return p___size__4 (p__object!(S191s.all));
+
+     so we skip all expressions that are references.  */
+  else if (!REFERENCE_CLASS_P (expr)
+          && !AGGREGATE_TYPE_P (etype)
+          && TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST
+          && (c = tree_int_cst_compare (TYPE_SIZE (etype), TYPE_SIZE (type))))
+    {
+      if (c < 0)
+       {
+         expr = convert (maybe_pad_type (etype, TYPE_SIZE (type), 0, Empty,
+                                         false, false, false, true),
+                         expr);
+         expr = unchecked_convert (type, expr, notrunc_p);
+       }
+      else
+       {
+         tree rec_type = maybe_pad_type (type, TYPE_SIZE (etype), 0, Empty,
+                                         false, false, false, true);
+         expr = unchecked_convert (rec_type, expr, notrunc_p);
+         expr = build_component_ref (expr, NULL_TREE, TYPE_FIELDS (rec_type),
+                                     false);
+       }
+    }
+
   /* We have a special case when we are converting between two unconstrained
      array types.  In that case, take the address, convert the fat pointer
      types, and dereference.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 40ef493c162de5437e4d3273ad2d81560df04f50..ecb1efb9eb4de9057deedcc3feca22cc09b53443 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/unchecked_convert5b.adb: New test.
+       * gnat.dg/unchecked_convert6.adb: Likewise.
+       * gnat.dg/unchecked_convert6b.adb: Likewise.
+
 2010-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/aggr15.ad[sb]: New test.

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert5b.adb b/gcc/testsuite/gnat.dg/unchecked_convert5b.adb
new file mode 100644 (file)
index 0000000..5232041
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert5b.adb
@@ -0,0 +1,22 @@
+-- { dg-do run { target i?86-*-* x86_64-*-* alpha*-*-* ia64-*-* } }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert5b is
+
+  subtype c_1 is string(1..1);
+
+  function int2c1 is  -- { dg-warning "different sizes" }
+    new unchecked_conversion (source => integer, target => c_1);
+
+  c1 : c_1;
+
+begin
+
+  c1 := int2c1(16#12#);
+
+  if c1 (1) /= ASCII.DC2 then
+    raise Program_Error;
+  end if;
+
+end;

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert6.adb b/gcc/testsuite/gnat.dg/unchecked_convert6.adb
new file mode 100644 (file)
index 0000000..a26a6a9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert6.adb
@@ -0,0 +1,22 @@
+-- { dg-do run { target hppa*-*-* sparc*-*-* powerpc*-*-* } }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert6 is
+
+  subtype c_5 is string(1..5);
+
+  function int2c5 is  -- { dg-warning "different sizes" }
+    new unchecked_conversion (source => integer, target => c_5);
+
+  c5 : c_5;
+
+begin
+
+  c5 := int2c5(16#12#);
+
+  if c5 (4) /= ASCII.DC2 then
+    raise Program_Error;
+  end if;
+
+end;

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert6b.adb b/gcc/testsuite/gnat.dg/unchecked_convert6b.adb
new file mode 100644 (file)
index 0000000..d696f7d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert6b.adb
@@ -0,0 +1,22 @@
+-- { dg-do run { target i?86-*-* x86_64-*-* alpha*-*-* ia64-*-* } }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert6b is
+
+  subtype c_5 is string(1..5);
+
+  function int2c5 is  -- { dg-warning "different sizes" }
+    new unchecked_conversion (source => integer, target => c_5);
+
+  c5 : c_5;
+
+begin
+
+  c5 := int2c5(16#12#);
+
+  if c5 (1) /= ASCII.DC2 then
+    raise Program_Error;
+  end if;
+
+end;