From 44143d7d0d4fbad5ae69fb042de1c3613832263c Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 25 Nov 2013 09:45:40 +0000 Subject: [PATCH] 2013-11-25 Janus Weil PR fortran/59143 * interface.c (get_expr_storage_size): Handle array-valued type-bound procedures. 2013-11-25 Janus Weil PR fortran/59143 * gfortran.dg/typebound_proc_30.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@205345 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/interface.c | 18 ++++++++++++ gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/typebound_proc_30.f90 | 38 +++++++++++++++++++++++++ 4 files changed, 67 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/typebound_proc_30.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 58b9c11d32f..4ac92423102 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-11-25 Janus Weil + + PR fortran/59143 + * interface.c (get_expr_storage_size): Handle array-valued type-bound + procedures. + 2013-11-24 Francois-Xavier Coudert * scanner.c (gfc_open_intrinsic_module): Remove function. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 5a0aa267707..da3db7e096c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2426,6 +2426,24 @@ get_expr_storage_size (gfc_expr *e) - mpz_get_si (ref->u.ar.as->lower[i]->value.integer)); } } + else if (ref->type == REF_COMPONENT && ref->u.c.component->attr.function + && ref->u.c.component->attr.proc_pointer + && ref->u.c.component->attr.dimension) + { + /* Array-valued procedure-pointer components. */ + gfc_array_spec *as = ref->u.c.component->as; + for (i = 0; i < as->rank; i++) + { + if (!as->upper[i] || !as->lower[i] + || as->upper[i]->expr_type != EXPR_CONSTANT + || as->lower[i]->expr_type != EXPR_CONSTANT) + return 0; + + elements = elements + * (mpz_get_si (as->upper[i]->value.integer) + - mpz_get_si (as->lower[i]->value.integer) + 1L); + } + } } if (substrlen) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3459c5142f5..ee6e3432398 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-11-25 Janus Weil + + PR fortran/59143 + * gfortran.dg/typebound_proc_30.f90: New. + 2013-11-25 Paolo Carlini PR c++/59080 diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_30.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_30.f90 new file mode 100644 index 00000000000..09b07261089 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_proc_30.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! +! PR 59143: [OOP] Bogus warning with array-valued type-bound procedure +! +! Contributed by Jürgen Reuter + +module phs_single + + type :: phs_single_t + contains + procedure, nopass :: d1, d2 + end type + +contains + + subroutine evaluate (phs) + class(phs_single_t) :: phs + call func1 (phs%d1 ()) + call func1 (phs%d2 (2)) + end subroutine + + subroutine func1 (p) + real :: p(2) + end subroutine + + function d1 () + real :: d1(2) + d1 = 1. + end function + + function d2 (n) + real :: d2(n) + d2 = 1. + end function + +end module + +! { dg-final { cleanup-modules "phs_single" } } -- 2.11.4.GIT