diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c8f5c2bb9c4..7a3092a420c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-10-06 Janus Weil + + PR fortran/54832 + * resolve.c (resolve_fl_derived0): Correctly copy the 'class_ok' + attribute for proc-ptr components with RESULT variable. + 2012-10-06 Janus Weil PR fortran/45521 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7c30cba9756..722e036510e 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12022,6 +12022,7 @@ resolve_fl_derived0 (gfc_symbol *sym) c->attr.pointer = ifc->result->attr.pointer; c->attr.dimension = ifc->result->attr.dimension; c->as = gfc_copy_array_spec (ifc->result->as); + c->attr.class_ok = ifc->result->attr.class_ok; } else { @@ -12030,6 +12031,7 @@ resolve_fl_derived0 (gfc_symbol *sym) c->attr.pointer = ifc->attr.pointer; c->attr.dimension = ifc->attr.dimension; c->as = gfc_copy_array_spec (ifc->as); + c->attr.class_ok = ifc->attr.class_ok; } c->ts.interface = ifc; c->attr.function = ifc->attr.function; @@ -12041,7 +12043,6 @@ resolve_fl_derived0 (gfc_symbol *sym) c->attr.recursive = ifc->attr.recursive; c->attr.always_explicit = ifc->attr.always_explicit; c->attr.ext_attr |= ifc->attr.ext_attr; - c->attr.class_ok = ifc->attr.class_ok; /* Replace symbols in array spec. */ if (c->as) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 793549bb297..88f3a516a32 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-10-06 Janus Weil + + PR fortran/54832 + * gfortran.dg/typebound_operator_17.f90: New. + 2012-10-06 Jan Hubicka * gcc.dg/lto/resolutions_0.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_17.f90 b/gcc/testsuite/gfortran.dg/typebound_operator_17.f90 new file mode 100644 index 00000000000..4e58a7fa27a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_operator_17.f90 @@ -0,0 +1,43 @@ +! { dg-do compile } +! +! PR 54832: [4.8 Regression] [OOP] Type-bound operator not picked up with RESULT variable +! +! Contributed by Damian Rouson + + type, abstract :: integrand + contains + procedure(t_interface), deferred :: t + procedure(assign_interface), deferred :: assign + procedure(times_interface), deferred :: times + generic :: operator(*) => times + generic :: assignment(=) => assign + end type + + abstract interface + function t_interface(this) result(dState_dt) + import :: integrand + class(integrand) ,intent(in) :: this + class(integrand) ,allocatable :: dState_dt + end function + function times_interface(lhs,rhs) + import :: integrand + class(integrand) ,intent(in) :: lhs + class(integrand) ,allocatable :: times_interface + real, intent(in) :: rhs + end function + subroutine assign_interface(lhs,rhs) + import :: integrand + class(integrand) ,intent(in) :: rhs + class(integrand) ,intent(inout) :: lhs + end subroutine + end interface + +contains + + subroutine integrate(model,dt) + class(integrand) :: model + real dt + model = model%t()*dt + end subroutine + +end