[Patch, fortran] PR83118 - [8/9/10 Regression] Bad intrinsic assignment of class(*) array component of derived type

[Andre Vehreschild]

Hi Paul,

I am not completely in your topic, but it seems close enough to my current
concerns to add my voice.

I am looking at allocatable components in coarrays and figured that there are
several things at odds, when the alloc. component's nesting level is greater
than one. I not only found that sizes where computed just in part of a
conditional but used in both, as well as free() being used instead of
deregister(). Furthermore are the descriptors not initialized at all, when the
nesting level is greater than one (I am working on that currently; hopefully
this is the last issue in this concern). 

Therefore, I vote for applying your patch as soon as possible, opening a new
ticket for the remaining array work and with this and my patch (to come)
improving gfortran sooner than later. 

Regards,
	Andre

On Tue, 27 Oct 2020 18:48:13 +0000
Paul Richard Thomas via Fortran <fortran@gcc.gnu.org> wrote:

> Hi Tobias and Thomas,
> 
> I am afraid that this is a rather long sad story, mainly due to my efforts
> with gfortran being interrupted by daytime work. I posted the first version
> of the patch nearly a year ago but this was derailed by your question
> below.
> 
> I took this PR from my list of regressions and immediately opened several
> cans of worms (eg. dependency_57.f90 segfaulting in runtime.). I have dealt
> with all of them except the point that you raise here.
> 
> Your testcase revealed that reallocate on assignment was not doing any
> reallocation for the scalar case! I have fixed that so that subroutine
> assign produces:
> assign (struct __class__STAR_a & restrict x)
> {
>   {
>     integer(kind=4) rhs.3;
>     struct __vtype__STAR * {ref-all} D.3990;
> 
>     D.3990 = x->_vptr;
>     rhs.3 = 5;
>     x->_vptr = (struct __vtype__STAR * {ref-all}) &__vtab_INTEGER_4_;
>     x->_len = 0;
>     if (x->_data == 0B)
>       {
>         x->_data = __builtin_malloc (MAX_EXPR <(unsigned long)
> x->_vptr->_size, 1>);
>         if (x->_data == 0B)
>           {
>             _gfortran_os_error_at (&"In file \'tobias.f90\', around line
> 38"[1]{lb: 1 sz: 1}, &"Error allocating %lu bytes"[1]{lb: 1 sz: 1},
> (unsigned long) x->_vptr->_size);
>           }
>       }
>     else
>       {
>         if (x->_vptr != D.3990)
>           {
>             __builtin_realloc (x->_data, x->_vptr->_size);
>           }
>       }
>     x->_vptr->_copy (&rhs.3, x->_data);
>   }
> }
> 
> Before the patch the realloc branch was absent so that any rhs of any size
> type/kind was accepted without reallocation and ptr remained associated
> with the data (associated wouldn't work of course).
> 
> My worry is that the array version is completely at odds with the standard.
> Should I deal with this now and risk further regressions down stream or
> should I raise a PR for it and fix it later?
> 
> I am tempted to do the job properly, thereby enabling class assignment in
> all the conditions that I have been able to produce.
> 
> Cheers
> 
> Paul
> 
> 
> On Mon, 18 Nov 2019 at 10:24, Tobias Burnus <tobias@codesourcery.com> wrote:
> 
> > On 11/17/19 7:34 PM, Paul Richard Thomas wrote:
> > […]
> > Sorry for not yet reviewing the code, but the following caught my eye:
> > >      (gfc_alloc_allocatable_for_assignment): […]
> > >      Force reallocation of unlimited
> > >      polymorphic lhs's. […]
> > > […]
> > > !   /* If the lhs is deferred length or unlimited polymorphic, assume
> > that
> > > !      the element size changes and force a reallocation.  */
> > > !   if (expr1->ts.deferred || UNLIMITED_POLY (expr1))
> > I wonder whether this assumption breaks code, which relies on a pointer
> > address not changing, cf. test case below.
> >
> > I think the standard does not state explicitly that no reallocation
> > happens, but I think it can be deduced. In any case, the reallocation is
> > only supposed to happen for (F2018, 10.2.1.3p1):
> > "If the variable is an allocated allocatable variable, it is deallocated
> > ifexpr is an array of different shape, any corresponding length type
> > parameter values of the variable andexprdiffer, or the variable is
> > polymorphic and the dynamic type or any corresponding kind type
> > parameter values of the variable andexpr differ."
> >
> > Cheers,
> >
> > Tobias
> >
> > implicit none (type, external)
> > integer, pointer :: ptr
> > class(*), target, allocatable :: alloc
> > allocate(integer :: alloc)
> > select type(alloc)
> >    type is(integer)
> >      alloc = 67
> >      ptr => alloc
> > end select
> > call assign(alloc)
> > !print *, ptr
> > if (ptr /= 5) error stop 1
> > select type(alloc)
> >    type is(integer)
> >     !print *, alloc
> >     if (ptr /= 5) error stop 2
> > end select
> > contains
> > subroutine assign(x)
> >    class(*), allocatable :: x
> >    x = 5
> > end subroutine assign
> > end
> >
> >
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de