Defined assignment for polymorphic variable and vector subscript

I was playing around with polymorphism and defined assignment when I encountered a problem with gfortran when trying to assign to a polymorphic variable using a vector subscript.

Here is an example of what I mean

module mod_1
implicit none

type, public :: typ
    integer :: a
contains
    procedure, pass(y) :: assign_typ
    generic :: assignment(=) => assign_typ
end type typ

contains
elemental subroutine assign_typ(x,y)
    class(typ), intent(inout) :: x
    class(typ), intent(in) :: y

    x%a = y%a + 1 
end subroutine assign_typ

subroutine test(x,y)
    class(typ), intent(out) :: x(:)
    class(typ), intent(in) :: y(:)

    x(1:3) = y(4:6)
    x = y
    x([2,1]) = y([1,2])
end subroutine test

end module mod_1

The above code compiles with ifx and flang, but I get the following error with gfortran:

 25 |     x([2,1]) = y([1,2])
      |     1~~~~~~~~
Error: Nonallocatable variable must not be polymorphic in intrinsic assignment at (1) - check that there is a matching specific subroutine for '=' operator
Compiler returned: 1

It seems gfortran is not able to use the defined assignment in combination with the vector subscript (but it seems to work for the other two assignments in the test subroutine). If I change the declaration of x in test to no longer be polymorphic (but still keep y as polymorphic), then I don’t get the error.

1 Like