utils.c (type_unsigned_for_rm): New predicate.

	* gcc-interface/utils.c (type_unsigned_for_rm): New predicate.
	(make_type_from_size): Use it.
	(unchecked_convert): Likewise.  Do not skip the extension step if the
	source type is not integral.

From-SVN: r240975

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dc6331e857ab34aaf70a9e8abc87aebc0fe87ed4..7022201405b0c4aff6f600b60aba27003e2a570c 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/utils.c (type_unsigned_for_rm): New predicate.
+       (make_type_from_size): Use it.
+       (unchecked_convert): Likewise.  Do not skip the extension step if the
+       source type is not integral.
+
 2016-10-11  Eric Botcazou  <ebotcazou@adacore.com>
             Tristan Gingold  <gingold@adacore.com>
 

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 8db92e5bf737dc38ec99b945ed752a58c2967d22..221b0b5171388dba4f080656156e34c9eca6f84f 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1070,6 +1070,25 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
   return new_type;
 }
 
+/* Return true if TYPE has an unsigned representation.  This needs to be used
+   when the representation of types whose precision is not equal to their size
+   is manipulated based on the RM size.  */
+
+static inline bool
+type_unsigned_for_rm (tree type)
+{
+  /* This is the common case.  */
+  if (TYPE_UNSIGNED (type))
+    return true;
+
+  /* See the E_Signed_Integer_Subtype case of gnat_to_gnu_entity.  */
+  if (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
+      && tree_int_cst_sgn (TYPE_MIN_VALUE (type)) >= 0)
+    return true;
+
+  return false;
+}
+
 /* Given a type TYPE, return a new type whose size is appropriate for SIZE.
    If TYPE is the best type, return it.  Otherwise, make a new type.  We
    only support new integral and pointer types.  FOR_BIASED is true if
@@ -1113,10 +1132,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
       /* The type should be an unsigned type if the original type is unsigned
         or if the lower bound is constant and non-negative or if the type is
         biased, see E_Signed_Integer_Subtype case of gnat_to_gnu_entity.  */
-      if (TYPE_UNSIGNED (type)
-         || (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
-             && tree_int_cst_sgn (TYPE_MIN_VALUE (type)) >= 0)
-         || biased_p)
+      if (type_unsigned_for_rm (type) || biased_p)
        new_type = make_unsigned_type (size);
       else
        new_type = make_signed_type (size);
@@ -4913,7 +4929,12 @@ can_fold_for_view_convert_p (tree expr)
 
    we expect the 8 bits at Vbits'Address to always contain Value, while
    their original location depends on the endianness, at Value'Address
-   on a little-endian architecture but not on a big-endian one.  */
+   on a little-endian architecture but not on a big-endian one.
+
+   One pitfall is that we cannot use TYPE_UNSIGNED directly to decide how
+   the bits between the precision and the size are filled, because of the
+   trick used in the E_Signed_Integer_Subtype case of gnat_to_gnu_entity.
+   So we use the special predicate type_unsigned_for_rm above.  */
 
 tree
 unchecked_convert (tree type, tree expr, bool notrunc_p)
@@ -4991,7 +5012,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
        TYPE_REVERSE_STORAGE_ORDER (rec_type)
          = TYPE_REVERSE_STORAGE_ORDER (etype);
 
-      if (TYPE_UNSIGNED (type))
+      if (type_unsigned_for_rm (type))
        field_type = make_unsigned_type (prec);
       else
        field_type = make_signed_type (prec);
@@ -5030,7 +5051,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
        TYPE_REVERSE_STORAGE_ORDER (rec_type)
          = TYPE_REVERSE_STORAGE_ORDER (type);
 
-      if (TYPE_UNSIGNED (etype))
+      if (type_unsigned_for_rm (etype))
        field_type = make_unsigned_type (prec);
       else
        field_type = make_signed_type (prec);
@@ -5131,31 +5152,26 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
        expr = build1 (VIEW_CONVERT_EXPR, type, expr);
     }
 
