This is the mail archive of the
gcc-bugs@gcc.gnu.org
mailing list for the GCC project.
[Bug fortran/60913] [OOP] Memory leak with allocatable polymorphic function result (in type-bound operator)
- From: "cmacmackin at gmail dot com" <gcc-bugzilla at gcc dot gnu dot org>
- To: gcc-bugs at gcc dot gnu dot org
- Date: Tue, 24 Jan 2017 17:48:46 +0000
- Subject: [Bug fortran/60913] [OOP] Memory leak with allocatable polymorphic function result (in type-bound operator)
- Auto-submitted: auto-generated
- References: <bug-60913-4@http.gcc.gnu.org/bugzilla/>
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=60913
--- Comment #5 from Chris <cmacmackin at gmail dot com> ---
Has there been any progress on this bug? It is making a large piece of
scientific software I have written unusable for decent resolution simulations.
I'm running gfortran 6.1.0, compiled with OpenCoarrays support.
Also, I've reduced the size of the reproducer:
Module Groups
Type, abstract :: Group
CONTAINS
Generic, Public :: Operator (*) => prod
Generic, Public :: Assignment (=) => equal
Procedure (gpr), deferred :: prod
Procedure (geq), deferred :: equal
End type Group
Type, extends (Group), abstract :: GaugeGroup
End type GaugeGroup
Abstract Interface
Function gpr(a, b)
Import :: Group
Class (Group), Intent (in) :: a, b
Class (Group), Allocatable :: gpr
End Function gpr
End Interface
Abstract Interface
Subroutine geq(a, b)
Import :: Group
Class (Group), Intent (in) :: b
Class (Group), Intent (out) :: a
End Subroutine geq
End Interface
End Module Groups
MODULE Group_SU2
USE Groups
IMPLICIT NONE
! Represent SU(2) element through quaternions
! (a_0, a_1, a_2, a_3)
Type, Extends (GaugeGroup) :: SU2
Real (kind=8) :: Comp(0:3)
CONTAINS
Procedure :: prod => prodsu2
Procedure :: equal => equalSU2
End Type SU2
CONTAINS
! *******************************************
! *
Subroutine EqualSU2(a, b)
! *
! *******************************************
! * Equals g1 to g2
! *******************************************
Class (SU2), Intent (out) :: a
Class (Group), Intent (in) :: b
select type (b)
class is (SU2)
a%Comp(0:3) = b%Comp(0:3)
class default
error stop
End select
Return
End Subroutine EqualSU2
! *******************************************
! *
Function Prodsu2(a,b) Result(g3)
! *
! *******************************************
! * Multiplies g1 by g2
! *******************************************
Class (SU2), Intent (in) :: a
Class (Group), Intent (in) :: b
Class (Group), allocatable :: g3
Allocate(SU2::g3)
select type (b)
class is (SU2)
select type (g3)
class is (SU2)
g3%Comp(0) = a%Comp(0)*b%Comp(0) - &
& Dot_Product(a%Comp(1:3),b%Comp(1:3))
g3%Comp(1) = a%Comp(0)*b%Comp(1) + a%Comp(1)*b%Comp(0) &
& + a%Comp(2)*b%Comp(3) - a%Comp(3)*b%Comp(2)
g3%Comp(2) = a%Comp(0)*b%Comp(2) - a%Comp(1)*b%Comp(3) &
& + a%Comp(2)*b%Comp(0) + a%Comp(3)*b%Comp(1)
g3%Comp(3) = a%Comp(0)*b%Comp(3) + a%Comp(1)*b%Comp(2) &
& - a%Comp(2)*b%Comp(1) + a%Comp(3)*b%Comp(0)
end select
class default
error stop
end select
Return
End Function Prodsu2
End MODULE GROUP_SU2
Program Testoo
USE Groups
USE Group_SU2
type(SU2) :: g1, g2, g3
ForAll (I=0:3) g1%comp(I) = 0.23_8*(I+1)
ForAll (I=0:3) g2%comp(I) = 0.32_8*(I+1)
Do I = 1, 2000
g3=g1*g2
End Do
Stop
End Program Testoo