Fortran: Fix complex associate-name with inferred kind [PR125172]

2026-05-07  Samir Ouchene  <samirmath01@gmail.com

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.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index a5d9add9d2fa2a3466dceed44734c8b34d126f12..0db362758636096bc6240eff7e19d5e26f467730 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -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;
     }
 
 

diff --git a/gcc/testsuite/gfortran.dg/associate_79.f90 b/gcc/testsuite/gfortran.dg/associate_79.f90
new file mode 100644 (file)
index 0000000..c7b04e0
--- /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
+