public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-8651] gfortran: Allow ref'ing PDT's len() in parameter-initializer.
@ 2024-04-26 7:07 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2024-04-26 7:07 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:e207b67fcde224f2be0c79bf2a24f7fc75b6f481
commit r13-8651-ge207b67fcde224f2be0c79bf2a24f7fc75b6f481
Author: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed Jul 12 12:51:30 2023 +0200
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.
(cherry picked from commit f9182da3213aa57c16dd0b52862126de4a259f6a)
Diff:
---
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(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 8b9c93940c8..a6c4dccb125 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1854,6 +1854,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;
@@ -1894,7 +1901,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))
@@ -2059,7 +2068,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)
{
@@ -3221,7 +3230,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;
@@ -6533,3 +6542,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 47414f73254..c1430f7dfec 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3716,6 +3716,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 b65854c1021..fe700097b7b 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4566,19 +4566,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
+
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-04-26 7:07 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-04-26 7:07 [gcc r13-8651] gfortran: Allow ref'ing PDT's len() in parameter-initializer Harald Anlauf
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).