utils.c (unchecked_convert): Use local variables for the biased and reverse SSO attri...

	* gcc-interface/utils.c (unchecked_convert): Use local variables for
	the biased and reverse SSO attributes of both types.
	Further extend the processing of integral types in the presence of
	reverse SSO to all scalar types.

From-SVN: r265381

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c002cdb1a1ef01af6f11142910733e37069f0833..73666129f555cb3bcca520c8603b3295fe25b238 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-10-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/utils.c (unchecked_convert): Use local variables for
+       the biased and reverse SSO attributes of both types.
+       Further extend the processing of integral types in the presence of
+       reverse SSO to all scalar types.
+
 2018-10-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Pragma_to_gnu) <Pragma_Inspection_Point>: Use

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 1ce2f7259270741466678d8aaea195fa557e124f..e7dfb41d1415750b3fab744b903a3213eedf3a10 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -5092,8 +5092,16 @@ 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);
+  const bool ebiased
+    = (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype));
+  const bool biased
+    = (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type));
+  const bool ereverse
+    = (AGGREGATE_TYPE_P (etype) && TYPE_REVERSE_STORAGE_ORDER (etype));
+  const bool reverse
+    = (AGGREGATE_TYPE_P (type) && TYPE_REVERSE_STORAGE_ORDER (type));
   tree tem;
-  int c;
+  int c = 0;
 
   /* If the expression is already of the right type, we are done.  */
   if (etype == type)
@@ -5109,7 +5117,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
           || (ecode == RECORD_TYPE && TYPE_JUSTIFIED_MODULAR_P (etype))))
       || code == UNCONSTRAINED_ARRAY_TYPE)
     {
-      if (ecode == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (etype))
+      if (ebiased)
        {
          tree ntype = copy_type (etype);
          TYPE_BIASED_REPRESENTATION_P (ntype) = 0;
@@ -5117,7 +5125,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
          expr = build1 (NOP_EXPR, ntype, expr);
        }
 
-      if (code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
+      if (biased)
        {
          tree rtype = copy_type (type);
          TYPE_BIASED_REPRESENTATION_P (rtype) = 0;
@@ -5146,30 +5154,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      Finally, for the sake of consistency, we do the unchecked conversion
      to an integral type with reverse storage order as soon as the source
      type is an aggregate type with reverse storage order, even if there
-     are no considerations of precision or size involved.  */
-  else if (INTEGRAL_TYPE_P (type)
-          && TYPE_RM_SIZE (type)
-          && (tree_int_cst_compare (TYPE_RM_SIZE (type),
-                                    TYPE_SIZE (type)) < 0
-              || (AGGREGATE_TYPE_P (etype)
-                  && TYPE_REVERSE_STORAGE_ORDER (etype))))
+     are no considerations of precision or size involved.  Ultimately, we
+     further extend this processing to any scalar type.  */
+  else if ((INTEGRAL_TYPE_P (type)
+           && TYPE_RM_SIZE (type)
+           && ((c = tree_int_cst_compare (TYPE_RM_SIZE (type),
+                                          TYPE_SIZE (type))) < 0
+               || ereverse))
+          || (SCALAR_FLOAT_TYPE_P (type) && ereverse))
     {
       tree rec_type = make_node (RECORD_TYPE);
-      unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (type));
       tree field_type, field;
 
-      if (AGGREGATE_TYPE_P (etype))
-       TYPE_REVERSE_STORAGE_ORDER (rec_type)
-         = TYPE_REVERSE_STORAGE_ORDER (etype);
+      TYPE_REVERSE_STORAGE_ORDER (rec_type) = ereverse;
 
-      if (type_unsigned_for_rm (type))
-       field_type = make_unsigned_type (prec);
+      if (c < 0)
+       {
+         const unsigned HOST_WIDE_INT prec
+           = TREE_INT_CST_LOW (TYPE_RM_SIZE (type));
+         if (type_unsigned_for_rm (type))
+           field_type = make_unsigned_type (prec);
+         else
+           field_type = make_signed_type (prec);
+         SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
+       }
       else
-       field_type = make_signed_type (prec);
-      SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
+       field_type = type;
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, bitsize_zero_node, 1, 0);
+                                NULL_TREE, bitsize_zero_node, c < 0, 0);
 
       finish_record_type (rec_type, field, 1, false);
 
@@ -5184,31 +5197,35 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
 
      The same considerations as above apply if the target type is an aggregate
      type with reverse storage order and we also proceed similarly.  */
-  else if (INTEGRAL_TYPE_P (etype)
-          && TYPE_RM_SIZE (etype)
-          && (tree_int_cst_compare (TYPE_RM_SIZE (etype),
-                                    TYPE_SIZE (etype)) < 0
-              || (AGGREGATE_TYPE_P (type)
-                  && TYPE_REVERSE_STORAGE_ORDER (type))))
+  else if ((INTEGRAL_TYPE_P (etype)
+           && TYPE_RM_SIZE (etype)
+           && ((c = tree_int_cst_compare (TYPE_RM_SIZE (etype),
+                                          TYPE_SIZE (etype))) < 0
+               || reverse))
+          || (SCALAR_FLOAT_TYPE_P (etype) && reverse))
     {
       tree rec_type = make_node (RECORD_TYPE);
-      unsigned HOST_WIDE_INT prec = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype));
       vec<constructor_elt, va_gc> *v;
       vec_alloc (v, 1);
       tree field_type, field;
 
