[4.8] Merge GCC 4.8.1

Change-Id: Ic8a60b7563f5172440fd40788605163a0cca6e30

4 files changed, 147 insertions, 52 deletions

diff --git a/gcc-4.8/libgfortran/ChangeLog b/gcc-4.8/libgfortran/ChangeLog
index f0d5b7cd6..99b919641 100644
--- a/gcc-4.8/libgfortran/ChangeLog
+++ b/gcc-4.8/libgfortran/ChangeLog
@@ -1,3 +1,74 @@
+2013-05-31  Release Manager
+
+	* GCC 4.8.1 released.
+
+2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	Backport from mainline:
+	2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>
+
+	PR libfortran/51825
+	* io/list_read.c (nml_read_obj): Don't end the component loop on a
+	nested derived type, but continue with the next loop iteration.
+	(nml_get_obj_data): Don't move the first_nl pointer further in the
+	list if a qualifier was found.
+
+2013-04-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	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-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	Backport from mainline:
+	2013-03-25  Tilo Schwarz  <tilo@tilo-schwarz.de>
+
+	PR libfortran/52512
+	* io/list_read.c (nml_parse_qualifier): To check for a derived type
+	don't use the namelist head element type but the current element type.
+	(nml_get_obj_data): Add current namelist element type to
+	nml_parse_qualifier call.
+
+2013-04-02  Tobias Burnus  <burnus@net-b.de>
+
+	Backport from mainline:
+	2013-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56735
+	* io/list_read.c (nml_query): Only abort when
+	an error occured.
+	(namelist_read): Add goto instead of falling through.
+
+2013-04-02  Tobias Burnus  <burnus@net-b.de>
+
+	Backport from mainline:
+	2013-03-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56737
+	* io/format.c (parse_format): With caching, copy
+	dtp->format string.
+	(save_parsed_format): Use dtp->format directly without
+	copying.
+
+	2012-03-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56737
+	* io/format.c (parse_format_list): Also cache FMT_STRING.
+	(parse_format): Update call.
+
+2013-03-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56696
+	* io/list_read.c (read_real): Fix EOF diagnostic.
+
 2013-03-22  Release Manager
 
 	* GCC 4.8.0 released.
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;