[Bug fortran/87566] ICE with class(*) and select

[pault at gcc dot gnu.org]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=87566

--- Comment #6 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 44835
  --> https://gcc.gnu.org/bugzilla/attachment.cgi?id=44835&action=edit
Fix for the PR

Hi Tobias,

The problem that you found occurs in trans-expr.c (gfc_conv_class_to_class).
Once found, the fix was trivial (See the attachment) and the testcase below
compiles and executes correctly.

The call to gfc_conv_class_to_class is made at trans-stmt.c:1822. The argument
'copy_back' is set true. However, the copyback is made to the select type
temporary, rather than to 'Pt'. Therefore, the assignment works but pointing to
a new target does not. Setting 'copy_back' to false regtests OK but I suspect
that it should break the associate construct for some cases.

That said, to my surprise, this causes an ICE:
    call AddArray
contains
    subroutine AddArray()
    type Object_array_pointer
        class(*), pointer :: p(:) => null()
    end type Object_array_pointer

    type (Object_array_pointer) :: obj
    character(3), target :: tgt1(2) = ['one','two']
    character(5), target :: tgt2(2) = ['three','four ']

    obj%p => tgt1
    associate (point => obj%p)
    end associate

    end subroutine AddArray

end

However, your patch in resolve.c caused a good number of regressions and so I
put that right too.

Over to you!

Paul

    call AddArray
contains
    subroutine AddArray()
    type Object_array_pointer
        class(*), pointer :: p(:) => null()
    end type Object_array_pointer
    class(*), pointer :: Pt => null()
    character(3), target :: tgt1(2) = ['one','two']

    allocate (Pt, source = Object_array_pointer ())
    select type (Pt)
      type is (object_array_pointer)
        Pt%p => tgt1
    end select

    select type (Pt)
    class is (object_array_pointer)
        select type (Point=> Pt%P)
          type is (character(*))
            if (any (Point .ne. tgt1)) stop 1
            Point = ['abc','efg']
        end select
    end select

    select type (Pt)
    class is (object_array_pointer)
        select type (Point=> Pt%P)
          type is (character(*))
            if (any (Point .ne. ['abc','efg'])) stop 2
        end select
    end select

    end subroutine AddArray

end