Re: [Patch, Fortran, committed] Allow ref'ing PDT's len() in parameter-initializer [PR102003]

[Andre Vehreschild <vehre@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 5772 bytes --]

Hi all, hi Harald,

thanks for the review. I choose to use gfc_replace_expr() and retested.
Everything went fine now.

Also thank you clarifying the pdt as a component in a derived type and that
that is still a bug and I didn't do it wrong.

I have pushed the attached patch seconds ago.

Thanks for your help,
Andre

On Tue, 11 Jul 2023 22:24:37 +0200
Harald Anlauf <anlauf@gmx.de> wrote:

> Hi Andre,
>
> this looks much better now!
>
> This looks mostly good to me, except for a typo in the testcase:
>
> +  if (p% ci% len /= 42) stop 4
>
> There is no component "ci", only "c".  The testsuite would fail.
>
> Regarding the memleak: replacing
>
>        // TODO: Fix leaking expr tmp, when simplify is done twice.
>        tmp = gfc_copy_expr (*newp);
>
> by
>
>        if (inquiry->next)
> 	{
> 	  gfc_free_expr (tmp);
> 	  tmp = gfc_copy_expr (*newp);
> 	}
>
> or rather
>
>        if (inquiry->next)
> 	gfc_replace_expr (tmp, *newp);
>
> at least shrinks the leak a bit.  (Untested otherwise).
>
> OK with one of the above changes (provided it survives regtesting).
>
> Thanks for the patch!
>
> Harald
>
>
> Am 11.07.23 um 18:23 schrieb Andre Vehreschild via Gcc-patches:
> > Hi Harald,
> >
> > attached is a new version of the patch. This now also respects inquiry-LEN.
> > Btw, there is a potential memory leak in the simplify for inquiry
> > functions. I have added a note into the code.
> >
> > I tried to use a pdt within a derived type as a component. Is that not
> > allowed by the standard? I know, I could hunt in the standard for it, but
> > when someone knows out of his head, he could greatly help me out.
> >
> > Regtests ok on x86_64-linux-gnu/F37.
> >
> > Regards,
> > 	Andre
> >
> > On Mon, 10 Jul 2023 20:55:29 +0200
> > Harald Anlauf <anlauf@gmx.de> wrote:
> >
> >> Hi Andre,
> >>
> >> thanks for looking into this!
> >>
> >> While it fixes the original PR, here is a minor extension of the
> >> testcase that ICEs here with your patch:
> >>
> >> program pr102003
> >>     type pdt(n)
> >>        integer, len     :: n = 8
> >>        character(len=n) :: c
> >>     end type pdt
> >>     type(pdt(42)) :: p
> >>     integer, parameter :: m = len (p% c)
> >>     integer, parameter :: n = p% c% len
> >>
> >>     if (m /= 42) stop 1
> >>     if (len (p% c) /= 42) stop 2
> >>     print *, p% c% len           ! OK
> >>     if (p% c% len  /= 42) stop 3 ! OK
> >>     print *, n                   ! ICE
> >> end
> >>
> >> I get:
> >>
> >> pdt_33.f03:14:27:
> >>
> >>      14 |   integer, parameter :: n = p% c% len
> >>         |                           1
> >> Error: non-constant initialization expression at (1)
> >> pdt_33.f03:20:31:
> >>
> >>      20 |   print *, n                   ! ICE
> >>         |                               1
> >> internal compiler error: tree check: expected record_type or union_type
> >> or qual_union_type, have integer_type in gfc_conv_component_ref, at
> >> fortran/trans-expr.cc:2757
> >> 0x84286c tree_check_failed(tree_node const*, char const*, int, char
> >> const*, ...)
> >>           ../../gcc-trunk/gcc/tree.cc:8899
> >> 0xa6d6fb tree_check3(tree_node*, char const*, int, char const*,
> >> tree_code, tree_code, tree_code)
> >>           ../../gcc-trunk/gcc/tree.h:3617
> >> 0xa90847 gfc_conv_component_ref(gfc_se*, gfc_ref*)
> >>           ../../gcc-trunk/gcc/fortran/trans-expr.cc:2757
> >> 0xa91bbc gfc_conv_variable
> >>           ../../gcc-trunk/gcc/fortran/trans-expr.cc:3137
> >> 0xaa8e9c gfc_conv_expr(gfc_se*, gfc_expr*)
> >>           ../../gcc-trunk/gcc/fortran/trans-expr.cc:9594
> >> 0xaa92ae gfc_conv_expr_reference(gfc_se*, gfc_expr*)
> >>           ../../gcc-trunk/gcc/fortran/trans-expr.cc:9713
> >> 0xad67f6 gfc_trans_transfer(gfc_code*)
> >>           ../../gcc-trunk/gcc/fortran/trans-io.cc:2607
> >> 0xa43cb7 trans_code
> >>           ../../gcc-trunk/gcc/fortran/trans.cc:2449
> >> 0xad37c6 build_dt
> >>           ../../gcc-trunk/gcc/fortran/trans-io.cc:2051
> >> 0xa43cd7 trans_code
> >>           ../../gcc-trunk/gcc/fortran/trans.cc:2421
> >> 0xa84711 gfc_generate_function_code(gfc_namespace*)
> >>           ../../gcc-trunk/gcc/fortran/trans-decl.cc:7762
> >> 0x9d9ca7 translate_all_program_units
> >>           ../../gcc-trunk/gcc/fortran/parse.cc:6929
> >> 0x9d9ca7 gfc_parse_file()
> >>           ../../gcc-trunk/gcc/fortran/parse.cc:7235
> >> 0xa40a1f gfc_be_parse_file
> >>           ../../gcc-trunk/gcc/fortran/f95-lang.cc:229
> >>
> >> The fortran-dump confirms that n is not simplified to a constant.
> >> So while you're at it, do you also see a solution to this variant?
> >>
> >> Harald
> >>
> >>
> >> Am 10.07.23 um 17:48 schrieb Andre Vehreschild via Gcc-patches:
> >>> Hi all,
> >>>
> >>> while browsing the pdt meta-bug I came across 102003 and thought to
> >>> myself: Well, that one is easy. How foolish of me...
> >>>
> >>> Anyway, the solution attached prevents a pdt_len (or pdt_kind) expression
> >>> in a function call (e.g. len() or kind()) to mark the whole expression as
> >>> a pdt one. The second part of the patch in simplify.cc then takes care of
> >>> either generating the correct component ref or when a constant expression
> >>> (i.e. gfc_init_expr_flag is set) is required to look this up from the
> >>> actual symbol (not from the type, because there the default value is
> >>> stored).
> >>>
> >>> Regtested ok on x86_64-linux-gnu/Fedora 37.
> >>>
> >>> Regards,
> >>> 	Andre
> >>> --
> >>> Andre Vehreschild * Email: vehre ad gmx dot de
> >>
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>


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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gfortran-Allow-ref-ing-PDT-s-len-in-parameter-initia.patch --]
[-- Type: text/x-patch, Size: 7546 bytes --]

