Abstract Interface Problem

[Blane_J_]

module mod1

    type, abstract :: tp1
    contains
        private
        procedure(Isub1), pass, deferred :: sub1
    end type tp1

    abstract interface

        subroutine Isub1(this)
            import tp1
            class(tp1) :: this
        end subroutine Isub1

    end interface

end module mod1

module mod2
    use mod1

    type, abstract, extends(tp1) :: tp2
    contains
        private
        generic, public :: sub => sub1,&
                                  sub2
        procedure(Isub1), pass,   deferred :: sub1
        procedure(Isub2), nopass, deferred :: sub2
    end type tp2
    
    abstract interface

        subroutine Isub2(a)
            integer :: a
        end subroutine Isub2

    end interface

end module mod2

In the nested abstract types, interface Isub1 is inherited from tp1 but the compiler generates an error message of :

error #8262: For a type-bound procedure that has the PASS binding attribute, the first dummy argument must have the same declared type as the type being defined.

The error is clear, tp2 needs the first passed dummy argument to be of type tp2(or class tp2) but the inherited interface Isub1 declares the argument to be of type tp1(class tp1). So How should I design the abstract type tp1 to make it work ?

[IanH]

Just give the sub1 binding in tp2 a different name.

This was the topic of relatively recent interp material that the compiler may not have caught up with yet.

Because the tp1 type has a deferred binding that is private, it cannot be usefully used as a parent type outside of module mod1.

[Blane_J_]

ianh wrote:

Just give the sub1 binding in tp2 a different name.

This was the topic of relatively recent interp material that the compiler may not have caught up with yet.

Because the tp1 type has a deferred binding that is private, it cannot be usefully used as a parent type outside of module mod1.

I changed sub1 to sub10 in tp2 but the compiler showed no difference and the error still exist. I tried using public attribute on sub1 in tp1 but resulted error as well. So are you suggesting writing another interface other than Isub1 in tp2, IanH ?

[IanH]

Yes .... with hindsight.

Testing here with 17.0 update one, the compiler appears to be doing the right thing as per the corrected/clarified standard.  Originally I thought the repeat use of the same binding name for a different binding might be confusing it.

Could you please clarify what you are trying to do?  Why do you have two, independent bindings, with the same name?

This will compile with 17.0.1, but note again that neither type can actually be usefully used.  You can't override the sub1 binding in the tp1 type outside of the mod1 module, because that binding is private.  Similarly for the sub1 (which is a different binding to the one inherited from tp1!) and sub2 bindings in the tp2 type, outside of the mod2 module. 

If you make the sub1 binding in tp1 public, then it can be overridden, but then you need to change the name of the binding declared in sub2 to be something else, because otherwise it will conflict with that inherited and accessible binding.  If you just want tp2 to inherit the same sub1 binding from tp1, then you don't explicitly declare it in tp2.  You can't make a binding that is public in a parent type, private in an extension.

module mod1
    implicit none
    
    private     ! hides the abstract interface.
    
    type, abstract, public :: tp1
    contains
        private
        procedure(Isub1), pass, deferred :: sub1
    end type tp1
    
    abstract interface
        subroutine Isub1(this)
            import tp1
            implicit none
            class(tp1) :: this
        end subroutine Isub1
    end interface
end module mod1

module mod2
    use mod1
    implicit none
    
    type, abstract, extends(tp1) :: tp2
    contains
        private
        generic, public :: sub => sub1,&
                                  sub2
        procedure(Isub1), pass,   deferred :: sub1
        procedure(Isub2), nopass, deferred :: sub2
    end type tp2
    
    abstract interface
        subroutine Isub1(this)
            import tp2
            implicit none
            class(tp2) :: this
        end subroutine Isub1
        
        subroutine Isub2(a)
            implicit none
            integer :: a
        end subroutine Isub2
    end interface
end module mod2

[Blane_J_]

type, abstract :: level0

contains
    ! ---> Some most basic methods (assume 3 funcs) waiting to be implemented, deferred.
end type level0

type, bastract, extends(level0) :: level1
contains
    ! ---> Some basic methods (assume another 3 funcs not associated of any kind with previous) to improve functionality, deferred as well.
end type level1

type, extends(level1) :: level2
    ! ---> Some data entities.
contains
    ! ----> Impementations of all the abstract methods (here we have 6 funcs), other functionalities may be add here too.
end type level2

I am looking forward to implement a three-level type structure. level0 is the base, level1 is higher than level0 and level2 is higher than level1. level0 and level1 are both abstract and level2 is the implementation. It works all right until GENERIC binding is used. How shall I resolve it ?

[IanH · Accepted solution]

