From 36ad06d23a2d7ca558691047fe54da18b078be8d Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sat, 7 Dec 2013 20:27:19 +0100 Subject: [PATCH] re PR fortran/59414 ([OOP] ICE in in gfc_conv_expr_descriptor on ALLOCATE inside SELECT TYPE) 2013-12-07 Janus Weil PR fortran/59414 * resolve.c (resolve_specific_f0): Handle CLASS-valued functions. 2013-12-07 Janus Weil PR fortran/59414 * gfortran.dg/class_result_2.f90: New. From-SVN: r205785 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/resolve.c | 4 +++- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/class_result_2.f90 | 21 ++++++++++++++++++++ 4 files changed, 34 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/class_result_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bad7d6b611f..4be8725bd0d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2013-12-07 Janus Weil + + PR fortran/59414 + * resolve.c (resolve_specific_f0): Handle CLASS-valued functions. + 2013-12-04 Tobias Burnus PR debug/37132 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d16347d034e..5ed70539a91 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 2d8d2eb60b4..fc320428699 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-12-07 Janus Weil + + PR fortran/59414 + * gfortran.dg/class_result_2.f90: New. + 2013-12-06 Jakub Jelinek 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 00000000000..be37a1991da --- /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 + + implicit none + + Type TObjectList + end Type + + Class(TObjectList), pointer :: Arr(:) + Arr => ArrayItem() + + contains + + function ArrayItem() result(P) + Class(TObjectList), pointer :: P(:) + end function + +end -- 2.30.2