procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/71194 (ICE on compilation with fcheck=all ; -fcheck=bounds)

Browse source 
2016-06-20  Tobias Burnus  <burnus@net-b.de>

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

2016-06-20  Tobias Burnus  <burnus@net-b.de>

        PR fortran/71194
        * gfortran.dg/pointer_remapping_10.f90: New.

From-SVN: r237612
This commit is contained in:
Tobias Burnus 2016-06-20 20:46:43 +02:00 • committed by Tobias Burnus
parent 842107e43d
commit f1b5abfbbb
4 changed files with 62 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View file

@ -1,3 +1,9 @@
2016-06-20 Tobias Burnus <burnus@net-b.de>
fortran/71194
* trans-expr.c (gfc_trans_pointer_assignment): Correctly handle
RHS pointer functions.
2016-06-19 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* class.c (gfc_add_class_array_ref): Call gfc_add_data_component()

10
gcc/fortran/trans-expr.c
View file

@ -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

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2016-06-20 Tobias Burnus <burnus@net-b.de>
PR fortran/71194
* gfortran.dg/pointer_remapping_10.f90: New.
2016-06-20 David Malcolm <dmalcolm@redhat.com>
* g++.dg/diagnostic/string-literal-concat.C: New test case.

46
gcc/testsuite/gfortran.dg/pointer_remapping_10.f90 Normal file
View file

@ -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