[Patch, fortran] PR61138 Wrong code with pointer-bounds remapping

[Mikael Morin <mikael.morin@sfr.fr>]

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

Hello,

this is about a pointer bounds remapping regression introduced at
http://gcc.gnu.org/r190641
That revision introduced support for se.descriptor_only in
gfc_conv_expr_descriptor with this hunk:

> Index: trans-array.c
> ===================================================================
> --- trans-array.c	(révision 220514)
> +++ trans-array.c	(copie de travail)
> @@ -6574,7 +6574,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *ex
>  	  /* Create a new descriptor if the array doesn't have one.  */
>  	  full = 0;
>  	}
> -      else if (info->ref->u.ar.type == AR_FULL)
> +      else if (info->ref->u.ar.type == AR_FULL || se->descriptor_only)
>  	full = 1;
>        else if (se->direct_byref)
>  	full = 0;

The problem comes from gfc_trans_pointer_assign, which uses several
times the same gfc_se struct, the first time with descriptor_only set,
the other times without clearing it.
This was not a problem before the above change, because the flag wasn't
looked at.
After the change however, one should make sure that descriptor_only is
not inherited from a previous use.

The fix proposed clears the flag upon reuse, which should match exactly
the original behaviour, making it rather safe, and suitable also for the
branches.
I have to admit that I'm not completely satisfied with it however.
I would prefer no GFC_SE reuse at all, namely collect every piece of
code in a separate struct, and merge them later explicitly into a block.
 Alas, the code is not exactly straightforward to my eyes, and my
attempt in that direction to sneak some orthogonality in that madness
failed.

Anyway, regression tested on x86_64-linux, OK for trunk/4.9/4.8 ?

Mikael

[-- Attachment #2: pr61138.CL --]
[-- Type: text/plain, Size: 275 bytes --]

2015-02-09  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/61138
	* trans-expr.c (gfc_trans_pointer_assignment): Clear DESCRIPTOR_ONLY
	field before reusing LSE.

2015-02-09  Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/61138
	gfortran.dg/pointer_remapping_9.f90: New.
	

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: pr61138.diff --]
[-- Type: text/x-patch; name="pr61138.diff", Size: 1153 bytes --]

Index: trans-expr.c
===================================================================
--- trans-expr.c	(révision 220514)
+++ trans-expr.c	(copie de travail)
@@ -7339,6 +7339,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gf
 					       bound, bound, 0,
 					       GFC_ARRAY_POINTER_CONT, false);
 	      tmp = gfc_create_var (tmp, "ptrtemp");
+	      lse.descriptor_only = 0;
 	      lse.expr = tmp;
 	      lse.direct_byref = 1;
 	      gfc_conv_expr_descriptor (&lse, expr2);
@@ -7354,6 +7355,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gf
       else if (expr2->expr_type == EXPR_VARIABLE)
 	{
 	  /* Assign directly to the LHS's descriptor.  */
+	  lse.descriptor_only = 0;
 	  lse.direct_byref = 1;
 	  gfc_conv_expr_descriptor (&lse, expr2);
 	  strlen_rhs = lse.string_length;
@@ -7405,6 +7407,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gf
 	  /* Assign to a temporary descriptor and then copy that
 	     temporary to the pointer.  */
 	  tmp = gfc_create_var (TREE_TYPE (desc), "ptrtemp");
+	  lse.descriptor_only = 0;
 	  lse.expr = tmp;
 	  lse.direct_byref = 1;
 	  gfc_conv_expr_descriptor (&lse, expr2);



[-- Attachment #4: pointer_remapping_9.f90 --]
[-- Type: text/x-fortran, Size: 670 bytes --]

! { dg-do run }
!
! PR fortran/61138
! Wrong code with pointer-bounds remapping
!
! Contributed by Tobias Burnus <burnus@net-b.de>

implicit none
integer, target :: tgt(10)
integer, target, allocatable :: tgt2(:)
integer, pointer :: ptr(:)

tgt = [1,2,3,4,5,6,7,8,9,10]
tgt2 = [1,2,3,4,5,6,7,8,9,10]


ptr(-5:) => tgt(5:)  ! Okay

if (size(ptr) /= 6 .or. lbound(ptr,1) /= -5) call abort()
if (any (ptr /= [5,6,7,8,9,10])) call abort()


ptr(-5:) => tgt2(5:)  ! wrongly associates the whole array

print '(*(i4))', size(ptr), lbound(ptr)
print '(*(i4))', ptr

if (size(ptr) /= 6 .or. lbound(ptr,1) /= -5) call abort()
if (any (ptr /= [5,6,7,8,9,10])) call abort()
end