[flang] Semantic error on pure subroutine that compiles with gfortran and ifx

[R-Goc]

Hitting this issue when trying to compile fortran-stdlib (issue there).
Other compilers accept this code. Compiling stdlib-error.f90:

error: Semantic errors in src/CMakeFiles/fortran_stdlib.dir/stdlib_error.f90-pp.f90
/code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:245:14: error: Left-hand side of assignment is not definable
               ierr_out = ierr
               ^^^^^^^^
/code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:245:14: because: 'ierr_out' is polymorphic in a pure subprogram
               ierr_out = ierr
               ^^^^^^^^
/code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:239:56: Declaration of 'ierr_out'
           class(state_type), optional, intent(inout) :: ierr_out
                                                         ^^^^^^^^

This is the function:

    pure subroutine error_handling(ierr,ierr_out)
         class(state_type), intent(in) :: ierr
         class(state_type), optional, intent(inout) :: ierr_out

         character(len=:),allocatable :: err_msg

         if (present(ierr_out)) then
             ! Return error flag
             ierr_out = ierr
         elseif (ierr%error()) then
             err_msg = ierr%print()
             error stop err_msg
         end if

    end subroutine error_handling

state_type:

    type :: state_type

        !> The current exit state
        integer(ilp) :: state = STDLIB_SUCCESS

        !> Message associated to the current state
        character(len=MSG_LENGTH) :: message = repeat(' ',MSG_LENGTH)

        !> Location of the state change
        character(len=NAME_LENGTH) :: where_at = repeat(' ',NAME_LENGTH)

        contains

           !> Cleanup
           procedure :: destroy   => state_destroy
           
           !> Parse error constructor
           procedure, private :: state_parse_at_location
           procedure, private :: state_parse_arguments
           generic   :: parse     => state_parse_at_location, &
                                     state_parse_arguments

           !> Print error message
           procedure :: print     => state_print
           procedure :: print_msg => state_message

           !> State properties
           procedure :: ok        => state_is_ok
           procedure :: error     => state_is_error
           
           !> Handle optional error message 
           procedure :: handle    => error_handling

    end type state_type

state_type is also extended by two methods:

    interface state_type
        module procedure new_state
        module procedure new_state_nowhere
    end interface state_type

which are defined here:

    pure type(state_type) function new_state(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                             a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) 

       !> Location
       character(len=*),intent(in) :: where_at

       !> Input error flag
       integer,intent(in) :: flag

       !> Optional rank-agnostic arguments
       class(*),optional,intent(in),dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20  

       ! Init object
       call new_state%parse(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                            a11,a12,a13,a14,a15,a16,a17,a18,a19,a20)

    end function new_state

    !> Error creation message, from N input variables (numeric or strings)
    pure type(state_type) function new_state_nowhere(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) &
                                                     result(new_state)

       !> Input error flag
       integer,intent(in) :: flag

       !> Optional rank-agnostic arguments
       class(*),optional,intent(in),dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20  

       ! Init object
       call new_state%parse(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                 a11,a12,a13,a14,a15,a16,a17,a18,a19,a20)

    end function new_state_nowhere

To reproduce compile stdlib using flang (disabling XDP and QDP might be needed cmake variables WITH_*DP)

[llvmbot]

@llvm/issue-subscribers-flang-frontend

Author: None (R-Goc)

Hitting this issue when trying to compile fortran-stdlib ([issue there](https://github.com/fortran-lang/stdlib/issues/990)). Other compilers accept this code. Compiling [stdlib-error.f90](https://github.com/fortran-lang/stdlib/blob/master/src/stdlib_error.fypp): ``` error: Semantic errors in src/CMakeFiles/fortran_stdlib.dir/stdlib_error.f90-pp.f90 /code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:245:14: error: Left-hand side of assignment is not definable ierr_out = ierr ^^^^^^^^ /code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:245:14: because: 'ierr_out' is polymorphic in a pure subprogram ierr_out = ierr ^^^^^^^^ /code/rbfx-new/standalone/batched-assembly/stdlib/build/src/stdlib_error.f90:239:56: Declaration of 'ierr_out' class(state_type), optional, intent(inout) :: ierr_out ^^^^^^^^ ``` This is the [function](https://github.com/fortran-lang/stdlib/blob/c14d599a7b9dabf8789be6ecc484339599f595c8/src/stdlib_error.fypp#L239): ```fortran pure subroutine error_handling(ierr,ierr_out) class(state_type), intent(in) :: ierr class(state_type), optional, intent(inout) :: ierr_out

     character(len=:),allocatable :: err_msg

     if (present(ierr_out)) then
         ! Return error flag
         ierr_out = ierr
     elseif (ierr%error()) then
         err_msg = ierr%print()
         error stop err_msg
     end if

end subroutine error_handling

[state_type](https://github.com/fortran-lang/stdlib/blob/c14d599a7b9dabf8789be6ecc484339599f595c8/src/stdlib_error.fypp#L52):
```fortran
    type :: state_type

        !> The current exit state
        integer(ilp) :: state = STDLIB_SUCCESS

        !> Message associated to the current state
        character(len=MSG_LENGTH) :: message = repeat(' ',MSG_LENGTH)

        !> Location of the state change
        character(len=NAME_LENGTH) :: where_at = repeat(' ',NAME_LENGTH)

        contains

           !> Cleanup
           procedure :: destroy   => state_destroy
           
           !> Parse error constructor
           procedure, private :: state_parse_at_location
           procedure, private :: state_parse_arguments
           generic   :: parse     => state_parse_at_location, &
                                     state_parse_arguments

           !> Print error message
           procedure :: print     => state_print
           procedure :: print_msg => state_message

           !> State properties
           procedure :: ok        => state_is_ok
           procedure :: error     => state_is_error
           
           !> Handle optional error message 
           procedure :: handle    => error_handling

    end type state_type

state_type is also extended by two methods:

    interface state_type
        module procedure new_state
        module procedure new_state_nowhere
    end interface state_type

which are defined here:

    pure type(state_type) function new_state(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                             a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) 

       !> Location
       character(len=*),intent(in) :: where_at

       !> Input error flag
       integer,intent(in) :: flag

       !> Optional rank-agnostic arguments
       class(*),optional,intent(in),dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20  

       ! Init object
       call new_state%parse(where_at,flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                            a11,a12,a13,a14,a15,a16,a17,a18,a19,a20)

    end function new_state

    !> Error creation message, from N input variables (numeric or strings)
    pure type(state_type) function new_state_nowhere(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20) &
                                                     result(new_state)

       !> Input error flag
       integer,intent(in) :: flag

       !> Optional rank-agnostic arguments
       class(*),optional,intent(in),dimension(..) :: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                                     a11,a12,a13,a14,a15,a16,a17,a18,a19,a20  

       ! Init object
       call new_state%parse(flag,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10, &
                                 a11,a12,a13,a14,a15,a16,a17,a18,a19,a20)

    end function new_state_nowhere

To reproduce compile stdlib using flang (disabling XDP and QDP might be needed cmake variables WITH_*DP)

[klausler]

A more manageable test case:

module m
  type t
   contains
    procedure asst
    generic :: assignment(=) => asst
  end type
 contains
  pure subroutine asst(lhs, rhs)
    class(t), intent(in out) :: lhs
    class(t), intent(in) :: rhs
  end
  pure subroutine test(x, y)
    class(t), intent(in out) :: x, y
    x = y
  end
end