diff mbox series

[Fortran] 2/3 Refactor locations where _vptr is (re)set.

Message ID 20240611144957.36671ecc@vepi2
State New
Headers show
Series [Fortran] 2/3 Refactor locations where _vptr is (re)set. | expand

Commit Message

Andre Vehreschild June 11, 2024, 12:49 p.m. UTC
Hi all,

this patch refactors most of the locations where the _vptr of a class data type
is reset. The code was inconsistent in most of the locations. The goal of using
only one routine for setting the _vptr is to be able to later modify it more
easily.

The ultimate goal being that every time one assigns to a class data type a
consistent way is used to prevent forgetting the corner cases. So this is just a
small step in this direction. I think it is worth to simplify the code to
something consistent to reduce maintenance efforts anyhow.

Regtested ok on x86_64 Fedora 39. Ok for mainline?

Regards,
	Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de

Comments

Paul Richard Thomas June 27, 2024, 6:29 a.m. UTC | #1
Hi Andre,

Thanks for resending the patches. I fear that daytime work and visitors
have taken my attention the last days - hence the delay in reviewing, for
which I apoloise,

The patches do what they are advertised to do, without regressions on my
side. I like gfc_class_set_vptr. Please remove the commented out assert,
unless you intend to deploy it.

OK for mainline.

Thanks for the patches.

Regards

Paul


On Fri, 21 Jun 2024 at 07:39, Andre Vehreschild <vehre@gmx.de> wrote:

> Hi Paul,
>
> I am sorry for the delay. I am fighting with PR96992, where Harald finds
> more
> and more issues. I think I am approaching that one wrongly. We will see.
>
> Anyway, please find attached updated version of the 2/3 and 3/3 patches,
> which
> apply cleanly onto master at 1f974c3a24b76e25a2b7f31a6c7f4aee93a9eaab .
>
> Hope that helps and thanks in advance for looking at the patches.
>
> Regards,
>         Andre
>
> PS. I have attached them in plain text and as archive to prevent mailers
> from
> corrupting them.
>
> On Thu, 20 Jun 2024 07:42:31 +0100
> Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
>
> > Hi Andre,
> >
> > Both this patch and 3/3 are corrupt according to git apply:
> > [pault@pc30 gcc]$ git apply --ignore-space-change --ignore-whitespace <
> > ~/prs/andre/u*.patch
> > error: corrupt patch at line 45
> > [pault@pc30 gcc]$ git apply --ignore-space-change --ignore-whitespace <
> > ~/prs/andre/i*.patch
> > error: corrupt patch at line 36
> >
> > I tried messing with the offending lines, to no avail. I can apply them
> by
> > hand or, perhaps, you could supply me with clean patches?
> >
> > The patches look OK but I want to check the code that they generate.
> >
> > Cheers
> >
> > Paul
> >
> >
> > On Tue, 11 Jun 2024 at 13:57, Andre Vehreschild <vehre@gmx.de> wrote:
> >
> > > Hi all,
> > >
> > > this patch refactors most of the locations where the _vptr of a class
> data
> > > type
> > > is reset. The code was inconsistent in most of the locations. The goal
> of
> > > using
> > > only one routine for setting the _vptr is to be able to later modify it
> > > more
> > > easily.
> > >
> > > The ultimate goal being that every time one assigns to a class data
> type a
> > > consistent way is used to prevent forgetting the corner cases. So this
> is
> > > just a
> > > small step in this direction. I think it is worth to simplify the code
> to
> > > something consistent to reduce maintenance efforts anyhow.
> > >
> > > Regtested ok on x86_64 Fedora 39. Ok for mainline?
> > >
> > > Regards,
> > >         Andre
> > > --
> > > Andre Vehreschild * Email: vehre ad gmx dot de
> > >
>
>
> --
> Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> Tel.: +49 241 9291018 * Email: vehre@gmx.de
>
Andre Vehreschild June 28, 2024, 9:12 a.m. UTC | #2
Hi Paul,

thanks for the review. I have removed the commented assert and committed as
gcc-15-1704-gaa3599a10ca

What about your pr59104 patch? It is living happily in my dev-branch and making
no problems.

Thanks again and regards,
	Andre


On Thu, 27 Jun 2024 07:29:40 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:

