procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/45961 ([OOP] Problem with polymorphic type-bound operators)

Browse source 
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.

From-SVN: r165263
This commit is contained in:
Janus Weil 2010-10-10 23:35:10 +02:00
parent 6ea7f14af8
commit d3735479a3
4 changed files with 86 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -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.

2
gcc/fortran/resolve.c
View file

@ -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;

7
gcc/testsuite/ChangeLog
View file

@ -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.

73
gcc/testsuite/gfortran.dg/typebound_operator_6.f03 Normal file
View file

@ -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" } }