X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Fio.c;h=7191a58382ec9f82760b4a345f0a3f24bd7945a0;hb=1cc51d4d0164baa1f4e8d86699c3243363ae3c44;hp=298c758ac0cd6f0a80d34aa2dcb7b54757234d15;hpb=b133fc4176e7960ad53a02f69b5b129ac0f529f7;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 298c758ac0c..7191a58382e 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1,5 +1,5 @@ /* Deal with I/O statements & related stuff. - Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 + Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -38,8 +38,8 @@ typedef struct io_tag; static const io_tag - tag_file = { "FILE", " file =", " %e", BT_CHARACTER }, - tag_status = { "STATUS", " status =", " %e", BT_CHARACTER}, + tag_file = {"FILE", " file =", " %e", BT_CHARACTER }, + tag_status = {"STATUS", " status =", " %e", BT_CHARACTER}, tag_e_access = {"ACCESS", " access =", " %e", BT_CHARACTER}, tag_e_form = {"FORM", " form =", " %e", BT_CHARACTER}, tag_e_recl = {"RECL", " recl =", " %e", BT_INTEGER}, @@ -94,7 +94,8 @@ static const io_tag tag_end = {"END", " end =", " %l", BT_UNKNOWN}, tag_eor = {"EOR", " eor =", " %l", BT_UNKNOWN}, tag_id = {"ID", " id =", " %v", BT_INTEGER}, - tag_pending = {"PENDING", " pending =", " %v", BT_LOGICAL}; + tag_pending = {"PENDING", " pending =", " %v", BT_LOGICAL}, + tag_newunit = {"NEWUNIT", " newunit =", " %v", BT_INTEGER}; static gfc_dt *current_dt; @@ -107,10 +108,10 @@ static gfc_dt *current_dt; typedef enum { FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, - FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_POS, FMT_LPAREN, + FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F, - FMT_E, FMT_EXT, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_ERROR, FMT_DC, - FMT_DP + FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, + FMT_ERROR, FMT_DC, FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR } format_token; @@ -118,7 +119,9 @@ format_token; used to back up by a single format token during the parsing process. */ static gfc_char_t *format_string; +static int format_string_pos; static int format_length, use_last_char; +static int starting_format_length; static char error_element; static locus format_locus; @@ -170,6 +173,8 @@ next_char (int in_string) if (mode != MODE_STRING) format_locus = gfc_current_locus; + format_string_pos++; + c = gfc_wide_toupper (c); return c; } @@ -314,10 +319,18 @@ format_lex (void) case 'T': c = next_char_not_space (&error); - if (c != 'L' && c != 'R') - unget_char (); - - token = FMT_POS; + switch (c) + { + case 'L': + token = FMT_TL; + break; + case 'R': + token = FMT_TR; + break; + default: + token = FMT_T; + unget_char (); + } break; case '(': @@ -404,8 +417,10 @@ format_lex (void) case 'E': c = next_char_not_space (&error); - if (c == 'N' || c == 'S') - token = FMT_EXT; + if (c == 'N' ) + token = FMT_EN; + else if (c == 'S') + token = FMT_ES; else { token = FMT_E; @@ -457,6 +472,10 @@ format_lex (void) token = FMT_END; break; + case '*': + token = FMT_STAR; + break; + default: token = FMT_UNKNOWN; break; @@ -469,6 +488,26 @@ format_lex (void) } +static const char * +token_to_string (format_token t) +{ + switch (t) + { + case FMT_D: + return "D"; + case FMT_G: + return "G"; + case FMT_E: + return "E"; + case FMT_EN: + return "EN"; + case FMT_ES: + return "ES"; + default: + return ""; + } +} + /* Check a format statement. The format string, either from a FORMAT statement or a constant in an I/O statement has already been parsed by itself, and we are checking it for validity. The dual origin @@ -495,6 +534,7 @@ check_format (bool is_input) level = 0; repeat = 0; rv = SUCCESS; + format_string_pos = 0; t = format_lex (); if (t == FMT_ERROR) @@ -520,6 +560,19 @@ format_item: format_item_1: switch (t) { + case FMT_STAR: + repeat = -1; + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + if (t == FMT_LPAREN) + { + level++; + goto format_item; + } + error = _("Left parenthesis required after '*'"); + goto syntax; + case FMT_POSINT: repeat = value; t = format_lex (); @@ -562,7 +615,7 @@ format_item_1: case FMT_X: /* X requires a prior number if we're being pedantic. */ if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor " - "requires leading space count at %C") + "requires leading space count at %L", &format_locus) == FAILURE) return FAILURE; goto between_desc; @@ -585,22 +638,26 @@ format_item_1: if (t == FMT_ERROR) goto fail; - if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %C") - == FAILURE) + if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L", + &format_locus) == FAILURE) return FAILURE; if (t != FMT_RPAREN || level > 0) { - gfc_warning ("$ should be the last specifier in format at %C"); + gfc_warning ("$ should be the last specifier in format at %L", + &format_locus); goto optional_comma_1; } goto finished; - case FMT_POS: + case FMT_T: + case FMT_TL: + case FMT_TR: case FMT_IBOZ: case FMT_F: case FMT_E: - case FMT_EXT: + case FMT_EN: + case FMT_ES: case FMT_G: case FMT_L: case FMT_A: @@ -630,23 +687,48 @@ data_desc: break; case FMT_P: - if (pedantic) + /* Comma after P is allowed only for F, E, EN, ES, D, or G. + 10.1.1 (1). */ + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + if (gfc_option.allow_std < GFC_STD_F2003 && t != FMT_COMMA + && t != FMT_F && t != FMT_E && t != FMT_EN && t != FMT_ES + && t != FMT_D && t != FMT_G) + { + error = _("Comma required after P descriptor"); + goto syntax; + } + if (t != FMT_COMMA) { - t = format_lex (); - if (t == FMT_ERROR) - goto fail; if (t == FMT_POSINT) { - error = _("Repeat count cannot follow P descriptor"); + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + } + if (t != FMT_F && t != FMT_E && t != FMT_EN && t != FMT_ES && t != FMT_D + && t != FMT_G) + { + error = _("Comma required after P descriptor"); goto syntax; } - - saved_token = t; } + saved_token = t; goto optional_comma; - case FMT_POS: + case FMT_T: + case FMT_TL: + case FMT_TR: + t = format_lex (); + if (t != FMT_POSINT) + { + error = _("Positive width required with T descriptor"); + goto syntax; + } + break; + case FMT_L: t = format_lex (); if (t == FMT_ERROR) @@ -657,8 +739,10 @@ data_desc: switch (gfc_notification_std (GFC_STD_GNU)) { case WARNING: + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; gfc_warning ("Extension: Missing positive width after L " - "descriptor at %C"); + "descriptor at %L", &format_locus); saved_token = t; break; @@ -691,7 +775,8 @@ data_desc: case FMT_D: case FMT_E: case FMT_G: - case FMT_EXT: + case FMT_EN: + case FMT_ES: u = format_lex (); if (t == FMT_G && u == FMT_ZERO) { @@ -701,7 +786,7 @@ data_desc: goto syntax; } if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in " - "format at %C") == FAILURE) + "format at %L", &format_locus) == FAILURE) return FAILURE; u = format_lex (); if (u != FMT_PERIOD) @@ -709,28 +794,51 @@ data_desc: saved_token = u; break; } - u = format_lex (); - if (u == FMT_ERROR) - goto fail; if (u != FMT_POSINT) { error = posint_required; goto syntax; } + u = format_lex (); + if (u == FMT_E) + { + error = _("E specifier not allowed with g0 descriptor"); + goto syntax; + } + saved_token = u; break; } + if (u != FMT_POSINT) + { + format_locus.nextc += format_string_pos; + gfc_error_now ("Positive width required in format " + "specifier %s at %L", token_to_string (t), + &format_locus); + saved_token = u; + goto finished; + } + u = format_lex (); if (u == FMT_ERROR) goto fail; if (u != FMT_PERIOD) { /* Warn if -std=legacy, otherwise error. */ + format_locus.nextc += format_string_pos; if (gfc_option.warn_std != 0) - gfc_error_now ("Period required in format specifier at %C"); + { + gfc_error_now ("Period required in format " + "specifier %s at %L", token_to_string (t), + &format_locus); + saved_token = u; + goto finished; + } else - gfc_warning ("Period required in format specifier at %C"); + gfc_warning ("Period required in format " + "specifier %s at %L", token_to_string (t), + &format_locus); saved_token = u; break; } @@ -791,9 +899,14 @@ data_desc: { /* Warn if -std=legacy, otherwise error. */ if (gfc_option.warn_std != 0) - gfc_error_now ("Period required in format specifier at %C"); - else - gfc_warning ("Period required in format specifier at %C"); + { + error = _("Period required in format specifier"); + goto syntax; + } + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + gfc_warning ("Period required in format specifier at %L", + &format_locus); saved_token = t; break; } @@ -811,22 +924,17 @@ data_desc: case FMT_H: if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) - gfc_warning ("The H format specifier at %C is" - " a Fortran 95 deleted feature"); - - if (mode == MODE_STRING) { - format_string += value; - format_length -= value; - } - else - { - while (repeat >0) - { - next_char (1); - repeat -- ; - } + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + gfc_warning ("The H format specifier at %L is" + " a Fortran 95 deleted feature", &format_locus); } + while (repeat >0) + { + next_char (1); + repeat -- ; + } break; case FMT_IBOZ: @@ -896,8 +1004,10 @@ between_desc: goto syntax; default: - if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C") - == FAILURE) + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L", + &format_locus) == FAILURE) return FAILURE; goto format_item_1; } @@ -953,16 +1063,20 @@ extension_optional_comma: goto syntax; default: - if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %C") - == FAILURE) + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; + if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L", + &format_locus) == FAILURE) return FAILURE; saved_token = t; break; } goto format_item; - + syntax: + if (mode != MODE_FORMAT) + format_locus.nextc += format_string_pos; if (error == unexpected_element) gfc_error (error, error_element, &format_locus); else @@ -971,6 +1085,13 @@ fail: rv = FAILURE; finished: + /* check for extraneous characters at end of valid format string */ + if ( starting_format_length > format_length ) + { + format_locus.nextc += format_length + 1; /* point to the extra */ + gfc_warning ("Extraneous characters in format at %L", &format_locus); + } + return rv; } @@ -986,7 +1107,7 @@ check_format_string (gfc_expr *e, bool is_input) mode = MODE_STRING; format_string = e->value.character.string; - + starting_format_length = e->value.character.length; /* More elaborate measures are needed to show where a problem is within a format string that has been calculated, but that's probably not worth the effort. */ @@ -1121,14 +1242,15 @@ match_vtag (const io_tag *tag, gfc_expr **v) if (result->symtree->n.sym->attr.intent == INTENT_IN) { - gfc_error ("Variable tag cannot be INTENT(IN) at %C"); + gfc_error ("Variable %s cannot be INTENT(IN) at %C", tag->name); gfc_free_expr (result); return MATCH_ERROR; } if (gfc_pure (NULL) && gfc_impure_variable (result->symtree->n.sym)) { - gfc_error ("Variable tag cannot be assigned in PURE procedure at %C"); + gfc_error ("Variable %s cannot be assigned in PURE procedure at %C", + tag->name); gfc_free_expr (result); return MATCH_ERROR; } @@ -1141,13 +1263,13 @@ match_vtag (const io_tag *tag, gfc_expr **v) /* Match I/O tags that cause variables to become redefined. */ static match -match_out_tag(const io_tag *tag, gfc_expr **result) +match_out_tag (const io_tag *tag, gfc_expr **result) { match m; - m = match_vtag(tag, result); + m = match_vtag (tag, result); if (m == MATCH_YES) - gfc_check_do_variable((*result)->symtree); + gfc_check_do_variable ((*result)->symtree); return m; } @@ -1203,8 +1325,11 @@ resolve_tag_format (const gfc_expr *e) /* If e's rank is zero and e is not an element of an array, it should be of integer or character type. The integer variable should be ASSIGNED. */ - if (e->symtree == NULL || e->symtree->n.sym->as == NULL - || e->symtree->n.sym->as->rank == 0) + if (e->rank == 0 + && (e->expr_type != EXPR_VARIABLE + || e->symtree == NULL + || e->symtree->n.sym->as == NULL + || e->symtree->n.sym->as->rank == 0)) { if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER) { @@ -1235,20 +1360,34 @@ resolve_tag_format (const gfc_expr *e) return SUCCESS; } - /* If rank is nonzero, we allow the type to be character under GFC_STD_GNU - and other type under GFC_STD_LEGACY. It may be assigned an Hollerith - constant. */ - if (e->ts.type == BT_CHARACTER) - { - if (gfc_notify_std (GFC_STD_GNU, "Extension: Character array " - "in FORMAT tag at %L", &e->where) == FAILURE) - return FAILURE; - } - else + /* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY. + It may be assigned an Hollerith constant. */ + if (e->ts.type != BT_CHARACTER) { if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character " "in FORMAT tag at %L", &e->where) == FAILURE) return FAILURE; + + if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE) + { + gfc_error ("Non-character assumed shape array element in FORMAT" + " tag at %L", &e->where); + return FAILURE; + } + + if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE) + { + gfc_error ("Non-character assumed size array element in FORMAT" + " tag at %L", &e->where); + return FAILURE; + } + + if (e->rank == 0 && e->symtree->n.sym->attr.pointer) + { + gfc_error ("Non-character pointer array element in FORMAT tag at %L", + &e->where); + return FAILURE; + } } return SUCCESS; @@ -1376,6 +1515,9 @@ match_open_element (gfc_open *open) m = match_etag (&tag_convert, &open->convert); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_newunit, &open->newunit); + if (m != MATCH_NO) + return m; return MATCH_NO; } @@ -1408,6 +1550,7 @@ gfc_free_open (gfc_open *open) gfc_free_expr (open->sign); gfc_free_expr (open->convert); gfc_free_expr (open->asynchronous); + gfc_free_expr (open->newunit); gfc_free (open); } @@ -1437,6 +1580,7 @@ gfc_resolve_open (gfc_open *open) RESOLVE_TAG (&tag_e_round, open->round); RESOLVE_TAG (&tag_e_sign, open->sign); RESOLVE_TAG (&tag_convert, open->convert); + RESOLVE_TAG (&tag_newunit, open->newunit); if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; @@ -1597,6 +1741,26 @@ gfc_match_open (void) } warn = (open->err || open->iostat) ? true : false; + + /* Checks on NEWUNIT specifier. */ + if (open->newunit) + { + if (open->unit) + { + gfc_error ("UNIT specifier not allowed with NEWUNIT at %C"); + goto cleanup; + } + + if (!(open->file || (open->status + && gfc_wide_strncasecmp (open->status->value.character.string, + "scratch", 7) == 0))) + { + gfc_error ("NEWUNIT specifier must have FILE= " + "or STATUS='scratch' at %C"); + goto cleanup; + } + } + /* Checks on the ACCESS specifier. */ if (open->access && open->access->expr_type == EXPR_CONSTANT) { @@ -2024,6 +2188,14 @@ gfc_resolve_close (gfc_close *close) if (gfc_reference_st_label (close->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; + if (close->unit->expr_type == EXPR_CONSTANT + && close->unit->ts.type == BT_INTEGER + && mpz_sgn (close->unit->value.integer) < 0) + { + gfc_error ("UNIT number in CLOSE statement at %L must be non-negative", + &close->unit->where); + } + return SUCCESS; } @@ -2146,6 +2318,14 @@ gfc_resolve_filepos (gfc_filepos *fp) if (gfc_reference_st_label (fp->err, ST_LABEL_TARGET) == FAILURE) return FAILURE; + if (fp->unit->expr_type == EXPR_CONSTANT + && fp->unit->ts.type == BT_INTEGER + && mpz_sgn (fp->unit->value.integer) < 0) + { + gfc_error ("UNIT number in statement at %L must be non-negative", + &fp->unit->where); + } + return SUCCESS; } @@ -2391,7 +2571,7 @@ match_dt_element (io_kind k, gfc_dt *dt) m = match_etag (&tag_rec, &dt->rec); if (m != MATCH_NO) return m; - m = match_etag (&tag_spos, &dt->rec); + m = match_etag (&tag_spos, &dt->pos); if (m != MATCH_NO) return m; m = match_out_tag (&tag_iomsg, &dt->iomsg); @@ -2457,6 +2637,7 @@ gfc_free_dt (gfc_dt *dt) gfc_free_expr (dt->blank); gfc_free_expr (dt->decimal); gfc_free_expr (dt->extra_comma); + gfc_free_expr (dt->pos); gfc_free (dt); } @@ -2464,14 +2645,15 @@ gfc_free_dt (gfc_dt *dt) /* Resolve everything in a gfc_dt structure. */ gfc_try -gfc_resolve_dt (gfc_dt *dt) +gfc_resolve_dt (gfc_dt *dt, locus *loc) { gfc_expr *e; RESOLVE_TAG (&tag_format, dt->format_expr); RESOLVE_TAG (&tag_rec, dt->rec); - RESOLVE_TAG (&tag_spos, dt->rec); + RESOLVE_TAG (&tag_spos, dt->pos); RESOLVE_TAG (&tag_advance, dt->advance); + RESOLVE_TAG (&tag_id, dt->id); RESOLVE_TAG (&tag_iomsg, dt->iomsg); RESOLVE_TAG (&tag_iostat, dt->iostat); RESOLVE_TAG (&tag_size, dt->size); @@ -2481,8 +2663,15 @@ gfc_resolve_dt (gfc_dt *dt) RESOLVE_TAG (&tag_e_round, dt->round); RESOLVE_TAG (&tag_e_blank, dt->blank); RESOLVE_TAG (&tag_e_decimal, dt->decimal); + RESOLVE_TAG (&tag_e_async, dt->asynchronous); e = dt->io_unit; + if (e == NULL) + { + gfc_error ("UNIT not specified at %L", loc); + return FAILURE; + } + if (gfc_resolve_expr (e) == SUCCESS && (e->ts.type != BT_INTEGER && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE))) @@ -2538,6 +2727,13 @@ gfc_resolve_dt (gfc_dt *dt) return FAILURE; } + if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_INTEGER + && mpz_sgn (e->value.integer) < 0) + { + gfc_error ("UNIT number in statement at %L must be non-negative", &e->where); + return FAILURE; + } + if (dt->extra_comma && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o " "item list at %L", &dt->extra_comma->where) == FAILURE) @@ -2758,6 +2954,7 @@ match_io_element (io_kind k, gfc_code **cpp) if (gfc_pure (NULL) && gfc_impure_variable (expr->symtree->n.sym) + && current_dt->io_unit && current_dt->io_unit->ts.type == BT_CHARACTER) { gfc_error ("Cannot read to variable '%s' in PURE procedure at %C", @@ -2771,7 +2968,8 @@ match_io_element (io_kind k, gfc_code **cpp) break; case M_WRITE: - if (current_dt->io_unit->ts.type == BT_CHARACTER + if (current_dt->io_unit + && current_dt->io_unit->ts.type == BT_CHARACTER && gfc_pure (NULL) && current_dt->io_unit->expr_type == EXPR_VARIABLE && gfc_impure_variable (current_dt->io_unit->symtree->n.sym)) @@ -2796,7 +2994,7 @@ match_io_element (io_kind k, gfc_code **cpp) cp = gfc_get_code (); cp->op = EXEC_TRANSFER; - cp->expr = expr; + cp->expr1 = expr; *cpp = cp; return MATCH_YES; @@ -2907,6 +3105,10 @@ if (condition) \ io_constraint (dt->rec != NULL, "REC tag at %L is incompatible with internal file", &dt->rec->where); + + io_constraint (dt->pos != NULL, + "POS tag at %L is incompatible with internal file", + &dt->pos->where); io_constraint (unformatted, "Unformatted I/O not allowed with internal unit at %L", @@ -2970,7 +3172,7 @@ if (condition) \ { static const char * asynchronous[] = { "YES", "NO", NULL }; - if (dt->asynchronous->expr_type != EXPR_CONSTANT) + if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS) { gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization " "expression", &dt->asynchronous->where); @@ -3145,7 +3347,7 @@ if (condition) \ io_constraint (dt->format_expr, "IO spec-list cannot contain both NAMELIST group name " - "and format specification at %L.", + "and format specification at %L", &dt->format_expr->where); io_constraint (dt->format_label, @@ -3154,22 +3356,26 @@ if (condition) \ io_constraint (dt->rec, "NAMELIST IO is not allowed with a REC= specifier " - "at %L.", &dt->rec->where); + "at %L", &dt->rec->where); io_constraint (dt->advance, "NAMELIST IO is not allowed with a ADVANCE= specifier " - "at %L.", &dt->advance->where); + "at %L", &dt->advance->where); } if (dt->rec) { io_constraint (dt->end, "An END tag is not allowed with a " - "REC= specifier at %L.", &dt->end_where); + "REC= specifier at %L", &dt->end_where); io_constraint (dt->format_label == &format_asterisk, "FMT=* is not allowed with a REC= specifier " - "at %L.", spec_end); + "at %L", spec_end); + + io_constraint (dt->pos, + "POS= is not allowed with REC= specifier " + "at %L", &dt->pos->where); } if (dt->advance) @@ -3517,9 +3723,11 @@ gfc_free_inquire (gfc_inquire *inquire) gfc_free_expr (inquire->convert); gfc_free_expr (inquire->strm_pos); gfc_free_expr (inquire->asynchronous); + gfc_free_expr (inquire->decimal); gfc_free_expr (inquire->pending); gfc_free_expr (inquire->id); gfc_free_expr (inquire->sign); + gfc_free_expr (inquire->size); gfc_free_expr (inquire->round); gfc_free (inquire); } @@ -3561,7 +3769,7 @@ match_inquire_element (gfc_inquire *inquire) RETM m = match_vtag (&tag_s_async, &inquire->asynchronous); RETM m = match_vtag (&tag_s_delim, &inquire->delim); RETM m = match_vtag (&tag_s_decimal, &inquire->decimal); - RETM m = match_vtag (&tag_s_blank, &inquire->blank); + RETM m = match_vtag (&tag_size, &inquire->size); RETM m = match_vtag (&tag_s_encoding, &inquire->encoding); RETM m = match_vtag (&tag_s_round, &inquire->round); RETM m = match_vtag (&tag_s_sign, &inquire->sign); @@ -3618,7 +3826,7 @@ gfc_match_inquire (void) goto syntax; new_st.op = EXEC_IOLENGTH; - new_st.expr = inquire->iolength; + new_st.expr1 = inquire->iolength; new_st.ext.inquire = inquire; if (gfc_pure (NULL)) @@ -3738,6 +3946,7 @@ gfc_resolve_inquire (gfc_inquire *inquire) RESOLVE_TAG (&tag_s_sign, inquire->sign); RESOLVE_TAG (&tag_s_round, inquire->round); RESOLVE_TAG (&tag_pending, inquire->pending); + RESOLVE_TAG (&tag_size, inquire->size); RESOLVE_TAG (&tag_id, inquire->id); if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)