> Hi Andre,
>
> Thanks for resending the patches. I fear that daytime work and visitors
> have taken my attention the last days - hence the delay in reviewing, for
> which I apoloise,
>
> The patches do what they are advertised to do, without regressions on my
> side. I like gfc_class_set_vptr. Please remove the commented out assert,
> unless you intend to deploy it.
>
> OK for mainline.
>
> Thanks for the patches.
>
> Regards
>
> Paul
>
>
> On Fri, 21 Jun 2024 at 07:39, Andre Vehreschild <vehre@gmx.de> wrote:
>
> > Hi Paul,
> >
> > I am sorry for the delay. I am fighting with PR96992, where Harald finds
> > more
> > and more issues. I think I am approaching that one wrongly. We will see.
> >
> > Anyway, please find attached updated version of the 2/3 and 3/3 patches,
> > which
> > apply cleanly onto master at 1f974c3a24b76e25a2b7f31a6c7f4aee93a9eaab .
> >
> > Hope that helps and thanks in advance for looking at the patches.
> >
> > Regards,
> >         Andre
> >
> > PS. I have attached them in plain text and as archive to prevent mailers
> > from
> > corrupting them.
> >
> > On Thu, 20 Jun 2024 07:42:31 +0100
> > Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> >
> > > Hi Andre,
> > >
> > > Both this patch and 3/3 are corrupt according to git apply:
> > > [pault@pc30 gcc]$ git apply --ignore-space-change --ignore-whitespace <
> > > ~/prs/andre/u*.patch
> > > error: corrupt patch at line 45
> > > [pault@pc30 gcc]$ git apply --ignore-space-change --ignore-whitespace <
> > > ~/prs/andre/i*.patch
> > > error: corrupt patch at line 36
> > >
> > > I tried messing with the offending lines, to no avail. I can apply them
> > by
> > > hand or, perhaps, you could supply me with clean patches?
> > >
> > > The patches look OK but I want to check the code that they generate.
> > >
> > > Cheers
> > >
> > > Paul
> > >
> > >
> > > On Tue, 11 Jun 2024 at 13:57, Andre Vehreschild <vehre@gmx.de> wrote:
> > >
> > > > Hi all,
> > > >
> > > > this patch refactors most of the locations where the _vptr of a class
> > data
> > > > type
> > > > is reset. The code was inconsistent in most of the locations. The goal
> > of
> > > > using
> > > > only one routine for setting the _vptr is to be able to later modify it
> > > > more
> > > > easily.
> > > >
> > > > The ultimate goal being that every time one assigns to a class data
> > type a
> > > > consistent way is used to prevent forgetting the corner cases. So this
> > is
> > > > just a
> > > > small step in this direction. I think it is worth to simplify the code
> > to
> > > > something consistent to reduce maintenance efforts anyhow.
> > > >
> > > > Regtested ok on x86_64 Fedora 39. Ok for mainline?
> > > >
> > > > Regards,
> > > >         Andre
> > > > --
> > > > Andre Vehreschild * Email: vehre ad gmx dot de
> > > >
> >
> >
> > --
> > Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
> > Tel.: +49 241 9291018 * Email: vehre@gmx.de
> >


--
Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox series

Patch

From f9018fa7d4dc752331e62963c9cf86ab01a1bfc5 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 7 Jun 2024 08:57:36 +0200
Subject: [PATCH 2/3] Use gfc_reset_vptr more consistently.

The vptr for a class type is set in various ways in different
locations.  Refactor the use and simplify code.

gcc/fortran/ChangeLog:

	* trans-array.cc (structure_alloc_comps): Use reset_vptr.
	* trans-decl.cc (gfc_trans_deferred_vars): Same.
	(gfc_generate_function_code): Same.
	* trans-expr.cc (gfc_reset_vptr): Allow supplying the class
	type.
	(gfc_conv_procedure_call): Use reset_vptr.
	* trans-intrinsic.cc (gfc_conv_intrinsic_transfer): Same.
