Allocatable actual argument on dummy arguments

module string
    implicit none
    public :: string_type

    type :: string_type
        character(:), allocatable :: char_seq
    end type string_type

    contains
        subroutine assign(instance, value)
            type(string_type) :: instance
            character(len=*), intent(in):: value
            instance%char_seq = value
        end subroutine assign

end module string

program tester
    use string
    implicit none
    type(string_type), allocatable :: string1
    character(len=20) :: value = "value to be assigned"
    string1 = string_type()
    call assign(string1, value)
end program tester

My question is that subroutine assign is expecting the input to be of type(string_type) and I have given an allocatable (which actually stores string_type object) as the input but it worked fine.

So can I conclude that fortran intelligently passes the string_type object, allocatable string1 is referring to, when I called assign subroutine on string1? I want to hear something more about this phenomenon to understand things better.
I tried changing subroutine assign to expect an allocatable as input and it worked fine again.

I agree that it makes little sense to use allocatable with string_type objects.

@kargl that is true. I got confused for a moment. I have used allocatable scalars before in place of pointers. But still, I don’t see the benefit here, perhaps that is why I got confused.

A allocatable variable can be passed to as actual argument to a dummy argument that isn’t allocatable. It just means inside the procedure the dummy argument can’t have it’s allocation status changed, since it might have been passed an actual argument that isn’t allocatable.

The reverse is not true though. A dummy argument that is allocatable must be passed an allocatable actual argument, since it might try to change the allocation status.

The semantics of the language are such that, once allocated, you can do whatever you were able to do with a variable that wasn’t allocatable. The only new thing you’re able to do with it is deallocate it.

3 Likes