Hi All, This is another relatively straight forward PDT patch that enables typebound procedures with a parameterized kind specification for the interface.
Regtests with FC42/x86_64. OK for mainline Paul PS Patches for PRs 84432, 103414 & 114815 are on the way. With all of the pending patches applied, 27 out of 48 of PDT PRs that failed, when I started this campaign, now succeed. A small handful of PRs remain after this, which do not require the change in the PDT representation (PR82649 in particular).
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 1e91b57aa96..fcbbc2f8c6e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4076,6 +4076,11 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
c2->ts = c1->ts;
c2->attr = c1->attr;
+ if (c1->tb)
+ {
+ c2->tb = gfc_get_tbp ();
+ c2->tb = c1->tb;
+ }
/* The order of declaration of the type_specs might not be the
same as that of the components. */
@@ -4163,6 +4168,17 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
c2->ts.kind, gfc_basic_typename (c2->ts.type));
goto error_return;
}
+ if (c2->attr.proc_pointer && c2->attr.function
+ && c1->ts.interface && c1->ts.interface->ts.kind == 0)
+ {
+ c2->ts.interface = gfc_new_symbol ("", gfc_current_ns);
+ c2->ts.interface->result = c2->ts.interface;
+ c2->ts.interface->ts = c2->ts;
+ c2->ts.interface->attr.flavor = FL_PROCEDURE;
+ c2->ts.interface->attr.function = 1;
+ c2->attr.function = 1;
+ c2->attr.if_source = IFSRC_UNKNOWN;
+ }
}
/* Similarly, set the string length if parameterized. */
@@ -7573,6 +7589,9 @@ match_ppc_decl (void)
*c->tb = *tb;
}
+ if (saved_kind_expr)
+ c->kind_expr = gfc_copy_expr (saved_kind_expr);
+
/* Set interface. */
if (proc_if != NULL)
{
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2644cd82210..482031d2600 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1916,6 +1916,7 @@ typedef struct gfc_typebound_proc
}
gfc_typebound_proc;
+#define gfc_get_tbp() XCNEW (gfc_typebound_proc)
/* Symbol nodes. These are important things. They are what the
standard refers to as "entities". The possibly multiple names that
diff --git a/gcc/testsuite/gfortran.dg/pdt_42.f03 b/gcc/testsuite/gfortran.dg/pdt_42.f03
new file mode 100644
index 00000000000..c9f25021ab9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_42.f03
@@ -0,0 +1,28 @@
+! { dg-do run )
+!
+! Test the fix for PR89707 in which the procedure pointer component
+! with a parameterized KIND expression caused an ICE in resolution.
+!
+! Contributed by Janus Weil <ja...@gcc.gnu.org>
+!
+program pdt_with_ppc
+ integer, parameter :: kt = kind (0d0)
+ type :: q(k)
+ integer, kind :: k = 4
+ procedure (real(kind=kt)), pointer, nopass :: p
+ end type
+ type (q(kt)) :: x
+ x%p => foo
+ if (int (x%p(2d0)) /= 4) stop 1
+ x%p => bar
+ if (int (x%p(2d0, 4d0)) /= 16) stop 2
+contains
+ real(kind=kt) function foo (x)
+ real(kind = kt) :: x
+ foo = 2.0 * x
+ end
+ real(kind=kt) function bar (x, y)
+ real(kind = kt) :: x, y
+ bar = x ** y
+ end
+end
