re PR fortran/54832 ([OOP] Type-bound operator not picked up with RESULT variable)

2012-10-06  Janus Weil  <janus@gcc.gnu.org>

	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  <janus@gcc.gnu.org>

	PR fortran/54832
	* gfortran.dg/typebound_operator_17.f90: New.

From-SVN: r192160
This commit is contained in:
Janus Weil 2012-10-06 16:03:08 +02:00
parent 46591697e1
commit 5e25600e6e
4 changed files with 56 additions and 1 deletions

View File

@ -1,3 +1,9 @@
2012-10-06 Janus Weil <janus@gcc.gnu.org>
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 <janus@gcc.gnu.org>
PR fortran/45521

View File

@ -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)
{

View File

@ -1,3 +1,8 @@
2012-10-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/54832
* gfortran.dg/typebound_operator_17.f90: New.
2012-10-06 Jan Hubicka <jh@suse.cz>
* gcc.dg/lto/resolutions_0.c: New testcase.

View File

@ -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 <rouson@sandia.gov>
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