2

Consider the following types.

TYPE, ABSTRACT:: base
...
  CONTAINS

  SUBROUTINE sanity_check
  END SUBROUTINE

END TYPE

TYPE, EXTENDS(base):: concrete1
...
END TYPE

TYPE, EXTENDS(base):: concrete2
...
END TYPE

where ... indicate some data which is not relevant for the question. The types concrete1 and concrete2 have their constructors defined in the code, and the subroutine sanity_check is also implemented.

Now, I would like to automatically execute sanity_check at the end of the constructors of concrete1 and concrete2. In other words, sanity_check should be executed at the end of the constructors of any type that extends base, without the need to call it explicitly in the constructors. This would be useful if other programmers were to write a type that extends base, to check that all the data has been initialized properly by their extended type, without the need for the programmer to call sanity_check explicitly.

Is this somehow possible? I have seen that it is possible to define an interface for an abstract type, but I don't know if that can be used to achieve what I describe above (or if it is of any use at all, since an abstract type cannot be instantiated by definition).

Frank
  • 97
  • 7
  • 1
    You can perhaps find much of this covered in [this other question](https://stackoverflow.com/q/30823756/3157076) and its answers. "Automatic" execution of procedures is, however, fairly rare in general. – francescalus Oct 29 '21 at 08:50
  • Thank you! That question is indeed very similar to mine, with the difference that I would like the call to the subroutine of the abstract base type to be automatic in the extended type. Otherwise, I can just call the subroutine explicitly, which is what I am doing now. – Frank Oct 29 '21 at 09:13
  • 1
    Essentially, there's no way for that call to be automatic. That's hinted at, rather than explicitly stated, in one of the answers. – francescalus Oct 29 '21 at 10:58
  • Thanks again. As a side question, which I mentioned in the original post, do you know what an interface of an abstract type would be useful for? – Frank Oct 29 '21 at 12:40
  • What do you mean by "interface of an abstract type"? Abstract types can appear in interface definitions, but they must be `class(base)` rather than `type(base)`. – francescalus Oct 29 '21 at 13:04
  • I mean an interface for the abstract type `base`, similarly to the declaration of the constructor for a non-abstract type. I can edit the main question and write an example, if that would clarify it. – Frank Oct 29 '21 at 13:16
  • You can have an interface for a _function_ named `base`, much as you'd have a function named `concrete1`. (It's a misnomer to call such a function a _constructor_, they are just generic functions which have the same name as a derived type, and they expressly make inaccessible the structure constructors of the types.) What you can't have is any instance of `base`, so while `concrete1()` can have a result `type(concrete1)`, the function `base` can't have a result `type(base)`. – francescalus Oct 29 '21 at 13:30
  • Right, I understand that I cannot have a result of type `base`. However, do I understand it correctly then: in the same module, I can have the **abstract** type `base` and a generic interface named also `base`, and they do not have anything to do with each other? If they instead have something to do with each other, what is their relationship? Is a procedure inside the generic interface `base` called when a **non-abstract** type that extends `base` is instantiated? – Frank Oct 29 '21 at 13:36
  • 1
    The relationship between a type and a generic function with the same name of that type is the basis of an interesting question (but perhaps a rather boring answer of "none"). But in another procedure, the only way to execute a `base` function is by explicitly referencing such a function (that's the "no automatic" part previously discussed). – francescalus Oct 29 '21 at 14:36
  • Ok, thank you! I will probably ask a new question about the relationship between type and generic function with the same name. – Frank Oct 29 '21 at 16:33

1 Answers1

1

As francescalus says, it's not possible to do exactly what you want.

However, if all of your constructors take the same arguments then you can get reasonably close to what you want by replacing your constructors with initialisation subroutines.

You can give the base class an initialise subroutine which initialises an object by first calling a deferred helper subroutine, and then calling sanity_check.

The base class would look something like:

module base_module
  implicit none
  
  type, abstract :: base
  contains
    procedure :: sanity_check
    procedure :: initialise
    procedure(helper_base), deferred :: helper
  end type
contains
  subroutine sanity_check(this)
    class(base), intent(in) :: this
  end subroutine
  
  subroutine initialise(this, args)
    class(base), intent(out) :: this
    integer, intent(in) :: args
    
    call this%helper(args)
    call this%sanity_check
  end subroutine
  
  abstract interface
    subroutine helper_base(this, args)
      import base
      class(base), intent(out) :: this
      integer, intent(in) :: args
    end subroutine
  end interface
end module

Each child class would then overload helper, and the initialise subroutine would automatically call sanity_check as desired.

A child class would look something like:

module concrete_module
  implicit none
  
  type, extends(base) :: concrete
  contains
    procedure :: helper => helper_concrete
  end type
contains
  subroutine helper_concrete(this, args)
    class(concrete), intent(out) :: this
    integer, intent(in) :: args
  end subroutine
end module

You would then construct a concrete object as e.g.

type(concrete) :: foo
integer :: args = 1
call foo%initialise(args)

If you wanted, you could re-introduce the foo = concrete(args) syntax by writing a thin wrapper which calls initialise, although this might be more work than just writing constructors manually.

veryreverie
  • 2,871
  • 2
  • 13
  • 26
  • 1
    Thank you very much, this is indeed very close to what I want! I will definitely try it out, trying to reintroduce the `foo = concrete(args)` syntax as well. – Frank Oct 30 '21 at 13:51