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

potential compiler bug with a particular case of polymorphism

Laasner__Raul
Beginner
321 Views

Is it a bug that the following compiles? I have a base type which contains a procedure that takes a user defined function as input. User defined functions are defined in extended types. The following compiles successfully with ifort-13.1.3:

[fortran]
module m

 


  implicit none

 


  type, abstract :: base
   contains
     procedure :: use_f
  end type base

 
  type, extends(base) :: extended
   contains
     procedure :: f
     procedure :: test ! calls use_f which takes f as argument
  end type extended

 


contains

  subroutine f(this)
    class(extended) :: this
  end subroutine f

 

  subroutine use_f(this, func)
    class(base) :: this
    interface
       subroutine func(this)
         import :: base
         class(base) :: this
       end subroutine func
    end interface
  end subroutine use_f

 

 

 subroutine test(this)
    class(extended) :: this
    call this%use_f(f) ! This is the important part!
  end subroutine test
end module m

 


end program
[/fortran]

However, even though 'base' is compatible with 'extended', they are not the same type, which conflicts with 12.5.9.1 of F2008 if I read it correctly. So the compiler should at least give a warning with the -std08 flag.

(The issue first emerged here http://stackoverflow.com/questions/18683436/gfortran-fails-with-a-particular-case-of-polymorphism#comment27522007_18683785 .)

0 Kudos
6 Replies
IanH
Honored Contributor II
321 Views

..."plausible extension"... clearly the user that answered your question on stack overflow has a tenuous grip on reality.  Here's an example that illustrates why the rules re the way they are in the standard.

[fortran]MODULE this_is_not_legal_fortran
  IMPLICIT NONE
 
  TYPE :: parent
  END TYPE parent
 
  TYPE, EXTENDS(parent) :: extension_A
    INTEGER :: i
  END TYPE extension_A
 
  TYPE, EXTENDS(parent) :: extension_B
    REAL :: r
  END TYPE extension_B
CONTAINS  
  ! Equivalent of use_f.
  SUBROUTINE use_proc(proc, object)
    INTERFACE
      SUBROUTINE proc(arg)
        IMPORT parent
        CLASS(parent), INTENT(IN) :: arg
      END SUBROUTINE proc
    END INTERFACE
    CLASS(parent), INTENT(IN) :: object
    CALL proc(object)
  END SUBROUTINE use_proc
 
  ! These two procedures look a little like the interface
  ! for the proc argument in use_proc.  The arg argument
  ! in the proc interface is type compatible with the arg
  ! arguments below.
 
  SUBROUTINE a_proc(arg)
    CLASS(extension_A), INTENT(IN) :: arg
    PRINT *, arg%i
  END SUBROUTINE a_proc
 
  SUBROUTINE b_proc(arg)
    CLASS(extension_B), INTENT(IN) :: arg
    PRINT *, arg%r
  END SUBROUTINE b_proc
 
  SUBROUTINE uh_oh
    TYPE(extension_A) :: a
    
    ! Uh oh!!!  If b_proc was actually called in use_proc, then the
    ! arg argument would be associated with an object of dynamic
    ! type a.  That's not going to work, hence the language prohibits it.
    CALL use_proc(b_proc, a)
  END SUBROUTINE uh_oh
END MODULE this_is_not_legal_fortran
[/fortran]

I see more incoherent babbling from the answering user in the comments to their answer.  Post here if you that noise doesn't make sense to you and you want further clarification.

0 Kudos
Laasner__Raul
Beginner
321 Views

Thanks for the example, I see your point. Running your code produces gargabe if I initialize 'a%i' to some value in 'uh_oh()' (otherwise it prints 0 without illustrating your point). So just to be clear, the above is in violation with Fortran rules and shouldn't compile? Because for me the compiler doesn't even give a warning.

0 Kudos
IanH
Honored Contributor II
321 Views

Yep - it clearly violates F2008 12.5.2.9 para 1.  ifort isn't required to diagnose this, but I suspect it has all the information required to determine that there's a violation so there's no real reason why it doesn't issue one, apart from oversight.

At the time I was thinking that if the arg argument was intent(in) or similar then maybe things could still work - but that's clearly rubbish. 

By the way - I wrote further comments on the answer, but the stackoverflow site got cross with me and told me to start a chat room.  I don't know if you've seen that.  Some of the characteristics of that site seem absurd to me.

0 Kudos
Steven_L_Intel1
Employee
321 Views

The section of the standard Ian referenced at stackoverflow, 12.5.2.9, isn't a numbered syntax rule or constraint, so the compiler isn't required to report the error. Generally, we do report this sort of mismatch so we will investigate why it didn't happen here.

0 Kudos
Steven_L_Intel1
Employee
321 Views

Escalated as issue DPD200247912.

0 Kudos
Steven_L_Intel1
Employee
321 Views

This has been fixed for version 15.0 later this year.

0 Kudos
Reply