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

utils.c (unchecked_convert): Use local variables for the biased and reverse SSO attributes of both types.

	* 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

gcc/ada/ChangeLog

 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
 	a simple memory constraint in all cases.
 

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)

gcc/testsuite/ChangeLog

 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.
 	* gnat.dg/warn19_pkg.ads: New helper.
 

gcc/testsuite/gnat.dg/sso14.adb

+--  { 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;

gcc/testsuite/gnat.dg/sso15.adb

+--  { 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;