module some_module
  implicit none
  
  type, abstract :: level0
  contains
    procedure(l0_jump), deferred :: jump
    procedure(l0_skip), deferred :: skip
    procedure(l0_hop), deferred :: hop
    
    ! Some generics that stick the above specifics behind a common
    ! name.  
    generic :: elevate => jump, skip, hop
    generic :: exercise => jump, skip, hop
  end type level0
  
  ! All these take a second scalar argument that differs in type, 
  ! so that they can be part of the same generic.
  abstract interface
    subroutine l0_jump(arg, i)
      import :: level0
      implicit none
      class(level0), intent(inout) :: arg
      integer, intent(in) :: i
    end subroutine l0_jump
    
    subroutine l0_skip(arg, r)
      import :: level0
      implicit none
      class(level0), intent(inout) :: arg
      real, intent(in) :: r
    end subroutine l0_skip
    
    subroutine l0_hop(arg, l)
      import :: level0
      implicit none
      class(level0), intent(inout) :: arg
      logical, intent(in) :: l
    end subroutine l0_hop
  end interface
  
  type, abstract, extends(level0) :: level1
  contains
    ! We inherit jump, skip, hop specifics, and the exercise and 
    ! elevate generics.
    
    ! Some specific bindings, specific to extensions of level1 
    ! (where the terminology is such that "extension of x" includes 
    ! x itself).
    procedure(l1_walk), deferred :: walk
    procedure(l1_jog), deferred :: jog
    procedure(l1_run), deferred :: run
    ! A generic binding, only for extensions of level1 and, in this case, 
    ! only using specifics from level1.
    generic :: relocate => walk, jog, run
    
    ! Adds some specific bindings to the generic that 
    ! was established in level1.  These additional 
    ! specifics are only considered when the 
    ! declared type is an extension of level1 
    generic :: exercise => walk, jog, run
    
    ! Another generic, specific to extensions of level1, that has 
    ! a mix of specifics from level0 and level1
    generic :: warm_up => skip, jog
  end type level1
  
  ! All these take a second rank one array argument that 
  ! differs in type - so they can be part of the same generic 
  ! and can be part of the same generic as in the level0 type 
  ! (because those specifics took scalars).
  abstract interface
    subroutine l1_walk(arg, i)
      import :: level1
      implicit none
      class(level1), intent(inout) :: arg
      integer, intent(in) :: i(:)
    end subroutine l1_walk
    
    subroutine l1_jog(arg, r)
      import :: level1
      implicit none
      class(level1), intent(inout) :: arg
      real, intent(in) :: r(:)
    end subroutine l1_jog
    
    subroutine l1_run(arg, l)
      import :: level1
      implicit none
      class(level1), intent(inout) :: arg
      logical, intent(in) :: l(:)
    end subroutine l1_run
  end interface
  
  type, extends(level1) :: level2
      ! ---> Some data entities.
  contains
    ! Implementation of all the deferred bindings that we've 
    ! picked up from our parents.
    procedure :: jump => l2_jump
    procedure :: skip => l2_skip
    procedure :: hop => l2_hop
    procedure :: walk => l2_walk
    procedure :: jog => l2_jog
    procedure :: run => l2_run
  end type level2
contains
  subroutine l2_jump(arg, i)
    class(level2), intent(inout) :: arg
    integer, intent(in) :: i
  end subroutine l2_jump
  
  subroutine l2_skip(arg, r)
    class(level2), intent(inout) :: arg
    real, intent(in) :: r
  end subroutine l2_skip
  
  subroutine l2_hop(arg, l)
    class(level2), intent(inout) :: arg
    logical, intent(in) :: l
  end subroutine l2_hop
  
  subroutine l2_walk(arg, i)
    class(level2), intent(inout) :: arg
    integer, intent(in) :: i(:)
  end subroutine l2_walk
  
  subroutine l2_jog(arg, r)
    class(level2), intent(inout) :: arg
    real, intent(in) :: r(:)
  end subroutine l2_jog
  
  subroutine l2_run(arg, l)
    class(level2), intent(inout) :: arg
    logical, intent(in) :: l(:)
  end subroutine l2_run
end module some_module

All the bindings in the above are public by default.  If they were private, then they would not be accessible outside of the module and could not be overridden.

[Blane_J_]

Thanks a lot, IanH, that's just what I meant to do. Unfortunately there seems still something wrong with the warm_up generic in level1, the compiler generates :

------ Build started: Project: Test, Configuration: Debug|Win32 ------

Compiling with Intel(R) Visual Fortran Compiler 17.0.1.143 [IA-32]...
Test.f90
D:\Project\Test\Test.f90(1560): error #8423: In GENERIC type bound procedure definition each binding name must be the name of a specific binding of the type.   [SKIP]
compilation aborted for D:\Project\Test\Test.f90 (code 1)

Build log written to  "file://D:\Project\Test\Debug\BuildLog.htm"
Test - 2 error(s), 0 warning(s)

---------------------- Done ----------------------

I don't see any mistakes within the code so I am confusing too.

[IanH]

(I corrected some spelling mistakes in the original post, and provided implementations of the l2_xxx procedures.)

I think that error is a compiler bug.  skip is inherited and accessible from level0 - it is a binding of the type.

[Steven_L_Intel1]

Yes, this is a bug already being investigated. Issue ID is DPD200256336.

[Blane_J_]

So just hope it'll be fixed in next release.

[IanH]

It is easy enough to work around - just declare another binding in level1, with its procedure forwarding to the skip binding.  See the skipx binding in the attached.

[Blane_J_]

Steve Lionel (Intel) wrote:

Yes, this is a bug already being investigated. Issue ID is DPD200256336.

So is there a list I can refer to that whether the second update has had this issue fixed then?

[Steve_Lionel]

Unfortunately, not at the present time. One of the Intel folks (I retired at the end of last year) can look up the issue and tell you the status.

[Kevin_D_Intel]

This issue has not been fixed yet.

[Blane_J_]

Oops... Then just look foreword to be fixed soon.