---
 gcc/fortran/trans-array.cc     | 34 ++++----------------
 gcc/fortran/trans-decl.cc      | 19 ++----------
 gcc/fortran/trans-expr.cc      | 57 +++++++++++++++++-----------------
 gcc/fortran/trans-intrinsic.cc | 10 +-----
 4 files changed, 38 insertions(+), 82 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cc50b961a97..b3088a892c8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9864,15 +9864,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      else
 		{
 		  /* Build the vtable address and set the vptr with it.  */
-		  tree vtab;
-		  gfc_symbol *vtable;
-		  vtable = gfc_find_derived_vtab (c->ts.u.derived);
-		  vtab = vtable->backend_decl;
-		  if (vtab == NULL_TREE)
-		    vtab = gfc_get_symbol_decl (vtable);
-		  vtab = gfc_build_addr_expr (NULL, vtab);
-		  vtab = fold_convert (TREE_TYPE (tmp), vtab);
-		  gfc_add_modify (&tmpblock, tmp, vtab);
+		  gfc_reset_vptr (&tmpblock, nullptr, tmp, c->ts.u.derived);
 		}
 	    }

@@ -9903,15 +9895,13 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      && (CLASS_DATA (c)->attr.allocatable
 		  || CLASS_DATA (c)->attr.class_pointer))
 	    {
-	      tree vptr_decl;
+	      tree class_ref;

 	      /* Allocatable CLASS components.  */
-	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
-				      decl, cdecl, NULL_TREE);
-
-	      vptr_decl = gfc_class_vptr_get (comp);
+	      class_ref = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+					   decl, cdecl, NULL_TREE);

-	      comp = gfc_class_data_get (comp);
+	      comp = gfc_class_data_get (class_ref);
 	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
 		gfc_conv_descriptor_data_set (&fnblock, comp,
 					      null_pointer_node);
@@ -9926,19 +9916,7 @@  structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      /* The dynamic type of a disassociated pointer or unallocated
 		 allocatable variable is its declared type. An unlimited
 		 polymorphic entity has no declared type.  */
-	      if (!UNLIMITED_POLY (c))
-		{
-		  vtab = gfc_find_derived_vtab (c->ts.u.derived);
-		  if (!vtab->backend_decl)
-		     gfc_get_symbol_decl (vtab);
-		  tmp = gfc_build_addr_expr (NULL_TREE, vtab->backend_decl);
-		}
-	      else
-		tmp = build_int_cst (TREE_TYPE (vptr_decl), 0);
-
-	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-					 void_type_node, vptr_decl, tmp);
-	      gfc_add_expr_to_block (&fnblock, tmp);
+	      gfc_reset_vptr (&fnblock, nullptr, class_ref, c->ts.u.derived);

 	      cmp_has_alloc_comps = false;
 	    }
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 88538713a02..1786f80245f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -5070,26 +5070,11 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	      if (sym->ts.type == BT_CLASS)
 		{
 		  /* Initialize _vptr to declared type.  */
-		  gfc_symbol *vtab;
-		  tree rhs;
-
 		  gfc_save_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
 		  e = gfc_lval_expr_from_sym (sym);
-		  gfc_add_vptr_component (e);
-		  gfc_init_se (&se, NULL);
-		  se.want_pointer = 1;
-		  gfc_conv_expr (&se, e);
+		  gfc_reset_vptr (&init, e);
 		  gfc_free_expr (e);
-		  if (UNLIMITED_POLY (sym))
-		    rhs = build_int_cst (TREE_TYPE (se.expr), 0);
-		  else
-		    {
-		      vtab = gfc_find_derived_vtab (sym->ts.u.derived);
-		      rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
-						gfc_get_symbol_decl (vtab));
-		    }
-		  gfc_add_modify (&init, se.expr, rhs);
 		  gfc_restore_backend_locus (&loc);
 		}

@@ -7931,7 +7916,7 @@  gfc_generate_function_code (gfc_namespace * ns)
 			      fold_convert (TREE_TYPE (tmp),
 					    null_pointer_node));
 	      gfc_reset_vptr (&init, nullptr, result,
-			      CLASS_DATA (sym->result)->ts.u.derived);
+			      sym->result->ts.u.derived);
 	    }
 	  else if (sym->ts.type == BT_DERIVED
 		   && !sym->attr.allocatable)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 558a7380516..454b87581f5 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -532,12 +532,12 @@  gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,

 /* Reset the vptr to the declared type, e.g. after deallocation.
    Use the variable in CLASS_CONTAINER if available.  Otherwise, recreate
-   one with e or derived.  At least one of the two has to be set.  The generated
-   assignment code is added at the end of BLOCK.  */
+   one with e or class_type.  At least one of the two has to be set.  The
+   generated assignment code is added at the end of BLOCK.  */

 void
 gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container,
