Hi Tobias, >> here is a straightforward patch to teach 'get_expr_storage_size' about >> type-bound procedures (which are handled internally as >> procedure-pointer components of the corresponding vtab). In that sense >> the patch should handle both TBPs as well as PPCs. >> >> Regtested on x86_64-unknown-linux-gnu. Ok for trunk? > > > The patch is NOT okay: > >> + 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++) >> + elements = elements >> + * (mpz_get_si (as->upper[i]->value.integer) >> + - mpz_get_si (as->lower[i]->value.integer) + >> 1L); > > > You cannot assume that the function returns an explicit size array with > constant bounds.
ouch, sorry for missing that. A new version is attached, and I have added one of your examples to the test case. Ok now? Cheers, Janus
Index: gcc/fortran/interface.c =================================================================== --- gcc/fortran/interface.c (revision 205304) +++ gcc/fortran/interface.c (working copy) @@ -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)
! { dg-do compile } ! ! PR 59143: [OOP] Bogus warning with array-valued type-bound procedure ! ! Contributed by Jürgen Reuter <juergen.reu...@desy.de> 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" } }