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

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

Browse source 
2009-10-24  Paul Thomas  <pault@gcc.gnu.org>

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

2009-10-24  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r153524
This commit is contained in:
Paul Thomas 2009-10-24 10:11:46 +00:00
parent 72580319c2
commit c0f81f78ae
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-10-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41772
* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Stop'extent'
from going negative.
2009-10-23 Janus Weil <janus@gcc.gnu.org>
PR fortran/41800

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

@ -4490,6 +4490,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-10-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41772
* gfortran.dg/transfer_intrinsic_3.f90.
2009-10-24 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/opt4.adb: New test.

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" } }