Hi,

most cases of VIEW_CONVERT_EXPRs involving reverse scalar storage order are
disqualified for SRA because they are storage_order_barrier_p, but you can
still have a VIEW_CONVERT_EXPR to a regular composite type being applied to
a component of a record type with reverse scalar storage order, although this
is pretty rare even in Ada (the only idiomatic way I know of is to use 'Valid
on a floating-point component).

In this case, the bypass for !useless_type_conversion_p in sra_modify_assign,
albeit already heavily guarded, triggers and may generate wrong code, e.g. on
the attached testcase, so the patch makes sure that it does only when the SSO
is the same on both side.

Bootstrapped/regtested on x86-64/Linux, OK for the mainline?


2022-05-13  Eric Botcazou  <ebotca...@adacore.com>

        * tree-sra.c (sra_modify_assign): Check that the scalar storage order
        is the same on the LHS and RHS before rewriting one with the model of
        the other.


2022-05-13  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/sso17.adb: New test.

-- 
Eric Botcazou
diff --git a/gcc/tree-sra.cc b/gcc/tree-sra.cc
index a86f8c01346..081c51b58a4 100644
--- a/gcc/tree-sra.cc
+++ b/gcc/tree-sra.cc
@@ -4270,32 +4270,31 @@ sra_modify_assign (gimple *stmt, gimple_stmt_iterator *gsi)
       sra_stats.exprs++;
     }
 
-  if (modify_this_stmt)
-    {
-      if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
+  if (modify_this_stmt
+      && !useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
+    {
+      /* If we can avoid creating a VIEW_CONVERT_EXPR, then do so.
+	 ??? This should move to fold_stmt which we simply should
+	 call after building a VIEW_CONVERT_EXPR here.  */
+      if (AGGREGATE_TYPE_P (TREE_TYPE (lhs))
+	  && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (lhs)) == racc->reverse
+	  && !contains_bitfld_component_ref_p (lhs))
 	{
-	  /* If we can avoid creating a VIEW_CONVERT_EXPR do so.
-	     ???  This should move to fold_stmt which we simply should
-	     call after building a VIEW_CONVERT_EXPR here.  */
-	  if (AGGREGATE_TYPE_P (TREE_TYPE (lhs))
-	      && !contains_bitfld_component_ref_p (lhs))
-	    {
-	      lhs = build_ref_for_model (loc, lhs, 0, racc, gsi, false);
-	      gimple_assign_set_lhs (stmt, lhs);
-	    }
-	  else if (lacc
-		   && AGGREGATE_TYPE_P (TREE_TYPE (rhs))
-		   && !contains_vce_or_bfcref_p (rhs))
-	    rhs = build_ref_for_model (loc, rhs, 0, lacc, gsi, false);
+	  lhs = build_ref_for_model (loc, lhs, 0, racc, gsi, false);
+	  gimple_assign_set_lhs (stmt, lhs);
+	}
+      else if (lacc
+	       && AGGREGATE_TYPE_P (TREE_TYPE (rhs))
+	       && TYPE_REVERSE_STORAGE_ORDER (TREE_TYPE (rhs)) == lacc->reverse
+	       && !contains_vce_or_bfcref_p (rhs))
+	rhs = build_ref_for_model (loc, rhs, 0, lacc, gsi, false);
 
-	  if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
-	    {
-	      rhs = fold_build1_loc (loc, VIEW_CONVERT_EXPR, TREE_TYPE (lhs),
-				     rhs);
-	      if (is_gimple_reg_type (TREE_TYPE (lhs))
-		  && TREE_CODE (lhs) != SSA_NAME)
-		force_gimple_rhs = true;
-	    }
+      if (!useless_type_conversion_p (TREE_TYPE (lhs), TREE_TYPE (rhs)))
+	{
+	  rhs = fold_build1_loc (loc, VIEW_CONVERT_EXPR, TREE_TYPE (lhs), rhs);
+	  if (is_gimple_reg_type (TREE_TYPE (lhs))
+	      && TREE_CODE (lhs) != SSA_NAME)
+	    force_gimple_rhs = true;
 	}
     }
 
--  { dg-do run }
--  { dg-options "-gnatws -O" }

with System;

procedure SSO17 is

  type My_Float is new Float range 0.0 .. 359.99;

  type Rec is record
    Az : My_Float;
    El : My_Float;
  end record;
  for Rec'Bit_Order use System.High_Order_First;
  for Rec'Scalar_Storage_Order use System.High_Order_First;

  R : Rec;

  procedure Is_True (B : Boolean);
  pragma No_Inline (Is_True);

  procedure Is_True (B : Boolean) is
  begin
    if not B then
      raise Program_Error;
    end if;
  end;

begin
  R := (Az => 1.1, El => 2.2);
  Is_True (R.Az'Valid);
  R := (Az => 3.3, El => 4.4);
  Is_True (R.Az'Valid);
end;

Reply via email to