From: Janus Weil <janus@gcc.gnu.org>
Date: Mon, 25 Nov 2013 09:45:40 +0000 (+0100)
Subject: re PR fortran/59143 ([OOP] Bogus warning with array-valued type-bound procedure)
X-Git-Tag: releases/gcc-4.9.0~2478
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=3436db7558562d59027e9ce4c530b660fe5c0011;p=thirdparty%2Fgcc.git

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 58b9c11d32fd..4ac92423102d 100644
--- 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 5a0aa2677079..da3db7e096c3 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 3459c5142f52..ee6e34323989 100644
--- 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
index 000000000000..09b072610893
--- /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" } }