Message ID | 56bf245f-7f72-7f90-f9b6-c5aa0e5e5fd7@charter.net |
---|---|
State | New |
Headers | show |
> 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. OK. Maybe you could add some “negative” tests too? To be sure we still catch malformed parenthesized formats? FX
On 06/01/2016 12:25 AM, FX wrote: >> 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. > > OK. Maybe you could add some “negative” tests too? To be sure we still catch malformed parenthesized formats? > > FX > Thanks for review! yes I will add some tests. Jerry
On Wed, Jun 1, 2016 at 9:28 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: > On 06/01/2016 12:25 AM, FX wrote: >>> 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. >> >> OK. Maybe you could add some “negative” tests too? To be sure we still catch malformed parenthesized formats? >> >> FX >> > > Thanks for review! yes I will add some tests. > It caused: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71404
On 06/03/2016 12:40 PM, H.J. Lu wrote: > On Wed, Jun 1, 2016 at 9:28 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: >> On 06/01/2016 12:25 AM, FX wrote: >>>> 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. >>> >>> OK. Maybe you could add some “negative” tests too? To be sure we still catch malformed parenthesized formats? >>> >>> FX >>> >> >> Thanks for review! yes I will add some tests. >> > > It caused: > > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=71404 > > Patch committed. Author: jvdelisle Date: Sun Jun 5 19:49:59 2016 New Revision: 237108 URL: https://gcc.gnu.org/viewcvs?rev=237108&root=gcc&view=rev Log: 2016-06-05 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/71404 * io.c (match_io): For READ, commit in pending symbols in the current statement before trying to match an expression so that if the match fails and we undo symbols we dont toss good symbols. Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/io.c
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; + } + } } }