Index: gcc/fortran/trans-array.c =================================================================== --- gcc/fortran/trans-array.c (révision 117568) +++ gcc/fortran/trans-array.c (copie de travail) @@ -3540,6 +3540,14 @@ gfc_add_modify_expr (pblock, stride, tmp); else stride = gfc_evaluate_now (tmp, pblock); + + /* Make sure that negative size arrays are translated + to being zero size. */ + tmp = build2 (GE_EXPR, boolean_type_node, + stride, gfc_index_zero_node); + tmp = build3 (COND_EXPR, gfc_array_index_type, tmp, + stride, gfc_index_zero_node); + gfc_add_modify_expr (pblock, stride, tmp); } size = stride; Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (révision 117568) +++ gcc/fortran/ChangeLog (copie de travail) @@ -1,3 +1,9 @@ +2006-10-16 Paul Thomas + + PR fortran/20541 + * trans-array.c (gfc_trans_array_bounds): Test for and set + negative stride of a non-constant bound array to zero. + 2006-10-08 Erik Edelmann Paul Thomas Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (révision 117568) +++ gcc/testsuite/ChangeLog (copie de travail) @@ -1,3 +1,8 @@ +2006-10-16 Paul Thomas + + PR fortran/20541 + * gfortran.dg/negative_automatic_size.f90: New test. + 2006-10-08 Erik Edelmann Paul Thomas Index: gcc/testsuite/gfortran.dg/negative_automatic_size.f90 =================================================================== --- gcc/testsuite/gfortran.dg/negative_automatic_size.f90 (révision 0) +++ gcc/testsuite/gfortran.dg/negative_automatic_size.f90 (révision 0) @@ -0,0 +1,28 @@ +! { dg-do run } +! { dg-options "-O2" } +! Tests the fix PR29451, in which the negative size of the +! automatic array 'jello' was not detected and the +! runtime error: Attempt to allocate a negative amount of memory +! resulted. +! +! Contributed by Philip Mason +! +program fred + call jackal (1, 0) + call jackal (2, 1) + call jackal (3, 0) +end + +subroutine jackal (b, c) + integer :: b, c + integer :: jello(b:c), cake(1:2, b:c), soda(b:c, 1:2) + if (lbound (jello, 1) <= ubound (jello, 1)) call abort () + if (size (jello) /= 0) call abort () + + if (.not.any(lbound (cake) <= ubound (cake))) call abort () + if (size (cake) /= 0) call abort () + + if (.not.any(lbound (soda) <= ubound (soda))) call abort () + if (size (soda) /= 0) call abort () + +end subroutine jackal