From 4486f7c3aa526f87bdccd9d7ee0ff5efef4b99f1 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed, 12 Jul 2023 12:51:30 +0200
Subject: [PATCH] gfortran: Allow ref'ing PDT's len() in parameter-initializer.

Fix declaring a parameter initialized using a pdt_len reference
not simplifying the reference to a constant.

2023-07-12  Andre Vehreschild  <vehre@gcc.gnu.org>

gcc/fortran/ChangeLog:

	PR fortran/102003
	* expr.cc (find_inquiry_ref): Replace len of pdt_string by
	constant.
	(simplify_ref_chain): Ensure input to find_inquiry_ref is
	NULL.
	(gfc_match_init_expr): Prevent PDT analysis for function calls.
	(gfc_pdt_find_component_copy_initializer): Get the initializer
	value for given component.
	* gfortran.h (gfc_pdt_find_component_copy_initializer): New
	function.
	* simplify.cc (gfc_simplify_len): Replace len() of PDT with pdt
	component ref or constant.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pdt_33.f03: New test.
---
 gcc/fortran/expr.cc                  | 31 +++++++++++++--
 gcc/fortran/gfortran.h               |  1 +
 gcc/fortran/simplify.cc              | 57 +++++++++++++++++++++-------
 gcc/testsuite/gfortran.dg/pdt_33.f03 | 21 ++++++++++
 4 files changed, 94 insertions(+), 16 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/pdt_33.f03

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e418f1f3301..663fe63dea6 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1862,6 +1862,13 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 	  else if (tmp->expr_type == EXPR_CONSTANT)
 	    *newp = gfc_get_int_expr (gfc_default_integer_kind,
 				      NULL, tmp->value.character.length);
+	  else if (gfc_init_expr_flag
+		   && tmp->ts.u.cl->length->symtree->n.sym->attr.pdt_len)
+	    *newp = gfc_pdt_find_component_copy_initializer (tmp->symtree->n
+							     .sym,
+							     tmp->ts.u.cl
+							     ->length->symtree
+							     ->n.sym->name);
 	  else
 	    goto cleanup;

@@ -1902,7 +1909,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 		    mpc_imagref (tmp->value.complex), GFC_RND_MODE);
 	  break;
 	}
-      tmp = gfc_copy_expr (*newp);
+      // TODO: Fix leaking expr tmp, when simplify is done twice.
+      if (inquiry->next)
+	gfc_replace_expr (tmp, *newp);
     }

   if (!(*newp))
