From 32fce3edda831e36ee484406c39dffbe0230f257 Mon Sep 17 00:00:00 2001 From: Ben Cheng Date: Mon, 5 Aug 2013 15:18:29 -0700 Subject: [4.8] Merge GCC 4.8.1 Change-Id: Ic8a60b7563f5172440fd40788605163a0cca6e30 --- gcc-4.8/libgfortran/io/format.c | 30 ++++++------ gcc-4.8/libgfortran/io/list_read.c | 96 +++++++++++++++++++++++--------------- gcc-4.8/libgfortran/io/transfer.c | 2 +- 3 files changed, 76 insertions(+), 52 deletions(-) (limited to 'gcc-4.8/libgfortran/io') diff --git a/gcc-4.8/libgfortran/io/format.c b/gcc-4.8/libgfortran/io/format.c index ff3c68046..3c685e34e 100644 --- a/gcc-4.8/libgfortran/io/format.c +++ b/gcc-4.8/libgfortran/io/format.c @@ -149,8 +149,7 @@ save_parsed_format (st_parameter_dt *dtp) u->format_hash_table[hash].hashed_fmt = NULL; free (u->format_hash_table[hash].key); - u->format_hash_table[hash].key = xmalloc (dtp->format_len); - memcpy (u->format_hash_table[hash].key, dtp->format, dtp->format_len); + u->format_hash_table[hash].key = dtp->format; u->format_hash_table[hash].key_len = dtp->format_len; u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt; @@ -588,16 +587,15 @@ format_lex (format_data *fmt) * parenthesis node which contains the rest of the list. */ static fnode * -parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) +parse_format_list (st_parameter_dt *dtp, bool *seen_dd) { fnode *head, *tail; format_token t, u, t2; int repeat; format_data *fmt = dtp->u.p.fmt; - bool saveit, seen_data_desc = false; + bool seen_data_desc = false; head = tail = NULL; - saveit = *save_ok; /* Get the next format item */ format_item: @@ -614,7 +612,7 @@ parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) } get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = -2; /* Signifies unlimited format. */ - tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); + tail->u.child = parse_format_list (dtp, &seen_data_desc); if (fmt->error != NULL) goto finished; if (!seen_data_desc) @@ -633,7 +631,7 @@ parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = repeat; - tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); + tail->u.child = parse_format_list (dtp, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; @@ -661,7 +659,7 @@ parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) case FMT_LPAREN: get_fnode (fmt, &head, &tail, FMT_LPAREN); tail->repeat = 1; - tail->u.child = parse_format_list (dtp, &saveit, &seen_data_desc); + tail->u.child = parse_format_list (dtp, &seen_data_desc); *seen_dd = seen_data_desc; if (fmt->error != NULL) goto finished; @@ -725,8 +723,6 @@ parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) goto between_desc; case FMT_STRING: - /* TODO: Find out why it is necessary to turn off format caching. */ - saveit = false; get_fnode (fmt, &head, &tail, FMT_STRING); tail->u.string.p = fmt->string; tail->u.string.length = fmt->value; @@ -1106,8 +1102,6 @@ parse_format_list (st_parameter_dt *dtp, bool *save_ok, bool *seen_dd) finished: - *save_ok = saveit; - return head; } @@ -1224,6 +1218,13 @@ parse_format (st_parameter_dt *dtp) /* Not found so proceed as follows. */ + if (format_cache_ok) + { + char *fmt_string = xmalloc (dtp->format_len); + memcpy (fmt_string, dtp->format, dtp->format_len); + dtp->format = fmt_string; + } + dtp->u.p.fmt = fmt = xmalloc (sizeof (format_data)); fmt->format_string = dtp->format; fmt->format_string_len = dtp->format_len; @@ -1250,14 +1251,15 @@ parse_format (st_parameter_dt *dtp) fmt->avail++; if (format_lex (fmt) == FMT_LPAREN) - fmt->array.array[0].u.child = parse_format_list (dtp, &format_cache_ok, - &seen_data_desc); + fmt->array.array[0].u.child = parse_format_list (dtp, &seen_data_desc); else fmt->error = "Missing initial left parenthesis in format"; if (fmt->error) { format_error (dtp, NULL, fmt->error); + if (format_cache_ok) + free (dtp->format); free_format_hash_table (dtp->u.p.current_unit); return; } 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; diff --git a/gcc-4.8/libgfortran/io/transfer.c b/gcc-4.8/libgfortran/io/transfer.c index d97a325a7..5260be740 100644 --- a/gcc-4.8/libgfortran/io/transfer.c +++ b/gcc-4.8/libgfortran/io/transfer.c @@ -3840,7 +3840,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; -- cgit v1.2.3