diff mbox

[Fortran] PR71194 - Fix ICE with pointer assignment

Message ID 20160620121037.GA31517@physik.fu-berlin.de
State New
Headers show

Commit Message

Tobias Burnus June 20, 2016, 12:10 p.m. UTC 
Dear all,

the issue occurs only if the RHS of a pointer assignment is a function and
the ICE is only triggered when a rank remapping is needed.

gfc_conv_expr_descriptor calls for a expr2 gfc_conv_procedure_call, which
sets "se.expr" to NULL_TREE - and the code later tries to access it.

The code correctly sets rse.expr to "tmp", but that does not help as all
actions were wrongly done on lse before. Solution: Stuff the RHS expr2 into
rse not into lse.

Build and regtested* on x86-64-gnu-linux.
OK for the trunk?

Tobias

(* gfortran.dg/graphite/pr68279.f90 fails but is a known PR,
gfortran.dg/vect/vect-8.f90 fails but not only for me, and
gfortran.dg/guality/pr41558.f90 never worked on that system)

Comments

Paul Richard Thomas June 20, 2016, 4:09 p.m. UTC | #1 
Dear Tobias,

Impeccably done, as always :-) OK for trunk.

Thanks for the patch.

Cheers

Paul

On 20 June 2016 at 14:10, Tobias Burnus
<tobias.burnus@physik.fu-berlin.de> wrote:
> Dear all,
>
> the issue occurs only if the RHS of a pointer assignment is a function and
> the ICE is only triggered when a rank remapping is needed.
>
> gfc_conv_expr_descriptor calls for a expr2 gfc_conv_procedure_call, which
> sets "se.expr" to NULL_TREE - and the code later tries to access it.
>
> The code correctly sets rse.expr to "tmp", but that does not help as all
> actions were wrongly done on lse before. Solution: Stuff the RHS expr2 into
> rse not into lse.
>
> Build and regtested* on x86-64-gnu-linux.
> OK for the trunk?
>
> Tobias
>
> (* gfortran.dg/graphite/pr68279.f90 fails but is a known PR,
> gfortran.dg/vect/vect-8.f90 fails but not only for me, and
> gfortran.dg/guality/pr41558.f90 never worked on that system)
diff mbox

Patch

	PR fortran/71194
	* trans-expr.c (gfc_trans_pointer_assignment): Correctly handle
	RHS pointer functions.

	PR fortran/71194
	* gfortran.dg/pointer_remapping_10.f90 | 46 ++++++++++++++++++++++

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8f84712..b5731aa 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7934,11 +7934,11 @@  gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 					       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);
-	      strlen_rhs = lse.string_length;
+	      rse.descriptor_only = 0;
+	      rse.expr = tmp;
+	      rse.direct_byref = 1;
+	      gfc_conv_expr_descriptor (&rse, expr2);
+	      strlen_rhs = rse.string_length;
 	      rse.expr = tmp;
 	    }
 	  else
diff --git a/gcc/testsuite/gfortran.dg/pointer_remapping_10.f90 b/gcc/testsuite/gfortran.dg/pointer_remapping_10.f90
new file mode 100644
index 0000000..4810506
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_remapping_10.f90
@@ -0,0 +1,46 @@ 
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! PR fortran/71194
+!
+! Contributed by T Kondic
+!
+program ice
+implicit none
+integer, parameter :: pa=10, pb=20
+complex, target :: a(pa*pb)
+real, pointer:: ptr(:,:) =>null()
+integer :: i, j, cnt
+logical :: negative
+
+  do i = 1, size(a)
+    a(i) = cmplx(i,-i)
+  end do
+
+  ! Was ICEing before with bounds checks
+  ptr(1:pa*2,1:pb) => conv2real(a)
+
+  negative = .false.
+  cnt = 1
+  do i = 1, ubound(ptr,dim=2)
+    do j = 1, ubound(ptr,dim=1)
+      if (negative) then
+        if (-cnt /= ptr(j, i)) call abort()
+        cnt = cnt + 1
+        negative = .false.
+      else
+        if (cnt /= ptr(j, i)) call abort()
+        negative = .true.
+      end if
+    end do 
+  end do
+
+contains
+  function conv2real(carr)
+    use, intrinsic :: iso_c_binding
+    ! returns real pointer to a complex array
+    complex, contiguous, intent(inout), target  :: carr(:)
+    real,contiguous,pointer :: conv2real(:)
+    call c_f_pointer(c_loc(carr),conv2real,[size(carr)*2])
+  end function conv2real
+end program