From 4731c9f025a6c14d77e3127b8c64a46bd933c687 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Wed, 1 Jun 2016 17:06:50 +0000 Subject: [PATCH] re PR fortran/52393 (I/O: "READ format" statement with parenthesed default-char-expr) 2016-06-01 Jerry DeLisle 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. PR fortran/52393 * gfortran.dg/fmt_read_3.f90: New test. From-SVN: r237003 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/io.c | 63 ++++++++++++++++++------ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/fmt_read_3.f90 | 13 +++++ 4 files changed, 74 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/fmt_read_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1cc998e78b5..2a9c9ceab93 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-06-01 Jerry DeLisle + + 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. + 2016-06-01 Paul Thomas PR fortran/71156 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index da0e1c5ec49..204cce2e565 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; + } + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5bc66767f44..7ee77b62f3f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-06-01 Jerry DeLisle + + PR fortran/52393 + * gfortran.dg/fmt_read_3.f90: New test. + 2016-06-01 Thomas Preud'homme * lib/target-supports.exp (check_effective_target_arm_acq_rel): New diff --git a/gcc/testsuite/gfortran.dg/fmt_read_3.f90 b/gcc/testsuite/gfortran.dg/fmt_read_3.f90 new file mode 100644 index 00000000000..72053697c40 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/fmt_read_3.f90 @@ -0,0 +1,13 @@ +! { 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 + -- 2.30.2