# Intrinsic comparison operator in polymorphic subroutine

**URL:** <https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618>\
**Category:** Help\
**Created:** [April 21, 2023, 6:17am UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618 "2023-04-21T06:17:28Z")\
**Posts on this page:** 7\
**Page:** 1

<div class="post-metadata">

**Author:** ![FedericoPerini](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/federicoperini/32/1750_2.png) [@FedericoPerini](https://fortran-lang.discourse.group/u/FedericoPerini)\
**Post date:** [April 21, 2023, 6:17am UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/1 "2023-04-21T06:17:28Z")

</div>

Hello fortran-lang community,

I need to compare polymorphic entities (`a==b`) a lot and I always struggle writing a lot of bloatware that basically just replicates the intrinsic comparison operator. Here’s the easiest way I came up with to accomplish that:

```fortran
type, abstract :: base
contains
    procedure(equality), deferred, private :: is_equal
    generic :: operator(==) => is_equal
end type base

type, extends(base) :: ext
contains
   procedure :: ext_is_equal => is_equal
end type

abstract interface
   elemental logical function equality(this,that) 
       import base
       class(base), intent(in) :: this, that
   end function equality
end interface 

! For each extended type, need to write this one
elemental logical function ext_is_equal(this,that)
    class(ext), intent(in) :: this
    class(base), intent(in) :: that

    select type (that_type => that)
        type is (ext)
            ext_is_equal = that_type == this ! use intrinsic comparison 
        class default
            ext_is_equal = .false.
    end select
end function ext_is_equal 

```

Now I need to write that such routine for each and every extended class, just to use the intrinsic operator. Is this the easiest strategy, or am I missing something?  
I would like e.g. to make usage of `same_type_as(a,b)` but I can’t because it’s not in a `select type` block.

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [April 21, 2023, 12:38pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/2 "2023-04-21T12:38:13Z")

</div>

Is this what you are trying to do?

```fortran
module mammals
implicit none
type, abstract :: mammal
end type
type, extends(mammal) :: dog
end type
type, extends(mammal) :: cat
end type
interface operator(==)
module procedure is_equal
end interface
contains
elemental logical function is_equal(A,B)
class(mammal), intent(in) :: A, B
is_equal = same_type_as(A,B)
end function
end module
program main
use mammals
implicit none
class(mammal), allocatable :: petA, petB, petC
allocate(dog :: petA)
allocate(cat :: petB)
allocate(cat :: petC)
write(*,'(A,L1)') "Are A and B same mammal? ", petA == petB
write(*,'(A,L1)') "Are B and C same mammal? ", petB == petC 
end program

```

---

<div class="post-metadata">

**Author:** ![FedericoPerini](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/federicoperini/32/1750_2.png) [@FedericoPerini](https://fortran-lang.discourse.group/u/FedericoPerini)\
**Post date:** [April 21, 2023, 12:45pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/3 "2023-04-21T12:45:09Z")

</div>

Thak you Ivan - I’m trying to get to the _full_ intrinsic comparison, i.e., not only the type, but also all of its contents.

i.e. if my extended class is

```fortran
type, extends(base) :: animal
   integer :: legs
   logical :: tail
   real :: max_speed
end type animal

```

I also need to implement

```fortran
elemental logical function ani_is_equal(this,that)
    class(animal), intent(in) :: this
    class(base), intent(in) :: that

    select type (that_type => that)
        type is (animal)
            ani_is_equal = that_type%legs == this%legs .and. &
                           that_type%max_speed == this%max_speed .and. &
                           that_type%tail .eqv. this%tail
        class default
            ani_is_equal = .false.
    end select
end function ani_is_equal

```

which is error-prone and could be totally avoided, it is just a reimplementation of the intrinsic `==` for two entities of the same type.

---

<div class="post-metadata">

**Author:** ![FortranFan](https://avatars.discourse-cdn.com/v4/letter/f/96bed5/32.png) [@FortranFan](https://fortran-lang.discourse.group/u/FortranFan)\
**Post date:** [April 21, 2023, 1:17pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/4 "2023-04-21T13:17:49Z")

</div>

> [@FedericoPerini](#):
>
> I also need to implement
> 
> …
> 
> which is error-prone and could be totally avoided, it is just a reimplementation of the intrinsic `==` for two entities of the same type.

@FedericoPerini , you can make a proposal at the GitHub J3 site on this and perhaps also look “under the hood” with gfortran, LFortran, etc. compiler implementatoins and consult with @certik et al. to see how much the processor itself can do this automagically for the practitioners, a la intrinsic assignment.

Note from the standard committee perspective, since the Fortran 90 days, the view appears appears to be that comparison operations with derived types are the responsibility of the author(s) of said types, that this cannot be “avoided”, meaning the processor cannot do this for you - hence my suggestion above to challenge such thinking.

My hunch is also there will not be acceptance that it is any more “error-prone” than authoring the type itself.

As things stand now with the current standard including in the works “Fortran 2023”, what you are doing with **defined** operations is the only option you have. You can pursue somewhat different takes on this depending on your situation but you still need to implement **defined** operations.

---

<div class="post-metadata">

**Author:** ![FedericoPerini](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/federicoperini/32/1750_2.png) [@FedericoPerini](https://fortran-lang.discourse.group/u/FedericoPerini)\
**Post date:** [April 21, 2023, 1:26pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/5 "2023-04-21T13:26:10Z")

</div>

I’ve got very much your same feeling. Hopefully with more and more people embracing the more advanced Fortran features, the practitioners will tell what design patterns in the language they stumble upon more often, that they may require an adjustment 🙂

BTW: the intrinsic comparison operator is (I believe) already natively available for all types.

---

<div class="post-metadata">

**Author:** ![ivanpribec](https://yyz2.discourse-cdn.com/free1/user_avatar/fortran-lang.discourse.group/ivanpribec/32/3290_2.png) [@ivanpribec](https://fortran-lang.discourse.group/u/ivanpribec)\
**Post date:** [April 21, 2023, 2:19pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/6 "2023-04-21T14:19:50Z")

</div>

Thanks for providing the extra example. It makes more sense when there are additional properties to compare. On the other hand the notion of comparison between polymorphic entities feels kind of ambiguous.

If you know you are working only with `animal`’s (and not also `plant`’s, `protozoa`, `bacteria`…), you should use a concrete/non-polymorphic type:

```auto
type(animal), allocatable :: group(:) ! <- intrinsic comparison available

```

A polymorphic comparison/equality makes more sense to me when you’d use it compare properties which exist for all child types:

```fortran
module mammals
implicit none
type :: mammal
   integer :: weight
end type
type, extends(mammal) :: dog
   character(32) :: furcolor
end type
type, extends(mammal) :: cat
   integer :: lives
end type
interface operator(==)
   module procedure are_equal_species_and_weigh_the_same
end interface
contains
logical function are_equal_species_and_weigh_the_same(A,B) result(equal)
   class(mammal), intent(in) :: A, B
   equal = same_type_as(A,B) .and. A%weight == B%weight
end function
end module

program main
use mammals
implicit none
class(mammal), allocatable, target :: petA, petB
petA = dog(weight=30,furcolor="brown")
petB = cat(weight=10,lives=7)
petC = dog(weight=30,furcolor="white")
write(*,'(A,L1)') 'Are pet A and B "equal"? ', petA == petB ! .false., different species
write(*,'(A,L1)') 'Are pet A and C "equal"? ', petA == petC ! .true., same species, same weight
end program

```

FWIW, your original solution appears to match the accepted answer on StackOverflow: [c++ - Class Polymorphism and equality operators - Stack Overflow](https://stackoverflow.com/questions/29380047/class-polymorphism-and-equality-operators); the base class cannot know what you mean by “equality”, so it has to be provided by the child:

```cpp
#include <iostream>
#include <string>
#include <typeinfo>

class Base
{
public:
    virtual ~Base() {}

    bool operator==(const Base& other) const
    {
        // If the derived types are the same then compare them
        return typeid(*this) == typeid(other) && isEqual(other);
    }

private:
    // A pure virtual function derived classes must implement.
    // Furthermore, this function has a precondition that it will only
    // be called when the 'other' is the same type as the instance
    // invoking the function.
    virtual bool isEqual(const Base& other) const = 0;
};

```

(In the C++ code, I guess short-circuiting applies to expression which first compares the `typeid`.)

---

<div class="post-metadata">

**Author:** ![FortranFan](https://avatars.discourse-cdn.com/v4/letter/f/96bed5/32.png) [@FortranFan](https://fortran-lang.discourse.group/u/FortranFan)\
**Post date:** [April 21, 2023, 9:47pm UTC](https://fortran-lang.discourse.group/t/intrinsic-comparison-operator-in-polymorphic-subroutine/5618/7 "2023-04-21T21:47:21Z")

</div>

> [@FedericoPerini](#):
>
> … I always struggle writing a lot of bloatware that basically just replicates the intrinsic comparison operator …

> [@ivanpribec](#):
>
> … If you know you are working only with `animal`’s (and not also `plant`’s, `protozoa`, `bacteria`…), you should use a concrete/non-polymorphic type: …

@FedericoPerini and any other reader interested in OO designs in Fortran:

So as indicated by @ivanpribec , there are a couple of aspects you may want to consider when it comes to **defined** operations (and assignment) with derived types in Fortran, particularly when OO patterns including polymorphism is of interest:

1. When it comes to defined operations, consider direct generic interfaces instead of type-bound generics,
2. Start with as abstract an type as the base class as can be envisioned e.g., `animal` class,
3. Make judicial use of **intermediate** concrete extensions to help here, particularly with type-safe operations e.g., a `mammal` class which then allows type extension to morph into other classes such as cats and dogs,
4. Realize there is no getting away from considerable boilerplate code in current standard Fortran including the 2023 revision

Thus for the example discussed here, you can do:

> **Click to see code**
>
> ```fortran
> module animal_m
> private
> type, abstract, public :: animal_t
> ! base class properties
> real :: body_mass = 0.0
> contains
> private
> procedure(Icompare), deferred, public :: is_equal
> procedure :: is_not_equal
> generic, public :: operator(/=) => is_not_equal !<-- perhaps this is Ok
> end type
> abstract interface
> impure elemental function Icompare( lhs, rhs) result(r) !<-- Impure for IO
> import :: animal_t
> class(animal_t), intent(in) :: lhs
> class(animal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> end function
> end interface
> contains
> impure elemental function is_not_equal( lhs, rhs) result(r)
> ! Argument list
> class(animal_t), intent(in) :: lhs
> class(animal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> r = .not. lhs%is_equal( rhs )
> end function
> end module 
> module mammal_m
> ! Intermediate concrete class
> use animal_m, only : animal_t
> private
> type, extends(animal_t), public :: mammal_t
> character(len=10) :: fur_color = ""
> contains
> private
> procedure, public :: is_equal => is_equal_mammal_animal
> end type
> !generic, public :: operator(==) => is_equal_mammal !<-- Fortran 2018
> interface operator(==)
> module procedure :: is_equal_mammal
> end interface 
> public :: operator(==) 
> contains
> impure elemental function is_equal_mammal_animal( lhs, rhs ) result(r)
> ! Argument list
> class(mammal_t), intent(in) :: lhs
> class(animal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_mammal_animal"
> r = .false.
> select type ( rhs )
> type is ( mammal_t )
> r = is_equal_mammal( lhs, rhs )
> class default 
> end select
> end function
> impure elemental function is_equal_mammal( lhs, rhs ) result(r)
> ! Argument list
> type(mammal_t), intent(in) :: lhs
> type(mammal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_mammal"
> r = ( lhs%fur_color == rhs%fur_color ) .and. &
> ( lhs%body_mass == rhs%body_mass )
> end function
> end module 
> module cat_m
> ! Extended concrete class
> use animal_m, only : animal_t
> use mammal_m, only : mammal_t, operator(==)
> private
> type, extends(mammal_t), public :: cat_t
> integer :: number_of_lives = 7
> contains
> private
> procedure, public :: is_equal => is_equal_cat_animal
> end type
> !generic, public :: operator(==) => is_equal_cat
> interface operator(==)
> module procedure :: is_equal_cat
> end interface
> public :: operator(==) 
> contains
> impure elemental function is_equal_cat_animal( lhs, rhs ) result(r)
> ! Argument list
> class(cat_t), intent(in) :: lhs
> class(animal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_cat_animal"
> r = .false.
> select type ( rhs )
> type is ( cat_t )
> r = is_equal_cat( lhs, rhs )
> class default 
> end select
> end function
> impure elemental function is_equal_cat( lhs, rhs ) result(r)
> ! Argument list
> type(cat_t), intent(in) :: lhs
> type(cat_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_cat"
> r = ( lhs%number_of_lives == rhs%number_of_lives ) .and. &
> ( lhs%mammal_t == rhs%mammal_t )
> end function
> end module
> module dog_m
> ! Extended concrete class
> use animal_m, only : animal_t
> use mammal_m, only : mammal_t, operator(==)
> private
> type, extends(mammal_t), public :: dog_t
> character(len=10) :: breed = ""
> contains
> private
> procedure, public :: is_equal => is_equal_dog_animal
> end type
> !generic, public :: operator(==) => is_equal_dog
> interface operator(==)
> module procedure :: is_equal_dog
> end interface 
> public :: operator(==) 
> contains
> impure elemental function is_equal_dog_animal( lhs, rhs ) result(r)
> ! Argument list
> class(dog_t), intent(in) :: lhs
> class(animal_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_dog_animal"
> r = .false.
> select type ( rhs )
> type is ( dog_t )
> r = is_equal_dog( lhs, rhs )
> class default 
> end select
> end function
> impure elemental function is_equal_dog( lhs, rhs ) result(r)
> ! Argument list
> type(dog_t), intent(in) :: lhs
> type(dog_t), intent(in) :: rhs
> ! Function result
> logical :: r
> print *, "In is_equal_dog"
> r = ( lhs%breed == rhs%breed ) .and. &
> ( lhs%mammal_t == rhs%mammal_t )
> end function
> end module
> use mammal_m
> use cat_m
> use dog_m
> class(mammal_t), allocatable :: Lucy, Jasper
> type(cat_t) :: Milo
> type(dog_t) :: Luna, Sur
> logical :: chk
> Lucy = cat_t(fur_color="brown") ; Jasper = cat_t(fur_color="black")
> chk = Lucy == Jasper
> print *, chk
> Milo = cat_t(fur_color="golden")
> Luna = dog_t(breed="Poodle")
> Sur = dog_t(breed="Labrador")
> chk = Luna == Sur 
> print *, chk
> !chk == Sur == Milo !<-- compiler error, only as expected and likely desired
> end
> 
> ```

```auto
C:\temp>gfortran -ffree-form p.f -o p.exe

C:\temp>p.exe
 In is_equal_mammal
 F
 In is_equal_dog
 In is_equal_mammal
 F

```