Re: [PATCH] Fix fortran/PR114024

[Steve Kargl <sgk@troutmask.apl.washington.edu>]

[-- Attachment #1: Type: text/plain, Size: 2403 bytes --]

On Wed, Feb 21, 2024 at 01:42:32PM -0800, Steve Kargl wrote:
> On Wed, Feb 21, 2024 at 10:20:43PM +0100, Harald Anlauf wrote:
> > On 2/21/24 22:00, Steve Kargl wrote:
> > > memleak vs ICE.  I think I'll take one over the other.
> > > Probably need to free code->expr3 before the copy.
> > 
> > Yep.
> > 
> > > I tried gfc_replace_expr in an earlier patch.  It did not
> > > work.


I tried freeing code->expr3 before assigning the new expression.
That leads to

% gfcx -c ~/gcc/gccx/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 
pid 69473 comm f951 has trashed its stack, killing
gfortran: internal compiler error: Illegal instruction signal terminated program f951

If I don't free code->expr3 but simply assign the new
expression from gfc_get_parentheses(), your example
now compiles are executes are expected.  It now
allocate_with_source_28.f90.  Caveat:  I don't know
how to test the CLASS uu.

> > > > - it still fails on the following code, because the traversal
> > > >    of the refs is incomplete / wrong:
> > > > 
> > > > program foo
> > > >     implicit none
> > > >     complex               :: cmp(3)
> > > >     real, pointer         :: pp(:)
> > > >     class(*), allocatable :: uu(:)
> > > >     type t
> > > >        real :: re
> > > >        real :: im
> > > >     end type t
> > > >     type u
> > > >        type(t) :: tt(3)
> > > >     end type u
> > > >     type(u) :: cc
> > > > 
> > > >     cmp = (3.45,6.78)
> > > >     cc% tt% re = cmp% re
> > > >     cc% tt% im = cmp% im
> > > >     allocate (pp, source = cc% tt% im)       ! ICE
> > > 
> > > cc%tt%im isn't a complex-part-ref, so this seems to
> > > be a different (maybe related) issue.  Does the code
> > > compile with 'source = (cc%tt%im)'?  If so, perhaps,
> > > detecting a component reference and doing the simply
> > > wrapping with parentheses can be done.
> > 
> > Yes, that's why I tried to make up the above example.
> > I think %re and %im are not too special, they work
> > here pretty much like component refs elsewhere.
> > 
> 
> I see.  The %re and %im complex-part-ref correspond to 
> ref->u.i == INQUIRY_RE and INQUIRY_IM, respectively.
> A part-ref for a user-defined type doesn't have an
> INQUIRY_xxx, so we'll need to see if there is a way to
> easily identify, e.g., cc%tt%re from your testcase.  

The attach patch uses ref->type == REF_COMPONENT to deal 
with the above code.

-- 
Steve

[-- Attachment #2: pr114024.diff --]
[-- Type: text/x-diff, Size: 3134 bytes --]

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 5247d3d39d7..414248fe2e5 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6354,9 +6354,35 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	   al = al->next)
 	vtab_needed = (al->expr->ts.type == BT_CLASS);
 
+      /* When expr3 is a variable, i.e., a very simple expression, then
+	 convert it once here.  */
+ 
       gfc_init_se (&se, NULL);
-      /* When expr3 is a variable, i.e., a very simple expression,
-	     then convert it once here.  */
+
+      /* If one has source = z%re or z%im with z a complex array or 
+	 source = a%b%c where a or b is an array of a derived type, then
+	 things can go sideways with the complex-part-refi or part-ref, so
+	 wrap the entity in parentheses to force evaluation of an expression.
+	 That is, the else-branch in the following if-else-stmt is entered.  */
+
+      if (code->expr3->expr_type == EXPR_VARIABLE
+	  && code->expr3->ts.type == BT_REAL
+	  && code->expr3->ref)
+	{
+	  gfc_ref *ref = code->expr3->ref;
+
+	  while (ref->next)
+	    ref = ref->next;
+
+	  if (ref->u.i == INQUIRY_IM || ref->u.i == INQUIRY_RE
+	      || ref->type == REF_COMPONENT)
+	    {
+	      gfc_expr *etmp = gfc_get_parentheses (code->expr3);
+	      code->expr3 = gfc_copy_expr (etmp);
+	      gfc_free_expr (etmp);
+	    }
+	}
+
       if (code->expr3->expr_type == EXPR_VARIABLE
 	  || code->expr3->expr_type == EXPR_ARRAY
 	  || code->expr3->expr_type == EXPR_CONSTANT)
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90
new file mode 100644
index 00000000000..d0f0f3c4a84
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_27.f90
@@ -0,0 +1,20 @@
+!
+! { dg-do run }
+!
+! fortran/PR114024
+! https://github.com/fujitsu/compiler-test-suite
+! Modified from Fortran/0093/0093_0130.f90
+!
+program foo
+   implicit none
+   complex :: cmp(3)
+   real, allocatable :: xx(:), yy(:), zz(:)
+   cmp = (3., 6.78)
+   allocate(xx, source = cmp%re)          ! This caused an ICE.
+   allocate(yy, source = cmp(1:3)%re)     ! This caused an ICE.
+   allocate(zz, source = (cmp%re))
+   if (any(xx /= [3., 3., 3.])) stop 1
+   if (any(yy /= [3., 3., 3.])) stop 2
+   if (any(zz /= [3., 3., 3.])) stop 3
+end program foo
+
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90
new file mode 100644
index 00000000000..5eeeeb167cd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_28.f90
@@ -0,0 +1,27 @@
+!
+! { dg-do run }
+! Testcase from Harald Anlauf
+! fortran/pr114024
+!
+program foo
+
+   implicit none
+
+   complex cmp(3)
+   real, pointer :: pp(:)
+   class(*), allocatable :: uu(:)
+   type t
+      real re, im
+   end type t
+   type u
+      type(t) tt(3)
+   end type u
+   type(u) :: cc
+
+   cmp = (3.,4.)
+   cc%tt%re = cmp%re
+   cc%tt%im = cmp%im
+   allocate (pp, source = cc%tt%im)       ! ICE
+   if (any(pp /= [4., 4., 4.])) stop 1
+   allocate (uu, source = cc%tt%im)       ! ICE
+end