From: Janus Weil <janus@gcc.gnu.org>
Date: Sat, 7 Dec 2013 19:27:19 +0000 (+0100)
Subject: re PR fortran/59414 ([OOP] ICE in in gfc_conv_expr_descriptor on ALLOCATE inside... 
X-Git-Tag: releases/gcc-4.9.0~2214
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=36ad06d23a2d7ca558691047fe54da18b078be8d;p=thirdparty%2Fgcc.git

re PR fortran/59414 ([OOP] ICE in in gfc_conv_expr_descriptor on ALLOCATE inside SELECT TYPE)

2013-12-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59414
	* resolve.c (resolve_specific_f0): Handle CLASS-valued functions.

2013-12-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/59414
	* gfortran.dg/class_result_2.f90: New.

From-SVN: r205785
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bad7d6b611f7..4be8725bd0d8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59414
+	* resolve.c (resolve_specific_f0): Handle CLASS-valued functions.
+
 2013-12-04  Tobias Burnus  <burnus@net-b.de>
 
 	PR debug/37132
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d16347d034e2..5ed70539a917 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2616,7 +2616,9 @@ found:
     expr->ts = sym->ts;
   expr->value.function.name = sym->name;
   expr->value.function.esym = sym;
-  if (sym->as != NULL)
+  if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as)
+    expr->rank = CLASS_DATA (sym)->as->rank;
+  else if (sym->as != NULL)
     expr->rank = sym->as->rank;
 
   return MATCH_YES;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2d8d2eb60b41..fc320428699b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-12-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/59414
+	* gfortran.dg/class_result_2.f90: New.
+
 2013-12-06  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/59388
diff --git a/gcc/testsuite/gfortran.dg/class_result_2.f90 b/gcc/testsuite/gfortran.dg/class_result_2.f90
new file mode 100644
index 000000000000..be37a1991da8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_result_2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+!
+! PR 59414: [OOP] Class array pointers: compile error on valid code (Different ranks in pointer assignment)
+!
+! Contributed by Antony Lewis <antony@cosmologist.info>
+
+    implicit none
+
+    Type TObjectList
+    end Type
+
+    Class(TObjectList), pointer :: Arr(:)
+    Arr => ArrayItem()
+      
+  contains
+
+    function ArrayItem() result(P)
+      Class(TObjectList), pointer :: P(:)
+    end function
+
+end