[patch, libfortran] Fix for PR 21594
Thomas Koenig
Thomas.Koenig@online.de
Mon Jul 4 22:09:00 GMT 2005
Regression-tested on mainline. OK (plus for 4.0, once it reopens)?
Thomas
2005-07-04 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/21594
* intrinsics/eoshift0.c: If abs(shift) > len, fill the
the whole array with the boundary value, but don't overrun it.
* intrinsics/eoshift2.c: Likewise.
* m4/eoshift1.m4: Likewise.
* m4/eoshift3.m4: Likewise.
* generated/eoshift1_4.c: Regenerated.
* generated/eoshift1_8.c: Regenerated.
* generated/eoshift3_4.c: Regenerated.
* generated/eoshift3_8.c: Regenerated.
2005-07-04 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/21594
* gfortran.fortran-torture/execute/intrinsic_eoshift.f90:
Add test cases where the shift length is greater than the
array length.
-------------- next part --------------
Index: intrinsic_eoshift.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_eoshift.f90,v
retrieving revision 1.4
diff -c -p -r1.4 intrinsic_eoshift.f90
*** intrinsic_eoshift.f90 28 Jun 2005 23:07:20 -0000 1.4
--- intrinsic_eoshift.f90 4 Jul 2005 21:34:56 -0000
*************** program intrinsic_eoshift
*** 11,20 ****
--- 11,28 ----
call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, 9999, 99, 1)
+ if (any (a .ne. 99)) call abort
+
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
a = eoshift (a, -2, dim = 2)
if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
call abort
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, -9999, 99, 1)
+ if (any (a .ne. 99)) call abort
+
! Array shift and scalar bound.
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
a = eoshift (a, (/1, 0, -1/), 99, 1)
*************** program intrinsic_eoshift
*** 22,27 ****
--- 30,40 ----
call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, (/9999, 0, -9999/), 99, 1)
+ if (any (a .ne. reshape ((/99, 99, 99, 4, 5, 6, 99, 99, 99/), (/3, 3/)))) &
+ call abort
+
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
a = eoshift (a, (/2, -2, 0/), dim = 2)
if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
call abort
*************** program intrinsic_eoshift
*** 33,38 ****
--- 46,61 ----
call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, 9999, (/99, -1, 42/), 1)
+ if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
+ (/3, 3/)))) call abort
+
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, -9999, (/99, -1, 42/), 1)
+ if (any (a .ne. reshape ((/99, 99, 99, -1, -1, -1, 42, 42, 42/), &
+ (/3, 3/)))) call abort
+
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
a = eoshift (a, -2, (/99, -1, 42/), 2)
if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
call abort
*************** program intrinsic_eoshift
*** 61,66 ****
--- 84,94 ----
if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
shape(a)))) call abort
+ a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
+ a = eoshift (a, (/9999, -9999, 0/), (/99, -1, 42/), 2)
+ if (any (a .ne. reshape ((/99, -1, 3, 99, -1, 6, 99, -1, 9/), (/3, 3/)))) &
+ call abort
+
! Test arrays > rank 2
b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
-------------- next part --------------
Index: intrinsics/eoshift0.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/eoshift0.c,v
retrieving revision 1.13
diff -c -p -r1.13 eoshift0.c
*** intrinsics/eoshift0.c 14 Jun 2005 20:45:20 -0000 1.13
--- intrinsics/eoshift0.c 4 Jul 2005 21:33:33 -0000
*************** eoshift0 (gfc_array_char * ret, const gf
*** 131,140 ****
sstride0 = sstride[0];
rptr = ret->data;
sptr = array->data;
! if (shift > 0)
! len = len - shift;
else
! len = len + shift;
while (rptr)
{
--- 131,149 ----
sstride0 = sstride[0];
rptr = ret->data;
sptr = array->data;
!
! if ((shift >= 0 ? shift : -shift) > len)
! {
! shift = len;
! len = 0;
! }
else
! {
! if (shift > 0)
! len = len - shift;
! else
! len = len + shift;
! }
while (rptr)
{
Index: intrinsics/eoshift2.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/intrinsics/eoshift2.c,v
retrieving revision 1.13
diff -c -p -r1.13 eoshift2.c
*** intrinsics/eoshift2.c 14 Jun 2005 20:45:21 -0000 1.13
--- intrinsics/eoshift2.c 4 Jul 2005 21:33:33 -0000
*************** eoshift2 (gfc_array_char *ret, const gfc
*** 139,154 ****
bstride0 = bstride[0];
rptr = ret->data;
sptr = array->data;
if (bound)
bptr = bound->data;
else
bptr = zeros;
- if (shift > 0)
- len = len - shift;
- else
- len = len + shift;
-
while (rptr)
{
/* Do the shift for this dimension. */
--- 139,163 ----
bstride0 = bstride[0];
rptr = ret->data;
sptr = array->data;
+
+ if ((shift >= 0 ? shift : -shift ) > len)
+ {
+ shift = len;
+ len = 0;
+ }
+ else
+ {
+ if (shift > 0)
+ len = len - shift;
+ else
+ len = len + shift;
+ }
+
if (bound)
bptr = bound->data;
else
bptr = zeros;
while (rptr)
{
/* Do the shift for this dimension. */
Index: m4/eoshift1.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/eoshift1.m4,v
retrieving revision 1.10
diff -c -p -r1.10 eoshift1.m4
*** m4/eoshift1.m4 28 Jun 2005 23:07:06 -0000 1.10
--- m4/eoshift1.m4 4 Jul 2005 21:33:33 -0000
*************** eoshift1_`'atype_kind (gfc_array_char *r
*** 159,165 ****
{
` /* Do the shift for this dimension. */'
sh = *hptr;
! delta = (sh >= 0) ? sh: -sh;
if (sh > 0)
{
src = &sptr[delta * soffset];
--- 159,172 ----
{
` /* Do the shift for this dimension. */'
sh = *hptr;
! if (( sh >= 0 ? sh : -sh ) > len)
! {
! delta = len;
! sh = len;
! }
! else
! delta = (sh >= 0) ? sh: -sh;
!
if (sh > 0)
{
src = &sptr[delta * soffset];
Index: m4/eoshift3.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/eoshift3.m4,v
retrieving revision 1.10
diff -c -p -r1.10 eoshift3.m4
*** m4/eoshift3.m4 28 Jun 2005 21:57:34 -0000 1.10
--- m4/eoshift3.m4 4 Jul 2005 21:33:33 -0000
*************** eoshift3_`'atype_kind (gfc_array_char *r
*** 168,174 ****
{
` /* Do the shift for this dimension. */'
sh = *hptr;
! delta = (sh >= 0) ? sh: -sh;
if (sh > 0)
{
src = &sptr[delta * soffset];
--- 168,181 ----
{
` /* Do the shift for this dimension. */'
sh = *hptr;
! if (( sh >= 0 ? sh : -sh ) > len)
! {
! delta = len;
! sh = len;
! }
! else
! delta = (sh >= 0) ? sh: -sh;
!
if (sh > 0)
{
src = &sptr[delta * soffset];
More information about the Fortran
mailing list