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/testsuite | |
| parent | 2d93be8907fa33f8791409490ed06e45de5c8420 (diff) | |
| download | gcc-f7dee170ba6d37aba6a9e1fa73711e4e03e42990.zip gcc-f7dee170ba6d37aba6a9e1fa73711e4e03e42990.tar.gz gcc-f7dee170ba6d37aba6a9e1fa73711e4e03e42990.tar.bz2 | |
Fortran: Allow PDT parameterized procedure pointer components [PR89707]
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/testsuite')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pdt_43.f03 | 28 |
1 files changed, 28 insertions, 0 deletions
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 |