From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <gcc-bugzilla@gcc.gnu.org>
Received: by sourceware.org (Postfix, from userid 48)
	id 309483858D37; Sun, 14 Jan 2024 08:54:54 +0000 (GMT)
DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 309483858D37
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org;
	s=default; t=1705222494;
	bh=bpLhxvJoweU5S7gOlK2bWbbwwC5VCwR7eC9akZQDCpc=;
	h=From:To:Subject:Date:In-Reply-To:References:From;
	b=c4F7EmT0EDUWLMSR8c4X3d0WoXEvVVk7xEFyHdBt7abzznms3+xU0FtxnhOj7XaVF
	 SjPQ8rvWIKDFPGg3UGnMR1fvox8xUXhgL8lv4/Nabfx8T1IDUwRLekpbqfcHx0pEbr
	 5ppjpRuYth6sgt/WYmaNZiRpLJyMJKgbqXeG4zyk=
From: "pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>
To: gcc-bugs@gcc.gnu.org
Subject: [Bug fortran/113363] ICE on ASSOCIATE and unlimited polymorphic
 function
Date: Sun, 14 Jan 2024 08:54:53 +0000
X-Bugzilla-Reason: CC
X-Bugzilla-Type: changed
X-Bugzilla-Watch-Reason: None
X-Bugzilla-Product: gcc
X-Bugzilla-Component: fortran
X-Bugzilla-Version: 14.0
X-Bugzilla-Keywords: ice-on-valid-code
X-Bugzilla-Severity: normal
X-Bugzilla-Who: pault at gcc dot gnu.org
X-Bugzilla-Status: UNCONFIRMED
X-Bugzilla-Resolution: 
X-Bugzilla-Priority: P3
X-Bugzilla-Assigned-To: unassigned at gcc dot gnu.org
X-Bugzilla-Target-Milestone: ---
X-Bugzilla-Flags: 
X-Bugzilla-Changed-Fields: 
Message-ID: <bug-113363-4-utU6qz8myX@http.gcc.gnu.org/bugzilla/>
In-Reply-To: <bug-113363-4@http.gcc.gnu.org/bugzilla/>
References: <bug-113363-4@http.gcc.gnu.org/bugzilla/>
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable
X-Bugzilla-URL: http://gcc.gnu.org/bugzilla/
Auto-Submitted: auto-generated
MIME-Version: 1.0
List-Id: <gcc-bugs.sourceware.org>

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

--- 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:
>=20
> https://gcc.gnu.org/pipermail/fortran/2024-January/060098.html
>=20
> program p
>   implicit none
>   class(*), allocatable :: x(:)
>   x =3D foo()
>   call prt (x)
>   deallocate (x)            ! up to here all is fine...
>   associate (var =3D> foo())  ! <- crash here
>     call prt (var)          ! <- or here
>   end associate
> contains
>   function foo() result(res)
>     class(*), allocatable :: res(:)
>     res =3D [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
>=20
>=20
> 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_blo=
ck
*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 =3D foo())
  call prt (x)              ! Wrong output "6 hello e"
  deallocate (x)
  x =3D foo()
  call prt (x)              ! Wrong output "0  "
  deallocate (x)            !
  associate (var =3D> foo())  ! Now OK
    call prt (var)          ! Now OK - outputs: "6 hello bye   "
  end associate
contains
  function foo() result(res)
    class(*), allocatable :: res(:)
    res =3D ["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 :-(=