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

[Janus Weil]

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" } }