Function `associated` bug for Intel Fortran compiler?

Initially, in the process of learning procedure pointer, I made the following attempt:

module test_m

    implicit none
    private

    public :: f, set_method

    ! local procedure pointer
    procedure(func), pointer :: f

    abstract interface
        function func(x)
            character(*), intent(in) :: x
            character(:), allocatable :: func
        end function func
    end interface

contains

    ! set method
    subroutine set_method(ifunc)
        integer, intent(in) :: ifunc
        if (ifunc == 1) then
            if (.not. associated(f, starts)) f => starts ! This line 👈
        elseif (ifunc == 2) then
            !...
        end if
    end subroutine set_method

    function starts(x)
        character(*), intent(in) :: x
        character(:), allocatable :: starts
        starts = ">"//x
    end function starts

end module test_m

program main

    use test_m
    implicit none

    call set_method(1)
    print *, f("string")

end program main

This code works fine on gfortran and flang(old), returning the result:

 >string

But it fails on ifort:

/app/example.f90: catastrophic error: **Internal compiler error: segmentation violation signal raised** Please report this error along with the circumstances in which it occurred in a Software Problem Report.  Note: File and line given may not be explicit cause of this error.
compilation aborted for /app/example.f90 (code 1)

ifx shows that associated is not implemented:

ifx error
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x1376b6a]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10126fd]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x106beb2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x106be86]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0xfb2f5d]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0xfa9606]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10f19a5]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10f44e7]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10ea90e]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x106e741]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x1072233]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x104d5a1]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x104d407]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x104e26d]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10ba5c4]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bcea2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bd51c]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10ba687]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bcea2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bd51c]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bf79d]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bcea2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bd51c]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bac32]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bcea2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10ba34a]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x10bcea2]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0xf80496]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0xf7fc24]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0x11065be]
/lib/x86_64-linux-gnu/libc.so.6(__libc_start_main+0xf3)[0x7f0b682ce0b3]
/opt/compiler-explorer/intel-fortran-2021.4.0.3224/compiler/2021.4.0/linux/bin/xfortcom[0xd9d2a9]

/app/example.f90(24): error #5533: Feature found on this line is not yet supported in ifx 
            if (.not. associated(f, starts)) f => starts
------------^
compilation aborted for /app/example.f90 (code 3)

Remove the associated judgment , the code runs normally on all these compilers.

no-associated judgment
module test_m

    implicit none
    private

    public :: f, set_method

    ! local procedure pointer
    procedure(func), pointer :: f

    abstract interface
        function func(x)
            character(*), intent(in) :: x
            character(:), allocatable :: func
        end function func
    end interface

contains

    ! set method
    subroutine set_method(ifunc)
        integer, intent(in) :: ifunc
        if (ifunc == 1) then
            f => starts   ! Note here 👈
        elseif (ifunc == 2) then
            !...
        end if
    end subroutine set_method

    function starts(x)
        character(*), intent(in) :: x
        character(:), allocatable :: starts
        starts = ">"//x
    end function starts

end module test_m

program main

    use test_m
    implicit none

    call set_method(1)
    print *, f("string")

end program main

Online compiler: Compiler Explorer (godbolt.org)

Update: ICE: Function associated bug for Intel Fortran compiler (ifort)? - Intel Communities

4 Likes

Making a function pointer (starts_p) somewhere (as a local or module variable) and using it in the associated statement worked for me with ifort-2021.6 + Ubuntu20.

subroutine set_method(ifunc)
    integer, intent(in) :: ifunc

    procedure(starts), pointer :: starts_p => starts  !! (*)

    if (ifunc == 1) then
        if (.not. associated(f, starts_p)) f => starts  !! (*)

But declaring it as procedure(func), pointer gave an error like

test.f90(13): error #6303: The assignment operation
or the binary expression operation is invalid for
the data types of the two operands.   [STARTS]
    procedure(func), pointer :: starts_p => starts

which I cannot understand…

Anyway, I guess the internal compiler error (ICE) is an issue of the compiler (to be hopefully reported), regardless of the contents of the code itself.

2 Likes

@zoziha ,

As you will know, an internal compiler error can be viewed as a compiler bug regardless of any other considerations as to whether the code conforms, etc. As such, compiler developers are generally keen to get such errors reported to them.

So you may want to post this at the Intel Fortran forum as well; Intel Software Team follows up on such posts and forwards them to the Fortran team as appropriate:

2 Likes

We opened a bug report CMPLRIL0-34800. Thanks for sending this over to the Intel Fortran Community Forum.

3 Likes