re PR fortran/59143 ([OOP] Bogus warning with array-valued type-bound procedure)

2013-11-25  Janus Weil  <janus@gcc.gnu.org>

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

2013-11-25  Janus Weil  <janus@gcc.gnu.org>

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

From-SVN: r205345

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 58b9c11d32fd42162d74fd2264fa6544973ce49e..4ac92423102d2e7c6f4102621af0913c577227e2 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-11-25  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/59143
+       * interface.c (get_expr_storage_size): Handle array-valued type-bound
+       procedures.
+
 2013-11-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * scanner.c (gfc_open_intrinsic_module): Remove function.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 5a0aa2677079830004587900dec9d4c2a8e534fd..da3db7e096c36196c35a26f428710317273f65e3 100644 (file)
--- 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 3459c5142f52d71f70a132bf0c8903f2dd18dc9a..ee6e343239899a756e73abbbc08fa99e897756dd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-11-25  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/59143
+       * gfortran.dg/typebound_proc_30.f90: New.
+
 2013-11-25  Paolo Carlini  <paolo.carlini@oracle.com>
 
        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 (file)
index 0000000..09b0726
--- /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 <juergen.reuter@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" } }