[v3] fortran: refresh associate-name kind once selector is resolved [PR125172]
Commit Message
When the ASSOCIATE target is a forward reference to an internal or
contained function whose return type is not yet known at parse time,
primary.cc infers a type for the associate-name from a %re/%im/%len
inquiry using the default kind (e.g. complex(4) when the user wrote
k%re). The actual selector kind cannot be known at that point.
The inferred-type cleanup in resolve_assoc_var only refreshed the
typespec when the target was BT_DERIVED/BT_CLASS, so for an inferred
intrinsic complex/character associate-name sym->ts kept the default
kind. Resolved expressions referencing the associate-name (or
applying the %re/%im inquiry) inherited that wrong kind, so for a
function returning complex(real64) one would see kind(k%re) == 4.
Refresh the kind in three places once the selector's actual type is
known:
- resolve_assoc_var: when the associate-name was inferred and the
target's resolved intrinsic type matches sym->ts.type but not its
kind, copy the target's typespec onto sym.
- resolve_variable: for a no-ref reference to an inferred-type
associate-name whose ts has changed at resolution, update e->ts
from sym->ts so callers like aimag(k) see the correct kind.
- gfc_fixup_inferred_type_refs: for an INQUIRY_RE/INQUIRY_IM ref on
a BT_COMPLEX associate-name, set e->ts.kind to sym->ts.kind so
kind(k%re) reflects the resolved kind.
PR fortran/125172
gcc/fortran/ChangeLog:
* resolve.cc (gfc_fixup_inferred_type_refs): Update kind for
INQUIRY_RE and INQUIRY_IM references on inferred complex
associate-name.
(resolve_variable): For an inferred-type associate-name with
no subobject ref, refresh e->ts from sym->ts.
(resolve_assoc_var): For an inferred-type complex/character
associate-name, refresh sym->ts from the resolved target when
only the kind differs.
gcc/testsuite/ChangeLog:
* gfortran.dg/associate_79.f90: New test.
Signed-off-by: Samir Ouchene <samirmath01@gmail.com>
Apologies; v1 and v2 went out malformed (commit msg folded into the
subject header). Please use v3.
Thank you.
Samir
---
gcc/fortran/resolve.cc | 26 +++++++++++++++++
gcc/testsuite/gfortran.dg/associate_79.f90 | 34 ++++++++++++++++++++++
2 files changed, 60 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/associate_79.f90
Comments
After checking and regtesting, pushed as r17-375.
Many thanks for the patch, Samir. May you do many more of them!
Paul
Dear Paul,
Thank you for committing it. Sorry again for the messy subjects in the
first two versions. I'm glad the patch is now in.
Kind regards,
Samir
On Thu, 7 May 2026 at 09:13, Paul Richard Thomas <
paul.richard.thomas@gmail.com> wrote:
> After checking and regtesting, pushed as r17-375.
>
> Many thanks for the patch, Samir. May you do many more of them!
>
> Paul
>
@@ -6578,6 +6578,13 @@ resolve_variable (gfc_expr *e)
if (e->expr_type == EXPR_CONSTANT)
return true;
}
+ else if (IS_INFERRED_TYPE (e)
+ && sym->ts.type != BT_UNKNOWN
+ && (sym->ts.type != e->ts.type || sym->ts.kind != e->ts.kind))
+ /* No subobject ref, but the expression's typespec was set at parse
+ time before the target's actual type/kind was known. Refresh from
+ the now-resolved associate-name symbol. */
+ e->ts = sym->ts;
else if (sym->attr.select_type_temporary
&& sym->ns->assoc_name_inferred)
gfc_fixup_inferred_type_refs (e);
@@ -6962,6 +6969,15 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
sym->assoc->target->ts.kind);
gfc_replace_expr (e, ne);
}
+ else if (ref && ref->type == REF_INQUIRY
+ && (ref->u.i == INQUIRY_RE || ref->u.i == INQUIRY_IM)
+ && sym->ts.type == BT_COMPLEX
+ && e->ts.type == BT_REAL
+ && e->ts.kind != sym->ts.kind)
+ /* primary.cc set the inquiry-result kind to the default real kind
+ when the associate-name's type was inferred from %re/%im before
+ the target was resolved. Now use the (resolved) selector kind. */
+ e->ts.kind = sym->ts.kind;
/* Now that the references are all sorted out, set the expression rank
and return. */
@@ -10680,6 +10696,16 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* Confirmed to be either a derived type or misidentified to be a
scalar class object, when the selector is a class array. */
sym->ts = target->ts;
+ else if (sym->assoc->inferred_type
+ && (sym->ts.type == BT_COMPLEX
+ || sym->ts.type == BT_CHARACTER)
+ && target->ts.type == sym->ts.type
+ && sym->ts.kind != target->ts.kind)
+ /* The inferred type was set from a %re, %im or %len inquiry on
+ the associate name with the default kind, before the target's
+ actual type was known. Now that the target has been resolved,
+ update the kind to match. */
+ sym->ts = target->ts;
}
new file mode 100644
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! Verify that an associate-name whose target is a call to an internal
+! procedure (CONTAINS in a program) gets the correct declared kind from
+! the function's return type, instead of falling back to default kind.
+!
+program demo
+ use, intrinsic :: iso_fortran_env, only: wp => real64
+ implicit none
+ complex(wp) :: z
+ real(wp) :: re_ref, im_ref
+
+ z = (1.0_wp, 2.0_wp)
+ re_ref = real (sin (z), wp)
+ im_ref = aimag (sin (z))
+
+ associate (k => myfunc (z))
+ if (kind (k%re) /= kind (1.0_wp)) stop 1
+ if (kind (k%im) /= kind (1.0_wp)) stop 2
+ if (kind (aimag (k)) /= kind (1.0_wp)) stop 3
+ if (abs (k%re - re_ref) > 1.0e-12_wp) stop 4
+ if (abs (k%im - im_ref) > 1.0e-12_wp) stop 5
+ if (abs (aimag (k) - im_ref) > 1.0e-12_wp) stop 6
+ end associate
+
+contains
+
+ complex(wp) function myfunc (x)
+ complex(wp), intent(in) :: x
+ myfunc = sin (x)
+ end function myfunc
+
+end program demo
+