OSDN Git Service

2012-10-06 Janus Weil <janus@gcc.gnu.org>
authorjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 6 Oct 2012 14:03:08 +0000 (14:03 +0000)
committerjanus <janus@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 6 Oct 2012 14:03:08 +0000 (14:03 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@192160 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/typebound_operator_17.f90 [new file with mode: 0644]

index c8f5c2b..7a3092a 100644 (file)
@@ -1,5 +1,11 @@
 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
        * interface.c (generic_correspondence): Implement additional
        distinguishability criteria of F08.
index 7c30cba..722e036 100644 (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)
                {
index 793549b..88f3a51 100644 (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.
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
@@ -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