Polymorphic Parametrized Derived Types

[mehran]

I'm trying to use Parametrized Derived Types in my project and I noticed that the Parametrized  Derived Types are not working correctly with abstract classes and deferred methods.

The attached code is compiled and built successfully using ifort 2021.5.0 or ifort 19.1.3 on Visual Studio 2019  but the results are not correct. 

I have tested 7 different cases, and only non-polymorphic parameterized cases (Test 1 and Test 2) work correctly. All polymorphic parametrized derived cases (Tests 3 to 7) are producing wrong results. 

I would appreciate it if you can help with this issue. At this point, it seems to me this is a compiler bug. 

Please see additional comments for my sample code below. The visual studio project and all source codes are attached.

I have the following abstract derived types in the following modules. 

module base 
    
    implicit none
  
    type, abstract :: BaseClass(m,n)
       
        integer(kind = 4), len :: m
        integer(kind = 4), len :: n
        real(kind = 8), dimension(m,n) :: val
        
    contains 
        procedure(PrinteValueTemplate), deferred :: PrintValue 
        
    end type
    
    abstract interface 
        subroutine PrinteValueTemplate(this)
            import :: BaseClass
            class(BaseClass(*,*)), intent(inout) :: this
        end subroutine
    end interface

end module

module child 
    
    use base
    implicit none
  
    type, abstract, extends(BaseClass) :: ChildClass
        
        real(kind = 8), dimension(m) :: v1
        
    end type

    type, extends(ChildClass) :: ChildType
        
    contains
        procedure :: PrintValue => PrintChildValue
        
    end type
    
 contains
    
        subroutine PrintChildValue(this)
        class(ChildType(*,*)), intent(inout) :: this
        
        write(*,'(A10,I)') 'Dim1 = ', this%m
        write(*,'(A10,I)') 'Dim2 = ', this%n
        write(*,'(A10,2I)') 'M(m,n)) = ', size(this%val,1),  size(this%val,2)
        write(*,'(A10,I)') 'V1(m)) = ', size(this%v1)
    
     end subroutine

end module

module GrandChild 
    
    use child
    implicit none

    type, extends(ChildClass) :: GrandChildClass
        
        real(kind = 8), dimension(n) :: v2
        
    contains
        procedure :: PrintValue => PrintGrandChildValue
        
    end type
    
    type :: GrandChildClass_NoAbstract(m,n)
        
        integer, len :: m 
        integer, len :: n
        
        real(kind = 8), dimension(m,n) :: val
        real(kind = 8), dimension(m) :: v1
        real(kind = 8), dimension(n) :: v2
        
    contains
        procedure :: PrintValue => PrintGrandChildValue_NoAbstract
        
    end type    

contains
    
     subroutine PrintGrandChildValue(this)
        class(GrandChildClass(*,*)), intent(inout) :: this
        
        write(*,'(A10,I)') 'Dim1 = ', this%m
        write(*,'(A10,I)') 'Dim2 = ', this%n
        write(*,'(A10,2I)') 'M(m,n)) = ', size(this%val,1),  size(this%val,2)
        write(*,'(A10,I)') 'V1(m)) = ', size(this%v1)
        write(*,'(A10,I)') 'V2(n)) = ', size(this%v2)
    
     end subroutine
 
     subroutine PrintGrandChildValue_NoAbstract(this)
        class(GrandChildClass_NoAbstract(*,*)), intent(inout) :: this
        
        write(*,'(A10,I)') 'Dim1 = ', this%m
        write(*,'(A10,I)') 'Dim2 = ', this%n
        write(*,'(A10,2I)') 'M(m,n)) = ', size(this%val,1),  size(this%val,2)
        write(*,'(A10,I)') 'V1(m)) = ', size(this%v1)
        write(*,'(A10,I)') 'V2(n)) = ', size(this%v2)
    
     end subroutine    

end module

And this is the main program. In the following code only Test 1 and Test 2 (non-polymorphic types) are producing correct results. The results from deferred methods are not correct at all. 

program test_parametrized_drived_type
    
    use base
    use grandchild
    use Create
    
    implicit none
    
    
    type(GrandChildClass_NoAbstract(3,2)) :: e1
    type(GrandChildClass_NoAbstract(:,:)), allocatable :: e2
    
    type(GrandChildClass(3,2)) :: e3
    class(BaseClass(:,:)), allocatable :: e4, e5
    
    type(ChildType(:,:)), allocatable :: e6
    type(ChildType(3,2)) :: e7
    
    
    
    ! test 1
    write(*,*) '---- test1: Standard Parameterized Drived Type ----'
    write(*,*) '-- outside the function --'
    write(*,'(A10,I)') 'Dim1 = ', e1%m
    write(*,'(A10,I)') 'Dim2 = ', e1%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e1%val,1),  size(e1%val,2)
    write(*,'(A10,I)') 'V1(m)) = ', size(e1%v1)
    write(*,'(A10,I)') 'V2(n)) = ', size(e1%v2)      
    
    write(*,*) '-- inside the function --'
    call e1%PrintValue()    
    write(*,*)    
   
    ! test 2
    
    allocate(GrandChildClass_NoAbstract(3,2)::e2)
    write(*,*) '---- test2: Allocatable Parameterized Drived Type ----'
    write(*,*) '-- outside the function --'
    write(*,'(A10,I)') 'Dim1 = ', e2%m
    write(*,'(A10,I)') 'Dim2 = ', e2%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e2%val,1),  size(e2%val,2)
    write(*,'(A10,I)') 'V1(m)) = ', size(e2%v1)
    write(*,'(A10,I)') 'V2(n)) = ', size(e2%v2)      
    
    write(*,*) '-- inside the function --'
    call e2%PrintValue()    
    write(*,*)    
    
    ! test 3
    write(*,*) '---- test3: Declared Type with Two-Level-Abstract Class----'
    write(*,*) 'outside the deferred function'
    write(*,'(A10,I)') 'Dim1 = ', e3%m
    write(*,'(A10,I)') 'Dim2 = ', e3%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e3%val,1),  size(e3%val,2)
    write(*,'(A10,I)') 'V1(m)) = ', size(e3%v1)
    write(*,'(A10,I)') 'V2(n)) = ', size(e3%v2)  
    
    write(*,*) 'inside the deferred function'
    call e3%PrintValue()    
    write(*,*)
   
    ! test 4:
    allocate(GrandChildClass(3,2)::e4)

    write(*,*) '---- test4: Polymorphic variable and Two-Level-Abstract Class ----'
    write(*,*) '-- outside the deferred function --'
    
    write(*,'(A10,I)') 'Dim1 = ', e4%m
    write(*,'(A10,I)') 'Dim2 = ', e4%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e4%val,1),  size(e4%val,2)
    
    write(*,*) '-- inside the deferred function --'
    call e4%PrintValue()  
    write(*,*)
    
    ! test 5:
    allocate(ChildType(3,2)::e5)

    write(*,*) '---- test5: Polymorphic variable and One-Level-Abstract Class ----'
    write(*,*) '-- outside the deferred function --'
    
    write(*,'(A10,I)') 'Dim1 = ', e5%m
    write(*,'(A10,I)') 'Dim2 = ', e5%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e5%val,1),  size(e5%val,2)
    
    write(*,*) '-- inside the deferred function --'
    call e5%PrintValue()  
    write(*,*)
    
    ! test 6: 
    allocate(ChildType(3,2)::e6)
    write(*,*) '---- test6: Allocatble variable and One-Level-Abstract Class ----'
    write(*,*) '-- outside the deferred function --'
    
    write(*,'(A10,I)') 'Dim1 = ', e6%m
    write(*,'(A10,I)') 'Dim2 = ', e6%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e6%val,1),  size(e6%val,2)
    write(*,'(A10,I)') 'V1(m)) = ', size(e6%v1)
    
    write(*,*) '-- inside the deferred function --'
    call e6%PrintValue()  
    write(*,*)
    
    
    ! test 7
    write(*,*) '---- test7: Declared Type with One-Level-Abstract Class----'
    write(*,*) 'outside the deferred function'
    write(*,'(A10,I)') 'Dim1 = ', e7%m
    write(*,'(A10,I)') 'Dim2 = ', e7%n
    write(*,'(A10,2I)') 'M(m,n)) = ', size(e7%val,1),  size(e7%val,2)
    write(*,'(A10,I)') 'V1(m)) = ', size(e7%v1)
    
    write(*,*) 'inside the deferred function'
    call e7%PrintValue()    
    write(*,*)
    
end program

[FortranFan]

@mehran , to the best of my knowledge, Intel Fortran compiler has issues with such use cases of the parameterized derived types and polymorphic instances (I've submitted similar support requests in the past with these that are outstanding).  At first glance, your code looks alright from the PDT aspect; a minor nit will be your use of "I" format for output - look into the documentation, I believe the language requires width, or you can set it to zero e.g., I0 format descriptor.

If you have support subscription, please submit a request with your reproducer at Intel OSC:

https://supporttickets.intel.com/servicecenter?lang=en-US

Otherwise, one of this community's friends among the Intel Support team will likely pick up this incident from here.

[mehran]

Thank you for your comment. I will check with my system admin to see if we have support subscription.

Also thank you for pointing out the non-standard "I" format. it should be at least "I0".

[Steve_Lionel · Accepted solution]

I can reproduce this, and also see that the NAG compiler gets this right (once I fix up the non-standard I formats and use of byte lengths for kinds.)

[mehran]

Thanks Steve for testing my code. I will check to see if we have support subscription to follow up with this issue.

[Ron_Green]

for things that are obviously bugs like this, we can pull the issue from this forum to our bug database.  

Having a support subscription does allow you direct access to Online Support Center, and Premier Support.  And you get email when updates are made to the compiler, and access to past versions of the compiler.

So it has it's advantages.  But in these cases where it's clearly a bug and you have clean, clear reproducers we will pull them over and get them into bug tracking/fix. 

[Ron_Green]

bug ID is CMPLRLLVM-35573

[mehran]

Thanks for the following up. I'm looking forward to a fix in the future release. 

By the way, the following code doesn't produce correct results either. 

    ! BaseType works fine
    type :: BaseType(m,n)
        integer(kind = 4), len :: m
        integer(kind = 4), len :: n
        real(kind = 8), dimension(m,n) :: val
    contains
        procedure PrintValue => PrintBase
    end type
    
    ! Level1 extended type works fine
    type, extends(BaseType) :: Level1
    contains
        procedure PrintValue => PrintLevel1
    end type    
    
    ! Level2 extedned type (and afterward) doesn't work correctly
    ! m and n values are incorrect
    type, extends(Level1) :: Level2
    contains
        procedure PrintValue => PrintLevel2
    end type 
    
    type, extends(Level2) :: Level3
    contains
        procedure PrintValue => PrintLevel3
    end type

[Barbara_P_Intel]

Do you have a complete reproducer? I can file a bug report.