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

[Andre Vehreschild <vehre@gmx.de>]

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