mpz_t size;
mpz_t nelems;
int shape_size;
+ bool shape_is_const;
if (!array_check (source, 0))
return false;
"than %d elements", &shape->where, GFC_MAX_DIMENSIONS);
return false;
}
- else if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_expr (shape))
+
+ gfc_simplify_expr (shape, 0);
+ shape_is_const = gfc_is_constant_expr (shape);
+
+ if (shape->expr_type == EXPR_ARRAY && shape_is_const)
{
gfc_expr *e;
int i, extent;
gfc_error ("%qs argument of %qs intrinsic at %L has "
"negative element (%d)",
gfc_current_intrinsic_arg[1]->name,
- gfc_current_intrinsic, &e->where, extent);
- return false;
- }
- }
- }
- else if (shape->expr_type == EXPR_VARIABLE && shape->ref
- && shape->ref->u.ar.type == AR_FULL && shape->ref->u.ar.dimen == 1
- && shape->ref->u.ar.as
- && shape->ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT
- && shape->ref->u.ar.as->lower[0]->ts.type == BT_INTEGER
- && shape->ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT
- && shape->ref->u.ar.as->upper[0]->ts.type == BT_INTEGER
- && shape->symtree->n.sym->attr.flavor == FL_PARAMETER
- && shape->symtree->n.sym->value)
- {
- int i, extent;
- gfc_expr *e, *v;
-
- v = shape->symtree->n.sym->value;
-
- for (i = 0; i < shape_size; i++)
- {
- e = gfc_constructor_lookup_expr (v->value.constructor, i);
- if (e == NULL)
- break;
-
- gfc_extract_int (e, &extent);
-
- if (extent < 0)
- {
- gfc_error ("Element %d of actual argument of RESHAPE at %L "
- "cannot be negative", i + 1, &shape->where);
+ gfc_current_intrinsic, &shape->where, extent);
return false;
}
}
}
}
- if (pad == NULL && shape->expr_type == EXPR_ARRAY
- && gfc_is_constant_expr (shape)
+ if (pad == NULL && shape->expr_type == EXPR_ARRAY && shape_is_const
&& !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as
&& source->symtree->n.sym->as->type == AS_ASSUMED_SIZE))
{
--- /dev/null
+! { dg-do compile }
+! PR fortran/103411 - ICE in gfc_conv_array_initializer
+! Based on testcase by G. Steinmetz
+! Test simplifications for checks of shape argument to reshape intrinsic
+
+program p
+ integer :: i
+ integer, parameter :: a(2) = [2,2]
+ integer, parameter :: u(5) = [1,2,2,42,2]
+ integer, parameter :: v(1,3) = 2
+ integer, parameter :: d(2,2) = reshape([1,2,3,4,5], a)
+ integer, parameter :: c(2,2) = reshape([1,2,3,4], a)
+ integer, parameter :: b(2,2) = &
+ reshape([1,2,3], a) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3], a) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], a)
+ print *, reshape([1,2,3,4,5], a)
+ print *, b, c, d
+ print *, reshape([1,2,3], [(u(i),i=1,2)])
+ print *, reshape([1,2,3], [(u(i),i=2,3)]) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3], &
+ [(u(i)*(-1)**i,i=2,3)]) ! { dg-error "has negative element" }
+ print *, reshape([1,2,3,4], u(5:3:-2))
+ print *, reshape([1,2,3], u(5:3:-2)) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], u([5,3]))
+ print *, reshape([1,2,3] , u([5,3])) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], v(1,2:))
+ print *, reshape([1,2,3], v(1,2:)) ! { dg-error "not enough elements" }
+ print *, reshape([1,2,3,4], v(1,[2,1]))
+ print *, reshape([1,2,3] , v(1,[2,1])) ! { dg-error "not enough elements" }
+end