-  /* If the result is an integral type whose precision is not equal to its
-     size, sign- or zero-extend the result.  We need not do this if the input
-     is an integral type of the same precision and signedness or if the output
-     is a biased type or if both the input and output are unsigned, or if the
-     lower bound is constant and non-negative, see E_Signed_Integer_Subtype
-     case of gnat_to_gnu_entity.  */
+  /* If the result is a non-biased integral type whose precision is not equal
+     to its size, sign- or zero-extend the result.  But we need not do this
+     if the input is also an integral type and both are unsigned or both are
+     signed and have the same precision.  */
   if (!notrunc_p
       && INTEGRAL_TYPE_P (type)
+      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
       && TYPE_RM_SIZE (type)
       && tree_int_cst_compare (TYPE_RM_SIZE (type), TYPE_SIZE (type)) < 0
       && !(INTEGRAL_TYPE_P (etype)
-          && TYPE_UNSIGNED (type) == TYPE_UNSIGNED (etype)
-          && tree_int_cst_compare (TYPE_RM_SIZE (type),
-                                   TYPE_RM_SIZE (etype)
-                                   ? TYPE_RM_SIZE (etype)
-                                   : TYPE_SIZE (etype)) == 0)
-      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
-      && !((TYPE_UNSIGNED (type)
-           || (TREE_CODE (TYPE_MIN_VALUE (type)) == INTEGER_CST
-               && tree_int_cst_sgn (TYPE_MIN_VALUE (type)) >= 0))
-          && TYPE_UNSIGNED (etype)))
+          && type_unsigned_for_rm (type) == type_unsigned_for_rm (etype)
+          && (type_unsigned_for_rm (type)
+              || tree_int_cst_compare (TYPE_RM_SIZE (type),
+                                       TYPE_RM_SIZE (etype)
+                                       ? TYPE_RM_SIZE (etype)
+                                       : TYPE_SIZE (etype)) == 0)))
     {
       tree base_type
        = gnat_type_for_size (TREE_INT_CST_LOW (TYPE_SIZE (type)),
-                             TYPE_UNSIGNED (type));
+                             type_unsigned_for_rm (type));
       tree shift_expr
        = convert (base_type,
                   size_binop (MINUS_EXPR,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 126342d63c886de5c6dfb3ccf96f9a4d07429021..4ceb8480cb0fbd86cb60002aaf008c9f043b7725 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-10-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/unchecked_convert10.adb: New test.
+       * gnat.dg/unchecked_convert11.adb: Likewise.
+       * gnat.dg/unchecked_convert12.adb: Likewise.
+
 2016-10-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc.target/sparc/cbcond-1.c: New test.

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert10.adb b/gcc/testsuite/gnat.dg/unchecked_convert10.adb
new file mode 100644 (file)
index 0000000..13b24c1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert10.adb
@@ -0,0 +1,42 @@
+-- { dg-do run }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert10 is
+
+  subtype Unsigned_Type is Integer range 2_034 .. 2_164;
+
+  subtype Signed_Type is Integer range -2048 .. 2047; 
+
+  function To_Signed_Type is
+     new Unchecked_Conversion (Source => Unsigned_Type, Target => Signed_Type);
+
+  function To_Unsigned_Type is
+     new Unchecked_Conversion (Source => Signed_Type, Target => Unsigned_Type);
+
+  Data : Unsigned_Type;
+  Temp : Signed_Type;
+
+begin
+
+  Data := 2100;
+  Temp := To_Signed_Type (Data);
+  if Temp /= -1996 then
+    raise Program_Error;
+  end if;
+  Data := To_Unsigned_Type (Temp);
+  if Data /= 2100 then
+    raise Program_Error;
+  end if;
+
+  Data := 2047;
+  Temp := To_Signed_Type (Data);
+  if Temp /= 2047 then
+    raise Program_Error;
+  end if;
+  Data := To_Unsigned_Type (Temp);
+  if Data /= 2047 then
+    raise Program_Error;
+  end if;
+
+end;

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert11.adb b/gcc/testsuite/gnat.dg/unchecked_convert11.adb
new file mode 100644 (file)
index 0000000..ad98a88
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert11.adb
@@ -0,0 +1,47 @@
+-- { dg-do run }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert11 is
+
+  subtype Unsigned_Type is Integer range 2_034 .. 2_164;
+
+  subtype Signed_Type is Integer range -2048 .. 2047; 
+
+  type Rec is record
+    S : Signed_Type;
+  end record;
+  pragma Pack (Rec);
+
+  function To_Signed_Type is
+     new Unchecked_Conversion (Source => Unsigned_Type, Target => Rec);
+
+  function To_Unsigned_Type is
+     new Unchecked_Conversion (Source => Rec, Target => Unsigned_Type);
+
+  Data : Unsigned_Type;
+  Temp : Rec;
+
+begin
+
+  Data := 2100;
+  Temp := To_Signed_Type (Data);
+  if Temp.S /= -1996 then
+    raise Program_Error;
+  end if;
+  Data := To_Unsigned_Type (Temp);
+  if Data /= 2100 then
+    raise Program_Error;
+  end if;
+
+  Data := 2047;
+  Temp := To_Signed_Type (Data);
+  if Temp.S /= 2047 then
+    raise Program_Error;
+  end if;
+  Data := To_Unsigned_Type (Temp);
+  if Data /= 2047 then
+    raise Program_Error;
+  end if;
+
+end;

diff --git a/gcc/testsuite/gnat.dg/unchecked_convert12.adb b/gcc/testsuite/gnat.dg/unchecked_convert12.adb
new file mode 100644 (file)
index 0000000..6a7ad22
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/unchecked_convert12.adb
@@ -0,0 +1,47 @@
+-- { dg-do run }
+
+with Unchecked_Conversion;
+
+procedure Unchecked_Convert12 is
+
+  subtype Unsigned_Type is Integer range 2_034 .. 2_164;
+
+  subtype Signed_Type is Integer range -2048 .. 2047; 
+
+  type Rec is record
+    S : Unsigned_Type;
+  end record;
+  pragma Pack (Rec);
+
+  function To_Signed_Type is
+     new Unchecked_Conversion (Source => Rec, Target => Signed_Type);
+
+  function To_Unsigned_Type is
+    new Unchecked_Conversion (Source => Signed_Type, Target => Rec);
+
+  Data : Signed_Type;
+  Temp : Rec;
+
+begin
+
+  Data := -1996;
+  Temp := To_Unsigned_Type (Data);
+  if Temp.S /= 2100 then
+    raise Program_Error;
+  end if;
+  Data := To_Signed_Type (Temp);
+  if Data /= -1996 then
+    raise Program_Error;
+  end if;
+
+  Data := 2047;
+  Temp := To_Unsigned_Type (Data);
+  if Temp.S /= 2047 then
+    raise Program_Error;
+  end if;
+  Data := To_Signed_Type (Temp);
+  if Data /= 2047 then
+    raise Program_Error;
+  end if;
+
+end;