/* Deal with I/O statements & related stuff.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
#include "parse.h"
gfc_st_label format_asterisk =
- { -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL, 0,
- {NULL, NULL}, NULL, NULL};
+ {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
+ 0, {NULL, NULL}};
typedef struct
{
tag_s_delim = {"DELIM", " delim = %v", BT_CHARACTER},
tag_s_pad = {"PAD", " pad = %v", BT_CHARACTER},
tag_iolength = {"IOLENGTH", " iolength = %v", BT_INTEGER},
+ tag_convert = {"CONVERT", " convert = %e", BT_CHARACTER},
tag_err = {"ERR", " err = %l", BT_UNKNOWN},
tag_end = {"END", " end = %l", BT_UNKNOWN},
tag_eor = {"EOR", " eor = %l", BT_UNKNOWN};
use_last_char = 1;
}
+/* Eat up the spaces and return a character. */
+
+static char
+next_char_not_space(void)
+{
+ char c;
+ do
+ {
+ c = next_char (0);
+ }
+ while (gfc_is_whitespace (c));
+ return c;
+}
+
static int value = 0;
/* Simple lexical analyzer for getting the next token in a FORMAT
return token;
}
- do
- {
- c = next_char (0);
- }
- while (gfc_is_whitespace (c));
-
+ c = next_char_not_space ();
+
negative_flag = 0;
switch (c)
{
case '-':
negative_flag = 1;
case '+':
- c = next_char (0);
+ c = next_char_not_space ();
if (!ISDIGIT (c))
{
token = FMT_UNKNOWN;
do
{
- c = next_char (0);
+ c = next_char_not_space ();
if(ISDIGIT (c))
value = 10 * value + c - '0';
}
do
{
- c = next_char (0);
+ c = next_char_not_space ();
if (c != '0')
zflag = 0;
if (ISDIGIT (c))
break;
case 'T':
- c = next_char (0);
+ c = next_char_not_space ();
if (c != 'L' && c != 'R')
unget_char ();
break;
case 'S':
- c = next_char (0);
+ c = next_char_not_space ();
if (c != 'P' && c != 'S')
unget_char ();
break;
case 'B':
- c = next_char (0);
+ c = next_char_not_space ();
if (c == 'N' || c == 'Z')
token = FMT_BLANK;
else
break;
case 'E':
- c = next_char (0);
+ c = next_char_not_space ();
if (c == 'N' || c == 'S')
token = FMT_EXT;
else
static try
check_format (void)
{
- const char *posint_required = "Positive width required";
- const char *period_required = "Period required";
- const char *nonneg_required = "Nonnegative width required";
- const char *unexpected_element = "Unexpected element";
- const char *unexpected_end = "Unexpected end of format string";
+ const char *posint_required = _("Positive width required");
+ const char *nonneg_required = _("Nonnegative width required");
+ const char *unexpected_element = _("Unexpected element");
+ const char *unexpected_end = _("Unexpected end of format string");
const char *error;
format_token t, u;
t = format_lex ();
if (t != FMT_LPAREN)
{
- error = "Missing leading left parenthesis";
+ error = _("Missing leading left parenthesis");
goto syntax;
}
t = format_lex ();
if (t != FMT_P)
{
- error = "Expected P edit descriptor";
+ error = _("Expected P edit descriptor");
goto syntax;
}
case FMT_P:
/* P requires a prior number. */
- error = "P descriptor requires leading scale factor";
+ error = _("P descriptor requires leading scale factor");
goto syntax;
case FMT_X:
return FAILURE;
if (t != FMT_RPAREN || level > 0)
{
- error = "$ must be the last specifier";
+ error = _("$ must be the last specifier");
goto syntax;
}
t = format_lex ();
if (t == FMT_POSINT)
{
- error = "Repeat count cannot follow P descriptor";
+ error = _("Repeat count cannot follow P descriptor");
goto syntax;
}
if (t == FMT_POSINT)
break;
- error = posint_required;
- goto syntax;
+ switch (gfc_notification_std (GFC_STD_GNU))
+ {
+ case WARNING:
+ gfc_warning
+ ("Extension: Missing positive width after L descriptor at %C");
+ saved_token = t;
+ break;
+
+ case ERROR:
+ error = posint_required;
+ goto syntax;
+
+ case SILENT:
+ saved_token = t;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+ break;
case FMT_A:
t = format_lex ();
u = format_lex ();
if (u != FMT_PERIOD)
{
- error = period_required;
- goto syntax;
+ /* 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");
+ saved_token = u;
+ break;
}
u = format_lex ();
u = format_lex ();
if (u != FMT_POSINT)
{
- error = "Positive exponent width required";
+ error = _("Positive exponent width required");
goto syntax;
}
}
t = format_lex ();
if (t != FMT_PERIOD)
{
- error = period_required;
- goto syntax;
+ /* 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");
+ saved_token = t;
+ break;
}
t = format_lex ();
gfc_expr *e;
locus start;
+ if (gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+ {
+ gfc_error ("Format statement in module main block at %C.");
+ return MATCH_ERROR;
+ }
+
if (gfc_statement_label == NULL)
{
gfc_error ("Missing format label at %C");
return MATCH_ERROR;
}
+ if (m == MATCH_YES
+ && gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE)
+ return MATCH_ERROR;
+
return m;
}
if (tag == &tag_format)
{
+ if (e->expr_type == EXPR_CONSTANT
+ && (e->ts.type != BT_CHARACTER
+ || e->ts.kind != gfc_default_character_kind))
+ {
+ gfc_error ("Constant expression in FORMAT tag at %L must be "
+ "of type default CHARACTER", &e->where);
+ return FAILURE;
+ }
+
/* 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. */
gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
return FAILURE;
}
+
if (tag == &tag_iomsg)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L",
&e->where) == FAILURE)
return FAILURE;
}
+
+ if (tag == &tag_iostat && e->ts.kind != gfc_default_integer_kind)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Fortran 95 requires default "
+ "INTEGER in IOSTAT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
+
+ if (tag == &tag_size && e->ts.kind != gfc_default_integer_kind)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Fortran 95 requires default "
+ "INTEGER in SIZE tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
+
+ if (tag == &tag_convert)
+ {
+ if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
+ &e->where) == FAILURE)
+ return FAILURE;
+ }
}
return SUCCESS;
m = match_ltag (&tag_err, &open->err);
if (m != MATCH_NO)
return m;
+ m = match_etag (&tag_convert, &open->convert);
+ if (m != MATCH_NO)
+ return m;
return MATCH_NO;
}
gfc_free_expr (open->action);
gfc_free_expr (open->delim);
gfc_free_expr (open->pad);
+ gfc_free_expr (open->convert);
gfc_free (open);
}
RESOLVE_TAG (&tag_iostat, open->iostat);
RESOLVE_TAG (&tag_file, open->file);
RESOLVE_TAG (&tag_status, open->status);
+ RESOLVE_TAG (&tag_e_access, open->access);
RESOLVE_TAG (&tag_e_form, open->form);
RESOLVE_TAG (&tag_e_recl, open->recl);
RESOLVE_TAG (&tag_e_action, open->action);
RESOLVE_TAG (&tag_e_delim, open->delim);
RESOLVE_TAG (&tag_e_pad, open->pad);
+ RESOLVE_TAG (&tag_convert, open->convert);
if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
return MATCH_YES;
}
- if (gfc_match_st_label (&label, 0) == MATCH_YES)
+ if (gfc_match_st_label (&label) == MATCH_YES)
{
if (dt->format_expr != NULL || dt->format_label != NULL)
{
if (m != MATCH_NO)
return m;
m = match_ltag (&tag_err, &dt->err);
+ if (m == MATCH_YES)
+ dt->err_where = gfc_current_locus;
if (m != MATCH_NO)
return m;
m = match_etag (&tag_advance, &dt->advance);
return FAILURE;
}
- /* Sanity checks on data transfer statements. */
if (e->ts.type == BT_CHARACTER)
{
- if (dt->rec != NULL)
+ if (gfc_has_vector_index (e))
{
- gfc_error ("REC tag at %L is incompatible with internal file",
- &dt->rec->where);
- return FAILURE;
- }
-
- if (dt->namelist != NULL)
- {
- gfc_error ("Internal file at %L is incompatible with namelist",
- &dt->io_unit->where);
+ gfc_error ("Internal unit with vector subscript at %L",
+ &e->where);
return FAILURE;
}
+ }
- if (dt->advance != NULL)
- {
- gfc_error ("ADVANCE tag at %L is incompatible with internal file",
- &dt->advance->where);
- return FAILURE;
- }
+ if (e->rank && e->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("External IO UNIT cannot be an array at %L", &e->where);
+ return FAILURE;
}
- if (dt->rec != NULL)
+ if (dt->err)
{
- if (dt->end != NULL)
+ if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
+ return FAILURE;
+ if (dt->err->defined == ST_LABEL_UNKNOWN)
{
- gfc_error ("REC tag at %L is incompatible with END tag",
- &dt->rec->where);
+ gfc_error ("ERR tag label %d at %L not defined",
+ dt->err->value, &dt->err_where);
return FAILURE;
}
+ }
- if (dt->format_label == &format_asterisk)
+ if (dt->end)
+ {
+ if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE)
+ return FAILURE;
+ if (dt->end->defined == ST_LABEL_UNKNOWN)
{
- gfc_error
- ("END tag at %L is incompatible with list directed format (*)",
- &dt->end_where);
+ gfc_error ("END tag label %d at %L not defined",
+ dt->end->value, &dt->end_where);
return FAILURE;
}
+ }
- if (dt->namelist != NULL)
+ if (dt->eor)
+ {
+ if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE)
+ return FAILURE;
+ if (dt->eor->defined == ST_LABEL_UNKNOWN)
{
- gfc_error ("REC tag at %L is incompatible with namelist",
- &dt->rec->where);
+ gfc_error ("EOR tag label %d at %L not defined",
+ dt->eor->value, &dt->eor_where);
return FAILURE;
}
}
- if (dt->advance != NULL && dt->format_label == &format_asterisk)
- {
- gfc_error ("ADVANCE tag at %L is incompatible with list directed "
- "format (*)", &dt->advance->where);
- return FAILURE;
- }
-
- if (dt->eor != 0 && dt->advance == NULL)
- {
- gfc_error ("EOR tag at %L requires an ADVANCE tag", &dt->eor_where);
- return FAILURE;
- }
-
- if (dt->size != NULL && dt->advance == NULL)
- {
- gfc_error ("SIZE tag at %L requires an ADVANCE tag", &dt->size->where);
- return FAILURE;
- }
-
- /* TODO: Make sure the ADVANCE tag is 'yes' or 'no' if it is a string
- constant. */
-
- if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
- return FAILURE;
-
- if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE)
- return FAILURE;
-
- if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE)
- return FAILURE;
-
/* Check the format label actually exists. */
if (dt->format_label && dt->format_label != &format_asterisk
&& dt->format_label->defined == ST_LABEL_UNKNOWN)
gfc_code *c;
if (io_code == NULL)
- io_code = &new_st;
+ io_code = new_st.block;
c = gfc_get_code ();
c->op = EXEC_DT_END;
}
+/* Check the constraints for a data transfer statement. The majority of the
+ constraints appearing in 9.4 of the standard appear here. Some are handled
+ in resolve_tag and others in gfc_resolve_dt. */
+
+static match
+check_io_constraints (io_kind k, gfc_dt *dt, gfc_code * io_code, locus * spec_end)
+{
+#define io_constraint(condition,msg,arg)\
+if (condition) \
+ {\
+ gfc_error(msg,arg);\
+ m = MATCH_ERROR;\
+ }
+
+ match m;
+ gfc_expr * expr;
+ gfc_symbol * sym = NULL;
+
+ m = MATCH_YES;
+
+ expr = dt->io_unit;
+ if (expr && expr->expr_type == EXPR_VARIABLE
+ && expr->ts.type == BT_CHARACTER)
+ {
+ sym = expr->symtree->n.sym;
+
+ io_constraint (k == M_WRITE && sym->attr.intent == INTENT_IN,
+ "Internal file at %L must not be INTENT(IN)",
+ &expr->where);
+
+ io_constraint (gfc_has_vector_index (dt->io_unit),
+ "Internal file incompatible with vector subscript at %L",
+ &expr->where);
+
+ io_constraint (dt->rec != NULL,
+ "REC tag at %L is incompatible with internal file",
+ &dt->rec->where);
+
+ io_constraint (dt->namelist != NULL,
+ "Internal file at %L is incompatible with namelist",
+ &expr->where);
+
+ io_constraint (dt->advance != NULL,
+ "ADVANCE tag at %L is incompatible with internal file",
+ &dt->advance->where);
+ }
+
+ if (expr && expr->ts.type != BT_CHARACTER)
+ {
+
+ io_constraint (gfc_pure (NULL)
+ && (k == M_READ || k == M_WRITE),
+ "IO UNIT in %s statement at %C must be "
+ "an internal file in a PURE procedure",
+ io_kind_name (k));
+ }
+
+
+ if (k != M_READ)
+ {
+ io_constraint (dt->end,
+ "END tag not allowed with output at %L",
+ &dt->end_where);
+
+ io_constraint (dt->eor,
+ "EOR tag not allowed with output at %L",
+ &dt->eor_where);
+
+ io_constraint (k != M_READ && dt->size,
+ "SIZE=specifier not allowed with output at %L",
+ &dt->size->where);
+ }
+ else
+ {
+ io_constraint (dt->size && dt->advance == NULL,
+ "SIZE tag at %L requires an ADVANCE tag",
+ &dt->size->where);
+
+ io_constraint (dt->eor && dt->advance == NULL,
+ "EOR tag at %L requires an ADVANCE tag",
+ &dt->eor_where);
+ }
+
+
+
+ if (dt->namelist)
+ {
+ io_constraint (io_code && dt->namelist,
+ "NAMELIST cannot be followed by IO-list at %L",
+ &io_code->loc);
+
+ io_constraint (dt->format_expr,
+ "IO spec-list cannot contain both NAMELIST group name "
+ "and format specification at %L.",
+ &dt->format_expr->where);
+
+ io_constraint (dt->format_label,
+ "IO spec-list cannot contain both NAMELIST group name "
+ "and format label at %L", spec_end);
+
+ io_constraint (dt->rec,
+ "NAMELIST IO is not allowed with a REC=specifier "
+ "at %L.", &dt->rec->where);
+
+ io_constraint (dt->advance,
+ "NAMELIST IO is not allowed with a ADVANCE=specifier "
+ "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);
+
+
+ io_constraint (dt->format_label == &format_asterisk,
+ "FMT=* is not allowed with a REC=specifier "
+ "at %L.", spec_end);
+ }
+
+ if (dt->advance)
+ {
+ int not_yes, not_no;
+ expr = dt->advance;
+
+ io_constraint (dt->format_label == &format_asterisk,
+ "List directed format(*) is not allowed with a "
+ "ADVANCE=specifier at %L.", &expr->where);
+
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
+ {
+ const char * advance = expr->value.character.string;
+ not_no = strncasecmp (advance, "no", 2) != 0;
+ not_yes = strncasecmp (advance, "yes", 2) != 0;
+ }
+ else
+ {
+ not_no = 0;
+ not_yes = 0;
+ }
+
+ io_constraint (not_no && not_yes,
+ "ADVANCE=specifier at %L must have value = "
+ "YES or NO.", &expr->where);
+
+ io_constraint (dt->size && not_no && k == M_READ,
+ "SIZE tag at %L requires an ADVANCE = 'NO'",
+ &dt->size->where);
+
+ io_constraint (dt->eor && not_no && k == M_READ,
+ "EOR tag at %L requires an ADVANCE = 'NO'",
+ &dt->eor_where);
+ }
+
+ expr = dt->format_expr;
+ if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
+ check_format_string (expr);
+
+ return m;
+}
+#undef io_constraint
+
/* Match a READ, WRITE or PRINT statement. */
static match
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_code *io_code;
gfc_symbol *sym;
- gfc_expr *expr;
int comma_flag, c;
locus where;
+ locus spec_end;
gfc_dt *dt;
match m;
+ where = gfc_current_locus;
comma_flag = 0;
current_dt = dt = gfc_getmem (sizeof (gfc_dt));
-
if (gfc_match_char ('(') == MATCH_NO)
{
+ where = gfc_current_locus;
if (k == M_WRITE)
goto syntax;
- else if (k == M_PRINT
- && (gfc_current_form == FORM_FIXED
- || gfc_peek_char () == ' '))
+ else if (k == M_PRINT)
{
/* Treat the non-standard case of PRINT namelist. */
- where = gfc_current_locus;
- if ((gfc_match_name (name) == MATCH_YES)
- && !gfc_find_symbol (name, NULL, 1, &sym)
- && sym->attr.flavor == FL_NAMELIST)
+ if ((gfc_current_form == FORM_FIXED || gfc_peek_char () == ' ')
+ && gfc_match_name (name) == MATCH_YES)
{
- if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
- "%C is an extension") == FAILURE)
+ gfc_find_symbol (name, NULL, 1, &sym);
+ if (sym && sym->attr.flavor == FL_NAMELIST)
{
- m = MATCH_ERROR;
- goto cleanup;
+ if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
+ "%C is an extension") == FAILURE)
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+
+ dt->io_unit = default_unit (k);
+ dt->namelist = sym;
+ goto get_io_list;
}
- if (gfc_match_eos () == MATCH_NO)
- {
- gfc_error ("Namelist followed by I/O list at %C");
- m = MATCH_ERROR;
- goto cleanup;
- }
-
- dt->io_unit = default_unit (k);
- dt->namelist = sym;
- goto get_io_list;
+ else
+ gfc_current_locus = where;
}
- else
- gfc_current_locus = where;
}
if (gfc_current_form == FORM_FREE)
- {
- c = gfc_peek_char();
- if (c != ' ' && c != '*' && c != '\'' && c != '"')
- {
- m = MATCH_NO;
- goto cleanup;
- }
- }
+ {
+ c = gfc_peek_char();
+ if (c != ' ' && c != '*' && c != '\'' && c != '"')
+ {
+ m = MATCH_NO;
+ goto cleanup;
+ }
+ }
m = match_dt_format (dt);
if (m == MATCH_ERROR)
dt->io_unit = default_unit (k);
goto get_io_list;
}
+ else
+ {
+ /* Error for constructs like print (1,*). */
+ if (k == M_PRINT)
+ goto syntax;
+ }
/* Match a control list */
if (match_dt_element (k, dt) == MATCH_YES)
where = gfc_current_locus;
- if (gfc_match_name (name) == MATCH_YES
- && !gfc_find_symbol (name, NULL, 1, &sym)
- && sym->attr.flavor == FL_NAMELIST)
+ m = gfc_match_name (name);
+ if (m == MATCH_YES)
{
- dt->namelist = sym;
- if (k == M_READ && check_namelist (sym))
+ gfc_find_symbol (name, NULL, 1, &sym);
+ if (sym && sym->attr.flavor == FL_NAMELIST)
{
- m = MATCH_ERROR;
- goto cleanup;
+ dt->namelist = sym;
+ if (k == M_READ && check_namelist (sym))
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+ goto next;
}
- goto next;
}
gfc_current_locus = where;
}
get_io_list:
+
+ /* Used in check_io_constraints, where no locus is available. */
+ spec_end = gfc_current_locus;
+
/* Optional leading comma (non-standard). */
if (!comma_flag
&& gfc_match_char (',') == MATCH_YES
goto syntax;
}
- /* A full IO statement has been matched. */
- if (dt->io_unit->expr_type == EXPR_VARIABLE
- && k == M_WRITE
- && dt->io_unit->ts.type == BT_CHARACTER
- && dt->io_unit->symtree->n.sym->attr.intent == INTENT_IN)
- {
- gfc_error ("Internal file '%s' at %L is INTENT(IN)",
- dt->io_unit->symtree->n.sym->name, &dt->io_unit->where);
- m = MATCH_ERROR;
- goto cleanup;
- }
+ /* A full IO statement has been matched. Check the constraints. spec_end is
+ supplied for cases where no locus is supplied. */
+ m = check_io_constraints (k, dt, io_code, &spec_end);
- expr = dt->format_expr;
-
- if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
- check_format_string (expr);
-
- if (gfc_pure (NULL)
- && (k == M_READ || k == M_WRITE)
- && dt->io_unit->ts.type != BT_CHARACTER)
- {
- gfc_error
- ("io-unit in %s statement at %C must be an internal file in a "
- "PURE procedure", io_kind_name (k));
- m = MATCH_ERROR;
- goto cleanup;
- }
+ if (m == MATCH_ERROR)
+ goto cleanup;
new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
new_st.ext.dt = dt;
- new_st.next = io_code;
+ new_st.block = gfc_get_code ();
+ new_st.block->op = new_st.op;
+ new_st.block->next = io_code;
terminate_io (io_code);
gfc_free_expr (inquire->delim);
gfc_free_expr (inquire->pad);
gfc_free_expr (inquire->iolength);
+ gfc_free_expr (inquire->convert);
gfc_free (inquire);
}
RETM m = match_vtag (&tag_s_delim, &inquire->delim);
RETM m = match_vtag (&tag_s_pad, &inquire->pad);
RETM m = match_vtag (&tag_iolength, &inquire->iolength);
+ RETM m = match_vtag (&tag_convert, &inquire->convert);
RETM return MATCH_NO;
}
if (m == MATCH_NO)
goto syntax;
- terminate_io (code);
-
new_st.op = EXEC_IOLENGTH;
new_st.expr = inquire->iolength;
new_st.ext.inquire = inquire;
return MATCH_ERROR;
}
- new_st.next = code;
+ new_st.block = gfc_get_code ();
+ new_st.block->op = EXEC_IOLENGTH;
+ terminate_io (code);
+ new_st.block->next = code;
return MATCH_YES;
}
RESOLVE_TAG (&tag_s_delim, inquire->delim);
RESOLVE_TAG (&tag_s_pad, inquire->pad);
RESOLVE_TAG (&tag_iolength, inquire->iolength);
+ RESOLVE_TAG (&tag_convert, inquire->convert);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
return FAILURE;
OSDN Git Service
