diff options
Diffstat (limited to 'gcc-4.8/libgfortran/io/list_read.c')
-rw-r--r-- | gcc-4.8/libgfortran/io/list_read.c | 96 |
1 files changed, 59 insertions, 37 deletions
diff --git a/gcc-4.8/libgfortran/io/list_read.c b/gcc-4.8/libgfortran/io/list_read.c index fb8a841b2..5a44bdf78 100644 --- a/gcc-4.8/libgfortran/io/list_read.c +++ b/gcc-4.8/libgfortran/io/list_read.c @@ -1433,7 +1433,6 @@ read_real (st_parameter_dt *dtp, void * dest, int length) goto got_sign; CASE_SEPARATORS: - case EOF: unget_char (dtp, c); /* Single null. */ eat_separator (dtp); return; @@ -2054,8 +2053,8 @@ calls: static try nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, - array_loop_spec *ls, int rank, char *parse_err_msg, - size_t parse_err_msg_size, + array_loop_spec *ls, int rank, bt nml_elem_type, + char *parse_err_msg, size_t parse_err_msg_size, int *parsed_rank) { int dim; @@ -2079,7 +2078,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. */ @@ -2093,7 +2092,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 '-': @@ -2111,11 +2110,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; @@ -2138,10 +2138,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: @@ -2230,7 +2228,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad, do not allow excess data to be processed. */ if (is_array_section == 1 || !(compile_options.allow_std & GFC_STD_GNU) - || dtp->u.p.ionml->type == BT_DERIVED) + || nml_elem_type == BT_DERIVED) ls[dim].end = ls[dim].start; else dtp->u.p.expanded_read = 1; @@ -2283,6 +2281,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; } @@ -2381,11 +2388,11 @@ nml_query (st_parameter_dt *dtp, char c) index_type len; char * p; #ifdef HAVE_CRLF - static const index_type endlen = 3; + static const index_type endlen = 2; static const char endl[] = "\r\n"; static const char nmlend[] = "&end\r\n"; #else - static const index_type endlen = 2; + static const index_type endlen = 1; static const char endl[] = "\n"; static const char nmlend[] = "&end\n"; #endif @@ -2415,12 +2422,12 @@ nml_query (st_parameter_dt *dtp, char c) /* "&namelist_name\n" */ len = dtp->namelist_name_len; - p = write_block (dtp, len + endlen); + p = write_block (dtp, len - 1 + endlen); if (!p) goto query_return; memcpy (p, "&", 1); memcpy ((char*)(p + 1), dtp->namelist_name, len); - memcpy ((char*)(p + len + 1), &endl, endlen - 1); + memcpy ((char*)(p + len + 1), &endl, endlen); for (nl = dtp->u.p.ionml; nl; nl = nl->next) { /* " var_name\n" */ @@ -2431,14 +2438,15 @@ nml_query (st_parameter_dt *dtp, char c) goto query_return; memcpy (p, " ", 1); memcpy ((char*)(p + 1), nl->var_name, len); - memcpy ((char*)(p + len + 1), &endl, endlen - 1); + memcpy ((char*)(p + len + 1), &endl, endlen); } /* "&end\n" */ - p = write_block (dtp, endlen + 3); + p = write_block (dtp, endlen + 4); + if (!p) goto query_return; - memcpy (p, &nmlend, endlen + 3); + memcpy (p, &nmlend, endlen + 4); } /* Flush the stream to force immediate output. */ @@ -2578,17 +2586,17 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, since a single object can have multiple reads. */ dtp->u.p.expanded_read = 0; - /* Now loop over the components. Update the component pointer - with the return value from nml_write_obj. This loop jumps - past nested derived types by testing if the potential - component name contains '%'. */ + /* Now loop over the components. */ for (cmp = nl->next; cmp && - !strncmp (cmp->var_name, obj_name, obj_name_len) && - !strchr (cmp->var_name + obj_name_len, '%'); + !strncmp (cmp->var_name, obj_name, obj_name_len); cmp = cmp->next) { + /* Jump over nested derived type by testing if the potential + component name contains '%'. */ + if (strchr (cmp->var_name + obj_name_len, '%')) + continue; if (nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos), pprev_nl, nml_err_msg, nml_err_msg_size, @@ -2751,12 +2759,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, @@ -2806,8 +2814,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); @@ -2867,7 +2876,7 @@ get_name: { parsed_rank = 0; if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank, - nml_err_msg, nml_err_msg_size, + nl->type, nml_err_msg, nml_err_msg_size, &parsed_rank) == FAILURE) { char *nml_err_msg_end = strchr (nml_err_msg, '\0'); @@ -2882,7 +2891,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) @@ -2901,14 +2910,15 @@ get_name: goto nml_err_ret; } - if (*pprev_nl == NULL || !component_flag) + /* Don't move first_nl further in the list if a qualifier was found. */ + if ((*pprev_nl == NULL && !qualifier_flag) || !component_flag) first_nl = nl; root_nl = nl; component_flag = 1; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; goto get_name; } @@ -2923,8 +2933,8 @@ get_name: descriptor_dimension chd[1] = { {1, clow, nl->string_length} }; array_loop_spec ind[1] = { {1, clow, nl->string_length, 1} }; - if (nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg, - nml_err_msg_size, &parsed_rank) + if (nml_parse_qualifier (dtp, chd, ind, -1, nl->type, + nml_err_msg, nml_err_msg_size, &parsed_rank) == FAILURE) { char *nml_err_msg_end = strchr (nml_err_msg, '\0'); @@ -2946,7 +2956,7 @@ get_name: } if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; unget_char (dtp, c); } @@ -2986,7 +2996,7 @@ get_name: return SUCCESS; if ((c = next_char (dtp)) == EOF) - return FAILURE; + goto nml_err_ret; if (c != '=') { @@ -3021,6 +3031,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; } @@ -3073,6 +3094,7 @@ find_nml_name: case '?': nml_query (dtp, '?'); + goto find_nml_name; case EOF: return; |