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.

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e418f1f33018b4c13ef09ac881d25bc4a5345035..663fe63dea68f0152916cc9e555d0ecfb6b006bf 100644 (file)
--- 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 30631abd7888b5b569e0007cc2f1ca2fcab267cd..74466c7f04c07de8affe4a66c26e3df242354ad4 100644 (file)
--- 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 81680117f708b7391f64ea2a58721ffdda430a6e..87fefe46cfdd6e1ce0412675d6e4790bb1edf50e 100644 (file)
--- 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 (file)
index 0000000..3b2fe72
--- /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
+