diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 41 |
2 files changed, 40 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 10b6cddf9fd..a3a37db8e20 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2015-07-06 Steven G. Kargl <kargl@gcc.gnu.org> + + * io.c (check_char_variable): New function. + (match_open_element, match_close_element, match_file_element, + match_dt_element, match_inquire_element, match_wait_element): Use it. + 2015-07-06 Andre Vehreschild <vehre@gmx.de> PR fortran/58586 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index fe3edb9f6e2..e8395b5480d 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1181,7 +1181,7 @@ check_format_string (gfc_expr *e, bool is_input) } -/************ Fortran 95 I/O statement matchers *************/ +/************ Fortran I/O statement matchers *************/ /* Match a FORMAT statement. This amounts to actually parsing the format descriptors in order to correctly locate the end of the @@ -1242,6 +1242,21 @@ gfc_match_format (void) } +/* Check for a CHARACTER variable. The check for scalar is done in + resolve_tag. */ + +static bool +check_char_variable (gfc_expr *e) +{ + if (e->expr_type != EXPR_VARIABLE || e->ts.type != BT_CHARACTER) + { + gfc_error("IOMSG must be a scalar-default-char-variable at %L", &e->where); + return false; + } + return true; +} + + static bool is_char_type (const char *name, gfc_expr *e) { @@ -1570,7 +1585,9 @@ match_open_element (gfc_open *open) m = match_etag (&tag_unit, &open->unit); if (m != MATCH_NO) return m; - m = match_out_tag (&tag_iomsg, &open->iomsg); + m = match_etag (&tag_iomsg, &open->iomsg); + if (m == MATCH_YES && !check_char_variable (open->iomsg)) + return MATCH_ERROR; if (m != MATCH_NO) return m; m = match_out_tag (&tag_iostat, &open->iostat); @@ -2234,7 +2251,9 @@ match_close_element (gfc_close *close) m = match_etag (&tag_status, &close->status); if (m != MATCH_NO) return m; - m = match_out_tag (&tag_iomsg, &close->iomsg); + m = match_etag (&tag_iomsg, &close->iomsg); + if (m == MATCH_YES && !check_char_variable (close->iomsg)) + return MATCH_ERROR; if (m != MATCH_NO) return m; m = match_out_tag (&tag_iostat, &close->iostat); @@ -2395,7 +2414,9 @@ match_file_element (gfc_filepos *fp) m = match_etag (&tag_unit, &fp->unit); if (m != MATCH_NO) return m; - m = match_out_tag (&tag_iomsg, &fp->iomsg); + m = match_etag (&tag_iomsg, &fp->iomsg); + if (m == MATCH_YES && !check_char_variable (fp->iomsg)) + return MATCH_ERROR; if (m != MATCH_NO) return m; m = match_out_tag (&tag_iostat, &fp->iostat); @@ -2760,7 +2781,9 @@ match_dt_element (io_kind k, gfc_dt *dt) m = match_etag (&tag_spos, &dt->pos); if (m != MATCH_NO) return m; - m = match_out_tag (&tag_iomsg, &dt->iomsg); + m = match_etag (&tag_iomsg, &dt->iomsg); + if (m == MATCH_YES && !check_char_variable (dt->iomsg)) + return MATCH_ERROR; if (m != MATCH_NO) return m; @@ -3939,7 +3962,9 @@ match_inquire_element (gfc_inquire *inquire) m = match_etag (&tag_unit, &inquire->unit); RETM m = match_etag (&tag_file, &inquire->file); RETM m = match_ltag (&tag_err, &inquire->err); - RETM m = match_out_tag (&tag_iomsg, &inquire->iomsg); + RETM m = match_etag (&tag_iomsg, &inquire->iomsg); + if (m == MATCH_YES && !check_char_variable (inquire->iomsg)) + return MATCH_ERROR; RETM m = match_out_tag (&tag_iostat, &inquire->iostat); RETM m = match_vtag (&tag_exist, &inquire->exist); RETM m = match_vtag (&tag_opened, &inquire->opened); @@ -4222,7 +4247,9 @@ match_wait_element (gfc_wait *wait) RETM m = match_ltag (&tag_err, &wait->err); RETM m = match_ltag (&tag_end, &wait->eor); RETM m = match_ltag (&tag_eor, &wait->end); - RETM m = match_out_tag (&tag_iomsg, &wait->iomsg); + RETM m = match_etag (&tag_iomsg, &wait->iomsg); + if (m == MATCH_YES && !check_char_variable (wait->iomsg)) + return MATCH_ERROR; RETM m = match_out_tag (&tag_iostat, &wait->iostat); RETM m = match_etag (&tag_id, &wait->id); RETM return MATCH_NO; |