re PR fortran/83683 (eoshift accepts wrong-length boundary)
2018-01-04 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/83683 PR fortran/45689 * check.c (gfc_check_eoshift): Check for string length and for conformance of boundary. * intrinsic.c (add_functions): Add gfc_simplify_eoshift. * intrinsic.h: Add prototype for gfc_simplify_eoshift. * simplify.c (gfc_simplify_eoshift): New function. 2018-01-04 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/83683 PR fortran/45689 * gfortran.dg/eoshift_8.f90: New test. * gfortran.dg/simplify_eoshift_1.f90: New test. From-SVN: r256265
This commit is contained in:
Thomas Koenig
parent
1e678f69f7
commit
fbd35ba1b3
8 changed files with 433 additions and 16 deletions
|
|
@ -1,3 +1,13 @@
|
|||
2018-01-04 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/83683
|
||||
PR fortran/45689
|
||||
* check.c (gfc_check_eoshift): Check for string length and
|
||||
for conformance of boundary.
|
||||
* intrinsic.c (add_functions): Add gfc_simplify_eoshift.
|
||||
* intrinsic.h: Add prototype for gfc_simplify_eoshift.
|
||||
* simplify.c (gfc_simplify_eoshift): New function.
|
||||
|
||||
2018-01-03 Richard Sandiford <richard.sandiford@linaro.org>
|
||||
Alan Hayward <alan.hayward@arm.com>
|
||||
David Sherwood <david.sherwood@arm.com>
|
||||
|
|
|
|||
|
|
@ -2185,6 +2185,8 @@ bool
|
|||
gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
||||
gfc_expr *dim)
|
||||
{
|
||||
int d;
|
||||
|
||||
if (!array_check (array, 0))
|
||||
return false;
|
||||
|
||||
|
|
@ -2197,6 +2199,13 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
|||
if (!dim_rank_check (dim, array, false))
|
||||
return false;
|
||||
|
||||
if (!dim)
|
||||
d = 1;
|
||||
else if (dim->expr_type == EXPR_CONSTANT)
|
||||
gfc_extract_int (dim, &d);
|
||||
else
|
||||
d = -1;
|
||||
|
||||
if (array->rank == 1 || shift->rank == 0)
|
||||
{
|
||||
if (!scalar_check (shift, 1))
|
||||
|
|
@ -2204,14 +2213,6 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
|||
}
|
||||
else if (shift->rank == array->rank - 1)
|
||||
{
|
||||
int d;
|
||||
if (!dim)
|
||||
d = 1;
|
||||
else if (dim->expr_type == EXPR_CONSTANT)
|
||||
gfc_extract_int (dim, &d);
|
||||
else
|
||||
d = -1;
|
||||
|
||||
if (d > 0)
|
||||
{
|
||||
int i, j;
|
||||
|
|
@ -2246,6 +2247,24 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
|||
if (!same_type_check (array, 0, boundary, 2))
|
||||
return false;
|
||||
|
||||
/* Reject unequal string lengths and emit a better error message than
|
||||
gfc_check_same_strlen would. */
|
||||
if (array->ts.type == BT_CHARACTER)
|
||||
{
|
||||
ssize_t len_a, len_b;
|
||||
|
||||
len_a = gfc_var_strlen (array);
|
||||
len_b = gfc_var_strlen (boundary);
|
||||
if (len_a != -1 && len_b != -1 && len_a != len_b)
|
||||
{
|
||||
gfc_error ("%qs must be of same type and kind as %qs at %L in %qs",
|
||||
gfc_current_intrinsic_arg[2]->name,
|
||||
gfc_current_intrinsic_arg[0]->name,
|
||||
&boundary->where, gfc_current_intrinsic);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
if (array->rank == 1 || boundary->rank == 0)
|
||||
{
|
||||
if (!scalar_check (boundary, 2))
|
||||
|
|
@ -2253,13 +2272,27 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
|||
}
|
||||
else if (boundary->rank == array->rank - 1)
|
||||
{
|
||||
if (!gfc_check_conformance (shift, boundary,
|
||||
"arguments '%s' and '%s' for "
|
||||
"intrinsic %s",
|
||||
gfc_current_intrinsic_arg[1]->name,
|
||||
gfc_current_intrinsic_arg[2]->name,
|
||||
gfc_current_intrinsic))
|
||||
return false;
|
||||
if (d > 0)
|
||||
{
|
||||
int i,j;
|
||||
for (i = 0, j = 0; i < array->rank; i++)
|
||||
{
|
||||
if (i != d - 1)
|
||||
{
|
||||
if (!identical_dimen_shape (array, i, boundary, j))
|
||||
{
|
||||
gfc_error ("%qs argument of %qs intrinsic at %L has "
|
||||
"invalid shape in dimension %d (%ld/%ld)",
|
||||
gfc_current_intrinsic_arg[2]->name,
|
||||
gfc_current_intrinsic, &shift->where, i+1,
|
||||
mpz_get_si (array->shape[i]),
|
||||
mpz_get_si (boundary->shape[j]));
|
||||
return false;
|
||||
}
|
||||
j += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1756,7 +1756,7 @@ add_functions (void)
|
|||
make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
|
||||
|
||||
add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
|
||||
gfc_check_eoshift, NULL, gfc_resolve_eoshift,
|
||||
gfc_check_eoshift, gfc_simplify_eoshift, gfc_resolve_eoshift,
|
||||
ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
|
||||
bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
|
||||
|
||||
|
|
|
|||
|
|
@ -287,6 +287,7 @@ gfc_expr *gfc_simplify_dot_product (gfc_expr *, gfc_expr *);
|
|||
gfc_expr *gfc_simplify_dreal (gfc_expr *);
|
||||
gfc_expr *gfc_simplify_dshiftl (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_expr *gfc_simplify_dshiftr (gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_expr *gfc_simplify_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
|
||||
gfc_expr *gfc_simplify_epsilon (gfc_expr *);
|
||||
gfc_expr *gfc_simplify_erf (gfc_expr *);
|
||||
gfc_expr *gfc_simplify_erfc (gfc_expr *);
|
||||
|
|
|
|||
|
|
@ -2347,6 +2347,271 @@ gfc_simplify_dshiftl (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg)
|
|||
}
|
||||
|
||||
|
||||
gfc_expr *
|
||||
gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
|
||||
gfc_expr *dim)
|
||||
{
|
||||
bool temp_boundary;
|
||||
gfc_expr *bnd;
|
||||
gfc_expr *result;
|
||||
int which;
|
||||
gfc_expr **arrayvec, **resultvec;
|
||||
gfc_expr **rptr, **sptr;
|
||||
mpz_t size;
|
||||
size_t arraysize, i;
|
||||
gfc_constructor *array_ctor, *shift_ctor, *bnd_ctor;
|
||||
ssize_t shift_val, len;
|
||||
ssize_t count[GFC_MAX_DIMENSIONS], extent[GFC_MAX_DIMENSIONS],
|
||||
sstride[GFC_MAX_DIMENSIONS], a_extent[GFC_MAX_DIMENSIONS],
|
||||
a_stride[GFC_MAX_DIMENSIONS], ss_ex[GFC_MAX_DIMENSIONS];
|
||||
ssize_t rsoffset;
|
||||
int d, n;
|
||||
bool continue_loop;
|
||||
gfc_expr **src, **dest;
|
||||
size_t s_len;
|
||||
|
||||
if (!is_constant_array_expr (array))
|
||||
return NULL;
|
||||
|
||||
if (shift->rank > 0)
|
||||
gfc_simplify_expr (shift, 1);
|
||||
|
||||
if (!gfc_is_constant_expr (shift))
|
||||
return NULL;
|
||||
|
||||
if (boundary)
|
||||
{
|
||||
if (boundary->rank > 0)
|
||||
gfc_simplify_expr (boundary, 1);
|
||||
|
||||
if (!gfc_is_constant_expr (boundary))
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if (dim)
|
||||
{
|
||||
if (!gfc_is_constant_expr (dim))
|
||||
return NULL;
|
||||
which = mpz_get_si (dim->value.integer) - 1;
|
||||
}
|
||||
else
|
||||
which = 0;
|
||||
|
||||
s_len = 0;
|
||||
if (boundary == NULL)
|
||||
{
|
||||
temp_boundary = true;
|
||||
switch (array->ts.type)
|
||||
{
|
||||
|
||||
case BT_INTEGER:
|
||||
bnd = gfc_get_int_expr (array->ts.kind, NULL, 0);
|
||||
break;
|
||||
|
||||
case BT_LOGICAL:
|
||||
bnd = gfc_get_logical_expr (array->ts.kind, NULL, 0);
|
||||
break;
|
||||
|
||||
case BT_REAL:
|
||||
bnd = gfc_get_constant_expr (array->ts.type, array->ts.kind, &gfc_current_locus);
|
||||
mpfr_set_ui (bnd->value.real, 0, GFC_RND_MODE);
|
||||
break;
|
||||
|
||||
case BT_COMPLEX:
|
||||
bnd = gfc_get_constant_expr (array->ts.type, array->ts.kind, &gfc_current_locus);
|
||||
mpc_set_ui (bnd->value.complex, 0, GFC_RND_MODE);
|
||||
break;
|
||||
|
||||
case BT_CHARACTER:
|
||||
s_len = mpz_get_ui (array->ts.u.cl->length->value.integer);
|
||||
bnd = gfc_get_character_expr (array->ts.kind, &gfc_current_locus, NULL, s_len);
|
||||
break;
|
||||
|
||||
default:
|
||||
gcc_unreachable();
|
||||
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
temp_boundary = false;
|
||||
bnd = boundary;
|
||||
}
|
||||
|
||||
gfc_array_size (array, &size);
|
||||
arraysize = mpz_get_ui (size);
|
||||
mpz_clear (size);
|
||||
|
||||
result = gfc_get_array_expr (array->ts.type, array->ts.kind, &array->where);
|
||||
result->shape = gfc_copy_shape (array->shape, array->rank);
|
||||
result->rank = array->rank;
|
||||
result->ts = array->ts;
|
||||
|
||||
if (arraysize == 0)
|
||||
goto final;
|
||||
|
||||
arrayvec = XCNEWVEC (gfc_expr *, arraysize);
|
||||
array_ctor = gfc_constructor_first (array->value.constructor);
|
||||
for (i = 0; i < arraysize; i++)
|
||||
{
|
||||
arrayvec[i] = array_ctor->expr;
|
||||
array_ctor = gfc_constructor_next (array_ctor);
|
||||
}
|
||||
|
||||
resultvec = XCNEWVEC (gfc_expr *, arraysize);
|
||||
|
||||
extent[0] = 1;
|
||||
count[0] = 0;
|
||||
|
||||
for (d=0; d < array->rank; d++)
|
||||
{
|
||||
a_extent[d] = mpz_get_si (array->shape[d]);
|
||||
a_stride[d] = d == 0 ? 1 : a_stride[d-1] * a_extent[d-1];
|
||||
}
|
||||
|
||||
if (shift->rank > 0)
|
||||
{
|
||||
shift_ctor = gfc_constructor_first (shift->value.constructor);
|
||||
shift_val = 0;
|
||||
}
|
||||
else
|
||||
{
|
||||
shift_ctor = NULL;
|
||||
shift_val = mpz_get_si (shift->value.integer);
|
||||
}
|
||||
|
||||
if (bnd->rank > 0)
|
||||
bnd_ctor = gfc_constructor_first (bnd->value.constructor);
|
||||
else
|
||||
bnd_ctor = NULL;
|
||||
|
||||
/* Shut up compiler */
|
||||
len = 1;
|
||||
rsoffset = 1;
|
||||
|
||||
n = 0;
|
||||
for (d=0; d < array->rank; d++)
|
||||
{
|
||||
if (d == which)
|
||||
{
|
||||
rsoffset = a_stride[d];
|
||||
len = a_extent[d];
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n] = 0;
|
||||
extent[n] = a_extent[d];
|
||||
sstride[n] = a_stride[d];
|
||||
ss_ex[n] = sstride[n] * extent[n];
|
||||
n++;
|
||||
}
|
||||
}
|
||||
|
||||
continue_loop = true;
|
||||
d = array->rank;
|
||||
rptr = resultvec;
|
||||
sptr = arrayvec;
|
||||
|
||||
while (continue_loop)
|
||||
{
|
||||
ssize_t sh, delta;
|
||||
|
||||
if (shift_ctor)
|
||||
sh = mpz_get_si (shift_ctor->expr->value.integer);
|
||||
else
|
||||
sh = shift_val;
|
||||
|
||||
if (( sh >= 0 ? sh : -sh ) > len)
|
||||
{
|
||||
delta = len;
|
||||
sh = len;
|
||||
}
|
||||
else
|
||||
delta = (sh >= 0) ? sh: -sh;
|
||||
|
||||
if (sh > 0)
|
||||
{
|
||||
src = &sptr[delta * rsoffset];
|
||||
dest = rptr;
|
||||
}
|
||||
else
|
||||
{
|
||||
src = sptr;
|
||||
dest = &rptr[delta * rsoffset];
|
||||
}
|
||||
|
||||
for (n = 0; n < len - delta; n++)
|
||||
{
|
||||
*dest = *src;
|
||||
dest += rsoffset;
|
||||
src += rsoffset;
|
||||
}
|
||||
|
||||
if (sh < 0)
|
||||
dest = rptr;
|
||||
|
||||
n = delta;
|
||||
|
||||
if (bnd_ctor)
|
||||
{
|
||||
while (n--)
|
||||
{
|
||||
*dest = gfc_copy_expr (bnd_ctor->expr);
|
||||
dest += rsoffset;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
while (n--)
|
||||
{
|
||||
*dest = gfc_copy_expr (bnd);
|
||||
dest += rsoffset;
|
||||
}
|
||||
}
|
||||
rptr += sstride[0];
|
||||
sptr += sstride[0];
|
||||
if (shift_ctor)
|
||||
shift_ctor = gfc_constructor_next (shift_ctor);
|
||||
|
||||
if (bnd_ctor)
|
||||
bnd_ctor = gfc_constructor_next (bnd_ctor);
|
||||
|
||||
count[0]++;
|
||||
n = 0;
|
||||
while (count[n] == extent[n])
|
||||
{
|
||||
count[n] = 0;
|
||||
rptr -= ss_ex[n];
|
||||
sptr -= ss_ex[n];
|
||||
n++;
|
||||
if (n >= d - 1)
|
||||
{
|
||||
continue_loop = false;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
count[n]++;
|
||||
rptr += sstride[n];
|
||||
sptr += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for (i = 0; i < arraysize; i++)
|
||||
{
|
||||
gfc_constructor_append_expr (&result->value.constructor,
|
||||
gfc_copy_expr (resultvec[i]),
|
||||
NULL);
|
||||
}
|
||||
|
||||
final:
|
||||
if (temp_boundary)
|
||||
gfc_free_expr (bnd);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
gfc_expr *
|
||||
gfc_simplify_erf (gfc_expr *x)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
2018-01-04 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/83683
|
||||
PR fortran/45689
|
||||
* gfortran.dg/eoshift_8.f90: New test.
|
||||
* gfortran.dg/simplify_eoshift_1.f90: New test.
|
||||
|
||||
2018-01-04 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR debug/83585
|
||||
|
|
|
|||
18
gcc/testsuite/gfortran.dg/eoshift_8.f90
Normal file
18
gcc/testsuite/gfortran.dg/eoshift_8.f90
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
! { dg-do compile }
|
||||
! PR 83664 - invalid code that used to be accepted.
|
||||
program main
|
||||
implicit none
|
||||
integer :: n
|
||||
integer :: i,n1, n2, n3
|
||||
character(len=3), parameter :: e(2,3,4) = reshape([(repeat(achar(i),3),i=iachar('a'),iachar('a')+2*3*4-1)], &
|
||||
shape(e))
|
||||
character(len=3), parameter :: bnd2(3,5) = reshape([(repeat(achar(i),3),i=iachar('A'),iachar('A')+3*5-1)], &
|
||||
shape(bnd2))
|
||||
character(len=3) :: f2(2,3,4)
|
||||
|
||||
n = -1
|
||||
f2 = eoshift(e,shift=n,boundary=bnd2) ! { dg-error "has invalid shape" }
|
||||
f2 = eoshift(e,shift=1,boundary="x") ! { dg-error "must be of same type and kind" }
|
||||
|
||||
print '(*(1H",A,1H",:","))',f2
|
||||
end program main
|
||||
83
gcc/testsuite/gfortran.dg/simplify_eoshift_1.f90
Normal file
83
gcc/testsuite/gfortran.dg/simplify_eoshift_1.f90
Normal file
|
|
@ -0,0 +1,83 @@
|
|||
! { dg-do run }
|
||||
program main
|
||||
implicit none
|
||||
integer :: i,n1, n2, n3
|
||||
integer, parameter :: a(3) = [1,2,3]
|
||||
integer, parameter :: b1(3) = eoshift(a,0)
|
||||
integer, parameter :: b2(3) = eoshift(a,1)
|
||||
integer, parameter :: b3(3) = eoshift(a,-2)
|
||||
integer, parameter :: b4(3) = eoshift(a,4,boundary=42)
|
||||
integer, parameter :: c(3,3) = reshape([(i,i=1,3*3)],shape(c))
|
||||
integer, parameter :: b5(3,3) = eoshift(c,shift=1,dim=1,boundary=33)
|
||||
integer, parameter :: b6(3,3) = eoshift(c,shift=2,dim=1)
|
||||
integer, parameter :: b7(3,3) = eoshift(c,shift=-1,dim=2)
|
||||
integer, parameter :: b8(3,3) = eoshift(c,shift=-1,dim=2,boundary=[-1,-2,-3])
|
||||
integer, parameter :: b9(3,3) = eoshift(c,shift=[-1,-1,-1])
|
||||
integer, parameter :: b10(3,3) = eoshift(c,shift=[-1,0,1]);
|
||||
integer, parameter :: b11(3,3) = eoshift(c,dim=2,shift=[-2,-1,1],boundary=42);
|
||||
integer, parameter :: b12(3,3) = eoshift(c,dim=1,shift=[-1,-2,0],boundary=[-3,-7,-9])
|
||||
real, parameter :: r(3,4,5) = reshape([(1.0*i**2,i=1,3*4*5)],shape(r))
|
||||
real, parameter :: q1(3,4,5) = eoshift(r,shift=1,dim=3)
|
||||
integer, parameter :: sh1(3,4) = reshape([-1,-2,0,3,2,5,6,-6,3,1,-1,-5],shape(sh1))
|
||||
real, parameter :: bnd1(3,4) = reshape([-1.,-2.,-3.,-4.,-5.,-6.,-7.,-8.,-9.,-10.,-11.,-12.],shape(bnd1))
|
||||
real, parameter :: q2(3,4,5) = eoshift(r,dim=3,shift=sh1)
|
||||
real, parameter :: q3(3,4,5) = eoshift(r,dim=3,shift=sh1,boundary=bnd1)
|
||||
complex(kind=8), parameter :: s(3,3) = reshape([(cmplx(i*i-5*i,-i+4,kind=8),i=1,9)],shape(s))
|
||||
complex(kind=8), parameter :: t(3,3) = eoshift(s,shift=4)
|
||||
character(len=3), parameter :: e(2,3,4) = reshape([(repeat(achar(i),3),i=iachar('a'),iachar('a')+2*3*4-1)], &
|
||||
shape(e))
|
||||
character(len=3) :: e2(2,3,4)
|
||||
character(len=3), parameter :: f1(2,3,4) = eoshift(e,1)
|
||||
character(len=3), parameter :: bnd2(2,4) = reshape([(repeat(achar(i),3),i=iachar('A'),iachar('A')+2*4-1)], &
|
||||
shape(bnd2))
|
||||
character(len=3), parameter :: f2(2,3,4) = eoshift(e,dim=2,shift=-1,boundary=bnd2);
|
||||
integer, parameter :: sh2(2,3) = reshape([1, -2, 0, 1, 2, -1, 2, 0],shape(sh2))
|
||||
character(len=3), parameter :: f3(2,3,4) = eoshift(e,dim=3,shift=sh2)
|
||||
integer, parameter :: empty(1:0) =[integer ::]
|
||||
integer, parameter :: empty2(1:0) = eoshift(empty,1)
|
||||
|
||||
n1 = 1
|
||||
n2 = 2
|
||||
n3 = 3
|
||||
|
||||
if (any(b1 /= a)) call abort
|
||||
if (any(b2 /= [2, 3, 0])) call abort
|
||||
if (any(b3 /= [0, 0, 1])) call abort
|
||||
if (any(b4 /= 42)) call abort
|
||||
if (any(eoshift(c,shift=1,dim=n1,boundary=33) /= b5)) call abort
|
||||
if (any(eoshift(c,shift=2,dim=1) /= b6)) call abort
|
||||
if (any(eoshift(c,shift=-1,dim=2) /= b7)) call abort
|
||||
if (any(eoshift(c,shift=-1,dim=n2,boundary=[-1,-2,-3]) /= b8)) call abort
|
||||
if (any(eoshift(c,shift=-1) /= b9)) call abort
|
||||
if (any(eoshift(r,shift=1,dim=n3) /= q1)) call abort
|
||||
if (any(b10 /= reshape([ 0, 1, 2, 4, 5, 6, 8, 9, 0],shape(b10)))) call abort
|
||||
if (any(b11 /= reshape([42, 42, 6, 42, 2, 9, 1, 5, 42],shape(b11)))) call abort
|
||||
if (any(b12 /= reshape([ -3, 1, 2, -7, -7, 4, 7, 8, 9],shape(b11)))) call abort
|
||||
if (any(q1 /= reshape([169.,196.,225.,256.,289.,324.,361.,400.,441.,484.,529.,576.,625.,&
|
||||
676.,729.,784.,841.,900.,961.,1024.,1089.,1156.,1225.,1296.,1369.,1444.,1521.,&
|
||||
1600.,1681.,1764.,1849.,1936.,2025.,2116.,2209.,2304.,2401.,2500.,2601.,2704.,&
|
||||
2809.,2916.,3025.,3136.,3249.,3364.,3481.,3600.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.],&
|
||||
shape(q1)))) call abort
|
||||
if (any(q2 /= reshape([0.,0.,9.,1600.,841.,0.,0.,0.,2025.,484.,0.,0.,1.,0.,225.,2704.,&
|
||||
1681.,0.,0.,0.,3249.,1156.,121.,0.,169.,4.,729.,0.,2809.,0.,0.,0.,0.,2116.,&
|
||||
529.,0.,625.,196.,1521.,0.,0.,0.,0.,0.,0.,3364.,1225.,0.,1369.,676.,2601.,&
|
||||
0.,0.,0.,0.,0.,0.,0.,2209.,0.],shape(q2)))) call abort
|
||||
if (any(q3 /= reshape([-1.,-2.,9.,1600.,841.,-6.,-7.,-8.,2025.,484.,-11.,-12.,1.,&
|
||||
-2.,225.,2704.,1681.,-6.,-7.,-8.,3249.,1156.,121.,-12.,169.,4.,729.,-4.,&
|
||||
2809.,-6.,-7.,-8.,-9.,2116.,529.,-12.,625.,196.,1521.,-4.,-5.,-6.,-7.,-8.,&
|
||||
-9.,3364.,1225.,-12.,1369.,676.,2601.,-4.,-5.,-6.,-7.,-8.,-9.,-10.,2209.,-12.],&
|
||||
shape(q3)))) call abort
|
||||
if (any(f1 /= reshape(["bbb"," ","ddd"," ","fff"," ","hhh"," ","jjj"," ","lll"," ",&
|
||||
"nnn"," ","ppp"," ","rrr"," ","ttt"," ","vvv"," ","xxx"," "], &
|
||||
shape(f1)))) call abort
|
||||
if (any(f2 /= reshape(["AAA","BBB","aaa","bbb","ccc","ddd","CCC","DDD","ggg","hhh","iii","jjj",&
|
||||
"EEE","FFF","mmm","nnn","ooo","ppp","GGG","HHH","sss","ttt","uuu","vvv"],shape(f2)))) call abort
|
||||
|
||||
e2 = e
|
||||
if (any (f2 /= eoshift(e2,dim=2,shift=-1,boundary=bnd2))) call abort
|
||||
if (any (f3 /= reshape (["ggg"," ","ccc","jjj","qqq"," ","mmm"," ","iii","ppp",&
|
||||
"www","fff","sss","bbb","ooo","vvv"," ","lll"," ","hhh","uuu",&
|
||||
" "," ","rrr"], shape(f3)))) call abort
|
||||
if (size(empty) /=0) call abort
|
||||
if (any(t /= (0.0_8, 0.0_8))) call abort
|
||||
end program main
|
||||
Loading…
Add table
Reference in a new issue