procedure pointer in derived type gets unassociated

[Meyer__Knut_Andreas]

Hi.

In my program I have several procedure pointers in a large derived type (with sub derived types). However, the pointers seem to become unassociated for some specific cases and I don't understand why. I would be very grateful if someone can give me hints on what I'm doing wrong and how a more stable behavior can be achieved!

Below is an as small example as I was able to create to show the behavior.

I get the following output depending on my settings (A,B,C):

A: As below
B: Comment out line 28
C: Comment out line 90 and 92, remove comment on line 89

Earlier in the digging down I also experienced a case D, but I haven't been able to reproduce this in a smaller example...

 Setting                              =  A | B | C | D
 get_lev2_2, lev2_2%addr              :  T   T   T   T
 get_lev1_2, lev1_2_tmp(1)%lev2_2%addr:  F   T   T   T
 get_lev1_2, lev1_2(1)%lev2_2%addr    :  F   T   F   T
 get_main, main%lev1_2(1)%lev2_2%addr :  F   T   F   T
 get_main, main%lev1_1%addr           :  T   T   T   T
 top_level, main%lev1_1%addr          :  T   T   T   T
 top_level, main%lev1_2(1)%lev2_2%addr:  F   T   F   F

This is running with Visual Studio 2012 and ifort 14.0.1.139

Running the same example on linux with ifort 18.0.1 and  gfortran 7.3.0 all tests are true.

module tmpl_mod
    implicit none
    abstract interface       
        subroutine sub_template(x,f)
            double precision, intent(in) :: x(:)
            double precision :: f(size(x))
        end subroutine
    end interface
    
    contains 
        
end module tmpl_mod
    
module types_mod
use tmpl_mod
    implicit none

    type lev1_1_typ
        integer                                :: k1
        procedure(sub_template),pointer,nopass :: addr
    end type
    
    type lev2_2_typ
        procedure(sub_template),pointer,nopass:: addr
    end type
    
    type lev1_2_typ 
        integer                        :: k1
        type(lev2_2_typ)               :: lev2_2
    end type
    
    type main_typ
        type(lev1_1_typ)                  :: lev1_1
        type(lev1_2_typ), allocatable     :: lev1_2(:)
    end type main_typ
    
end module types_mod
    
module ass_mod
    use tmpl_mod
    implicit none   
                
    character(len=4), parameter     :: lib_ext = '.dll'
    
    contains
    
    subroutine sub(x,f)
        double precision, intent(in) :: x(:)
        double precision :: f(size(x))
        f = 2.d0*x
    end subroutine
    
    subroutine ass_sub(proc_ptr)
    implicit none
        procedure (sub_template), pointer   :: proc_ptr
        proc_ptr => sub
    end subroutine
    
end module ass_mod
    
    
module get_mod
    use types_mod
    use ass_mod
    implicit none
    
    contains

subroutine get_main(main)
    implicit none
    type(main_typ) :: main
    
    call get_lev1_1(main%lev1_1)
    call get_lev1_2(main%lev1_2)
    write(*,*) 'get_main, main%lev1_2(1)%lev2_2%addr: ', associated(main%lev1_2(1)%lev2_2%addr)
    write(*,*) 'get_main, main%lev1_1%addr          : ', associated(main%lev1_1%addr)
    
end subroutine

subroutine get_lev1_1(lev1_1)
    implicit none
    type(lev1_1_typ)                  :: lev1_1
    call ass_sub(lev1_1%addr)
end subroutine

subroutine get_lev1_2(lev1_2)
    implicit none
    type(lev1_2_typ), allocatable       :: lev1_2(:)
   !type(lev1_2_typ)                    :: lev1_2_tmp(3)
    type(lev1_2_typ), allocatable       :: lev1_2_tmp(:)
    integer                             :: stype, k1
    allocate(lev1_2_tmp(3))
    k1 = 1
    call get_lev2_2(lev1_2_tmp(k1)%lev2_2)
    allocate(lev1_2(k1))
    lev1_2 = lev1_2_tmp(1:k1)
    write(*,*) 'get_lev1_2, lev1_2_tmp(1)%lev2_2%addr:', associated(lev1_2_tmp(1)%lev2_2%addr)
    write(*,*) 'get_lev1_2, lev1_2(1)%lev2_2%addr    : ', associated(lev1_2(1)%lev2_2%addr)
    
end subroutine

subroutine get_lev2_2(lev2_2)
    implicit none
    type(lev2_2_typ), intent(inout)        :: lev2_2
    
    call ass_sub(lev2_2%addr)
    write(*,*) 'get_lev2_2, lev2_2%addr: ', associated(lev2_2%addr)
    
end subroutine

end module get_mod
    
program top_level 
    use types_mod
    use get_mod
    implicit none
    type(main_typ)                 :: main
    
    call get_main(main)
    write(*,*) 'top_level, main%lev1_1%addr          : ', associated(main%lev1_1%addr)
    write(*,*) 'top_level, main%lev1_2(1)%lev2_2%addr: ', associated(main%lev1_2(1)%lev2_2%addr)
    
end program

[Steve_Lionel · Accepted solution]

It seems you already solved the problem by not using a five-year-old compiler. It would appear that you encountered a bug in the 14.0 compiler. 

[Meyer__Knut_Andreas]

Thank you Steve, that's good news that you think this is the reason!

I was afraid that my code was written in a bad way causing it to be unstable (I've learnt to never blame compiler bugs as it is usually my own bugs...)

//Knut