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

	PR fortran/45961
	* resolve.c (resolve_typebound_function): Bugfix for type-bound
	operators.

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

	PR fortran/45961
	* gfortran.dg/typebound_operator_6.f03: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 55f57fc..f748da6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-10-10  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45961
+       * resolve.c (resolve_typebound_function): Bugfix for type-bound
+       operators.
+
 2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        * frontend-passes.c:  Include opts.h.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a5aa62a..4280555 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5736,7 +5736,7 @@ resolve_typebound_function (gfc_expr* e)
       /* Use the generic name if it is there.  */
       name = name ? name : e->value.function.esym->name;
       e->symtree = expr->symtree;
-      expr->symtree->n.sym->ts.u.derived = declared;
+      e->ref = gfc_copy_ref (expr->ref);
       gfc_add_component_ref (e, "$vptr");
       gfc_add_component_ref (e, name);
       e->value.function.esym = NULL;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4efcbde..34783f9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,4 +1,9 @@
-2010-10.10  Kai Tietz  <kai.tietz@onevision.com>
+2010-10-10  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/45961
+       * gfortran.dg/typebound_operator_6.f03: New.
+
+2010-10-10  Kai Tietz  <kai.tietz@onevision.com>
 
        * g++.dg/ext/dllexport-MI1.C: Enable for x86_64 mingw
        and adjust -export symbol scanning.

diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_6.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03
new file mode 100644 (file)
index 0000000..b2c3ee8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_6.f03
@@ -0,0 +1,73 @@
+! { dg-do run }
+!
+! PR 45961: [4.6 Regression] [OOP] Problem with polymorphic type-bound operators
+!
+! Contributed by Mark Rashid <mmrashid@ucdavis.edu>
+
+MODULE DAT_MOD
+
+  TYPE :: DAT
+    INTEGER :: NN
+  CONTAINS
+    PROCEDURE :: LESS_THAN
+    GENERIC :: OPERATOR (.LT.) => LESS_THAN
+  END TYPE DAT
+
+CONTAINS
+
+  LOGICAL FUNCTION LESS_THAN(A, B)
+    CLASS (DAT), INTENT (IN) :: A, B
+    LESS_THAN = (A%NN .LT. B%NN)
+  END FUNCTION LESS_THAN
+
+END MODULE DAT_MOD
+
+
+MODULE NODE_MOD
+  USE DAT_MOD
+
+  TYPE NODE
+    INTEGER :: KEY
+    CLASS (DAT), POINTER :: PT
+  CONTAINS
+    PROCEDURE :: LST
+    GENERIC :: OPERATOR (.LT.) => LST
+  END TYPE NODE
+
+CONTAINS
+
+  LOGICAL FUNCTION LST(A, B)
+    CLASS (NODE), INTENT (IN) :: A, B
+    IF (A%KEY .GT. 0 .AND. B%KEY .GT. 0) THEN
+      LST = (A%KEY .LT. B%KEY)
+    ELSE
+      LST = (A%PT .LT. B%PT)
+    END IF
+  END FUNCTION LST
+
+END MODULE NODE_MOD
+
+
+PROGRAM TEST
+  USE NODE_MOD
+  IMPLICIT NONE
+
+  CLASS (DAT), POINTER :: POINTA => NULL(), POINTB => NULL()
+  CLASS (NODE), POINTER :: NDA => NULL(), NDB => NULL()
+
+  ALLOCATE (DAT :: POINTA)
+  ALLOCATE (DAT :: POINTB)
+  ALLOCATE (NODE :: NDA)
+  ALLOCATE (NODE :: NDB)
+
+  POINTA%NN = 5
+  NDA%PT => POINTA
+  NDA%KEY = 2
+  POINTB%NN = 10
+  NDB%PT => POINTB
+  NDB%KEY = 3
+
+  if (.NOT. NDA .LT. NDB) call abort()
+END
+
+! { dg-final { cleanup-modules "DAT_MOD NODE_MOD" } }