diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/intrinsics/spread_generic.c | 69 |
2 files changed, 66 insertions, 10 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bc3ed64d92a..9fc369e678c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2007-09-06 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/33298 + * intrinsics/spread_generic.c(spread_internal): Enable + bounds checking by comparing extents if the bounds_check + option has been set. If any extent is <=0, return early. + 2007-09-06 David Edelsohn <edelsohn@gnu.org> * libgfortran.h: Include config.h first. diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c index 4f34e84cd1c..3752717aa8e 100644 --- a/libgfortran/intrinsics/spread_generic.c +++ b/libgfortran/intrinsics/spread_generic.c @@ -110,26 +110,75 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source, } else { + int zero_sized; + + zero_sized = 0; + dim = 0; if (GFC_DESCRIPTOR_RANK(ret) != rrank) runtime_error ("rank mismatch in spread()"); - for (n = 0; n < rrank; n++) + if (compile_options.bounds_check) { - if (n == *along - 1) + for (n = 0; n < rrank; n++) { - rdelta = ret->dim[n].stride * size; + index_type ret_extent; + + ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound; + if (n == *along - 1) + { + rdelta = ret->dim[n].stride * size; + + if (ret_extent != ncopies) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %d: is %ld," + " should be %ld", n+1, (long int) ret_extent, + (long int) ncopies); + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (ret_extent != extent[dim]) + runtime_error("Incorrect extent in return value of SPREAD" + " intrinsic in dimension %d: is %ld," + " should be %ld", n+1, (long int) ret_extent, + (long int) extent[dim]); + + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride * size; + rstride[dim] = ret->dim[n].stride * size; + dim++; + } } - else + } + else + { + for (n = 0; n < rrank; n++) { - count[dim] = 0; - extent[dim] = source->dim[dim].ubound + 1 - - source->dim[dim].lbound; - sstride[dim] = source->dim[dim].stride * size; - rstride[dim] = ret->dim[n].stride * size; - dim++; + if (n == *along - 1) + { + rdelta = ret->dim[n].stride * size; + } + else + { + count[dim] = 0; + extent[dim] = source->dim[dim].ubound + 1 + - source->dim[dim].lbound; + if (extent[dim] <= 0) + zero_sized = 1; + sstride[dim] = source->dim[dim].stride * size; + rstride[dim] = ret->dim[n].stride * size; + dim++; + } } } + + if (zero_sized) + return; + if (sstride[0] == 0) sstride[0] = size; } |