mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-22 21:31:19 +08:00
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:
parent
dbc518f09c
commit
067feae32f
@ -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>
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
40
gcc/testsuite/gfortran.dg/allocate_zerosize_3.f
Normal file
40
gcc/testsuite/gfortran.dg/allocate_zerosize_3.f
Normal 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
|
||||
|
17
gcc/testsuite/gfortran.dg/character_assign_1.f90
Normal file
17
gcc/testsuite/gfortran.dg/character_assign_1.f90
Normal 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" } }
|
Loading…
x
Reference in New Issue
Block a user