From 463ec8224b9fc5661646c4f8c9242c92ebb08f72 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 31 Jan 2011 23:51:59 +0100 Subject: [PATCH] re PR fortran/47455 ([OOP] internal compiler error: in fold_convert_loc, at fold-const.c:2028) 2011-01-31 Janus Weil PR fortran/47455 * trans-expr.c (gfc_conv_procedure_call): Handle procedure pointers with pointer or allocatable result. 2011-01-31 Janus Weil PR fortran/47455 * gfortran.dg/typebound_call_19.f03: New. From-SVN: r169455 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-expr.c | 7 ++- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/typebound_call_19.f03 | 51 +++++++++++++++++++ 4 files changed, 65 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/typebound_call_19.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae08fdc6a87..e05645d14af 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-01-31 Janus Weil + + PR fortran/47455 + * trans-expr.c (gfc_conv_procedure_call): Handle procedure pointers + with pointer or allocatable result. + 2011-01-31 Paul Thomas PR fortran/47519 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 96828020689..b5b6d614984 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3606,10 +3606,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, x = f() where f is pointer valued, we have to dereference the result. */ if (!se->want_pointer && !byref - && (sym->attr.pointer || sym->attr.allocatable) - && !gfc_is_proc_ptr_comp (expr, NULL)) - se->expr = build_fold_indirect_ref_loc (input_location, - se->expr); + && ((!comp && (sym->attr.pointer || sym->attr.allocatable)) + || (comp && (comp->attr.pointer || comp->attr.allocatable)))) + se->expr = build_fold_indirect_ref_loc (input_location, se->expr); /* f2c calling conventions require a scalar default real function to return a double precision result. Convert this back to default diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7d22d04e6e8..17bb107bfe1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-31 Janus Weil + + PR fortran/47455 + * gfortran.dg/typebound_call_19.f03: New. + 2011-01-31 Jakub Jelinek PR c++/47416 diff --git a/gcc/testsuite/gfortran.dg/typebound_call_19.f03 b/gcc/testsuite/gfortran.dg/typebound_call_19.f03 new file mode 100644 index 00000000000..95b272a80ab --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_19.f03 @@ -0,0 +1,51 @@ +! { dg-do run } +! +! PR 47455: [4.6 Regression][OOP] internal compiler error: in fold_convert_loc, at fold-const.c:2028 +! +! Contributed by Thomas Henlich + +module class_t + type :: tx + integer :: i + end type + type :: t + type(tx) :: x + procedure(find_x), pointer :: ppc + contains + procedure :: find_x + end type + type(tx), target :: zero = tx(0) +contains + function find_x(this) + class(t), intent(in) :: this + type(tx), pointer :: find_x + find_x => zero + end function find_x +end module + +program test + use class_t + class(t),allocatable :: this + procedure(find_x), pointer :: pp + allocate(this) + ! (1) ordinary function call + zero = tx(1) + this%x = find_x(this) + if (this%x%i /= 1) call abort() + ! (2) procedure pointer + zero = tx(2) + pp => find_x + this%x = pp(this) + if (this%x%i /= 2) call abort() + ! (3) PPC + zero = tx(3) + this%ppc => find_x + this%x = this%ppc() + if (this%x%i /= 3) call abort() + ! (4) TBP + zero = tx(4) + this%x = this%find_x() + if (this%x%i /= 4) call abort() +end + +! { dg-final { cleanup-modules "class_t" } }