https://gcc.gnu.org/g:818e522d0fc00451241590fc0564de10bcfdac86
commit r14-12736-g818e522d0fc00451241590fc0564de10bcfdac86 Author: Paul Thomas <[email protected]> Date: Thu May 7 08:04:27 2026 +0100 Fortran: Fix complex associate-name with inferred kind [PR125172] 2026-05-07 Samir Ouchene <[email protected] gcc/fortran PR fortran/125172 * 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 PR fortran/125172 * gfortran.dg/associate_79.f90: New test. (cherry picked from commit 7cd09938f5484b2c66ca381a15f1dc8b1ecb8d01) Diff: --- gcc/fortran/resolve.cc | 26 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/associate_79.f90 | 34 ++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index b43fd8bdfe60..f8a76545ec23 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5927,6 +5927,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); @@ -6306,6 +6313,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. */ @@ -9551,6 +9567,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; } diff --git a/gcc/testsuite/gfortran.dg/associate_79.f90 b/gcc/testsuite/gfortran.dg/associate_79.f90 new file mode 100644 index 000000000000..c7b04e0ab4b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_79.f90 @@ -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 +
