compare_star.f90

module m_type0
    
    type :: Type0
    contains
        procedure :: eq => eq0
    end type Type0
    
contains
    
    logical function eq0(this,b)
        
        class(Type0) , intent(in)            :: this
        class (*) ,    intent(in)            :: b
        
        eq0 = .false.
        print *, "Unfortunatelly, type (Type0) comparison eq", eq0
        
    end function eq0
    
    logical function iseq0(a,b)
        class (Type0),  intent(in) :: a
        class (*),      intent(in) :: b
        
        iseq0 = a%eq(b)
        
    end function iseq0
        
end module m_type0


module m_type1
    use m_type0
    
    type, extends(Type0) :: Type1
        integer :: n1
    contains
        procedure :: eq => eq1
    endtype
    
    
contains

    logical function eq1(this,b)
        
        class(Type1) , intent(in)         :: this
        class (*)    , intent(in)            :: b
        
        eq1 = .false.
        select type ( b )
            class is ( Type1 )
                if (this%n1==b%n1) then
                    eq1 = .true.
                end if
        end select
        print *, "Hopefully, Type1 eq", eq1
    
    end function eq1

end module m_type1

module m_type2
    use m_type0
    
    type, extends(Type0) :: Type2
        integer :: n2
    contains
        procedure :: eq => eq2
    endtype
    
    
contains
    
    
    logical function eq2(this,b)
        
        class(Type2) , intent(in)         :: this
        class (*) ,    intent(in)            :: b
        
        eq2 = .false.
        select type ( b )
        class is ( Type2 )
        if (this%n2==b%n2) then
            eq2= .true.
            end if
        end select
        print *, "Hopefully, Type2 eq", eq2
    
    end function eq2

end module m_type2

module star
    use m_type0
    use m_type1
    use m_type2

    interface operator (.eq.)
        module procedure equals
    end interface

contains

    logical function equals (a, b)
        class(*), intent(in) :: a, b
        
        equals = .false.
        if ( same_type_as( a, b ) ) then
            
            print *, "equals(a,b):: same type"
            
            select type ( a )
                !Only our super class
                class is ( Type0 )
                    select type ( b )
                        class is ( Type0 )
                            equals = iseq0(a,b)
                        class default
                            error stop "Fortran Runtime Error: Incompatible types"
                    end select
            end select
        
        end if
        
    end function equals

end module star

program main
    use m_type1, only: Type1
    use m_type2, only: Type2
    use star

    class(*), allocatable :: a, b, c, d
    class(*), allocatable :: apples, oranges
    
    logical eq
    integer  :: i=2, j=2
    
    a = Type1( n1 = 100 )
    b = Type1( n1 = 100 )

    c = Type2( n2 = 200 )
    d = Type2( n2 = 200 )
    
    print *, "----------------------------------------------------"
    
    print *, "I'll Compare integers, I thought it should be equal:"
    eq = i == j
    print *, "MAIN PROGRAM: i == j is:", eq
    
    print *, "I'll Compare Type1 Objects, I thought it should be equal:"
    eq = a == b
    print *, "MAIN PROGRAM: a == b is:", eq
    
    print *, "I'll Compare Type2 Objects, I thought it should be equal:"
    eq = c == d
    print *, "MAIN PROGRAM: c == d is:", eq
    
    
    apples  = Type1( n1 = 100 )
    oranges = Type2( n2 = 100 )
    
    print *, "I'll Compare Apples & Oranges:"
    eq = apples == oranges
    print *, "MAIN PROGRAM: apples == oranges is:", eq
    
end

output.txt

$ cp ftest.f90 compare_star.f90
$ gfc compare_star.f90 && ./a.out
 ----------------------------------------------------
 I'll Compare integers, I thought it should be equal:
 MAIN PROGRAM: i == j is: T
 I'll Compare Type1 Objects, I thought it should be equal:
 equals(a,b):: same type
 Hopefully, Type1 eq T
 MAIN PROGRAM: a == b is: T
 I'll Compare Type2 Objects, I thought it should be equal:
 equals(a,b):: same type
 Hopefully, Type2 eq T
 MAIN PROGRAM: c == d is: T
 I'll Compare Apples & Oranges:
 MAIN PROGRAM: apples == oranges is: F