-      if (AGGREGATE_TYPE_P (type))
-       TYPE_REVERSE_STORAGE_ORDER (rec_type)
-         = TYPE_REVERSE_STORAGE_ORDER (type);
+      TYPE_REVERSE_STORAGE_ORDER (rec_type) = reverse;
 
-      if (type_unsigned_for_rm (etype))
-       field_type = make_unsigned_type (prec);
+      if (c < 0)
+       {
+         const unsigned HOST_WIDE_INT prec
+           = TREE_INT_CST_LOW (TYPE_RM_SIZE (etype));
+         if (type_unsigned_for_rm (etype))
+           field_type = make_unsigned_type (prec);
+         else
+           field_type = make_signed_type (prec);
+         SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
+       }
       else
-       field_type = make_signed_type (prec);
-      SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
+       field_type = etype;
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, bitsize_zero_node, 1, 0);
+                                NULL_TREE, bitsize_zero_node, c < 0, 0);
 
       finish_record_type (rec_type, field, 1, false);
 
@@ -5308,8 +5325,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      signed and have the same precision.  */
   tree type_rm_size;
   if (!notrunc_p
+      && !biased
       && INTEGRAL_TYPE_P (type)
-      && !(code == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type))
       && (type_rm_size = TYPE_RM_SIZE (type))
       && tree_int_cst_compare (type_rm_size, TYPE_SIZE (type)) < 0
       && !(INTEGRAL_TYPE_P (etype)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 42a33ae00996f4380f68a81750499fc3b9e7b35b..fa4247ac1651672efc2cd94ea3ed8753b1f84b1e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-10-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/sso14.adb: New test.
+       * gnat.dg/sso15.adb: Likewise.
+
 2018-10-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/warn19.ad[sb]: New test.

diff --git a/gcc/testsuite/gnat.dg/sso14.adb b/gcc/testsuite/gnat.dg/sso14.adb
new file mode 100644 (file)
index 0000000..6c50f15
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sso14.adb
@@ -0,0 +1,52 @@
+--  { dg-do run }
+--  { dg-options "-gnatws" }
+
+with System;
+with Ada.Unchecked_Conversion;
+
+procedure SSO14 is
+
+   type Arr is array (1 .. Integer'Size) of Boolean;
+   pragma Pack (Arr);
+   for Arr'Scalar_Storage_Order use System.High_Order_First;
+
+   function From_Float is new Ada.Unchecked_Conversion (Float, Arr);
+   function From_Int is new Ada.Unchecked_Conversion (Integer, Arr);
+
+   type R_Float is record
+     F : Float;
+   end record;
+   for R_Float'Bit_Order use System.High_Order_First;
+   for R_Float'Scalar_Storage_Order use System.High_Order_First;
+
+   type R_Int is record
+     I : Integer;
+   end record;
+   for R_Int'Bit_Order use System.High_Order_First;
+   for R_Int'Scalar_Storage_Order use System.High_Order_First;
+
+   F1 : Float := 1.234567;
+   FA : Arr;
+   F2 : R_Float;
+   for F2'Address use FA'Address;
+   pragma Import (Ada, F2);
+
+   I1 : Integer := 1234567;
+   IA : Arr;
+   I2 : R_Int;
+   for I2'Address use IA'Address;
+   pragma Import (Ada, I2);
+
+begin
+   -- Check that converting a FP value yields a big-endian array
+   FA := From_Float (F1);
+   if F2.F /= F1 then
+      raise Program_Error;
+   end if;
+
+   -- Check that converting an integer value yields a big-endian array.
+   IA := From_Int (I1);
+   if I2.I /= I1 then
+      raise Program_Error;
+   end if;
+end;

diff --git a/gcc/testsuite/gnat.dg/sso15.adb b/gcc/testsuite/gnat.dg/sso15.adb
new file mode 100644 (file)
index 0000000..19d255a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sso15.adb
@@ -0,0 +1,52 @@
+--  { dg-do run }
+--  { dg-options "-gnatws" }
+
+with System;
+with Ada.Unchecked_Conversion;
+
+procedure SSO15 is
+
+   type Arr is array (1 .. Integer'Size) of Boolean;
+   pragma Pack (Arr);
+   for Arr'Scalar_Storage_Order use System.High_Order_First;
+
+   function To_Float is new Ada.Unchecked_Conversion (Arr, Float);
+   function To_Int is new Ada.Unchecked_Conversion (Arr, Integer);
+
+   type R_Float is record
+     F : Float;
+   end record;
+   for R_Float'Bit_Order use System.High_Order_First;
+   for R_Float'Scalar_Storage_Order use System.High_Order_First;
+
+   type R_Int is record
+     I : Integer;
+   end record;
+   for R_Int'Bit_Order use System.High_Order_First;
+   for R_Int'Scalar_Storage_Order use System.High_Order_First;
+
+   A : Arr := (1 .. 2 => True, others => False);
+
+   F1 : Float;
+   F2 : R_Float;
+   for F2'Address use A'Address;
+   pragma Import (Ada, F2);
+
+   I1 : Integer;
+   I2 : R_Int;
+   for I2'Address use A'Address;
+   pragma Import (Ada, I2);
+
+begin
+   -- Check that converting to FP yields a big-endian value.
+   F1 := To_Float (A);
+   if F2.F /= F1 then
+      raise Program_Error;
+   end if;
+
+   -- Check that converting to integer yields a big-endian value.
+   I1 := To_Int (A);
+   if I2.I /= I1 then
+      raise Program_Error;
+   end if;
+end;