re PR fortran/35698 (lbound and ubound wrong for allocated run-time zero size array)

2008-03-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35698
	* trans-array.c (gfc_array_init_size): Set 'size' zero if
	negative in one dimension.

	PR fortran/35702
	* trans-expr.c (gfc_trans_string_copy): Only assign a char
	directly if the lhs and rhs types are the same.

2008-03-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35698
	* gfortran.dg/allocate_zerosize_3.f: New test.

	PR fortran/35702
	* gfortran.dg/character_assign_1.f90: New test.

From-SVN: r133710
This commit is contained in:
Paul Thomas 2008-03-29 08:11:02 +00:00
parent dbc518f09c
commit 067feae32f
6 changed files with 82 additions and 2 deletions

View File

@ -1,3 +1,13 @@
2008-03-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35698
* trans-array.c (gfc_array_init_size): Set 'size' zero if
negative in one dimension.
PR fortran/35702
* trans-expr.c (gfc_trans_string_copy): Only assign a char
directly if the lhs and rhs types are the same.
2008-03-28 Daniel Franke <franke.daniel@gmail.com>
Paul Richard Thomas <paul.richard.thomas@gmail.com>

View File

@ -3505,7 +3505,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
size = 1 - lbound;
a.ubound[n] = specified_upper_bound;
a.stride[n] = stride;
size = ubound + size; //size = ubound + 1 - lbound
size = siz >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
stride = stride * size;
}
return (stride);
@ -3605,6 +3605,9 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
else
or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
size = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
gfc_index_zero_node, size);
/* Multiply the stride by the number of elements in this dimension. */
stride = fold_build2 (MULT_EXPR, gfc_array_index_type, stride, size);
stride = gfc_evaluate_now (stride, pblock);

View File

@ -2858,7 +2858,9 @@ gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
dsc = gfc_to_single_character (dlen, dest);
if (dsc != NULL_TREE && ssc != NULL_TREE)
/* Assign directly if the types are compatible. */
if (dsc != NULL_TREE && ssc != NULL_TREE
&& TREE_TYPE (dsc) == TREE_TYPE (ssc))
{
gfc_add_modify_expr (block, dsc, ssc);
return;

View File

@ -1,3 +1,11 @@
2008-03-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35698
* gfortran.dg/allocate_zerosize_3.f: New test.
PR fortran/35702
* gfortran.dg/character_assign_1.f90: New test.
2008-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/32972

View File

@ -0,0 +1,40 @@
C { dg-do run }
C Test the fix for PR35698, in which the negative size dimension would
C throw out the subsequent bounds.
C
C Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
C
program try_lf0030
call LF0030(10)
end
SUBROUTINE LF0030(nf10)
INTEGER ILA1(7)
INTEGER ILA2(7)
LOGICAL LLA(:,:,:,:,:,:,:)
INTEGER ICA(7)
ALLOCATABLE LLA
ALLOCATE (LLA(2:3, 4, 0:5,
$ NF10:1, -2:7, -3:8,
$ -4:9))
ILA1 = LBOUND(LLA)
ILA2 = UBOUND(LLA)
C CORRECT FOR THE ZERO DIMENSIONED TERM TO ALLOW AN EASIER VERIFY
ILA1(4) = ILA1(4) - 2 ! 1 - 2 = -1
ILA2(4) = ILA2(4) + 6 ! 0 + 6 = 6
DO J1 = 1,7
IVAL = 3-J1
IF (ILA1(J1) .NE. IVAL) call abort ()
100 ENDDO
DO J1 = 1,7
IVAL = 2+J1
IF (ILA2(J1) .NE. IVAL) call abort ()
101 ENDDO
END SUBROUTINE

View File

@ -0,0 +1,17 @@
! { dg-do compile }
! Tests the fix for PR35702, which caused an ICE because the types in the assignment
! were not translated to be the same.
!
! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
!
MODULE TESTS
TYPE UNSEQ
CHARACTER(1) :: C
END TYPE UNSEQ
CONTAINS
SUBROUTINE CG0028 (TDA1L, TDA1R, nf0, nf1, nf2, nf3)
TYPE(UNSEQ) TDA1L(NF3)
TDA1L(NF1:NF2:NF1)%C = TDA1L(NF0+2:NF3:NF2/2)%C
END SUBROUTINE
END MODULE TESTS
! { dg-final { cleanup-modules "tests" } }