diff options
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 58 |
1 files changed, 46 insertions, 12 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index bcbaeaa6369..50d7072b670 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -483,7 +483,7 @@ backup: static match match_real_constant (gfc_expr **result, int signflag) { - int kind, count, seen_dp, seen_digits, is_iso_c; + int kind, count, seen_dp, seen_digits, is_iso_c, default_exponent; locus old_loc, temp_loc; char *p, *buffer, c, exp_char; gfc_expr *e; @@ -494,6 +494,7 @@ match_real_constant (gfc_expr **result, int signflag) e = NULL; + default_exponent = 0; count = 0; seen_dp = 0; seen_digits = 0; @@ -575,8 +576,14 @@ match_real_constant (gfc_expr **result, int signflag) if (!ISDIGIT (c)) { - gfc_error ("Missing exponent in real number at %C"); - return MATCH_ERROR; + /* With -fdec, default exponent to 0 instead of complaining. */ + if (flag_dec) + default_exponent = 1; + else + { + gfc_error ("Missing exponent in real number at %C"); + return MATCH_ERROR; + } } while (ISDIGIT (c)) @@ -597,8 +604,8 @@ done: gfc_current_locus = old_loc; gfc_gobble_whitespace (); - buffer = (char *) alloca (count + 1); - memset (buffer, '\0', count + 1); + buffer = (char *) alloca (count + default_exponent + 1); + memset (buffer, '\0', count + default_exponent + 1); p = buffer; c = gfc_next_ascii_char (); @@ -621,6 +628,8 @@ done: c = gfc_next_ascii_char (); } + if (default_exponent) + *p++ = '0'; kind = get_kind (&is_iso_c); if (kind == -1) @@ -1353,6 +1362,10 @@ match_complex_constant (gfc_expr **result) if (gfc_match_char (',') == MATCH_NO) { + /* It is possible that gfc_int2real issued a warning when + converting an integer to real. Throw this away here. */ + + gfc_clear_warning (); gfc_pop_error (&old_error); m = MATCH_NO; goto cleanup; @@ -1918,15 +1931,36 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, } /* For associate names, we may not yet know whether they are arrays or not. - Thus if we have one and parentheses follow, we have to assume that it - actually is one for now. The final decision will be made at - resolution time, of course. */ - if (sym->assoc && gfc_peek_ascii_char () == '(' - && !(sym->assoc->dangling && sym->assoc->st + If the selector expression is unambiguously an array; eg. a full array + or an array section, then the associate name must be an array and we can + fix it now. Otherwise, if parentheses follow and it is not a character + type, we have to assume that it actually is one for now. The final + decision will be made at resolution, of course. */ + if (sym->assoc + && gfc_peek_ascii_char () == '(' + && sym->ts.type != BT_CLASS + && !sym->attr.dimension) + { + if ((!sym->assoc->dangling + && sym->assoc->target + && sym->assoc->target->ref + && sym->assoc->target->ref->type == REF_ARRAY + && (sym->assoc->target->ref->u.ar.type == AR_FULL + || sym->assoc->target->ref->u.ar.type == AR_SECTION)) + || + (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER) + && sym->assoc->st && sym->assoc->st->n.sym - && sym->assoc->st->n.sym->attr.dimension == 0) - && sym->ts.type != BT_CLASS) + && sym->assoc->st->n.sym->attr.dimension == 0)) + { sym->attr.dimension = 1; + if (sym->as == NULL && sym->assoc + && sym->assoc->st + && sym->assoc->st->n.sym + && sym->assoc->st->n.sym->as) + sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as); + } + } if ((equiv_flag && gfc_peek_ascii_char () == '(') || gfc_peek_ascii_char () == '[' || sym->attr.codimension |