[Bug fortran/96495] [gfortran] Composition of user-defined operators does not copy ALLOCATABLE property of derived type

["pault at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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

Paul Thomas <pault at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Assignee|unassigned at gcc dot gnu.org      |pault at gcc dot gnu.org
                 CC|                            |pault at gcc dot gnu.org
             Status|UNCONFIRMED                 |NEW
     Ever confirmed|0                           |1
   Last reconfirmed|                            |2020-08-28

--- Comment #3 from Paul Thomas <pault at gcc dot gnu.org> ---
Hi Paul,

Thank you very much for this report. The cause if the segfault is revealed by
using the option -fdump-tree-original.

The assignment
  g = g .binaryElemental. (f .binary. f)

is rendered as:

    {
      struct foo D.4200;

      D.4200 = foo_sub_foo (&f, &f);  /* Outside the scalarization loop.  */
      {                               /* ...as it should be :-)   */
        integer(kind=8) S.30;

        S.30 = 1;
        while (1)
          {
            if (S.30 > 2) goto L.21;
            {
              struct foo * D.4202;
              struct foo D.4203;

              D.4202 = &D.4200;
              D.4203 = g[S.30 + -1];
              g[S.30 + -1] = foo_add_foo (&g[S.30 + -1], D.4202);
              if ((integer(kind=4)[0:] * restrict) D.4203.j.data != 0B)
                {
                  __builtin_free ((void *) D.4203.j.data);
                  (integer(kind=4)[0:] * restrict) D.4203.j.data = 0B;
                }

              /* Here the 'j' component of the scalar temporary is
                 deallocated on the first pass through the scalarization
                 loop so that the second pass through the loop attempts
                 to read a null address.  /*
              if ((integer(kind=4)[0:] * restrict) D.4202->j.data != 0B)
                {
                  __builtin_free ((void *) D.4202->j.data);
                  (integer(kind=4)[0:] * restrict) D.4202->j.data = 0B;
                }
            }
            S.30 = S.30 + 1;
          }
        L.21:;
      }
    }

As you can see from the comments, the garbage collection mechanism is overdoing
it and the deallocation of D.4202->j should be done outside the scalarization
loop.

I presume that you have already found the workaround:
  tmp = (f .binary. f)
  g = g .binaryElemental. tmp

where tmp is a scalar of type 'foo'?

This does the right thing...
    {
      struct foo D.4201;

      D.4201 = tmp;
      tmp = foo_sub_foo (&f, &f);
      if ((integer(kind=4)[0:] * restrict) D.4201.j.data != 0B)
        {
          __builtin_free ((void *) D.4201.j.data);
          (integer(kind=4)[0:] * restrict) D.4201.j.data = 0B;
        }
    }
    {
      struct foo * D.4202;

      D.4202 = &tmp;
      {
        integer(kind=8) S.30;

        S.30 = 1;
        while (1)
          {
            if (S.30 > 2) goto L.21;
            {
              struct foo D.4204;

              D.4204 = g[S.30 + -1];
              g[S.30 + -1] = foo_add_foo (&g[S.30 + -1], D.4202);
              if ((integer(kind=4)[0:] * restrict) D.4204.j.data != 0B)
                {
                  __builtin_free ((void *) D.4204.j.data);
                  (integer(kind=4)[0:] * restrict) D.4204.j.data = 0B;
                }
            }
            S.30 = S.30 + 1;
          }
        L.21:;
      }
    }
  }
}

I will work on this in the coming days.

Best regards

Paul