[Patch, fortran] PR84074 Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic

[Patch, fortran] PR84074 Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic

[Paul Richard Thomas]

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

Hi All,

This patch makes sure that offsets and bounds are correct in passing
derived types to class formal arrays. It is straightforward enough as
not to require explanation.

Bootstraps and regtests on FC25/x86_64 - OK for trunk?

Paul

2018-02-11  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/84074
* trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
flag. If the is a vector subscript or the expression is not a
variable, make the descriptor one-based.

2018-02-11  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/84074
* gfortran.dg/type_to_class_5.f03: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 3114 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 257549)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_derived_to_class (gfc_se *parms
*** 547,552 ****
--- 547,553 ----
    tree ctree;
    tree var;
    tree tmp;
+   int dim;
  
    /* The derived type needs to be converted to a temporary
       CLASS object.  */
*************** gfc_conv_derived_to_class (gfc_se *parms
*** 636,645 ****
--- 637,670 ----
  	{
  	  stmtblock_t block;
  	  gfc_init_block (&block);
+ 	  gfc_ref *ref;
  
  	  parmse->ss = ss;
+ 	  parmse->use_offset = 1;
  	  gfc_conv_expr_descriptor (parmse, e);
  
+ 	  /* Detect any vector array references.  */
+ 	  for (ref = e->ref; ref; ref = ref->next)
+ 	    if (ref->type == REF_ARRAY
+ 		&& ref->u.ar.type != AR_ELEMENT
+ 		&& ref->u.ar.type != AR_FULL)
+ 	      {
+ 		for (dim = 0; dim < ref->u.ar.dimen; dim++)
+ 		  if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+ 		    break;
+ 		if (dim < ref->u.ar.dimen)
+ 		  break;
+ 	      }
+ 
+ 	  /* Vector array references and non-variable expressions need be
+ 	     coverted to one-based descriptors.  */
+ 	  if (ref || e->expr_type != EXPR_VARIABLE)
+ 	    {
+ 	      for (dim = 0; dim < e->rank; ++dim)
+ 		gfc_conv_shift_descriptor_lbound (&block, parmse->expr, dim,
+ 						  gfc_index_one_node);
+ 	    }
+ 
  	  if (e->rank != class_ts.u.derived->components->as->rank)
  	    {
  	      gcc_assert (class_ts.u.derived->components->as->type
*************** gfc_trans_assignment_1 (gfc_expr * expr1
*** 10105,10111 ****
  				   &expr1->where, msg);
  	}
  
!       /* Deallocate the lhs parameterized components if required.  */ 
        if (dealloc && expr2->expr_type == EXPR_FUNCTION
  	  && !expr1->symtree->n.sym->attr.associate_var)
  	{
--- 10130,10136 ----
  				   &expr1->where, msg);
  	}
  
!       /* Deallocate the lhs parameterized components if required.  */
        if (dealloc && expr2->expr_type == EXPR_FUNCTION
  	  && !expr1->symtree->n.sym->attr.associate_var)
  	{
Index: gcc/testsuite/gfortran.dg/type_to_class_5.f03
===================================================================
*** gcc/testsuite/gfortran.dg/type_to_class_5.f03	(nonexistent)
--- gcc/testsuite/gfortran.dg/type_to_class_5.f03	(working copy)
***************
*** 0 ****
--- 1,29 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR84074
+ !
+ ! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
+ !
+   type :: t
+       integer :: n
+   end type
+ 
+   type(t) :: array(4) = [t(1),t(2),t(3),t(4)]
+ 
+   call sub(array((/3,1/)), [3,1,0,0]) ! Does not increment any elements of 'array'.
+   call sub(array(1:3:2), [1,3,0,0])
+   call sub(array(3:1:-2), [4,2,0,0])
+   call sub(array, [3,2,5,4])          ! Elements 1 and 3 should have been incremented twice.
+ 
+ contains
+ 
+   subroutine sub(a, iarray)
+     class(t) :: a(:)
+     integer :: iarray(4)
+     integer :: i
+     do i=1,size(a)
+         if (a(i)%n .ne. iarray(i)) call abort
+         a(i)%n = a(i)%n+1
+     enddo
+   end subroutine
+ end program

Re: [Patch, fortran] PR84074 Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic

[Steve Kargl]

On Sun, Feb 11, 2018 at 03:08:52PM +0000, Paul Richard Thomas wrote:
> 
> PR fortran/84074
> * trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
> flag. If the is a vector subscript or the expression is not a
> variable, make the descriptor one-based.


"If the is a" ?

> + 
> + 	  /* Vector array references and non-variable expressions need be
> + 	     coverted to one-based descriptors.  */

s/coverted/converted


OK with the above fixed.

-- 
steve

Re: [Patch, fortran] PR84074 Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic

[Paul Richard Thomas]

Committed as revision 257564 with the comment reworded.

Thanks

Paul


On 11 February 2018 at 16:37, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Sun, Feb 11, 2018 at 03:08:52PM +0000, Paul Richard Thomas wrote:
>>
>> PR fortran/84074
>> * trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
>> flag. If the is a vector subscript or the expression is not a
>> variable, make the descriptor one-based.
>
>
> "If the is a" ?
>
>> +
>> +       /* Vector array references and non-variable expressions need be
>> +          coverted to one-based descriptors.  */
>
> s/coverted/converted
>
>
> OK with the above fixed.
>
> --
> steve



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