[Bug fortran/123772] New: [OOP] Missed function result finalization when using defined assignment

[abensonca at gcc dot gnu.org via Gcc-bugs]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=123772

            Bug ID: 123772
           Summary: [OOP] Missed function result finalization when using
                    defined assignment
           Product: gcc
           Version: 16.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: abensonca at gcc dot gnu.org
  Target Milestone: ---

The following code misses finalization of a function result with current
gfortran:

module rmm
  private
  public :: rm

  type :: rm
     integer, pointer :: counter => null()
   contains
     final     :: rmDestructor
     procedure :: rmAssign
     generic   :: assignment(=) => rmAssign
  end type rm

  interface rm
     module procedure rmConstructor
  end interface rm

contains

  function rmConstructor() result(self)
    implicit none
    type(rm) :: self
    allocate(self%counter)
    self%counter=1
    write (*,'(a,i1)') '  rm construct - count = ',self%counter
    return
  end function rmConstructor

  subroutine rmDestructor(self)
    implicit none
    type(rm), intent(inout) :: self
    if (.not.associated(self%counter)) return
    self%counter=self%counter-1
    write (*,'(a,i1)') '  rm destruct - count = ',self%counter
    nullify(self%counter )
    return
  end subroutine rmDestructor

  subroutine rmAssign(to,from)
    implicit none
    class(rm), intent(  out) :: to
    class(rm), intent(in   ) :: from
    if (associated(from%counter)) then
       to%counter => from%counter
       to%counter =  to  %counter+1
       write (*,'(a,i1)') '  rm assign - count = ',to%counter
    else
       to%counter  => null()
    end if
    return
  end subroutine rmAssign

end module rmm

module hom
  use :: rmm, only : rm
  implicit none
  private
  public :: ho

  type ho
    private
    type(rm) :: fm
   contains
     final     ::                  hoDestructor
     procedure ::                  hoAssign
     generic   :: assignment(=) => hoAssign
  end type ho

  interface ho
     module procedure hoConstructor
  end interface ho

contains

  subroutine hoDestructor(self)
    implicit none
    type(ho), intent(inout) :: self
    write (*,'(a)') " ho destruct"    
    return
  end subroutine hoDestructor

  subroutine hoAssign(to,from)
    implicit none
    class(ho), intent(  out) :: to
    class(ho), intent(in   ) :: from

    write (*,'(a)') " ho assign"    
    to%fm=from%fm
    return
  end subroutine hoAssign

  function hoConstructor() result(self)
    implicit none
    type(ho) :: self

    write (*,'(a)') " ho construct"    
    self%fm=rm()
    return
  end function hoConstructor

end module hom

program bug
  use :: hom, only : ho 
  implicit none
  type(ho) :: fileObject
  write (*,'(a)') "start"
  fileObject=ho()
  write (*,'(a)') "end"  
end program bug


$ gfortran -v
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/carnegie/nobackup/users/abenson/upstream/libexec/gcc/x86_64-pc-linux-gnu/16.0.0/lto-wrapper
Target: x86_64-pc-linux-gnu
Configured with: ../configure
--prefix=/carnegie/nobackup/users/abenson/upstream --disable-multilib
--enable-checking=release --enable-host-shared --with-pic
--enable-languages=c,c++,fortran,jit,lto : (reconfigured) ../configure
--prefix=/carnegie/nobackup/users/abenson/upstream --disable-multilib
--enable-checking=release --enable-host-shared --with-pic
--enable-languages=c,c++,fortran,jit,lto : (reconfigured) ../configure
--prefix=/carnegie/nobackup/users/abenson/upstream --disable-multilib
--enable-checking=release --enable-host-shared --with-pic
--enable-languages=c,c++,fortran,jit,lto --no-create --no-recursion
Thread model: posix
Supported LTO compression algorithms: zlib zstd
gcc version 16.0.0 20260108 (experimental) (GCC) 

$ gfortran bug.F90
$ ./a.out
start
 ho construct
  rm construct - count = 1
  rm assign - count = 2
  rm destruct - count = 1
 ho destruct
 ho assign
  rm assign - count = 2
end

There should be another `ho destruct` and `rm destruct` before the `end` as a
result of finalizing the function result after assigning it. For example, using
ifort:

$ ifort bug.F90
$ ./a.out
start
 ho construct
  rm construct - count = 1
  rm assign - count = 2
  rm destruct - count = 1
 ho destruct
 ho assign
  rm assign - count = 2
 ho destruct
  rm destruct - count = 1
end

This problem does not occur if the defined assignment for the `ho` type is
removed.