[Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Paul Richard Thomas]

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

Fixing the different variants of this PR was somewhat like drawing teeth.
Fixing the scalar problem with derived type and class formal arguments was
straightforward. However, the need to strip NOPS for scalar unlimited
polymorphic arguments was less than obvious. Even less obvious was the
problem with unlimited polymorphic arrays, which required the use of the
'derived_array' argument of gfc_conv_derived_to_class because the code
looked just fine. Evidently, the convoluted casting in expressions like:
(integer(kind=4)[0:] * restrict) (*(void *[0:] *)
D.4413->_data.data)[S.61]->t.data
is the cause. I have seen this kind of problem with unlimited polymorphic
expressions previously. The fix re-renders them as:
(integer(kind=4)[0:] * restrict) (*(struct tuple[1] * restrict)
array.46.data)[S.47].t.data

Regtests on FC33/x86_64

OK for master (and maybe for 10-branch?)

Paul


Fortran: Fix memory problems with assumed rank formal args [PR98342].

2021-01-29  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
PR fortran/98342
* trans-expr.c (gfc_conv_derived_to_class): Add optional arg.
'derived_array' to hold the fixed, parmse expr in the case of
assumed rank formal arguments. Deal with optional arguments.
(gfc_conv_procedure_call): Null 'derived' array for each actual
argument. Add its address to the call to gfc_conv_derived_to_
class. Access the 'data' field of scalar descriptors before
deallocating allocatable components. Also strip NOPs before the
calls to gfc_deallocate_alloc_comp. Use 'derived' array as the
input to gfc_deallocate_alloc_comp if it is available.
* trans.h : Include the optional argument 'derived_array' to
the prototype of gfc_conv_derived_to_class. The default value
is NULL_TREE.

gcc/testsuite/
PR fortran/98342
* gfortran.dg/assumed_rank_20.f90 : New test.

[-- Attachment #2: assumed_rank_20.f90 --]
[-- Type: text/x-fortran, Size: 2196 bytes --]

! { dg-do run }
!
! Test the fix for PR98342.
!
! Contributed by Martin Stein  <mscfd@gmx.net>
!
module mod
  implicit none
  private
  public get_tuple, sel_rank1, sel_rank2, sel_rank3

  type, public :: tuple
  integer, dimension(:), allocatable :: t
end type tuple

contains

function sel_rank1(x) result(s)
  character(len=:), allocatable :: s
  type(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '10'
    rank (1)
      s = '11'
    rank default
      s = '?'
  end select
end function sel_rank1

function sel_rank2(x) result(s)
  character(len=:), allocatable :: s
  class(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '20'
    rank (1)
      s = '21'
    rank default
      s = '?'
  end select
end function sel_rank2

function sel_rank3(x) result(s)
  character(len=:), allocatable :: s
  class(*), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '30'
    rank (1)
      s = '31'
    rank default
      s = '?'
  end select
end function sel_rank3

function get_tuple(t) result(a)
  type(tuple) :: a
  integer, dimension(:), intent(in) :: t
  allocate(a%t, source=t)
end function get_tuple

end module mod


program alloc_rank
  use mod
  implicit none

  integer, dimension(1:3) :: x
  character(len=:), allocatable :: output
  type(tuple) :: z(1)

  x = [1,2,3]
                                      ! Derived type formal arg
  output = sel_rank1(get_tuple(x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '10') stop 1
  output = sel_rank1([get_tuple(x)])  ! This worked OK
  if (output .ne. '11') stop 2

                                      ! Class formal arg
  output = sel_rank2(get_tuple(x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '20') stop 3
  output = sel_rank2([get_tuple(x)])  ! This worked OK
  if (output .ne. '21') stop 4

                                      ! Unlimited polymorphic formal arg
  output = sel_rank3(get_tuple(x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '30') stop 5
  output = sel_rank3([get_tuple(x)])  ! runtime: segmentation fault
  if (output .ne. '31') stop 6

  deallocate(output)
end program alloc_rank

[-- Attachment #3: submit.diff --]
[-- Type: text/x-patch, Size: 4368 bytes --]

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b0c8d577ca5..2e804566786 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -613,11 +613,15 @@ class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
    class object of the 'declared' type.  If vptr is not NULL, this is
    used for the temporary class object.
    optional_alloc_ptr is false when the dummy is neither allocatable
-   nor a pointer; that's only relevant for the optional handling.  */
+   nor a pointer; that's only relevant for the optional handling.
+   The optional argument 'derived_array' is used to preserve the parmse
+   expression for deallocation of allocatable components. Assumed rank
+   formal arguments made this necessary.  */
 void
 gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 			   gfc_typespec class_ts, tree vptr, bool optional,
-			   bool optional_alloc_ptr)
+			   bool optional_alloc_ptr,
+			   tree *derived_array)
 {
   gfc_symbol *vtab;
   tree cond_optional = NULL_TREE;
@@ -747,6 +751,13 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
 	    {
 	      gcc_assert (class_ts.u.derived->components->as->type
 			  == AS_ASSUMED_RANK);
+	      if (derived_array
+		  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse->expr)))
+		{
+		  *derived_array = gfc_create_var (TREE_TYPE (parmse->expr),
+						   "array");
+		  gfc_add_modify (&block, *derived_array , parmse->expr);
+		}
 	      class_array_data_assign (&block, ctree, parmse->expr, false);
 	    }
 	  else
@@ -765,6 +776,9 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,

 	      gfc_init_block (&block);
 	      gfc_conv_descriptor_data_set (&block, ctree, null_pointer_node);
+	      if (derived_array && *derived_array != NULL_TREE)
+		gfc_conv_descriptor_data_set (&block, *derived_array,
+					      null_pointer_node);

 	      tmp = build3_v (COND_EXPR, cond_optional, tmp,
 			      gfc_finish_block (&block));
@@ -5665,6 +5679,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
     {
       bool finalized = false;
       bool non_unity_length_string = false;
+      tree derived_array = NULL_TREE;

       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
@@ -5770,7 +5785,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     && e->expr_type == EXPR_VARIABLE
 				     && e->symtree->n.sym->attr.optional,
 				     CLASS_DATA (fsym)->attr.class_pointer
-				     || CLASS_DATA (fsym)->attr.allocatable);
+				     || CLASS_DATA (fsym)->attr.allocatable,
+				     &derived_array);
 	}
       else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS
 	       && gfc_expr_attr (e).flavor != FL_PROCEDURE)
@@ -6593,6 +6609,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 					&& parm_rank == 0
 					&& parmse.loop;

+	      /* Scalars passed to an assumed rank argument are converted to
+		 a descriptor. Obtain the data field before deallocating any
+		 allocatable components.  */
+	      if (parm_rank == 0 && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+		tmp = gfc_conv_descriptor_data_get (tmp);
+
 	      if (scalar_res_outside_loop)
 		{
 		  /* Go through the ss chain to find the argument and use
@@ -6608,9 +6630,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      }
 		}

-	      if ((e->ts.type == BT_CLASS
-		   && GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
-		  || e->ts.type == BT_DERIVED)
+	      STRIP_NOPS (tmp);
+
+	      if (derived_array != NULL_TREE)
+		tmp = gfc_deallocate_alloc_comp (e->ts.u.derived,
+						 derived_array,
+						 parm_rank);
+	      else if ((e->ts.type == BT_CLASS
+			&& GFC_CLASS_TYPE_P (TREE_TYPE (tmp)))
+		       || e->ts.type == BT_DERIVED)
 		tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp,
 						 parm_rank);
 	      else if (e->ts.type == BT_CLASS)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1e4ab39cb89..44cbfb63f39 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -452,7 +452,7 @@ bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *);
 bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);

 void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_typespec, tree, bool,
-				bool);
+				bool, tree *derived_array = NULL);
 void gfc_conv_class_to_class (gfc_se *, gfc_expr *, gfc_typespec, bool, bool,
 			      bool, bool);

Re: [Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Tobias Burnus]

Hi Paul,

On 29.01.21 15:20, Paul Richard Thomas via Fortran wrote:
> Regtests on FC33/x86_64
> OK for master (and maybe for 10-branch?)

The patch by itself looks good to me, but

  gfortran-trunk assumed_rank_20.f90 -fsanitize=address,undefined -g

shows three times the warning:

Direct leak of 12 byte(s) in 1 object(s) allocated from:
     #0 0x7f2d5ef6e517 in malloc (/usr/lib/x86_64-linux-gnu/libasan.so.6+0xb0517)
     #1 0x404221 in __mod_MOD_get_tuple /dev/shm/assumed_rank_20.f90:60
     #2 0x40ad8e in alloc_rank /dev/shm/assumed_rank_20.f90:78 (+ line 84, + line 90)
     #3 0x40d9e7 in main /dev/shm/assumed_rank_20.f90:67

Thus, the function-result temporary does not seem to get deallocated
when a constructor is used:

78:  output = sel_rank1([get_tuple(x)])  ! This worked OK
84:  output = sel_rank2([get_tuple(x)])  ! This worked OK
90:  output = sel_rank3([get_tuple(x)])  ! runtime: segmentation fault

Thanks,

Tobias

> Fortran: Fix memory problems with assumed rank formal args [PR98342].
>
> 2021-01-29  Paul Thomas  <pault@gcc.gnu.org>
>
> gcc/fortran
> PR fortran/98342
> * trans-expr.c (gfc_conv_derived_to_class): Add optional arg.
> 'derived_array' to hold the fixed, parmse expr in the case of
> assumed rank formal arguments. Deal with optional arguments.
> (gfc_conv_procedure_call): Null 'derived' array for each actual
> argument. Add its address to the call to gfc_conv_derived_to_
> class. Access the 'data' field of scalar descriptors before
> deallocating allocatable components. Also strip NOPs before the
> calls to gfc_deallocate_alloc_comp. Use 'derived' array as the
> input to gfc_deallocate_alloc_comp if it is available.
> * trans.h : Include the optional argument 'derived_array' to
> the prototype of gfc_conv_derived_to_class. The default value
> is NULL_TREE.
>
> gcc/testsuite/
> PR fortran/98342
> * gfortran.dg/assumed_rank_20.f90 : New test.
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

Re: [Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Paul Richard Thomas]

Hi Tobias,

Yes, I am aware of the memory leaks. Valgrind, in spite of the dwarf
problem, reports definite loss of 3 blocks of 24bytes. This leak from
constructors goes back a very long way (PR38319). I have periodically had a
stab at fixing it but, thus far, have not successfully eliminated it
without breaking something else. That said, this version of the problem
might be easier than most. I will take a look.

Cheers

Paul


On Fri, 29 Jan 2021 at 14:56, Tobias Burnus <tobias@codesourcery.com> wrote:

> Hi Paul,
>
> On 29.01.21 15:20, Paul Richard Thomas via Fortran wrote:
> > Regtests on FC33/x86_64
> > OK for master (and maybe for 10-branch?)
>
> The patch by itself looks good to me, but
>
>   gfortran-trunk assumed_rank_20.f90 -fsanitize=address,undefined -g
>
> shows three times the warning:
>
> Direct leak of 12 byte(s) in 1 object(s) allocated from:
>      #0 0x7f2d5ef6e517 in malloc
> (/usr/lib/x86_64-linux-gnu/libasan.so.6+0xb0517)
>      #1 0x404221 in __mod_MOD_get_tuple /dev/shm/assumed_rank_20.f90:60
>      #2 0x40ad8e in alloc_rank /dev/shm/assumed_rank_20.f90:78 (+ line 84,
> + line 90)
>      #3 0x40d9e7 in main /dev/shm/assumed_rank_20.f90:67
>
> Thus, the function-result temporary does not seem to get deallocated
> when a constructor is used:
>
> 78:  output = sel_rank1([get_tuple(x)])  ! This worked OK
> 84:  output = sel_rank2([get_tuple(x)])  ! This worked OK
> 90:  output = sel_rank3([get_tuple(x)])  ! runtime: segmentation fault
>
> Thanks,
>
> Tobias
>
> > Fortran: Fix memory problems with assumed rank formal args [PR98342].
> >
> > 2021-01-29  Paul Thomas  <pault@gcc.gnu.org>
> >
> > gcc/fortran
> > PR fortran/98342
> > * trans-expr.c (gfc_conv_derived_to_class): Add optional arg.
> > 'derived_array' to hold the fixed, parmse expr in the case of
> > assumed rank formal arguments. Deal with optional arguments.
> > (gfc_conv_procedure_call): Null 'derived' array for each actual
> > argument. Add its address to the call to gfc_conv_derived_to_
> > class. Access the 'data' field of scalar descriptors before
> > deallocating allocatable components. Also strip NOPs before the
> > calls to gfc_deallocate_alloc_comp. Use 'derived' array as the
> > input to gfc_deallocate_alloc_comp if it is available.
> > * trans.h : Include the optional argument 'derived_array' to
> > the prototype of gfc_conv_derived_to_class. The default value
> > is NULL_TREE.
> >
> > gcc/testsuite/
> > PR fortran/98342
> > * gfortran.dg/assumed_rank_20.f90 : New test.
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München /
> Germany
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
> Alexander Walter
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: [Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Paul Richard Thomas]

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

Hi Tobias,

I have attached a memory leak free version of the testcase. I have asked
for Thomas's help to use frontend-passes.c tools to do the same for
compound constructors with allocatable components. My attempts to do the
job in other ways have failed totally.

Cheers

Paul


On Fri, 29 Jan 2021 at 14:56, Tobias Burnus <tobias@codesourcery.com> wrote:

> Hi Paul,
>
> On 29.01.21 15:20, Paul Richard Thomas via Fortran wrote:
> > Regtests on FC33/x86_64
> > OK for master (and maybe for 10-branch?)
>
> The patch by itself looks good to me, but
>
>   gfortran-trunk assumed_rank_20.f90 -fsanitize=address,undefined -g
>
> shows three times the warning:
>
> Direct leak of 12 byte(s) in 1 object(s) allocated from:
>      #0 0x7f2d5ef6e517 in malloc
> (/usr/lib/x86_64-linux-gnu/libasan.so.6+0xb0517)
>      #1 0x404221 in __mod_MOD_get_tuple /dev/shm/assumed_rank_20.f90:60
>      #2 0x40ad8e in alloc_rank /dev/shm/assumed_rank_20.f90:78 (+ line 84,
> + line 90)
>      #3 0x40d9e7 in main /dev/shm/assumed_rank_20.f90:67
>
> Thus, the function-result temporary does not seem to get deallocated
> when a constructor is used:
>
> 78:  output = sel_rank1([get_tuple(x)])  ! This worked OK
> 84:  output = sel_rank2([get_tuple(x)])  ! This worked OK
> 90:  output = sel_rank3([get_tuple(x)])  ! runtime: segmentation fault
>
> Thanks,
>
> Tobias
>
> > Fortran: Fix memory problems with assumed rank formal args [PR98342].
> >
> > 2021-01-29  Paul Thomas  <pault@gcc.gnu.org>
> >
> > gcc/fortran
> > PR fortran/98342
> > * trans-expr.c (gfc_conv_derived_to_class): Add optional arg.
> > 'derived_array' to hold the fixed, parmse expr in the case of
> > assumed rank formal arguments. Deal with optional arguments.
> > (gfc_conv_procedure_call): Null 'derived' array for each actual
> > argument. Add its address to the call to gfc_conv_derived_to_
> > class. Access the 'data' field of scalar descriptors before
> > deallocating allocatable components. Also strip NOPs before the
> > calls to gfc_deallocate_alloc_comp. Use 'derived' array as the
> > input to gfc_deallocate_alloc_comp if it is available.
> > * trans.h : Include the optional argument 'derived_array' to
> > the prototype of gfc_conv_derived_to_class. The default value
> > is NULL_TREE.
> >
> > gcc/testsuite/
> > PR fortran/98342
> > * gfortran.dg/assumed_rank_20.f90 : New test.
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München /
> Germany
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
> Alexander Walter
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

[-- Attachment #2: assumed_rank_20.f90 --]
[-- Type: text/x-fortran, Size: 2242 bytes --]

! { dg-do run }
!
! Test the fix for PR98342.
!
! Contributed by Martin Stein  <mscfd@gmx.net>
!
module mod
  implicit none
  private
  public get_tuple, sel_rank1, sel_rank2, sel_rank3

  type, public :: tuple
  integer, dimension(:), allocatable :: t
end type tuple

contains

function sel_rank1(x) result(s)
  character(len=:), allocatable :: s
  type(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '10'
    rank (1)
      s = '11'
    rank default
      s = '?'
  end select
end function sel_rank1

function sel_rank2(x) result(s)
  character(len=:), allocatable :: s
  class(tuple), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '20'
    rank (1)
      s = '21'
    rank default
      s = '?'
  end select
end function sel_rank2

function sel_rank3(x) result(s)
  character(len=:), allocatable :: s
  class(*), dimension(..), intent(in) :: x
  select rank (x)
    rank (0)
      s = '30'
    rank (1)
      s = '31'
    rank default
      s = '?'
  end select
end function sel_rank3

function get_tuple(t) result(a)
  type(tuple) :: a
  integer, dimension(:), intent(in) :: t
  allocate(a%t, source=t)
end function get_tuple

end module mod


program alloc_rank
  use mod
  implicit none

  integer, dimension(1:3) :: x
  character(len=:), allocatable :: output
  type(tuple) :: z

  x = [1,2,3]
  z = get_tuple (x)
                                       ! Derived type formal arg
  output = sel_rank1(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '10') stop 1
  output = sel_rank1([z])              ! This worked OK
  if (output .ne. '11') stop 2

                                       ! Class formal arg
  output = sel_rank2(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '20') stop 3
  output = sel_rank2([z])              ! This worked OK
  if (output .ne. '21') stop 4

                                       ! Unlimited polymorphic formal arg
  output = sel_rank3(get_tuple (x))    ! runtime: Error in `./alloc_rank.x':
  if (output .ne. '30') stop 5
  output = sel_rank3([z])              ! runtime: segmentation fault
  if (output .ne. '31') stop 6

  deallocate (output)
  deallocate (z%t)
end program alloc_rank

Re: [Patch, fortran] PR98342 - Allocatable component in call to assumed-rank routine causes invalid pointer

[Tobias Burnus]

On 01.02.21 19:28, Paul Richard Thomas wrote:

> I have attached a memory leak free version of the testcase. I have
> asked for Thomas's help to use frontend-passes.c tools to do the same
> for compound constructors with allocatable components. My attempts to
> do the job in other ways have failed totally.

Well, if we can do it in the FE passes, why not.

I also do not mind if we have memory leaks in the testcase – if either
the standard permits it or if (as here) a PR exists, which tracks the
issue. (Especially as it is not a new issue.)

I am fine with either testcase – the non-memory-leaking one is nicer, if
we are reasonably sure it tests the right thing. (I think we are.) If
not, we should instead/additionally add the currently leaking variant.

Thanks for looking into this,

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter