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 <anl...@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
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.
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 <anl...@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
+
