re PR fortran/60232 ([OOP] The rank of the element in the structure constructor does not match that of the component)

2014-02-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60232
	* expr.c (gfc_get_variable_expr): Don't add REF_ARRAY for dimensionful
	functions, which are used as procedure pointer target.


2014-02-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60232
	* gfortran.dg/typebound_proc_33.f90: New.

From-SVN: r207896

gcc/fortran/ChangeLog

@@ -1,3 +1,9 @@
+2014-02-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/60232
+	* expr.c (gfc_get_variable_expr): Don't add REF_ARRAY for dimensionful
+	functions, which are used as procedure pointer target.
+
 2014-02-18  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/49397

gcc/fortran/expr.c

@@ -3972,9 +3972,10 @@ gfc_get_variable_expr (gfc_symtree *var)
   e->symtree = var;
   e->ts = var->n.sym->ts;
 
-  if ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS)
-      || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym)
-	  && CLASS_DATA (var->n.sym)->as))
+  if (var->n.sym->attr.flavor != FL_PROCEDURE
+      && ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS)
+	   || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym)
+	       && CLASS_DATA (var->n.sym)->as)))
     {
       e->rank = var->n.sym->ts.type == BT_CLASS
 		? CLASS_DATA (var->n.sym)->as->rank : var->n.sym->as->rank;

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2014-02-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/60232
+	* gfortran.dg/typebound_proc_33.f90: New.
+
 2014-02-19  Marek Polacek  <polacek@redhat.com>
 
 	PR c/60195

gcc/testsuite/gfortran.dg/typebound_proc_33.f90

@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR 60232: [OOP] The rank of the element in the structure constructor does not match that of the component
+!
+! Contributed by Antony Lewis <antony@cosmologist.info>
+
+module ObjectLists
+  implicit none
+
+  Type TObjectList
+  contains
+    procedure :: ArrayItem
+  end Type
+
+contains
+
+  function ArrayItem(L) result(P)
+    Class(TObjectList) :: L
+    Class(TObjectList), pointer :: P(:)
+  end function
+
+end module
+
+
+  use ObjectLists
+  implicit none
+
+  Type, extends(TObjectList):: TSampleList
+  end Type
+
+contains
+
+  subroutine TSampleList_ConfidVal(L)
+    Class(TSampleList) :: L
+  end subroutine
+
+end
+
+! { dg-final { cleanup-modules "ObjectLists" } }