diff mbox series

[12/14] fortran: Factor scalar descriptor generation

Message ID 20230713085236.330222-13-mikael@gcc.gnu.org
State Accepted
Headers
Series fortran: Use precalculated class container for deallocation [PR110618] |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Mikael Morin July 13, 2023, 8:52 a.m. UTC 
  The same scalar descriptor generation code is present twice, in the
case of derived type entities, and in the case of polymorphic
non-coarray entities.  Factor it in preparation for a future third case
that will also need the same code for scalar descriptor generation.

gcc/fortran/ChangeLog:

	* trans.cc (get_var_descr): Factor scalar descriptor generation.
---
 gcc/fortran/trans.cc | 33 +++++++++++++++------------------
 1 file changed, 15 insertions(+), 18 deletions(-)
diff mbox series

Patch

diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 731dfb626ab..69e9329c9cb 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1146,7 +1146,6 @@  static void
 get_var_descr (gfc_se *se, gfc_expr *var)
 {
   gfc_se tmp_se;
-  symbol_attribute attr;
 
   gcc_assert (var);
 
@@ -1164,13 +1163,6 @@  get_var_descr (gfc_se *se, gfc_expr *var)
 	{
 	  gfc_conv_expr (&tmp_se, var);
 //	  gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
-
-	  /* No copy back needed, hence set attr's allocatable/pointer
-	     to zero.  */
-	  gfc_clear_attr (&attr);
-	  tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
-						       attr);
-	  gcc_assert (tmp_se.post.head == NULL_TREE);
 	}
     }
   else
@@ -1191,20 +1183,25 @@  get_var_descr (gfc_se *se, gfc_expr *var)
 	  gfc_add_data_component (array_expr);
 	  gfc_conv_expr (&tmp_se, array_expr);
 	  gcc_assert (tmp_se.post.head == NULL_TREE);
-
-	  if (!gfc_is_coarray (array_expr))
-	    {
-	      /* No copy back needed, hence set attr's allocatable/pointer
-		 to zero.  */
-	      gfc_clear_attr (&attr);
-	      tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
-							   attr);
-	    }
-	  gcc_assert (tmp_se.post.head == NULL_TREE);
 	}
       gfc_free_expr (array_expr);
     }
 
+  if (var->rank == 0)
+    {
+      if (var->ts.type == BT_DERIVED
+	  || !gfc_is_coarray (var))
+	{
+	  /* No copy back needed, hence set attr's allocatable/pointer
+	     to zero.  */
+	  symbol_attribute attr;
+	  gfc_clear_attr (&attr);
+	  tmp_se.expr = gfc_conv_scalar_to_descriptor (&tmp_se, tmp_se.expr,
+						       attr);
+	}
+      gcc_assert (tmp_se.post.head == NULL_TREE);
+    }
+
   if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
     tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);