diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 341 |
1 files changed, 158 insertions, 183 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 1146bd11796..dbe51888656 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1,6 +1,6 @@ /* Routines for manipulation of expression nodes. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software - Foundation, Inc. + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 + Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -34,7 +34,6 @@ gfc_get_expr (void) gfc_expr *e; e = gfc_getmem (sizeof (gfc_expr)); - gfc_clear_ts (&e->ts); e->shape = NULL; e->ref = NULL; @@ -47,7 +46,7 @@ gfc_get_expr (void) /* Free an argument list and everything below it. */ void -gfc_free_actual_arglist (gfc_actual_arglist * a1) +gfc_free_actual_arglist (gfc_actual_arglist *a1) { gfc_actual_arglist *a2; @@ -64,7 +63,7 @@ gfc_free_actual_arglist (gfc_actual_arglist * a1) /* Copy an arglist structure and all of the arguments. */ gfc_actual_arglist * -gfc_copy_actual_arglist (gfc_actual_arglist * p) +gfc_copy_actual_arglist (gfc_actual_arglist *p) { gfc_actual_arglist *head, *tail, *new; @@ -93,7 +92,7 @@ gfc_copy_actual_arglist (gfc_actual_arglist * p) /* Free a list of reference structures. */ void -gfc_free_ref_list (gfc_ref * p) +gfc_free_ref_list (gfc_ref *p) { gfc_ref *q; int i; @@ -134,7 +133,7 @@ gfc_free_ref_list (gfc_ref * p) something else or the expression node belongs to another structure. */ static void -free_expr0 (gfc_expr * e) +free_expr0 (gfc_expr *e) { int n; @@ -221,9 +220,8 @@ free_expr0 (gfc_expr * e) /* Free an expression node and everything beneath it. */ void -gfc_free_expr (gfc_expr * e) +gfc_free_expr (gfc_expr *e) { - if (e == NULL) return; if (e->con_by_offset) @@ -236,12 +234,10 @@ gfc_free_expr (gfc_expr * e) /* Graft the *src expression onto the *dest subexpression. */ void -gfc_replace_expr (gfc_expr * dest, gfc_expr * src) +gfc_replace_expr (gfc_expr *dest, gfc_expr *src) { - free_expr0 (dest); *dest = *src; - gfc_free (src); } @@ -252,9 +248,8 @@ gfc_replace_expr (gfc_expr * dest, gfc_expr * src) failure is OK for some callers. */ const char * -gfc_extract_int (gfc_expr * expr, int *result) +gfc_extract_int (gfc_expr *expr, int *result) { - if (expr->expr_type != EXPR_CONSTANT) return _("Constant expression required at %C"); @@ -276,7 +271,7 @@ gfc_extract_int (gfc_expr * expr, int *result) /* Recursively copy a list of reference structures. */ static gfc_ref * -copy_ref (gfc_ref * src) +copy_ref (gfc_ref *src) { gfc_array_ref *ar; gfc_ref *dest; @@ -312,13 +307,12 @@ copy_ref (gfc_ref * src) } -/* Detect whether an expression has any vector index array - references. */ +/* Detect whether an expression has any vector index array references. */ int gfc_has_vector_index (gfc_expr *e) { - gfc_ref * ref; + gfc_ref *ref; int i; for (ref = e->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY) @@ -332,7 +326,7 @@ gfc_has_vector_index (gfc_expr *e) /* Copy a shape array. */ mpz_t * -gfc_copy_shape (mpz_t * shape, int rank) +gfc_copy_shape (mpz_t *shape, int rank) { mpz_t *new_shape; int n; @@ -363,7 +357,7 @@ gfc_copy_shape (mpz_t * shape, int rank) */ mpz_t * -gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim) +gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim) { mpz_t *new_shape, *s; int i, n; @@ -380,12 +374,12 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim) if (n < 0 || n >= rank) return NULL; - s = new_shape = gfc_get_shape (rank-1); + s = new_shape = gfc_get_shape (rank - 1); for (i = 0; i < rank; i++) { if (i == n) - continue; + continue; mpz_init_set (*s, shape[i]); s++; } @@ -393,11 +387,12 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim) return new_shape; } + /* Given an expression pointer, return a copy of the expression. This subroutine is recursive. */ gfc_expr * -gfc_copy_expr (gfc_expr * p) +gfc_copy_expr (gfc_expr *p) { gfc_expr *q; char *s; @@ -423,8 +418,7 @@ gfc_copy_expr (gfc_expr * p) s = gfc_getmem (p->value.character.length + 1); q->value.character.string = s; - memcpy (s, p->value.character.string, - p->value.character.length + 1); + memcpy (s, p->value.character.string, p->value.character.length + 1); break; } switch (q->ts.type) @@ -434,15 +428,15 @@ gfc_copy_expr (gfc_expr * p) break; case BT_REAL: - gfc_set_model_kind (q->ts.kind); - mpfr_init (q->value.real); + gfc_set_model_kind (q->ts.kind); + mpfr_init (q->value.real); mpfr_set (q->value.real, p->value.real, GFC_RND_MODE); break; case BT_COMPLEX: - gfc_set_model_kind (q->ts.kind); - mpfr_init (q->value.complex.r); - mpfr_init (q->value.complex.i); + gfc_set_model_kind (q->ts.kind); + mpfr_init (q->value.complex.r); + mpfr_init (q->value.complex.i); mpfr_set (q->value.complex.r, p->value.complex.r, GFC_RND_MODE); mpfr_set (q->value.complex.i, p->value.complex.i, GFC_RND_MODE); break; @@ -452,8 +446,7 @@ gfc_copy_expr (gfc_expr * p) s = gfc_getmem (p->value.character.length + 1); q->value.character.string = s; - memcpy (s, p->value.character.string, - p->value.character.length + 1); + memcpy (s, p->value.character.string, p->value.character.length + 1); break; case BT_LOGICAL: @@ -512,9 +505,8 @@ gfc_copy_expr (gfc_expr * p) kind numbers mean more precision for numeric types. */ int -gfc_kind_max (gfc_expr * e1, gfc_expr * e2) +gfc_kind_max (gfc_expr *e1, gfc_expr *e2) { - return (e1->ts.kind > e2->ts.kind) ? e1->ts.kind : e2->ts.kind; } @@ -524,7 +516,6 @@ gfc_kind_max (gfc_expr * e1, gfc_expr * e2) static int numeric_type (bt type) { - return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER; } @@ -532,9 +523,8 @@ numeric_type (bt type) /* Returns nonzero if the typespec is a numeric type, zero otherwise. */ int -gfc_numeric_ts (gfc_typespec * ts) +gfc_numeric_ts (gfc_typespec *ts) { - return numeric_type (ts->type); } @@ -562,7 +552,7 @@ gfc_int_expr (int i) /* Returns an expression node that is a logical constant. */ gfc_expr * -gfc_logical_expr (int i, locus * where) +gfc_logical_expr (int i, locus *where) { gfc_expr *p; @@ -586,7 +576,7 @@ gfc_logical_expr (int i, locus * where) argument list with a NULL pointer terminating the list. */ gfc_expr * -gfc_build_conversion (gfc_expr * e) +gfc_build_conversion (gfc_expr *e) { gfc_expr *p; @@ -612,7 +602,7 @@ gfc_build_conversion (gfc_expr * e) 1.0**2 stays as it is. */ void -gfc_type_convert_binary (gfc_expr * e) +gfc_type_convert_binary (gfc_expr *e) { gfc_expr *op1, *op2; @@ -628,10 +618,9 @@ gfc_type_convert_binary (gfc_expr * e) /* Kind conversions of same type. */ if (op1->ts.type == op2->ts.type) { - if (op1->ts.kind == op2->ts.kind) { - /* No type conversions. */ + /* No type conversions. */ e->ts = op1->ts; goto done; } @@ -685,7 +674,7 @@ done: function expects that the expression has already been simplified. */ int -gfc_is_constant_expr (gfc_expr * e) +gfc_is_constant_expr (gfc_expr *e) { gfc_constructor *c; gfc_actual_arglist *arg; @@ -757,7 +746,7 @@ gfc_is_constant_expr (gfc_expr * e) /* Try to collapse intrinsic expressions. */ static try -simplify_intrinsic_op (gfc_expr * p, int type) +simplify_intrinsic_op (gfc_expr *p, int type) { gfc_expr *op1, *op2, *result; @@ -882,9 +871,8 @@ simplify_intrinsic_op (gfc_expr * p, int type) with gfc_simplify_expr(). */ static try -simplify_constructor (gfc_constructor * c, int type) +simplify_constructor (gfc_constructor *c, int type) { - for (; c; c = c->next) { if (c->iterator @@ -904,8 +892,8 @@ simplify_constructor (gfc_constructor * c, int type) /* Pull a single array element out of an array constructor. */ static try -find_array_element (gfc_constructor * cons, gfc_array_ref * ar, - gfc_constructor ** rval) +find_array_element (gfc_constructor *cons, gfc_array_ref *ar, + gfc_constructor **rval) { unsigned long nelemen; int i; @@ -930,10 +918,9 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar, /* Check the bounds. */ if (ar->as->upper[i] - && (mpz_cmp (e->value.integer, - ar->as->upper[i]->value.integer) > 0 - || mpz_cmp (e->value.integer, - ar->as->lower[i]->value.integer) < 0)) + && (mpz_cmp (e->value.integer, ar->as->upper[i]->value.integer) > 0 + || mpz_cmp (e->value.integer, + ar->as->lower[i]->value.integer) < 0)) { gfc_error ("index in dimension %d is out of bounds " "at %L", i + 1, &ar->c_where[i]); @@ -942,8 +929,7 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar, goto depart; } - mpz_sub (delta, e->value.integer, - ar->as->lower[i]->value.integer); + mpz_sub (delta, e->value.integer, ar->as->lower[i]->value.integer); mpz_add (offset, offset, delta); } @@ -973,7 +959,7 @@ depart: /* Find a component of a structure constructor. */ static gfc_constructor * -find_component_ref (gfc_constructor * cons, gfc_ref * ref) +find_component_ref (gfc_constructor *cons, gfc_ref *ref) { gfc_component *comp; gfc_component *pick; @@ -994,7 +980,7 @@ find_component_ref (gfc_constructor * cons, gfc_ref * ref) the subobject reference in the process. */ static void -remove_subobject_ref (gfc_expr * p, gfc_constructor * cons) +remove_subobject_ref (gfc_expr *p, gfc_constructor *cons) { gfc_expr *e; @@ -1075,11 +1061,11 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) upper = ref->u.ar.as->upper[d]; if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */ - { - gcc_assert(begin); - gcc_assert(begin->expr_type == EXPR_ARRAY); - gcc_assert(begin->rank == 1); - gcc_assert(begin->shape); + { + gcc_assert (begin); + gcc_assert (begin->expr_type == EXPR_ARRAY); + gcc_assert (begin->rank == 1); + gcc_assert (begin->shape); vecsub[d] = begin->value.constructor; mpz_set (ctr[d], vecsub[d]->expr->value.integer); @@ -1090,7 +1076,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) for (c = vecsub[d]; c; c = c->next) { if (mpz_cmp (c->expr->value.integer, upper->value.integer) > 0 - || mpz_cmp (c->expr->value.integer, lower->value.integer) < 0) + || mpz_cmp (c->expr->value.integer, + lower->value.integer) < 0) { gfc_error ("index in dimension %d is out of bounds " "at %L", d + 1, &ref->u.ar.c_where[d]); @@ -1098,12 +1085,12 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) goto cleanup; } } - } + } else - { + { if ((begin && begin->expr_type != EXPR_CONSTANT) - || (finish && finish->expr_type != EXPR_CONSTANT) - || (step && step->expr_type != EXPR_CONSTANT)) + || (finish && finish->expr_type != EXPR_CONSTANT) + || (step && step->expr_type != EXPR_CONSTANT)) { t = FAILURE; goto cleanup; @@ -1157,8 +1144,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) mpz_div (tmp_mpz, tmp_mpz, stride[d]); mpz_mul (nelts, nelts, tmp_mpz); - /* An element reference reduces the rank of the expression; don't add - anything to the shape array. */ + /* An element reference reduces the rank of the expression; don't + add anything to the shape array. */ if (ref->u.ar.dimen_type[d] != DIMEN_ELEMENT) mpz_set (expr->shape[shape_i++], tmp_mpz); } @@ -1178,7 +1165,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) /* Now clock through the array reference, calculating the index in the source constructor and transferring the elements to the new constructor. */ - for (idx = 0; idx < (int)mpz_get_si (nelts); idx++) + for (idx = 0; idx < (int) mpz_get_si (nelts); idx++) { if (ref->u.ar.offset) mpz_set (ptr, ref->u.ar.offset->value.integer); @@ -1189,14 +1176,13 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) for (d = 0; d < rank; d++) { mpz_set (tmp_mpz, ctr[d]); - mpz_sub (tmp_mpz, tmp_mpz, - ref->u.ar.as->lower[d]->value.integer); + mpz_sub (tmp_mpz, tmp_mpz, ref->u.ar.as->lower[d]->value.integer); mpz_mul (tmp_mpz, tmp_mpz, delta[d]); mpz_add (ptr, ptr, tmp_mpz); if (!incr_ctr) continue; - if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */ + if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */ { gcc_assert(vecsub[d]); @@ -1213,9 +1199,9 @@ find_array_section (gfc_expr *expr, gfc_ref *ref) { mpz_add (ctr[d], ctr[d], stride[d]); - if (mpz_cmp_ui (stride[d], 0) > 0 ? - mpz_cmp (ctr[d], end[d]) > 0 : - mpz_cmp (ctr[d], end[d]) < 0) + if (mpz_cmp_ui (stride[d], 0) > 0 + ? mpz_cmp (ctr[d], end[d]) > 0 + : mpz_cmp (ctr[d], end[d]) < 0) mpz_set (ctr[d], start[d]); else incr_ctr = false; @@ -1269,13 +1255,13 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) char *chr; if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT - || p->ref->u.ss.end->expr_type != EXPR_CONSTANT) + || p->ref->u.ss.end->expr_type != EXPR_CONSTANT) return FAILURE; *newp = gfc_copy_expr (p); chr = p->value.character.string; - end = (int)mpz_get_ui (p->ref->u.ss.end->value.integer); - start = (int)mpz_get_ui (p->ref->u.ss.start->value.integer); + end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer); + start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer); (*newp)->value.character.length = end - start + 1; strncpy ((*newp)->value.character.string, &chr[start - 1], @@ -1289,7 +1275,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) parameter variable values are substituted. */ static try -simplify_const_ref (gfc_expr * p) +simplify_const_ref (gfc_expr *p) { gfc_constructor *cons; gfc_expr *newp; @@ -1302,8 +1288,7 @@ simplify_const_ref (gfc_expr * p) switch (p->ref->u.ar.type) { case AR_ELEMENT: - if (find_array_element (p->value.constructor, - &p->ref->u.ar, + if (find_array_element (p->value.constructor, &p->ref->u.ar, &cons) == FAILURE) return FAILURE; @@ -1322,7 +1307,7 @@ simplify_const_ref (gfc_expr * p) case AR_FULL: if (p->ref->next != NULL - && (p->ts.type == BT_CHARACTER || p->ts.type == BT_DERIVED)) + && (p->ts.type == BT_CHARACTER || p->ts.type == BT_DERIVED)) { cons = p->value.constructor; for (; cons; cons = cons->next) @@ -1364,7 +1349,7 @@ simplify_const_ref (gfc_expr * p) /* Simplify a chain of references. */ static try -simplify_ref_chain (gfc_ref * ref, int type) +simplify_ref_chain (gfc_ref *ref, int type) { int n; @@ -1375,16 +1360,12 @@ simplify_ref_chain (gfc_ref * ref, int type) case REF_ARRAY: for (n = 0; n < ref->u.ar.dimen; n++) { - if (gfc_simplify_expr (ref->u.ar.start[n], type) - == FAILURE) + if (gfc_simplify_expr (ref->u.ar.start[n], type) == FAILURE) return FAILURE; - if (gfc_simplify_expr (ref->u.ar.end[n], type) - == FAILURE) + if (gfc_simplify_expr (ref->u.ar.end[n], type) == FAILURE) return FAILURE; - if (gfc_simplify_expr (ref->u.ar.stride[n], type) - == FAILURE) + if (gfc_simplify_expr (ref->u.ar.stride[n], type) == FAILURE) return FAILURE; - } break; @@ -1405,7 +1386,7 @@ simplify_ref_chain (gfc_ref * ref, int type) /* Try to substitute the value of a parameter variable. */ static try -simplify_parameter_variable (gfc_expr * p, int type) +simplify_parameter_variable (gfc_expr *p, int type) { gfc_expr *e; try t; @@ -1423,7 +1404,7 @@ simplify_parameter_variable (gfc_expr * p, int type) /* Only use the simplification if it eliminated all subobject references. */ - if (t == SUCCESS && ! e->ref) + if (t == SUCCESS && !e->ref) gfc_replace_expr (p, e); else gfc_free_expr (e); @@ -1446,12 +1427,12 @@ simplify_parameter_variable (gfc_expr * p, int type) The expression type is defined for: 0 Basic expression parsing 1 Simplifying array constructors -- will substitute - iterator values. + iterator values. Returns FAILURE on error, SUCCESS otherwise. NOTE: Will return SUCCESS even if the expression can not be simplified. */ try -gfc_simplify_expr (gfc_expr * p, int type) +gfc_simplify_expr (gfc_expr *p, int type) { gfc_actual_arglist *ap; @@ -1489,7 +1470,7 @@ gfc_simplify_expr (gfc_expr * p, int type) gfc_extract_int (p->ref->u.ss.end, &end); s = gfc_getmem (end - start + 2); memcpy (s, p->value.character.string + start, end - start); - s[end-start+1] = '\0'; /* TODO: C-style string for debugging. */ + s[end - start + 1] = '\0'; /* TODO: C-style string. */ gfc_free (p->value.character.string); p->value.character.string = s; p->value.character.length = end - start; @@ -1510,7 +1491,7 @@ gfc_simplify_expr (gfc_expr * p, int type) case EXPR_VARIABLE: /* Only substitute array parameter variables if we are in an - initialization expression, or we want a subsection. */ + initialization expression, or we want a subsection. */ if (p->symtree->n.sym->attr.flavor == FL_PARAMETER && (gfc_init_expr || p->ref || p->symtree->n.sym->value->expr_type != EXPR_ARRAY)) @@ -1539,9 +1520,8 @@ gfc_simplify_expr (gfc_expr * p, int type) if (simplify_constructor (p->value.constructor, type) == FAILURE) return FAILURE; - if (p->expr_type == EXPR_ARRAY - && p->ref && p->ref->type == REF_ARRAY - && p->ref->u.ar.type == AR_FULL) + if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY + && p->ref->u.ar.type == AR_FULL) gfc_expand_constructor (p); if (simplify_const_ref (p) == FAILURE) @@ -1559,9 +1539,8 @@ gfc_simplify_expr (gfc_expr * p, int type) be declared as. */ static bt -et0 (gfc_expr * e) +et0 (gfc_expr *e) { - if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e) == SUCCESS) return BT_INTEGER; @@ -1575,7 +1554,7 @@ et0 (gfc_expr * e) static try check_init_expr (gfc_expr *); static try -check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *)) +check_intrinsic_op (gfc_expr *e, try (*check_function) (gfc_expr *)) { gfc_expr *op1 = e->value.op.op1; gfc_expr *op2 = e->value.op.op2; @@ -1605,7 +1584,7 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *)) { gfc_error ("Numeric or CHARACTER operands are required in " "expression at %L", &e->where); - return FAILURE; + return FAILURE; } break; @@ -1703,7 +1682,7 @@ not_numeric: this problem here. */ static try -check_inquiry (gfc_expr * e, int not_restricted) +check_inquiry (gfc_expr *e, int not_restricted) { const char *name; @@ -1743,7 +1722,7 @@ check_inquiry (gfc_expr * e, int not_restricted) { if (e->symtree->n.sym->ts.type == BT_UNKNOWN && gfc_set_default_type (e->symtree->n.sym, 0, gfc_current_ns) - == FAILURE) + == FAILURE) return FAILURE; e->ts = e->symtree->n.sym->ts; @@ -1752,8 +1731,8 @@ check_inquiry (gfc_expr * e, int not_restricted) /* Assumed character length will not reduce to a constant expression with LEN, as required by the standard. */ if (i == 4 && not_restricted - && e->symtree->n.sym->ts.type == BT_CHARACTER - && e->symtree->n.sym->ts.cl->length == NULL) + && e->symtree->n.sym->ts.type == BT_CHARACTER + && e->symtree->n.sym->ts.cl->length == NULL) gfc_notify_std (GFC_STD_GNU, "assumed character length " "variable '%s' in constant expression at %L", e->symtree->n.sym->name, &e->where); @@ -1770,7 +1749,7 @@ check_inquiry (gfc_expr * e, int not_restricted) FAILURE is returned an error message has been generated. */ static try -check_init_expr (gfc_expr * e) +check_init_expr (gfc_expr *e) { gfc_actual_arglist *ap; match m; @@ -1809,7 +1788,7 @@ check_init_expr (gfc_expr * e) if (m == MATCH_NO) gfc_error ("Function '%s' in initialization expression at %L " "must be an intrinsic function", - e->symtree->n.sym->name, &e->where); + e->symtree->n.sym->name, &e->where); if (m != MATCH_YES) t = FAILURE; @@ -1882,7 +1861,7 @@ check_init_expr (gfc_expr * e) expression, then reducing it to a constant. */ match -gfc_match_init_expr (gfc_expr ** result) +gfc_match_init_expr (gfc_expr **result) { gfc_expr *expr; match m; @@ -1914,9 +1893,8 @@ gfc_match_init_expr (gfc_expr ** result) /* Not all inquiry functions are simplified to constant expressions so it is necessary to call check_inquiry again. */ - if (!gfc_is_constant_expr (expr) - && check_inquiry (expr, 1) == FAILURE - && !gfc_in_match_data ()) + if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) == FAILURE + && !gfc_in_match_data ()) { gfc_error ("Initialization expression didn't reduce %C"); return MATCH_ERROR; @@ -1928,7 +1906,6 @@ gfc_match_init_expr (gfc_expr ** result) } - static try check_restricted (gfc_expr *); /* Given an actual argument list, test to see that each argument is a @@ -1936,7 +1913,7 @@ static try check_restricted (gfc_expr *); integer or character. */ static try -restricted_args (gfc_actual_arglist * a) +restricted_args (gfc_actual_arglist *a) { for (; a; a = a->next) { @@ -1954,7 +1931,7 @@ restricted_args (gfc_actual_arglist * a) /* Make sure a non-intrinsic function is a specification function. */ static try -external_spec_function (gfc_expr * e) +external_spec_function (gfc_expr *e) { gfc_symbol *f; @@ -1996,7 +1973,7 @@ external_spec_function (gfc_expr * e) restricted expression. */ static try -restricted_intrinsic (gfc_expr * e) +restricted_intrinsic (gfc_expr *e) { /* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */ if (check_inquiry (e, 0) == SUCCESS) @@ -2011,7 +1988,7 @@ restricted_intrinsic (gfc_expr * e) return FAILURE. */ static try -check_restricted (gfc_expr * e) +check_restricted (gfc_expr *e) { gfc_symbol *sym; try t; @@ -2029,8 +2006,8 @@ check_restricted (gfc_expr * e) break; case EXPR_FUNCTION: - t = e->value.function.esym ? - external_spec_function (e) : restricted_intrinsic (e); + t = e->value.function.esym ? external_spec_function (e) + : restricted_intrinsic (e); break; @@ -2052,10 +2029,11 @@ check_restricted (gfc_expr * e) break; } - /* gfc_is_formal_arg broadcasts that a formal argument list is being processed - in resolve.c(resolve_formal_arglist). This is done so that host associated - dummy array indices are accepted (PR23446). This mechanism also does the - same for the specification expressions of array-valued functions. */ + /* gfc_is_formal_arg broadcasts that a formal argument list is being + processed in resolve.c(resolve_formal_arglist). This is done so + that host associated dummy array indices are accepted (PR23446). + This mechanism also does the same for the specification expressions + of array-valued functions. */ if (sym->attr.in_common || sym->attr.use_assoc || sym->attr.dummy @@ -2109,7 +2087,7 @@ check_restricted (gfc_expr * e) we return FAILURE, an error has been generated. */ try -gfc_specification_expr (gfc_expr * e) +gfc_specification_expr (gfc_expr *e) { if (e == NULL) return SUCCESS; @@ -2138,8 +2116,7 @@ gfc_specification_expr (gfc_expr * e) /* Given two expressions, make sure that the arrays are conformable. */ try -gfc_check_conformance (const char *optype_msgid, - gfc_expr * op1, gfc_expr * op2) +gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) { int op1_flag, op2_flag, d; mpz_t op1_size, op2_size; @@ -2189,7 +2166,7 @@ gfc_check_conformance (const char *optype_msgid, sure that the assignment can take place. */ try -gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform) +gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { gfc_symbol *sym; gfc_ref *ref; @@ -2219,10 +2196,9 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform) variable local to a function subprogram. Its existence begins when execution of the function is initiated and ends when execution of the function is terminated..... - Therefore, the left hand side is no longer a varaiable, when it is:*/ - if (sym->attr.flavor == FL_PROCEDURE - && sym->attr.proc != PROC_ST_FUNCTION - && !sym->attr.external) + Therefore, the left hand side is no longer a varaiable, when it is: */ + if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_ST_FUNCTION + && !sym->attr.external) { bool bad_proc; bad_proc = false; @@ -2237,10 +2213,10 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform) /* (iii) A module or internal procedure.... */ if ((gfc_current_ns->proc_name->attr.proc == PROC_INTERNAL - || gfc_current_ns->proc_name->attr.proc == PROC_MODULE) + || gfc_current_ns->proc_name->attr.proc == PROC_MODULE) && gfc_current_ns->parent && (!(gfc_current_ns->parent->proc_name->attr.function - || gfc_current_ns->parent->proc_name->attr.subroutine) + || gfc_current_ns->parent->proc_name->attr.subroutine) || gfc_current_ns->parent->proc_name->attr.is_main_program)) { /* .... that is not a function.... */ @@ -2285,8 +2261,8 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform) && lvalue->ref->u.ar.type == AR_FULL && lvalue->ref->u.ar.as->cp_was_assumed) { - gfc_error ("Vector assignment to assumed-size Cray Pointee at %L" - " is illegal", &lvalue->where); + gfc_error ("Vector assignment to assumed-size Cray Pointee at %L " + "is illegal", &lvalue->where); return FAILURE; } @@ -2332,7 +2308,7 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform) NULLIFY statement. */ try -gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) +gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) { symbol_attribute attr; gfc_ref *ref; @@ -2347,7 +2323,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) } if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE - && lvalue->symtree->n.sym->attr.use_assoc) + && lvalue->symtree->n.sym->attr.use_assoc) { gfc_error ("'%s' in the pointer assignment at %L cannot be an " "l-value since it is a procedure", @@ -2364,16 +2340,16 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) for (ref = lvalue->ref; ref; ref = ref->next) { if (pointer) - check_intent_in = 0; + check_intent_in = 0; if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) - pointer = 1; + pointer = 1; } if (check_intent_in && lvalue->symtree->n.sym->attr.intent == INTENT_IN) { gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L", - lvalue->symtree->n.sym->name, &lvalue->where); + lvalue->symtree->n.sym->name, &lvalue->where); return FAILURE; } @@ -2387,8 +2363,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym)) { - gfc_error ("Bad pointer object in PURE procedure at %L", - &lvalue->where); + gfc_error ("Bad pointer object in PURE procedure at %L", &lvalue->where); return FAILURE; } @@ -2415,7 +2390,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) if (lvalue->rank != rvalue->rank) { gfc_error ("Different ranks in pointer assignment at %L", - &lvalue->where); + &lvalue->where); return FAILURE; } @@ -2424,9 +2399,9 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) return SUCCESS; if (lvalue->ts.type == BT_CHARACTER - && lvalue->ts.cl->length && rvalue->ts.cl->length - && abs (gfc_dep_compare_expr (lvalue->ts.cl->length, - rvalue->ts.cl->length)) == 1) + && lvalue->ts.cl->length && rvalue->ts.cl->length + && abs (gfc_dep_compare_expr (lvalue->ts.cl->length, + rvalue->ts.cl->length)) == 1) { gfc_error ("Different character lengths in pointer " "assignment at %L", &lvalue->where); @@ -2457,7 +2432,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) if (attr.protected && attr.use_assoc) { gfc_error ("Pointer assigment target has PROTECTED " - "attribute at %L", &rvalue->where); + "attribute at %L", &rvalue->where); return FAILURE; } @@ -2469,7 +2444,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue) symbol. Used for initialization assignments. */ try -gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue) +gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue) { gfc_expr lvalue; try r; @@ -2480,7 +2455,7 @@ gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue) lvalue.ts = sym->ts; if (sym->as) lvalue.rank = sym->as->rank; - lvalue.symtree = (gfc_symtree *)gfc_getmem (sizeof (gfc_symtree)); + lvalue.symtree = (gfc_symtree *) gfc_getmem (sizeof (gfc_symtree)); lvalue.symtree->n.sym = sym; lvalue.where = sym->declared_at; @@ -2510,7 +2485,7 @@ gfc_default_initializer (gfc_typespec *ts) for (c = ts->derived->components; c; c = c->next) { if ((c->initializer || c->allocatable) && init == NULL) - init = gfc_get_expr (); + init = gfc_get_expr (); } if (init == NULL) @@ -2524,15 +2499,15 @@ gfc_default_initializer (gfc_typespec *ts) for (c = ts->derived->components; c; c = c->next) { if (tail == NULL) - init->value.constructor = tail = gfc_get_constructor (); + init->value.constructor = tail = gfc_get_constructor (); else - { - tail->next = gfc_get_constructor (); - tail = tail->next; - } + { + tail->next = gfc_get_constructor (); + tail = tail->next; + } if (c->initializer) - tail->expr = gfc_copy_expr (c->initializer); + tail->expr = gfc_copy_expr (c->initializer); if (c->allocatable) { @@ -2550,7 +2525,7 @@ gfc_default_initializer (gfc_typespec *ts) whole array. */ gfc_expr * -gfc_get_variable_expr (gfc_symtree * var) +gfc_get_variable_expr (gfc_symtree *var) { gfc_expr *e; @@ -2574,7 +2549,7 @@ gfc_get_variable_expr (gfc_symtree * var) /* Traverse expr, marking all EXPR_VARIABLE symbols referenced. */ void -gfc_expr_set_symbols_referenced (gfc_expr * expr) +gfc_expr_set_symbols_referenced (gfc_expr *expr) { gfc_actual_arglist *arg; gfc_constructor *c; @@ -2592,7 +2567,7 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr) case EXPR_FUNCTION: for (arg = expr->value.function.actual; arg; arg = arg->next) - gfc_expr_set_symbols_referenced (arg->expr); + gfc_expr_set_symbols_referenced (arg->expr); break; case EXPR_VARIABLE: @@ -2607,7 +2582,7 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr) case EXPR_STRUCTURE: case EXPR_ARRAY: for (c = expr->value.constructor; c; c = c->next) - gfc_expr_set_symbols_referenced (c->expr); + gfc_expr_set_symbols_referenced (c->expr); break; default: @@ -2617,26 +2592,26 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr) for (ref = expr->ref; ref; ref = ref->next) switch (ref->type) - { - case REF_ARRAY: - for (i = 0; i < ref->u.ar.dimen; i++) - { - gfc_expr_set_symbols_referenced (ref->u.ar.start[i]); - gfc_expr_set_symbols_referenced (ref->u.ar.end[i]); - gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]); - } - break; - - case REF_COMPONENT: - break; - - case REF_SUBSTRING: - gfc_expr_set_symbols_referenced (ref->u.ss.start); - gfc_expr_set_symbols_referenced (ref->u.ss.end); - break; - - default: - gcc_unreachable (); - break; - } + { + case REF_ARRAY: + for (i = 0; i < ref->u.ar.dimen; i++) + { + gfc_expr_set_symbols_referenced (ref->u.ar.start[i]); + gfc_expr_set_symbols_referenced (ref->u.ar.end[i]); + gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]); + } + break; + + case REF_COMPONENT: + break; + + case REF_SUBSTRING: + gfc_expr_set_symbols_referenced (ref->u.ss.start); + gfc_expr_set_symbols_referenced (ref->u.ss.end); + break; + + default: + gcc_unreachable (); + break; + } } |