diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2025-09-02 21:51:33 +0100 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2025-09-02 21:51:33 +0100 |
| commit | f7dee170ba6d37aba6a9e1fa73711e4e03e42990 (patch) | |
| tree | 2ddcd8bbfdb4bb94e37625ed8bbe38ffe9736061 /gcc | |
| parent | 2d93be8907fa33f8791409490ed06e45de5c8420 (diff) | |
| download | gcc-trunk.zip gcc-trunk.tar.gz gcc-trunk.tar.bz2 | |
2025-09-02 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/89707
* decl.cc (gfc_get_pdt_instance): Copy the typebound procedure
field from the PDT template. If the template interface has
kind=0, provide the new instance with an interface with a type
spec that points to that of the parameterized component.
(match_ppc_decl): When 'saved_kind_expr' this is a PDT and the
expression should be copied to the component kind_expr.
* gfortran.h: Define gfc_get_tbp.
gcc/testsuite/
PR fortran/89707
* gfortran.dg/pdt_43.f03: New test.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/decl.cc | 19 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_43.f03 | 28 |
3 files changed, 48 insertions, 0 deletions
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 1e91b57..fcbbc2f 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 2644cd8..482031d 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_43.f03 b/gcc/testsuite/gfortran.dg/pdt_43.f03 new file mode 100644 index 0000000..c9f2502 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_43.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 <janus@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 |