From: burnus Date: Sun, 7 Jun 2009 13:45:47 +0000 (+0000) Subject: 2009-06-07 Daniel Franke X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=8828904bfbc698b6b4aab7199951f504c391cf59 2009-06-07 Daniel Franke * check.c (dim_rank_check): Return SUCCESS if DIM=NULL. (gfc_check_lbound): Removed (now) redundant check for DIM=NULL. (gfc_check_minloc_maxloc): Likewise. (check_reduction): Likewise. (gfc_check_size): Likewise. (gfc_check_ubound): Likewise. (gfc_check_cshift): Added missing shape-conformance checks. (gfc_check_eoshift): Likewise. * gfortran.h (gfc_check_conformance): Modified prototype to printf-style. * expr.c (gfc_check_conformance): Accept error-message chunks in printf-style. Changed all callers. 2009-06-07 Daniel Franke PR fortran/36874 * gfortran.dg/intrinsic_argument_conformance_2.f90: Adjusted error message. * gfortran.dg/zero_sized_1.f90: Removed checks with incompatible shapes. * gfortran.dg/zero_sized_5.f90: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148247 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d101c8bed06..be976690d14 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,20 @@ 2009-06-07 Daniel Franke + * check.c (dim_rank_check): Return SUCCESS if DIM=NULL. + (gfc_check_lbound): Removed (now) redundant check for DIM=NULL. + (gfc_check_minloc_maxloc): Likewise. + (check_reduction): Likewise. + (gfc_check_size): Likewise. + (gfc_check_ubound): Likewise. + (gfc_check_cshift): Added missing shape-conformance checks. + (gfc_check_eoshift): Likewise. + * gfortran.h (gfc_check_conformance): Modified prototype to printf-style. + * expr.c (gfc_check_conformance): Accept error-message chunks in + printf-style. Changed all callers. + + +2009-06-07 Daniel Franke + PR fortran/25104 PR fortran/29962 * intrinsic.h (gfc_simplify_dot_product): New prototype. diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 17f2221ef8c..070e2bfca73 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -1561,7 +1561,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), rc = ARITH_OK; d = op2->value.constructor; - if (gfc_check_conformance ("elemental binary operation", op1, op2) + if (gfc_check_conformance (op1, op2, "elemental binary operation") != SUCCESS) rc = ARITH_INCOMMENSURATE; else diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index b61909bf40a..eaab309b1b8 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -339,6 +339,9 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed) gfc_array_ref *ar; int rank; + if (dim == NULL) + return SUCCESS; + if (dim->expr_type != EXPR_CONSTANT || (array->expr_type != EXPR_VARIABLE && array->expr_type != EXPR_ARRAY)) @@ -876,24 +879,56 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) if (type_check (shift, 1, BT_INTEGER) == FAILURE) return FAILURE; - if (array->rank == 1) + if (dim_check (dim, 2, true) == FAILURE) + return FAILURE; + + if (dim_rank_check (dim, array, false) == FAILURE) + return FAILURE; + + if (array->rank == 1 || shift->rank == 0) { if (scalar_check (shift, 1) == FAILURE) return FAILURE; } - else if (shift->rank != array->rank - 1 && shift->rank != 0) + else if (shift->rank == array->rank - 1) { - gfc_error ("SHIFT argument at %L of CSHIFT must have rank %d or be a " - "scalar", &shift->where, 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; + for (i = 0, j = 0; i < array->rank; i++) + if (i != d - 1) + { + if (!identical_dimen_shape (array, i, shift, j)) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L has " + "invalid shape in dimension %d (%ld/%ld)", + gfc_current_intrinsic_arg[1], + gfc_current_intrinsic, &shift->where, i + 1, + mpz_get_si (array->shape[i]), + mpz_get_si (shift->shape[j])); + return FAILURE; + } + + j += 1; + } + } + } + else + { + gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank " + "%d or be a scalar", gfc_current_intrinsic_arg[1], + gfc_current_intrinsic, &shift->where, array->rank - 1); return FAILURE; } - /* TODO: Add shape conformance check between array (w/o dimension dim) - and shift. */ - - if (dim_check (dim, 2, true) == FAILURE) - return FAILURE; - return SUCCESS; } @@ -1042,55 +1077,85 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, if (type_check (shift, 1, BT_INTEGER) == FAILURE) return FAILURE; - if (array->rank == 1) + if (dim_check (dim, 3, true) == FAILURE) + return FAILURE; + + if (dim_rank_check (dim, array, false) == FAILURE) + return FAILURE; + + if (array->rank == 1 || shift->rank == 0) { - if (scalar_check (shift, 2) == FAILURE) + if (scalar_check (shift, 1) == FAILURE) return FAILURE; } - else if (shift->rank != array->rank - 1 && shift->rank != 0) + else if (shift->rank == array->rank - 1) { - gfc_error ("SHIFT argument at %L of EOSHIFT must have rank %d or be a " - "scalar", &shift->where, 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; + for (i = 0, j = 0; i < array->rank; i++) + if (i != d - 1) + { + if (!identical_dimen_shape (array, i, shift, j)) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L has " + "invalid shape in dimension %d (%ld/%ld)", + gfc_current_intrinsic_arg[1], + gfc_current_intrinsic, &shift->where, i + 1, + mpz_get_si (array->shape[i]), + mpz_get_si (shift->shape[j])); + return FAILURE; + } + + j += 1; + } + } + } + else + { + gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank " + "%d or be a scalar", gfc_current_intrinsic_arg[1], + gfc_current_intrinsic, &shift->where, array->rank - 1); return FAILURE; } - /* TODO: Add shape conformance check between array (w/o dimension dim) - and shift. */ - if (boundary != NULL) { if (same_type_check (array, 0, boundary, 2) == FAILURE) return FAILURE; - if (array->rank == 1) + if (array->rank == 1 || boundary->rank == 0) { if (scalar_check (boundary, 2) == FAILURE) return FAILURE; } - else if (boundary->rank != array->rank - 1 && boundary->rank != 0) + else if (boundary->rank == array->rank - 1) { - gfc_error ("BOUNDARY argument at %L of EOSHIFT must have rank %d or be " - "a scalar", &boundary->where, array->rank - 1); - return FAILURE; + if (gfc_check_conformance (shift, boundary, + "arguments '%s' and '%s' for " + "intrinsic %s", + gfc_current_intrinsic_arg[1], + gfc_current_intrinsic_arg[2], + gfc_current_intrinsic ) == FAILURE) + return FAILURE; } - - if (shift->rank == boundary->rank) + else { - int i; - for (i = 0; i < shift->rank; i++) - if (! identical_dimen_shape (shift, i, boundary, i)) - { - gfc_error ("Different shape in dimension %d for SHIFT and " - "BOUNDARY arguments of EOSHIFT at %L", shift->rank, - &boundary->where); - return FAILURE; - } + gfc_error ("'%s' argument of intrinsic '%s' at %L of must have " + "rank %d or be a scalar", gfc_current_intrinsic_arg[1], + gfc_current_intrinsic, &shift->where, array->rank - 1); + return FAILURE; } } - if (dim_check (dim, 4, true) == FAILURE) - return FAILURE; - return SUCCESS; } @@ -1512,14 +1577,11 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (array_check (array, 0) == FAILURE) return FAILURE; - if (dim != NULL) - { - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (dim_check (dim, 1, false) == FAILURE) + return FAILURE; - if (dim_rank_check (dim, array, 1) == FAILURE) - return FAILURE; - } + if (dim_rank_check (dim, array, 1) == FAILURE) + return FAILURE; if (kind_check (kind, 2, BT_INTEGER) == FAILURE) return FAILURE; @@ -1719,13 +1781,11 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) } for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++) - { - char buffer[80]; - snprintf (buffer, 80, "arguments 'a%d' and 'a%d' for intrinsic '%s'", - m, n, gfc_current_intrinsic); - if (gfc_check_conformance (buffer, tmp->expr, x) == FAILURE) + if (gfc_check_conformance (tmp->expr, x, + "arguments 'a%d' and 'a%d' for " + "intrinsic '%s'", m, n, + gfc_current_intrinsic) == FAILURE) return FAILURE; - } } return SUCCESS; @@ -1905,24 +1965,22 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap) ap->next->next->expr = m; } - if (d && dim_check (d, 1, false) == FAILURE) + if (dim_check (d, 1, false) == FAILURE) return FAILURE; - if (d && dim_rank_check (d, a, 0) == FAILURE) + if (dim_rank_check (d, a, 0) == FAILURE) return FAILURE; if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; - if (m != NULL) - { - char buffer[80]; - snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], - gfc_current_intrinsic); - if (gfc_check_conformance (buffer, a, m) == FAILURE) - return FAILURE; - } + if (m != NULL + && gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], + gfc_current_intrinsic_arg[2], + gfc_current_intrinsic ) == FAILURE) + return FAILURE; return SUCCESS; } @@ -1961,24 +2019,22 @@ check_reduction (gfc_actual_arglist *ap) ap->next->next->expr = m; } - if (d && dim_check (d, 1, false) == FAILURE) + if (dim_check (d, 1, false) == FAILURE) return FAILURE; - if (d && dim_rank_check (d, a, 0) == FAILURE) + if (dim_rank_check (d, a, 0) == FAILURE) return FAILURE; if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE) return FAILURE; - if (m != NULL) - { - char buffer[80]; - snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic %s", - gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[2], - gfc_current_intrinsic); - if (gfc_check_conformance (buffer, a, m) == FAILURE) - return FAILURE; - } + if (m != NULL + && gfc_check_conformance (a, m, + "arguments '%s' and '%s' for intrinsic %s", + gfc_current_intrinsic_arg[0], + gfc_current_intrinsic_arg[2], + gfc_current_intrinsic) == FAILURE) + return FAILURE; return SUCCESS; } @@ -2133,18 +2189,17 @@ gfc_check_null (gfc_expr *mold) gfc_try gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector) { - char buffer[80]; - if (array_check (array, 0) == FAILURE) return FAILURE; if (type_check (mask, 1, BT_LOGICAL) == FAILURE) return FAILURE; - snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'", - gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1], - gfc_current_intrinsic); - if (gfc_check_conformance (buffer, array, mask) == FAILURE) + if (gfc_check_conformance (array, mask, + "arguments '%s' and '%s' for intrinsic '%s'", + gfc_current_intrinsic_arg[0], + gfc_current_intrinsic_arg[1], + gfc_current_intrinsic) == FAILURE) return FAILURE; if (vector != NULL) @@ -2700,14 +2755,11 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (array_check (array, 0) == FAILURE) return FAILURE; - if (dim != NULL) - { - if (dim_check (dim, 1, true) == FAILURE) - return FAILURE; + if (dim_check (dim, 1, true) == FAILURE) + return FAILURE; - if (dim_rank_check (dim, array, 0) == FAILURE) - return FAILURE; - } + if (dim_rank_check (dim, array, 0) == FAILURE) + return FAILURE; if (kind_check (kind, 2, BT_INTEGER) == FAILURE) return FAILURE; @@ -3043,14 +3095,11 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind) if (array_check (array, 0) == FAILURE) return FAILURE; - if (dim != NULL) - { - if (dim_check (dim, 1, false) == FAILURE) - return FAILURE; + if (dim_check (dim, 1, false) == FAILURE) + return FAILURE; - if (dim_rank_check (dim, array, 0) == FAILURE) - return FAILURE; - } + if (dim_rank_check (dim, array, 0) == FAILURE) + return FAILURE; if (kind_check (kind, 2, BT_INTEGER) == FAILURE) return FAILURE; diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 31b0df15920..71acbd6df3d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2776,18 +2776,25 @@ gfc_specification_expr (gfc_expr *e) /* Given two expressions, make sure that the arrays are conformable. */ gfc_try -gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) +gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, ...) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; gfc_try t; + va_list argp; + char buffer[240]; + if (op1->rank == 0 || op2->rank == 0) return SUCCESS; + va_start (argp, optype_msgid); + vsnprintf (buffer, 240, optype_msgid, argp); + va_end (argp); + if (op1->rank != op2->rank) { - gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(optype_msgid), + gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(buffer), op1->rank, op2->rank, &op1->where); return FAILURE; } @@ -2802,7 +2809,7 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { gfc_error ("Different shape for %s at %L on dimension %d " - "(%d and %d)", _(optype_msgid), &op1->where, d + 1, + "(%d and %d)", _(buffer), &op1->where, d + 1, (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); @@ -2950,7 +2957,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) /* Check size of array assignments. */ if (lvalue->rank != 0 && rvalue->rank != 0 - && gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS) + && gfc_check_conformance (lvalue, rvalue, "array assignment") != SUCCESS) return FAILURE; if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 82f07ef0052..902790428b8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2484,7 +2484,7 @@ gfc_try gfc_specification_expr (gfc_expr *); int gfc_numeric_ts (gfc_typespec *); int gfc_kind_max (gfc_expr *, gfc_expr *); -gfc_try gfc_check_conformance (const char *, gfc_expr *, gfc_expr *); +gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3; gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int); gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *); gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *); diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 6088a8d80fa..c519f6ee808 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -3617,14 +3617,13 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag) first_expr = arg->expr; for ( ; arg && arg->expr; arg = arg->next, n++) - { - char buffer[80]; - snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'", - gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n], - gfc_current_intrinsic); - if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE) - return FAILURE; - } + if (gfc_check_conformance (first_expr, arg->expr, + "arguments '%s' and '%s' for " + "intrinsic '%s'", + gfc_current_intrinsic_arg[0], + gfc_current_intrinsic_arg[n], + gfc_current_intrinsic) == FAILURE) + return FAILURE; } if (t == FAILURE) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8158b71ee4f..5bb38fec577 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1584,8 +1584,8 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) /* Elemental procedure's array actual arguments must conform. */ if (e != NULL) { - if (gfc_check_conformance ("elemental procedure", arg->expr, e) - == FAILURE) + if (gfc_check_conformance (arg->expr, e, + "elemental procedure") == FAILURE) return FAILURE; } else diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 050a6fe9298..4b9ac1cf01a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-06-07 Daniel Franke + + PR fortran/36874 + * gfortran.dg/intrinsic_argument_conformance_2.f90: Adjusted error message. + * gfortran.dg/zero_sized_1.f90: Removed checks with incompatible shapes. + * gfortran.dg/zero_sized_5.f90: Likewise. + 2009-06-07 H.J. Lu PR middle-end/32950 diff --git a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90 b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90 index 44a4b39f742..c9284607fec 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_2.f90 @@ -34,7 +34,7 @@ program main b2 = eoshift (a2,1,boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" } b2 = eoshift (a2,(/1/), boundary=c2(:,:)) ! { dg-error "have rank 1 or be a scalar" } - b = eoshift (a,(/1/), boundary=c(1,:)) ! { dg-error "Different shape in dimension 1" } + b = eoshift (a,(/1/), boundary=c(1,:)) ! { dg-error "invalid shape in dimension" } if (any(eoshift(foo,dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort() ! { dg-error "must be a scalar" } if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=(/42.0,-7.0/))/= 0)) call abort() ! { dg-error "must be a scalar" } diff --git a/gcc/testsuite/gfortran.dg/zero_sized_1.f90 b/gcc/testsuite/gfortran.dg/zero_sized_1.f90 index 5461fb1a7f0..85167fcca3e 100644 --- a/gcc/testsuite/gfortran.dg/zero_sized_1.f90 +++ b/gcc/testsuite/gfortran.dg/zero_sized_1.f90 @@ -15,9 +15,6 @@ subroutine test_cshift if (any(cshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort if (any(cshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort - if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=2)/= 0)) call abort - if (any(cshift(tempm(:,5:4),shift=(/1,-1/),dim=1)/= 0)) call abort - if (any(cshift(tempm(:,5:4),shift=(/1,-1/),dim=2)/= 0)) call abort deallocate(foo,bar,gee) end @@ -34,9 +31,6 @@ subroutine test_eoshift if (any(eoshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort if (any(eoshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort - if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2)/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1)/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2)/= 0)) call abort if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=42.0)/= 0)) call abort @@ -45,9 +39,6 @@ subroutine test_eoshift if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort - if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=-7.0)/= 0)) call abort @@ -56,9 +47,6 @@ subroutine test_eoshift if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort - if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort - if (any(eoshift(tempm(:,5:4),shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort deallocate(foo,bar,gee) end diff --git a/gcc/testsuite/gfortran.dg/zero_sized_5.f90 b/gcc/testsuite/gfortran.dg/zero_sized_5.f90 index 30ca8bf8199..49a5d548df0 100644 --- a/gcc/testsuite/gfortran.dg/zero_sized_5.f90 +++ b/gcc/testsuite/gfortran.dg/zero_sized_5.f90 @@ -8,8 +8,6 @@ program main b = cshift (a,1) b = cshift (a,j) b = eoshift (a,1) - b = eoshift (a,(/1/)) b = eoshift (a,1,boundary=c(1,:)) b = eoshift (a, j, boundary=c(1,:)) - end program main