OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41772 (Wrong code due to TRANSFER of EMPTY array section) 

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

        PR fortran/41772
        * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Stop'extent'
        from going negative.

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

        PR fortran/41772
        * gfortran.dg/transfer_intrinsic_3.f90.

From-SVN: r153817
This commit is contained in:
Paul Thomas 2009-11-02 16:30:48 +00:00 committed by Tobias Burnus
parent 5f9553aa1a
commit 83a23d296d
4 changed files with 51 additions and 0 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 @@
2009-11-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41772
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Stop'extent'
from going negative.
2009-11-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41850

2
gcc/fortran/trans-intrinsic.c
View File

@ -3903,6 +3903,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
scalar_transfer:
extent = fold_build2 (MIN_EXPR, gfc_array_index_type,
dest_word_len, source_bytes);
extent = fold_build2 (MAX_EXPR, gfc_array_index_type,
extent, gfc_index_zero_node);
if (expr->ts.type == BT_CHARACTER)
{

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-11-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41772
* gfortran.dg/transfer_intrinsic_3.f90.
2009-11-01 Tobias Burnus <burnus@net-b.de>
PR fortran/41850

38
gcc/testsuite/gfortran.dg/transfer_intrinsic_3.f90 Normal file
View File

@ -0,0 +1,38 @@
! { dg-do run }
! Tests the fix for PR41772 in which the empty array reference
! 'qname(1:n-1)' was not handled correctly in TRANSFER.
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
module m
implicit none
contains
pure function str_vs(vs) result(s)
character, dimension(:), intent(in) :: vs
character(len=size(vs)) :: s
s = transfer(vs, s)
end function str_vs
subroutine has_key_ns(uri, localname, n)
character(len=*), intent(in) :: uri, localname
integer, intent(in) :: n
if ((n .lt. 2) .and. (len (uri) .ne. 0)) then
call abort
else IF ((n .ge. 2) .and. (len (uri) .ne. n - 1)) then
call abort
end if
end subroutine
end module m
use m
implicit none
character, dimension(:), pointer :: QName
integer :: n
allocate(qname(6))
qname = (/ 'a','b','c','d','e','f' /)
do n = 0, 3
call has_key_ns(str_vs(qname(1:n-1)),"", n)
end do
deallocate(qname)
end
! { dg-final { cleanup-modules "m" } }