[Patch, fortran] PR 122696 - [PDT] ICE when selector is a generic interface with the same name as a derived type
Paul Richard Thomas <[email protected]>
| Newsgroups | gmane.comp.gcc.patches,gmane.comp.gcc.fortran |
|---|---|
| Message-ID | <CAGkQGi+1at2tRV4JeZEs-L06PC+CfmHS1G5-_yJo5VgWjdhukQ@mail.gmail.com> |
Hi All, This patch is sufficiently straightforward and 'obvious' that I intend to push later today, unless somebody objects. Regtests on FC43/x86_64. OK for mainline. Paul
Change.Logs
(application/octet-stream, 357 B) - not displayed
submit.diff
(text/x-patch, 1.9 KB)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f20e0ea5bde..e0cdd06cfde 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10447,6 +10447,23 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
gcc_assert (sym->assoc);
gcc_assert (sym->attr.flavor == FL_VARIABLE);
+ if (sym->assoc->target
+ && sym->assoc->target->expr_type == EXPR_FUNCTION
+ && sym->assoc->target->symtree
+ && sym->assoc->target->symtree->n.sym
+ && sym->assoc->target->symtree->n.sym->attr.generic)
+ {
+ if (gfc_resolve_expr (sym->assoc->target))
+ sym->ts = sym->assoc->target->ts;
+ else
+ {
+ gfc_error ("%s could not be resolved to a specific function at %L",
+ sym->assoc->target->symtree->n.sym->name,
+ &sym->assoc->target->where);
+ return;
+ }
+ }
+
/* If this is for SELECT TYPE, the target may not yet be set. In that
case, return. Resolution will be called later manually again when
this is done. */
diff --git a/gcc/testsuite/gfortran.dg/pdt_89.f03 b/gcc/testsuite/gfortran.dg/pdt_89.f03
new file mode 100644
index 00000000000..2c218467464
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_89.f03
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for pr122696, which used to ICE on the associate statement. The
+! generic selector tensor_t () should resolve to tensor ().
+!
+! Contributed by Damian Rouson <[email protected]>
+!
+module tensor_m
+ implicit none
+
+ type tensor_t(k)
+ integer, kind :: k = kind(0.)
+ end type
+
+ interface tensor_t
+ module function tensor()
+ implicit none
+ type(tensor_t) tensor
+ end function
+ end interface
+
+end module
+
+ use tensor_m
+ implicit none
+ associate(t => tensor_t())
+ end associate
+end
+! { dg-final { scan-tree-dump-times "t = tensor \\(\\)" 1 "original" } }