This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libfortran] Fix PR 38225
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Sat, 22 Nov 2008 21:30:41 +0100
- Subject: [patch, libfortran] Fix PR 38225
Hello world,
this fixes a 4.4 regression where bounds checking for RESHAPE assumed
that only the first dimension of SOURCE mattered. This is obviously
wrong :-)
Will regtest.
OK for trunk once the regtest passes?
Thomas
2008-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
* intrinsics/reshape_generic.c (reshape_internal):
Use all dimensions of source for bounds checking.
* m4/reshape.m4: Likewise.
* generated/reshape_c10.c Regenerated.
* generated/reshape_c16.c Regenerated.
* generated/reshape_c4.c Regenerated.
* generated/reshape_c8.c Regenerated.
* generated/reshape_i16.c Regenerated.
* generated/reshape_i4.c Regenerated.
* generated/reshape_i8.c Regenerated.
* generated/reshape_r10.c Regenerated.
* generated/reshape_r16.c Regenerated.
* generated/reshape_r4.c Regenerated.
* generated/reshape_r8.c Regenerated.
2008-11-22 Thomas Koenig <tkoenig@gcc.gnu.org>
* gfortran.dg/reshape_3.f90: Likewise.
Index: m4/reshape.m4
===================================================================
--- m4/reshape.m4 (revision 142120)
+++ m4/reshape.m4 (working copy)
@@ -139,7 +139,14 @@ reshape_'rtype_ccode` ('rtype` * const r
(long int) ret_extent, (long int) shape_data[n]);
}
- source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ source_extent = 1;
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ for (n = 0; n < sdim; n++)
+ {
+ index_type se;
+ se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ source_extent *= se > 0 ? se : 0;
+ }
if (rs < source_extent || (rs > source_extent && !pad))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
Index: intrinsics/reshape_generic.c
===================================================================
--- intrinsics/reshape_generic.c (revision 142120)
+++ intrinsics/reshape_generic.c (working copy)
@@ -124,7 +124,14 @@ reshape_internal (parray *ret, parray *s
(long int) ret_extent, (long int) shape_data[n]);
}
- source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+ source_extent = 1;
+ sdim = GFC_DESCRIPTOR_RANK (source);
+ for (n = 0; n < sdim; n++)
+ {
+ index_type se;
+ se = source->dim[n].ubound + 1 - source->dim[0].lbound;
+ source_extent *= se > 0 ? se : 0;
+ }
if (rs < source_extent || (rs > source_extent && !pad))
runtime_error("Incorrect size in SOURCE argument to RESHAPE"
! { dg-do run }
! { dg-options "-fbounds-check" }
program main
implicit none
integer, dimension(2,2) :: a4
integer(kind=1), dimension(2,2) :: a1
character(len=100) line
data a4 /1, 2, 3, 4/
a1 = a4
write (unit=line,fmt='(4I3)') reshape(a4,(/4/))
write (unit=line,fmt='(4I3)') reshape(a1,(/4/))
end program main