re PR fortran/56615 (Wrong code with TRANSFER of arrays of character with stride -1)
2013-03-15 Tobias Burnus <burnus@net-b.de> PR fortran/56615 * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays if they are not simply contiguous. 2013-03-15 Tobias Burnus <burnus@net-b.de> PR fortran/56615 * gfortran.dg/transfer_intrinsic_5.f90: New. From-SVN: r196675
This commit is contained in:
parent
83c214a835
commit
4b4a1012fb
4 changed files with 63 additions and 3 deletions
|
@ -1,3 +1,9 @@
|
|||
2013-03-15 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/56615
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays
|
||||
if they are not simply contiguous.
|
||||
|
||||
2013-03-11 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
* gfortran.texi (STRUCTURE and RECORD): State more clearly how
|
||||
|
|
|
@ -5435,9 +5435,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
|
|||
source = gfc_conv_descriptor_data_get (argse.expr);
|
||||
source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
|
||||
|
||||
/* Repack the source if not a full variable array. */
|
||||
if (arg->expr->expr_type == EXPR_VARIABLE
|
||||
&& arg->expr->ref->u.ar.type != AR_FULL)
|
||||
/* Repack the source if not simply contiguous. */
|
||||
if (!gfc_is_simply_contiguous (arg->expr, false))
|
||||
{
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2013-03-15 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/56615
|
||||
* gfortran.dg/transfer_intrinsic_5.f90: New.
|
||||
|
||||
2013-03-15 Kai Tietz <ktietz@redhat.com>
|
||||
|
||||
* gcc.target/i386/movti.c: Don't test for x64 mingw.
|
||||
|
|
50
gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
Normal file
50
gcc/testsuite/gfortran.dg/transfer_intrinsic_5.f90
Normal file
|
@ -0,0 +1,50 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/56615
|
||||
!
|
||||
! Contributed by Harald Anlauf
|
||||
!
|
||||
!
|
||||
program gfcbug
|
||||
implicit none
|
||||
integer, parameter :: n = 8
|
||||
integer :: i
|
||||
character(len=1), dimension(n) :: a, b
|
||||
character(len=n) :: s, t
|
||||
character(len=n/2) :: u
|
||||
|
||||
do i = 1, n
|
||||
a(i) = achar (i-1 + iachar("a"))
|
||||
end do
|
||||
! print *, "# Forward:"
|
||||
! print *, "a=", a
|
||||
s = transfer (a, s)
|
||||
! print *, "s=", s
|
||||
call cmp (a, s)
|
||||
! print *, " stride = +2:"
|
||||
do i = 1, n/2
|
||||
u(i:i) = a(2*i-1)
|
||||
end do
|
||||
! print *, "u=", u
|
||||
call cmp (a(1:n:2), u)
|
||||
! print *
|
||||
! print *, "# Backward:"
|
||||
b = a(n:1:-1)
|
||||
! print *, "b=", b
|
||||
t = transfer (b, t)
|
||||
! print *, "t=", t
|
||||
call cmp (b, t)
|
||||
! print *, " stride = -1:"
|
||||
call cmp (a(n:1:-1), t)
|
||||
contains
|
||||
subroutine cmp (b, s)
|
||||
character(len=1), dimension(:), intent(in) :: b
|
||||
character(len=*), intent(in) :: s
|
||||
character(len=size(b)) :: c
|
||||
c = transfer (b, c)
|
||||
if (c /= s) then
|
||||
print *, "c=", c, " ", merge (" ok","BUG!", c == s)
|
||||
call abort ()
|
||||
end if
|
||||
end subroutine cmp
|
||||
end program gfcbug
|
Loading…
Add table
Reference in a new issue