Commit 47b3a403 by Thomas Koenig Committed by Thomas Koenig

re PR fortran/21594 ([4.0 only] FAIL: gfortran.dg/eoshift.f90 -O0 execution test)

2005-07-07  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-07  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.

From-SVN: r101738
parent 5a29b385
2005-07-07 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.
2005-07-07 Ziemowit Laski <zlaski@apple.com> 2005-07-07 Ziemowit Laski <zlaski@apple.com>
* obj-c++.dg/gnu-runtime-2.mm: Compile, do not run. * obj-c++.dg/gnu-runtime-2.mm: Compile, do not run.
......
...@@ -11,10 +11,18 @@ program intrinsic_eoshift ...@@ -11,10 +11,18 @@ program intrinsic_eoshift
call abort call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) 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) a = eoshift (a, -2, dim = 2)
if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) & if (any (a .ne. reshape ((/0, 0, 0, 0, 0, 0, 1, 2, 3/), (/3, 3/)))) &
call abort 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. ! Array shift and scalar bound.
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
a = eoshift (a, (/1, 0, -1/), 99, 1) a = eoshift (a, (/1, 0, -1/), 99, 1)
...@@ -22,6 +30,11 @@ program intrinsic_eoshift ...@@ -22,6 +30,11 @@ program intrinsic_eoshift
call abort call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) 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) a = eoshift (a, (/2, -2, 0/), dim = 2)
if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) & if (any (a .ne. reshape ((/7, 0, 3, 0, 0, 6, 0, 2, 9/), (/3, 3/)))) &
call abort call abort
...@@ -33,6 +46,16 @@ program intrinsic_eoshift ...@@ -33,6 +46,16 @@ program intrinsic_eoshift
call abort call abort
a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) 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) a = eoshift (a, -2, (/99, -1, 42/), 2)
if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) & if (any (a .ne. reshape ((/99, -1, 42, 99, -1, 42, 1, 2, 3/), (/3, 3/)))) &
call abort call abort
...@@ -61,6 +84,11 @@ program intrinsic_eoshift ...@@ -61,6 +84,11 @@ program intrinsic_eoshift
if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), & if (any (a .ne. reshape ((/ -999, -999, -999, -99, 4, 5, -9, -9, -9 /), &
shape(a)))) call abort 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 ! Test arrays > rank 2
b(:, :, 1) = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)) 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/)) b(:, :, 2) = 10 + reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/))
......
2005-07-07 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-07 Feng Wang <fengwang@nudt.edu.cn> 2005-07-07 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/16531 PR fortran/16531
......
...@@ -158,7 +158,14 @@ eoshift1_4 (gfc_array_char *ret, ...@@ -158,7 +158,14 @@ eoshift1_4 (gfc_array_char *ret,
{ {
/* Do the shift for this dimension. */ /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
...@@ -158,7 +158,14 @@ eoshift1_8 (gfc_array_char *ret, ...@@ -158,7 +158,14 @@ eoshift1_8 (gfc_array_char *ret,
{ {
/* Do the shift for this dimension. */ /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
...@@ -167,7 +167,14 @@ eoshift3_4 (gfc_array_char *ret, gfc_array_char *array, ...@@ -167,7 +167,14 @@ eoshift3_4 (gfc_array_char *ret, gfc_array_char *array,
{ {
/* Do the shift for this dimension. */ /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
...@@ -167,7 +167,14 @@ eoshift3_8 (gfc_array_char *ret, gfc_array_char *array, ...@@ -167,7 +167,14 @@ eoshift3_8 (gfc_array_char *ret, gfc_array_char *array,
{ {
/* Do the shift for this dimension. */ /* Do the shift for this dimension. */
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
...@@ -131,10 +131,19 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, ...@@ -131,10 +131,19 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array,
sstride0 = sstride[0]; sstride0 = sstride[0];
rptr = ret->data; rptr = ret->data;
sptr = array->data; sptr = array->data;
if ((shift >= 0 ? shift : -shift) > len)
{
shift = len;
len = 0;
}
else
{
if (shift > 0) if (shift > 0)
len = len - shift; len = len - shift;
else else
len = len + shift; len = len + shift;
}
while (rptr) while (rptr)
{ {
......
...@@ -139,15 +139,24 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, ...@@ -139,15 +139,24 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array,
bstride0 = bstride[0]; bstride0 = bstride[0];
rptr = ret->data; rptr = ret->data;
sptr = array->data; sptr = array->data;
if (bound)
bptr = bound->data;
else
bptr = zeros;
if ((shift >= 0 ? shift : -shift ) > len)
{
shift = len;
len = 0;
}
else
{
if (shift > 0) if (shift > 0)
len = len - shift; len = len - shift;
else else
len = len + shift; len = len + shift;
}
if (bound)
bptr = bound->data;
else
bptr = zeros;
while (rptr) while (rptr)
{ {
......
...@@ -159,7 +159,14 @@ eoshift1_`'atype_kind (gfc_array_char *ret, ...@@ -159,7 +159,14 @@ eoshift1_`'atype_kind (gfc_array_char *ret,
{ {
` /* Do the shift for this dimension. */' ` /* Do the shift for this dimension. */'
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
...@@ -168,7 +168,14 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array, ...@@ -168,7 +168,14 @@ eoshift3_`'atype_kind (gfc_array_char *ret, gfc_array_char *array,
{ {
` /* Do the shift for this dimension. */' ` /* Do the shift for this dimension. */'
sh = *hptr; sh = *hptr;
if (( sh >= 0 ? sh : -sh ) > len)
{
delta = len;
sh = len;
}
else
delta = (sh >= 0) ? sh: -sh; delta = (sh >= 0) ? sh: -sh;
if (sh > 0) if (sh > 0)
{ {
src = &sptr[delta * soffset]; src = &sptr[delta * soffset];
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment