From: jvdelisle Date: Sun, 28 Apr 2013 17:20:06 +0000 (+0000) Subject: 2013-04-28 Jerry DeLisle X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=bda5e163c26c2c8ee321fceecf2d1c6bbfd6d307 2013-04-28 Jerry DeLisle Backport from mainline: PR libfortran/56786 * io/list_read.c (nml_parse_qualifier): Remove spurious next_char call when checking for EOF. Use error return mechanism when EOF detected. Do not return FAILURE unless parse_err_msg and parse_err_msg_size have been set. Use hit_eof. (nml_get_obj_data): Likewise use the correct error mechanism. * io/transfer.c (hit_eof): Do not set AFTER_ENDFILE if in namelist mode. Backport from trunk: PR fortran/56786 * gfortran.dg/namelist_81.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@198375 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7b67c65c04e..9321fcefcfd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -2,6 +2,13 @@ Backport from trunk: + PR fortran/56786 + * gfortran.dg/namelist_81.f90: New test. + +2013-04-28 Jerry DeLisle + + Backport from trunk: + PR fortran/52512 * gfortran.dg/namelist_79.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/namelist_81.f90 b/gcc/testsuite/gfortran.dg/namelist_81.f90 new file mode 100644 index 00000000000..ddb100bf882 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_81.f90 @@ -0,0 +1,43 @@ +! { dg-do run } +! PR56786 Error on embedded spaces +integer :: i(3) +namelist /nml/ i + +i = -42 +open(99,status='scratch') +write(99,'(a)') '&nml i(3 ) = 5 /' +rewind(99) +read(99,nml=nml) +close(99) +if (i(1)/=-42 .or. i(2)/=-42 .or. i(3)/=5) call abort() + +! Shorten the file so the read hits EOF + +open(99,status='scratch') +write(99,'(a)') '&nml i(3 ) = 5 ' +rewind(99) +read(99,nml=nml, end=30) +call abort() +! Shorten some more + 30 close(99) +open(99,status='scratch') +write(99,'(a)') '&nml i(3 ) =' +rewind(99) +read(99,nml=nml, end=40) +call abort() +! Shorten some more + 40 close(99) +open(99,status='scratch') +write(99,'(a)') '&nml i(3 )' +rewind(99) +read(99,nml=nml, end=50) +call abort() +! Shorten some more + 50 close(99) +open(99,status='scratch') +write(99,'(a)') '&nml i(3 ' +rewind(99) +read(99,nml=nml, end=60) +call abort() + 60 close(99) +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 759ca5df6be..c02d6d5479e 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,6 +1,19 @@ 2013-04-28 Jerry DeLisle Backport from mainline: + + PR libfortran/56786 + * io/list_read.c (nml_parse_qualifier): Remove spurious next_char call + when checking for EOF. Use error return mechanism when EOF detected. + Do not return FAILURE unless parse_err_msg and parse_err_msg_size have + been set. Use hit_eof. + (nml_get_obj_data): Likewise use the correct error mechanism. + * io/transfer.c (hit_eof): Do not set AFTER_ENDFILE if in namelist + mode. + +2013-04-28 Jerry DeLisle + + Backport from mainline: 2013-03-25 Tilo Schwarz PR libfortran/52512 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 42c984ba0f2..d0e83ab9690 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2053,7 +2053,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, /* The next character in the stream should be the '('. */ if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto err_ret; /* Process the qualifier, by dimension and triplet. */ @@ -2067,7 +2067,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, /* Process a potential sign. */ if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto err_ret; switch (c) { case '-': @@ -2085,11 +2085,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, /* Process characters up to the next ':' , ',' or ')'. */ for (;;) { - if ((c = next_char (dtp)) == EOF) - return FAILURE; - + c = next_char (dtp); switch (c) { + case EOF: + goto err_ret; + case ':': is_array_section = 1; break; @@ -2112,10 +2113,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, push_char (dtp, c); continue; - case ' ': case '\t': + case ' ': case '\t': case '\r': case '\n': eat_spaces (dtp); - if ((c = next_char (dtp) == EOF)) - return FAILURE; break; default: @@ -2257,6 +2256,15 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, err_ret: + /* The EOF error message is issued by hit_eof. Return true so that the + caller does not use parse_err_msg and parse_err_msg_size to generate + an unrelated error message. */ + if (c == EOF) + { + hit_eof (dtp); + dtp->u.p.input_complete = 1; + return SUCCESS; + } return FAILURE; } @@ -2726,12 +2734,12 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl, return SUCCESS; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; switch (c) { case '=': if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; if (c != '?') { snprintf (nml_err_msg, nml_err_msg_size, @@ -2781,8 +2789,9 @@ get_name: if (!is_separator (c)) push_char (dtp, tolower(c)); if ((c = next_char (dtp)) == EOF) - return FAILURE; - } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); + goto nml_err_ret; + } + while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' )); unget_char (dtp, c); @@ -2857,7 +2866,7 @@ get_name: qualifier_flag = 1; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; unget_char (dtp, c); } else if (nl->var_rank > 0) @@ -2883,7 +2892,7 @@ get_name: component_flag = 1; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; goto get_name; } @@ -2921,7 +2930,7 @@ get_name: } if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; unget_char (dtp, c); } @@ -2961,7 +2970,7 @@ get_name: return SUCCESS; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; if (c != '=') { @@ -2996,6 +3005,17 @@ get_name: nml_err_ret: + /* The EOF error message is issued by hit_eof. Return true so that the + caller does not use nml_err_msg and nml_err_msg_size to generate + an unrelated error message. */ + if (c == EOF) + { + dtp->u.p.input_complete = 1; + unget_char (dtp, c); + hit_eof (dtp); + return SUCCESS; + } + return FAILURE; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index f71e96f75de..63e3af1b2dd 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -3748,7 +3748,7 @@ hit_eof (st_parameter_dt * dtp) case NO_ENDFILE: case AT_ENDFILE: generate_error (&dtp->common, LIBERROR_END, NULL); - if (!is_internal_unit (dtp)) + if (!is_internal_unit (dtp) && !dtp->u.p.namelist_mode) { dtp->u.p.current_unit->endfile = AFTER_ENDFILE; dtp->u.p.current_unit->current_record = 0;