This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] PR52393 I/O: "READ format" statement with parenthesized default-char-expr
- From: Jerry DeLisle <jvdelisle at charter dot net>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 31 May 2016 12:19:54 -0700
- Subject: [patch, fortran] PR52393 I/O: "READ format" statement with parenthesized default-char-expr
- Authentication-results: sourceware.org; auth=none
The attached patch fixes this by adding code to match a default character
expression if the left paren is first matched on a READ statement. If the
expression is matched the dt-format is set and processing continues. Otherwise
execution drops through to match a control list as usual.
Regression tested on x86-64-linux. Test case attached.
OK for trunk?
Regards,
Jerry
2016-05-30 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/52393
* io.c (match_io): For READ, try to match a default character
expression. If found, set the dt format expression to this,
otherwise go back and try control list.
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index da0e1c5..204cce2 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -3689,7 +3689,7 @@ match_io (io_kind k)
gfc_symbol *sym;
int comma_flag;
locus where;
- locus spec_end;
+ locus spec_end, control;
gfc_dt *dt;
match m;
@@ -3751,21 +3751,56 @@ match_io (io_kind k)
{
/* Before issuing an error for a malformed 'print (1,*)' type of
error, check for a default-char-expr of the form ('(I0)'). */
- if (k == M_PRINT && m == MATCH_YES)
- {
- /* Reset current locus to get the initial '(' in an expression. */
- gfc_current_locus = where;
- dt->format_expr = NULL;
- m = match_dt_format (dt);
+ if (m == MATCH_YES)
+ {
+ control = gfc_current_locus;
+ if (k == M_PRINT)
+ {
+ /* Reset current locus to get the initial '(' in an expression. */
+ gfc_current_locus = where;
+ dt->format_expr = NULL;
+ m = match_dt_format (dt);
- if (m == MATCH_ERROR)
- goto cleanup;
- if (m == MATCH_NO || dt->format_expr == NULL)
- goto syntax;
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ if (m == MATCH_NO || dt->format_expr == NULL)
+ goto syntax;
- comma_flag = 1;
- dt->io_unit = default_unit (k);
- goto get_io_list;
+ comma_flag = 1;
+ dt->io_unit = default_unit (k);
+ goto get_io_list;
+ }
+ if (k == M_READ)
+ {
+ /* Reset current locus to get the initial '(' in an expression. */
+ gfc_current_locus = where;
+ dt->format_expr = NULL;
+ m = gfc_match_expr (&dt->format_expr);
+ if (m == MATCH_YES)
+ {
+ if (dt->format_expr
+ && dt->format_expr->ts.type == BT_CHARACTER)
+ {
+ comma_flag = 1;
+ dt->io_unit = default_unit (k);
+ goto get_io_list;
+ }
+ else
+ {
+ gfc_free_expr (dt->format_expr);
+ dt->format_expr = NULL;
+ gfc_current_locus = control;
+ }
+ }
+ else
+ {
+ gfc_clear_error ();
+ gfc_undo_symbols ();
+ gfc_free_expr (dt->format_expr);
+ dt->format_expr = NULL;
+ gfc_current_locus = control;
+ }
+ }
}
}
! { dg-do compile }
! PR52392 "READ format" statement with parenthesed default-char-expr
PROGRAM ReadMeTwo
IMPLICIT NONE
CHARACTER(10) :: var
var = "TestStr"
PRINT ('(') // 'A)', var
PRINT ('(') // 'A)', var
READ ('(') // 'A)', var
PRINT *, var
READ *, var
END PROGRAM ReadMeTwo