diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/typebound_operator_6.f03 | 73 |
4 files changed, 86 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 55f57fc..f748da6 100644 --- 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 --- 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 --- 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 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" } } |