@@ -2067,7 +2076,7 @@ static bool
 simplify_ref_chain (gfc_ref *ref, int type, gfc_expr **p)
 {
   int n;
-  gfc_expr *newp;
+  gfc_expr *newp = NULL;

   for (; ref; ref = ref->next)
     {
@@ -3229,7 +3238,7 @@ gfc_match_init_expr (gfc_expr **result)
       return m;
     }

-  if (gfc_derived_parameter_expr (expr))
+  if (expr->expr_type != EXPR_FUNCTION && gfc_derived_parameter_expr (expr))
     {
       *result = expr;
       gfc_init_expr_flag = false;
@@ -6556,3 +6565,19 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,

   return true;
 }
+
+gfc_expr*
+gfc_pdt_find_component_copy_initializer (gfc_symbol *sym, const char *name)
+{
+  /* The actual length of a pdt is in its components.  In the
+     initializer of the current ref is only the default value.
+     Therefore traverse the chain of components and pick the correct
+     one's initializer expressions.  */
+  for (gfc_component *comp = sym->ts.u.derived->components; comp != NULL;
+       comp = comp->next)
+    {
+      if (!strcmp (comp->name, name))
+	return gfc_copy_expr (comp->initializer);
+    }
+  return NULL;
+}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 30631abd788..74466c7f04c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3727,6 +3727,7 @@ gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
 bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*);
+gfc_expr* gfc_pdt_find_component_copy_initializer (gfc_symbol *, const char *);


 /* st.cc */
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 81680117f70..87fefe46cfd 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4580,19 +4580,50 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
       return range_check (result, "LEN");
     }
   else if (e->expr_type == EXPR_VARIABLE && e->ts.type == BT_CHARACTER
-	   && e->symtree->n.sym
-	   && e->symtree->n.sym->ts.type != BT_DERIVED
-	   && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
-	   && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
-	   && e->symtree->n.sym->assoc->target->symtree->n.sym
-	   && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
-
-    /* The expression in assoc->target points to a ref to the _data component
-       of the unlimited polymorphic entity.  To get the _len component the last
-       _data ref needs to be stripped and a ref to the _len component added.  */
-    return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
-  else
-    return NULL;
+	   && e->symtree->n.sym)
+    {
+      if (e->symtree->n.sym->ts.type != BT_DERIVED
+	  && e->symtree->n.sym->assoc && e->symtree->n.sym->assoc->target
+	  && e->symtree->n.sym->assoc->target->ts.type == BT_DERIVED
+	  && e->symtree->n.sym->assoc->target->symtree->n.sym
+	  && UNLIMITED_POLY (e->symtree->n.sym->assoc->target->symtree->n.sym))
+	/* The expression in assoc->target points to a ref to the _data
+	   component of the unlimited polymorphic entity.  To get the _len
+	   component the last _data ref needs to be stripped and a ref to the
+	   _len component added.  */
+	return gfc_get_len_component (e->symtree->n.sym->assoc->target, k);
+      else if (e->symtree->n.sym->ts.type == BT_DERIVED
+	       && e->ref && e->ref->type == REF_COMPONENT
+	       && e->ref->u.c.component->attr.pdt_string
+	       && e->ref->u.c.component->ts.type == BT_CHARACTER
+	       && e->ref->u.c.component->ts.u.cl->length)
+	{
+	  if (gfc_init_expr_flag)
+	    {
+	      gfc_expr* tmp;
+	      tmp = gfc_pdt_find_component_copy_initializer (e->symtree->n.sym,
+							     e->ref->u.c
+							     .component->ts.u.cl
+							     ->length->symtree
+							     ->name);
+	      if (tmp)
+		return tmp;
+	    }
+	  else
+	    {
+	      gfc_expr *len_expr = gfc_copy_expr (e);
+	      gfc_free_ref_list (len_expr->ref);
+	      len_expr->ref = NULL;
+	      gfc_find_component (len_expr->symtree->n.sym->ts.u.derived, e->ref
+				  ->u.c.component->ts.u.cl->length->symtree
+				  ->name,
+				  false, true, &len_expr->ref);
+	      len_expr->ts = len_expr->ref->u.c.component->ts;
+	      return len_expr;
+	    }
+	}
+    }
+  return NULL;
 }


diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f03 b/gcc/testsuite/gfortran.dg/pdt_33.f03
new file mode 100644
index 00000000000..3b2fe72431d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_33.f03
@@ -0,0 +1,21 @@
+! { dg-do run }
+!
+! Test the fix for PR102003, where len parameters where not returned as constants.
+!
+! Contributed by Harald Anlauf  <anlauf@gcc.gnu.org>
+!
+program pr102003
+  type pdt(n)
+     integer, len     :: n = 8
+     character(len=n) :: c
+  end type pdt
+  type(pdt(42)) :: p
+  integer, parameter :: m = len (p% c)
+  integer, parameter :: lm = p% c% len
+
+  if (m /= 42) stop 1
+  if (len (p% c) /= 42) stop 2
+  if (lm /= 42) stop 3
+  if (p% c% len /= 42) stop 4
+end
+
--
2.41.0