]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
utils.c (unchecked_convert): Use local variables for the biased and reverse SSO attri...
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 22 Oct 2018 11:09:11 +0000 (11:09 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Mon, 22 Oct 2018 11:09:11 +0000 (11:09 +0000)
* 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: r265383

gcc/ada/ChangeLog
gcc/ada/gcc-interface/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/sso14.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/sso15.adb [new file with mode: 0644]

index 54928957b960a58868848f519aea79c646412e3d..0873a0cc0483e9e4435985230b6b53a419d760d5 100644 (file)
@@ -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
index b434d29bf63b72b15dbde1abe8a9aab4d0624131..01a182af737169b5ac4b7e83c32492ae4dc16dd3 100644 (file)
@@ -5030,8 +5030,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)
@@ -5047,7 +5055,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;
@@ -5055,7 +5063,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;
@@ -5084,30 +5092,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);
 
@@ -5122,31 +5135,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);
 
@@ -5245,8 +5262,8 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
      if the input is also an integral type and both are unsigned or both are
      signed and have the same precision.  */
   if (!notrunc_p
+      && !biased
       && 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)
index ba29eafdc1b986ed80dfed481126f144b06bd301..cbec180e0083fccbe536d8c7e85ed15f2bc2bb31 100644 (file)
@@ -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-19  Andreas Krebbel  <krebbel@linux.ibm.com>
 
        Backport from mainline
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
@@ -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
@@ -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;