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

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

[Andre Vehreschild]

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

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

[-- Attachment #2: pr102003.clog --]
[-- Type: text/plain, Size: 258 bytes --]

gcc/fortran/ChangeLog:

	* expr.cc (gfc_match_init_expr): Prevent PDT analysis for function
	calls.
	* 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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: pr102003.patch --]
[-- Type: text/x-patch, Size: 4119 bytes --]

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e418f1f3301..fb6eb76cda7 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3229,7 +3229,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;
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 81680117f70..8fb453d0a54 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4580,19 +4580,54 @@ 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)
+	    {
+	      /* 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 = e->symtree->n.sym->ts.u.derived
+		   ->components; comp != NULL; comp = comp->next)
+		{
+		  if (!strcmp (comp->name, e->ref->u.c.component->ts.u.cl
+			       ->length->symtree->name))
+		    return gfc_copy_expr (comp->initializer);
+		}
+	    }
+	  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..c12bd9b411c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_33.f03
@@ -0,0 +1,18 @@
+! { 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)
+
+  if (m /= 42) stop 1
+  if (len (p% c) /= 42) stop 2
+end
+

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

[Harald Anlauf]

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

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

[Andre Vehreschild]

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

Hi Harald,

I do get why this happens. I still don't get why I have to do this
'optimization' manually. I mean, this rewriting of expressions is needed in
more than one location and most probably already present somewhere. So who
can point me in the right direction?

Regards,
Andre

Andre Vehreschild

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

[Andre Vehreschild]

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

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

[-- Attachment #2: pr102003_2.clog --]
[-- Type: text/plain, Size: 482 bytes --]

gcc/fortran/ChangeLog:

	* expr.cc (find_inquiry_ref): Replace len of pdt_string by
	constant.
	(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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: pr102003_2.patch --]
[-- Type: text/x-patch, Size: 5913 bytes --]

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e418f1f3301..23324517ff2 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,6 +1909,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp)
 		    mpc_imagref (tmp->value.complex), GFC_RND_MODE);
 	  break;
 	}
+      // TODO: Fix leaking expr tmp, when simplify is done twice.
       tmp = gfc_copy_expr (*newp);
     }

@@ -3229,7 +3237,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 +6564,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..2637cacceea
--- /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% ci% len /= 42) stop 4
+end
+

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

[Harald Anlauf]

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

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

[Harald Anlauf]

Hi Andre,

I forgot to answer your other question:

Am 11.07.23 um 18:23 schrieb Andre Vehreschild via Gcc-patches:
> 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.

You mean something like the following is rejected with a strange error:

  type pdt(n)
      integer, len     :: n = 8
      character(len=n) :: c
   end type pdt
   type t
      type(pdt(42)) :: q
   end type t
   type(t) :: u
end


pr102003.f90:1:10:

     1 |   type pdt(n)
       |          1
Error: Cannot convert TYPE(Pdtpdt) to TYPE(pdt) at (1)


ISTR that there is an existing PR...

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

[Andre Vehreschild]

[-- 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