re PR fortran/60232 ([OOP] The rank of the element in the structure constructor does...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c1bca007a8d8c53dea8a10bc238fd312162df61e..b0c0c573bba0bf0771830aa6ba3eec1a8afa2f12 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index fe6eab559576edf1c61dd19b3adb5743c77d3552..fe92c53a45304325759f7a1822f1a89da7a25d3b 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e246657c5ee63bc0afafd29aad7e1784f537787f..da20072bdfca0c6ece9bb39266ec8d95a5dd7d25 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_33.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_33.f90
new file mode 100644 (file)
index 0000000..68ea53f
--- /dev/null
+++ b/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" } }