[Bug fortran/113363] ICE on ASSOCIATE and unlimited polymorphic function

[pault at gcc dot gnu.org via Gcc-bugs]

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

--- Comment #1 from Paul Thomas <pault at gcc dot gnu.org> ---
(In reply to anlauf from comment #0)
> While discussing a patch for PR89645/99065, the following issue with
> ASSOCIATE and unlimited polymorphic functions was found:
> 
> https://gcc.gnu.org/pipermail/fortran/2024-January/060098.html
> 
> program p
>   implicit none
>   class(*), allocatable :: x(:)
>   x = foo()
>   call prt (x)
>   deallocate (x)            ! up to here all is fine...
>   associate (var => foo())  ! <- crash here
>     call prt (var)          ! <- or here
>   end associate
> contains
>   function foo() result(res)
>     class(*), allocatable :: res(:)
>     res = [42]
>   end function foo
>   subroutine prt (x)
>     class(*), intent(in) :: x(:)
>     select type (x)
>     type is (integer)
>        print *, x
>     class default
>        stop 99
>     end select
>   end subroutine prt
> end
> 
> 
> This ICEs on current trunk for any of the indicated statements.

The associate bit is fixed with a one liner; with the patch applied:
@@ -2295,7 +2305,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block
*block)
     }

   /* Set the stringlength, when needed.  */
-  if (need_len_assign)
+  if (need_len_assign
+      && !(e->symtree->n.sym->attr.function && UNLIMITED_POLY
(e->symtree->n.sym)))
     {
       gfc_se se;
       gfc_init_se (&se, NULL);

the following gives the output in the comments:
program p
  implicit none
  class(*), allocatable :: x(:)
  allocate(x, source = foo())
  call prt (x)              ! Wrong output "6 hello e"
  deallocate (x)
  x = foo()
  call prt (x)              ! Wrong output "0  "
  deallocate (x)            !
  associate (var => foo())  ! Now OK
    call prt (var)          ! Now OK - outputs: "6 hello bye   "
  end associate
contains
  function foo() result(res)
    class(*), allocatable :: res(:)
    res = ["hello ","bye   "]
  end function foo
  subroutine prt (x)
    class(*), intent(in) :: x(:)
    select type (x)
    type is (character(*))
       print *, len(x), x
    class default
       stop 99
    end select
  end subroutine prt
end

Both allocation with source and assignment are broken :-(