Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.
28744 Discussions

Type Bound Generic Assignment Bug Using Intrinsic Assignments

schiffmann__florian
398 Views

Hello everybody,

I assume I ran into a bug with Intel Fortran 19.0.5.281. I ran into this problem writing a reference counting scheme.

The problem can be tested with this program:

 

MODULE Classes

    IMPLICIT NONE

    TYPE Inner_
       INTEGER                       :: iCount=0
    END TYPE

    TYPE Inner
       CLASS(Inner_), POINTER         :: this => NULL()
       CONTAINS
       PROCEDURE                     :: init
       PROCEDURE                     :: assignMe
       GENERIC                       :: assignment(=) => assignMe 
       FINAL                         :: deleteIt
    END TYPE

    TYPE user
       TYPE(Inner)    :: mInner
    END TYPE
CONTAINS

   SUBROUTINE init(self)
      CLASS(Inner), INTENT(OUT)      ::  self

      ALLOCATE(Inner_ :: self%this)
      self%this%icount=1
   END SUBROUTINE 

   SUBROUTINE deleteIt(self)
      TYPE(Inner)          ::  self
      IF(ASSOCIATED(self%this)) THEN
         self%this%icount=self%this%icount-1
         IF(self%this%icount==0)DEALLOCATE(self%this)
      ENd IF
   END SUBROUTINE

   ELEMENTAL IMPURE SUBROUTINE assignMe(self, input)
      CLASS(Inner), INTENT(OUT)      ::  self
      CLASS(Inner), INTENT(IN)      ::  input
      
      IF(ASSOCIATED(input%this))THEN
         self%this=>input%this
         self%this%icount=self%this%icount+1
      END IF
   END SUBROUTINE

END MODULE

PROGRAM test

   USE Classes

   IMPLICIT NONE

WRITE(*,*)"Assign Each Element(Works as expected)"
   BLOCK
      TYPE(user)          :: mOuter(2), reassigned(2)

      CALL mOuter(1)%mInner%init()
      CALL mOuter(2)%mInner%init()
      reassigned(1)=mOuter(1)
      reassigned(2)=mOuter(2)
      WRITE(*,*)"mOuter(1)    ", mOuter(1)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"mOuter(2)    ", mOuter(2)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"reassigned(1)", reassigned(1)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"reassigned(2)", reassigned(2)%mInner%this%iCount , "EXPECTING 2"
   END BLOCK
WRITE(*,*)
WRITE(*,*)"Assign intrinsic vector(Does not increment reference count)"
   BLOCK
      TYPE(user)          :: mOuter(2), reassigned(2)

      CALL mOuter(1)%mInner%init()
      CALL mOuter(2)%mInner%init()
      reassigned=mOuter
      WRITE(*,*)"mOuter(1)    ", mOuter(1)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"mOuter(2)    ", mOuter(2)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"reassigned(1)", reassigned(1)%mInner%this%iCount , "EXPECTING 2"
      WRITE(*,*)"reassigned(2)", reassigned(2)%mInner%this%iCount , "EXPECTING 2"
   END BLOCK


END PROGRAM

The produced output is:

 Assign Each Element(Works as expected)
 mOuter(1)               2 EXPECTING 2
 mOuter(2)               2 EXPECTING 2
 reassigned(1)           2 EXPECTING 2
 reassigned(2)           2 EXPECTING 2

 Assign intrinsic vector(Does not increment reference count)
 mOuter(1)               1 EXPECTING 2
 mOuter(2)               1 EXPECTING 2
 reassigned(1)           1 EXPECTING 2
 reassigned(2)           1 EXPECTING 2

 

As it can be seen, using an element by element assignment increases the counter by calling the type bound assignment.

However using a vector assignment for the outer class does not call the type bound assignment function.

I would expect the vector assignment to be a shorthand notation for the element by element assignment. Is this correct?

 

Best regards

Flo

0 Kudos
1 Reply
Steve_Lionel
Honored Contributor III
398 Views

I would expect the vector assignment to be a shorthand notation for the element by element assignment. Is this correct?

Yes. See paragraph 2 of Fortran 2018 section 10.2.1.4 (Defined Assignment).

A subroutine defines the defined assignment x1 = x2 if
... (5) either
(a) the ranks of x1 and x2 match those of d1 and d2 or 
(b) the subroutine is elemental, x2 is scalar or has the same rank as x1, and there is no other
 subroutine that defines the assignment.

0 Kudos
Reply