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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c8f5c2bb9c46a38c26b5e3a0b72c9d67d4e2cd03..7a3092a420c64bed97ed040356fbe38ccbfe2eb7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7c30cba9756d33ca65ee2525f6d13d42befa5012..722e036510e86be1d18726b80ca42c3e06419cbb 100644 (file)
--- 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 793549bb297a694cb4c32264ab169d2a68d0fa48..88f3a516a329cb18d998116a9d5eb5b72b1200bb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_17.f90 b/gcc/testsuite/gfortran.dg/typebound_operator_17.f90
new file mode 100644 (file)
index 0000000..4e58a7f
--- /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 <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