This is the mail archive of the gcc-bugs@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Bug fortran/60913] [OOP] Memory leak with allocatable polymorphic function result (in type-bound operator)


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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]