-		gfc_symbol *derived)
+		gfc_symbol *class_type)
 {
   tree vptr = NULL_TREE;

@@ -564,15 +564,31 @@  gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container,
   if (vptr == NULL_TREE)
     return;

-  if (UNLIMITED_POLY (e))
+  if (UNLIMITED_POLY (e)
+      || UNLIMITED_POLY (class_type)
+      /* When the class_type's source is not a symbol (e.g. a component's ts),
+	 then look at the _data-components type.  */
+      || (class_type != NULL && class_type->ts.type == BT_UNKNOWN
+	  && class_type->components && class_type->components->ts.u.derived
+	  && class_type->components->ts.u.derived->attr.unlimited_polymorphic))
     gfc_add_modify (block, vptr, build_int_cst (TREE_TYPE (vptr), 0));
   else
     {
-      gfc_symbol *vtab;
+      gfc_symbol *vtab, *type = nullptr;
       tree vtable;

+      if (e)
+	type = e->ts.u.derived;
+      else if (class_type)
+	{
+	  if (class_type->ts.type == BT_CLASS)
+	    type = CLASS_DATA (class_type)->ts.u.derived;
+	  else
+	    type = class_type;
+	}
+      gcc_assert (type);
       /* Return the vptr to the address of the declared type.  */
-      vtab = gfc_find_derived_vtab (derived ? derived : e->ts.u.derived);
+      vtab = gfc_find_derived_vtab (type);
       vtable = vtab->backend_decl;
       if (vtable == NULL_TREE)
 	vtable = gfc_get_symbol_decl (vtab);
@@ -6872,29 +6888,14 @@  gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 							       NULL_TREE, true,
 							       e, e->ts, cls);
 		      gfc_add_expr_to_block (&block, tmp);
-		      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
-					     void_type_node, ptr,
-					     null_pointer_node);
-		      gfc_add_expr_to_block (&block, tmp);
+		      gfc_add_modify (&block, ptr,
+				      fold_convert (TREE_TYPE (ptr),
+						    null_pointer_node));

-		      if (fsym->ts.type == BT_CLASS && UNLIMITED_POLY (fsym))
-			{
-			  gfc_add_modify (&block, ptr,
-					  fold_convert (TREE_TYPE (ptr),
-							null_pointer_node));
-			  gfc_add_expr_to_block (&block, tmp);
-			}
-		      else if (fsym->ts.type == BT_CLASS)
-			{
-			  gfc_symbol *vtab;
-			  vtab = gfc_find_derived_vtab (fsym->ts.u.derived);
-			  tmp = gfc_get_symbol_decl (vtab);
-			  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
-			  ptr = gfc_class_vptr_get (parmse.expr);
-			  gfc_add_modify (&block, ptr,
-					  fold_convert (TREE_TYPE (ptr), tmp));
-			  gfc_add_expr_to_block (&block, tmp);
-			}
+		      if (fsym->ts.type == BT_CLASS)
+			gfc_reset_vptr (&block, nullptr,
+					build_fold_indirect_ref (parmse.expr),
+					fsym->ts.u.derived);

 		      if (fsym->attr.optional
 			  && e->expr_type == EXPR_VARIABLE
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 96839705112..ac7fcd250d3 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -8815,15 +8815,7 @@  scalar_transfer:

       /* For CLASS results, set the _vptr.  */
       if (mold_expr->ts.type == BT_CLASS)
-	{
-	  tree vptr;
-	  gfc_symbol *vtab;
-	  vptr = gfc_class_vptr_get (tmpdecl);
-	  vtab = gfc_find_derived_vtab (source_expr->ts.u.derived);
-	  gcc_assert (vtab);
-	  tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
-	  gfc_add_modify (&se->pre, vptr, fold_convert (TREE_TYPE (vptr), tmp));
-	}
+	gfc_reset_vptr (&se->pre, nullptr, tmpdecl, source_expr->ts.u.derived);

       se->expr = tmpdecl;
     }
--
2.45.1