[Patch, Fortran, OOP] PR 59143: Bogus warning with array-valued type-bound procedure

[Janus Weil]

Hi all,

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?

Cheers,
Janus



2013-11-18  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/59143
    * interface.c (get_expr_storage_size): Handle array-valued type-bound
    procedures.

2013-11-18  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/59143
    * gfortran.dg/typebound_proc_30.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c     (revision 204897)
+++ gcc/fortran/interface.c     (working copy)
@@ -2426,6 +2426,17 @@ 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++)
+           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 :: decay_p 
  end type
  
contains

  subroutine evaluate (phs)
    class(phs_single_t) :: phs
    call func1 (phs%decay_p ())
  end subroutine

  subroutine func1 (p)
    real :: p(2)
  end subroutine
  
  function decay_p ()
    real :: decay_p(2)
    decay_p = 1.
  end function

end module

! { dg-final { cleanup-modules "phs_single" } }