Hi All,
I have made a start on ASSOCIATE issues. Some of the low(-ish) hanging
fruit are already fixed but I have yet to check that they a really fixed
and to close them:
pr102106, pr102111, pr104430, pr106048, pr85510, pr87460, pr92960 & pr93338
The attached patch picks up those PRs involving deferred length characters
in one guise or another. I believe that it is all pretty straightforward.
Structure constructors with allocatable, deferred length, character array
components just weren't implemented and so this is the biggest part of the
patch. I found two other, non-associate PRs(106918 & 105205) that are
fixed and there are probably more.
The chunk in trans-io.cc is something of a kludge, which I will come back
to. Some descriptors come through with a data pointer that looks as if it
should be OK but
I thought to submit this now to get it out of the way. The ratio of PRs
fixed to the size of the patch warrants this. The next stage is going to be
rather messy and so "I might take a little while" (cross talk between
associate and select type, in particular).
Regtests OK - good for mainline?
Cheers
Paul
Fortran: Fix some of the bugs in associate [PR87477]
2023-03-28 Paul Thomas
gcc/fortran
PR fortran/87477
* trans-array.cc (gfc_conv_expr_descriptor): Guard string len
expression in condition.
(duplicate_allocatable): Make element type more explicit with
'eltype'.
* trans-expr.cc (gfc_get_expr_charlen): Retain last charlen in
'previous' and use if end expression in substring reference is
null.
(gfc_conv_string_length): Use gfc_conv_expr_descriptor if
'expr_flat' is an array.
(gfc_trans_alloc_subarray_assign): If this is a deferred string
length component, store the string length in the hidden comp.
Update the typespec length accordingly. Generate a new type
spec for the call to gfc_duplicate-allocatable in this case.
* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
deferred character array components.
gcc/testsuite/
PR fortran/92994
* gfortran.dg/finalize_51.f90 : Update an error message.
PR fortran/85686
* gfortran.dg/pr85686.f90 : New test
PR fortran/88247
* gfortran.dg/pr88247.f90 : New test
PR fortran/91941
* gfortran.dg/pr91941.f90 : New test
PR fortran/92779
* gfortran.dg/pr92779.f90 : New test
PR fortran/93339
* gfortran.dg/pr93339.f90 : New test
PR fortran/93813
* gfortran.dg/pr93813.f90 : New test
PR fortran/100948
* gfortran.dg/pr100948.f90 : New test
PR fortran/102106
* gfortran.dg/pr102106.f90 : New test
PR fortran/105205
* gfortran.dg/pr105205.f90 : New test
PR fortran/106918
* gfortran.dg/pr106918.f90 : New test
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 33794f0a858..8acad60a02b 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -230,7 +230,9 @@ gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string)
{
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
- if (string->ts.u.cl)
+ if (string->ts.deferred)
+f->ts = string->ts;
+ else if (string->ts.u.cl)
f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);
f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind);
@@ -242,7 +244,9 @@ gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
{
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
- if (string->ts.u.cl)
+ if (string->ts.deferred)
+f->ts = string->ts;
+ else if (string->ts.u.cl)
f->ts.u.cl = gfc_new_charlen (gfc_current_ns, string->ts.u.cl);
f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind);
@@ -3361,7 +3365,7 @@ gfc_resolve_mvbits (gfc_code *c)
}
-/* Set up the call to RANDOM_INIT. */
+/* Set up the call to RANDOM_INIT. */
void
gfc_resolve_random_init (gfc_code *c)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 1a03e458d99..23a04d2c5bd 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9084,6 +9084,7 @@ static void
resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
{
gfc_expr* target;
+ bool parentheses = false;
gcc_assert (sym->assoc);
gcc_assert (sym->attr.flavor == FL_VARIABLE);
@@ -9096,6 +9097,16 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
return;
gcc_assert (!sym->assoc->dangling);
+ if (target->expr_type == EXPR_OP
+ && target->value.op.op == INTRINSIC_PARENTHESES
+ && target->value.op.op1->expr_type == EXPR_VARIABLE)
+{
+ sym->assoc->target = gfc_copy_expr (target->value.op.op1);
+ gfc_free_expr (target);
+ target = sym->assoc->target;
+ parentheses = true;
+}
+
if (resolve_target && !gfc_resolve_expr (target))
return;
@@ -9177,6 +9188,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* See if this is a valid association-to-variable. */
sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
+ && !parentheses
&& !gfc_has_vector_subscript (target));
/* Finally resolve if this is an array or not. */
@@ -10885,11 +10897,6 @@ gfc_r
