diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 159 |
2 files changed, 122 insertions, 44 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 845e35e702b..208d7847148 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2007-04-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/31591 + * simplify.c (simplify_bound_dim): New function. + (simplify_bound): Use the above. Perform simplification of LBOUND + and UBOUND when DIM argument is not present. + 2007-04-29 Daniel Franke <franke.daniel@gmail.com> * gfortran.texi: Cleaned up keyword index. diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index ab3d3d2fe75..b31597d170b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -1938,20 +1938,57 @@ gfc_simplify_kind (gfc_expr *e) static gfc_expr * -simplify_bound (gfc_expr *array, gfc_expr *dim, int upper) +simplify_bound_dim (gfc_expr *array, int d, int upper, gfc_array_spec *as) { - gfc_ref *ref; - gfc_array_spec *as; gfc_expr *l, *u, *result; - int d; - if (dim == NULL) - /* TODO: Simplify constant multi-dimensional bounds. */ - return NULL; + /* The last dimension of an assumed-size array is special. */ + if (d == as->rank && as->type == AS_ASSUMED_SIZE && !upper) + { + if (as->lower[d-1]->expr_type == EXPR_CONSTANT) + return gfc_copy_expr (as->lower[d-1]); + else + return NULL; + } - if (dim->expr_type != EXPR_CONSTANT) + /* Then, we need to know the extent of the given dimension. */ + l = as->lower[d-1]; + u = as->upper[d-1]; + + if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) return NULL; + result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, + &array->where); + + if (mpz_cmp (l->value.integer, u->value.integer) > 0) + { + /* Zero extent. */ + if (upper) + mpz_set_si (result->value.integer, 0); + else + mpz_set_si (result->value.integer, 1); + } + else + { + /* Nonzero extent. */ + if (upper) + mpz_set (result->value.integer, u->value.integer); + else + mpz_set (result->value.integer, l->value.integer); + } + + return range_check (result, upper ? "UBOUND" : "LBOUND"); +} + + +static gfc_expr * +simplify_bound (gfc_expr *array, gfc_expr *dim, int upper) +{ + gfc_ref *ref; + gfc_array_spec *as; + int d; + if (array->expr_type != EXPR_VARIABLE) return NULL; @@ -1992,55 +2029,89 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, int upper) gcc_unreachable (); done: + if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE) return NULL; - d = mpz_get_si (dim->value.integer); - - if (d < 1 || d > as->rank - || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper)) + if (dim == NULL) { - gfc_error ("DIM argument at %L is out of bounds", &dim->where); - return &gfc_bad_expr; - } + /* Multi-dimensional bounds. */ + gfc_expr *bounds[GFC_MAX_DIMENSIONS]; + gfc_expr *e; + gfc_constructor *head, *tail; - /* The last dimension of an assumed-size array is special. */ - if (d == as->rank && as->type == AS_ASSUMED_SIZE && !upper) - { - if (as->lower[d-1]->expr_type == EXPR_CONSTANT) - return gfc_copy_expr (as->lower[d-1]); - else - return NULL; - } + /* UBOUND(ARRAY) is not valid for an assumed-size array. */ + if (upper && as->type == AS_ASSUMED_SIZE) + { + /* An error message will be emitted in + check_assumed_size_reference (resolve.c). */ + return &gfc_bad_expr; + } - /* Then, we need to know the extent of the given dimension. */ - l = as->lower[d-1]; - u = as->upper[d-1]; + /* Simplify the bounds for each dimension. */ + for (d = 0; d < array->rank; d++) + { + bounds[d] = simplify_bound_dim (array, d + 1, upper, as); + if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr) + { + int j; - if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) - return NULL; + for (j = 0; j < d; j++) + gfc_free_expr (bounds[j]); + return bounds[d]; + } + } - result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, - &array->where); + /* Allocate the result expression. */ + e = gfc_get_expr (); + e->where = array->where; + e->expr_type = EXPR_ARRAY; + e->ts.type = BT_INTEGER; + e->ts.kind = gfc_default_integer_kind; + + /* The result is a rank 1 array; its size is the rank of the first + argument to {L,U}BOUND. */ + e->rank = 1; + e->shape = gfc_get_shape (1); + mpz_init_set_ui (e->shape[0], array->rank); + + /* Create the constructor for this array. */ + head = tail = NULL; + for (d = 0; d < array->rank; d++) + { + /* Get a new constructor element. */ + if (head == NULL) + head = tail = gfc_get_constructor (); + else + { + tail->next = gfc_get_constructor (); + tail = tail->next; + } - if (mpz_cmp (l->value.integer, u->value.integer) > 0) - { - /* Zero extent. */ - if (upper) - mpz_set_si (result->value.integer, 0); - else - mpz_set_si (result->value.integer, 1); + tail->where = e->where; + tail->expr = bounds[d]; + } + e->value.constructor = head; + + return e; } else { - /* Nonzero extent. */ - if (upper) - mpz_set (result->value.integer, u->value.integer); - else - mpz_set (result->value.integer, l->value.integer); - } + /* A DIM argument is specified. */ + if (dim->expr_type != EXPR_CONSTANT) + return NULL; - return range_check (result, upper ? "UBOUND" : "LBOUND"); + d = mpz_get_si (dim->value.integer); + + if (d < 1 || d > as->rank + || (d == as->rank && as->type == AS_ASSUMED_SIZE && upper)) + { + gfc_error ("DIM argument at %L is out of bounds", &dim->where); + return &gfc_bad_expr; + } + + return simplify_bound_dim (array, d, upper, as); + } } |
