Merged revisions 196607-196608,196611-196614,196625,196629-196634,196636,196639,196645-196647,196649-196650,196654-196659,196666,196669,196671-196675,196682-196683,196694-196695,196697-196698,196700-196701,196704-196706,196709,196721-196748,196750-196751,196753,196755-196758,196762,196764-196765,196767-196771,196773-196779,196781-196784,196788-196792,196795-196797,196799-196800,196804-196807,196810-196814,196821,196823-196825,196828-196829,196831-196832,196834,196841-196842,196847-196853,196855-196856,196858,196860-196861,196864-196866,196868,196870-196872,196874,196876,196878-196879,196882,196884-196890,196896-196897,196899-196902,196954,196956-196961,196964-196965,196970,196977-196978,196981-196983,196989,197002-197005,197007,197011-197012,197016-197019,197021,197023-197025,197029-197034,197036-197042 via svnmerge from cxx-conversion

svn+ssh://gcc.gnu.org/svn/gcc/trunk



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/cxx-conversion@197098 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 50 insertions, 52 deletions

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index fb8a841b229..e7ae98fcf28 100644
--- a/libgfortran/io/list_read.c
+++ b/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;
@@ -2052,7 +2051,7 @@ calls:
 /* Inputs a rank-dimensional qualifier, which can contain
    singlets, doublets, triplets or ':' with the standard meanings.  */
 
-static try
+static bool
 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,
@@ -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;
+    return false;
 
   /* 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;
+	    return false;
 	  switch (c)
 	    {
 	    case '-':
@@ -2112,7 +2111,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
 	  for (;;)
 	    {
 	      if ((c = next_char (dtp)) == EOF)
-		return FAILURE;
+		return false;
 
 	      switch (c)
 		{
@@ -2141,7 +2140,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
 		case ' ': case '\t':
 		  eat_spaces (dtp);
 		  if ((c = next_char (dtp) == EOF))
-		    return FAILURE;
+		    return false;
 		  break;
 
 		default:
@@ -2279,11 +2278,11 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
       ls[dim].idx = ls[dim].start;
     }
   eat_spaces (dtp);
-  return SUCCESS;
+  return true;
 
 err_ret:
 
-  return FAILURE;
+  return false;
 }
 
 static namelist_info *
@@ -2467,7 +2466,7 @@ query_return:
    little data to be available.  On the other hand, too much data is an
    error.  */
 
-static try
+static bool
 nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
 	      namelist_info **pprev_nl, char *nml_err_msg,
 	      size_t nml_err_msg_size, index_type clow, index_type chigh)
@@ -2485,7 +2484,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
   /* This object not touched in name parsing.  */
 
   if (!nl->touched)
-    return SUCCESS;
+    return true;
 
   dtp->u.p.repeat_count = 0;
   eat_spaces (dtp);
@@ -2532,11 +2531,11 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
       if (--dtp->u.p.repeat_count <= 0)
 	{
 	  if (dtp->u.p.input_complete)
-	    return SUCCESS;
+	    return true;
 	  if (dtp->u.p.at_eol)
 	    finish_separator (dtp);
 	  if (dtp->u.p.input_complete)
-	    return SUCCESS;
+	    return true;
 
 	  dtp->u.p.saved_type = BT_UNKNOWN;
 	  free_saved (dtp);
@@ -2578,30 +2577,30 @@ 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),
+		if (!nml_read_obj (dtp, cmp, (index_type)(pdata - nl->mem_pos),
 				  pprev_nl, nml_err_msg, nml_err_msg_size,
-				  clow, chigh) == FAILURE)
+				  clow, chigh))
 		  {
 		    free (obj_name);
-		    return FAILURE;
+		    return false;
 		  }
 
 		if (dtp->u.p.input_complete)
 		  {
 		    free (obj_name);
-		    return SUCCESS;
+		    return true;
 		  }
 	      }
 
@@ -2625,7 +2624,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
       if (dtp->u.p.nml_read_error)
 	{
 	  dtp->u.p.expanded_read = 0;
-	  return SUCCESS;
+	  return true;
 	}
 
       if (dtp->u.p.saved_type == BT_UNKNOWN)
@@ -2711,11 +2710,11 @@ incr_idx:
 		"Repeat count too large for namelist object %s", nl->var_name);
       goto nml_err_ret;
     }
-  return SUCCESS;
+  return true;
 
 nml_err_ret:
 
-  return FAILURE;
+  return false;
 }
 
 /* Parses the object name, including array and substring qualifiers.  It
@@ -2725,7 +2724,7 @@ nml_err_ret:
    touched.  nml_read_obj is called at the end and this reads the data in
    the manner specified by the object name.  */
 
-static try
+static bool
 nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
 		  char *nml_err_msg, size_t nml_err_msg_size)
 {
@@ -2743,20 +2742,20 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
 
   eat_separator (dtp);
   if (dtp->u.p.input_complete)
-    return SUCCESS;
+    return true;
 
   if (dtp->u.p.at_eol)
     finish_separator (dtp);
   if (dtp->u.p.input_complete)
-    return SUCCESS;
+    return true;
 
   if ((c = next_char (dtp)) == EOF)
-    return FAILURE;
+    return false;
   switch (c)
     {
     case '=':
       if ((c = next_char (dtp)) == EOF)
-	return FAILURE;
+	return false;
       if (c != '?')
 	{
 	  snprintf (nml_err_msg, nml_err_msg_size, 
@@ -2764,11 +2763,11 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
 	  goto nml_err_ret;
 	}
       nml_query (dtp, '=');
-      return SUCCESS;
+      return true;
 
     case '?':
       nml_query (dtp, '?');
-      return SUCCESS;
+      return true;
 
     case '$':
     case '&':
@@ -2781,7 +2780,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
 	}
     case '/':
       dtp->u.p.input_complete = 1;
-      return SUCCESS;
+      return true;
 
     default :
       break;
@@ -2806,7 +2805,7 @@ get_name:
       if (!is_separator (c))
 	push_char (dtp, tolower(c));
       if ((c = next_char (dtp)) == EOF)
-	return FAILURE;
+	return false;
     } while (!( c=='=' || c==' ' || c=='\t' || c =='(' || c =='%' ));
 
   unget_char (dtp, c);
@@ -2866,9 +2865,9 @@ get_name:
   if (c == '(' && nl->var_rank)
     {
       parsed_rank = 0;
-      if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
+      if (!nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
 			       nml_err_msg, nml_err_msg_size, 
-			       &parsed_rank) == FAILURE)
+			       &parsed_rank))
 	{
 	  char *nml_err_msg_end = strchr (nml_err_msg, '\0');
 	  snprintf (nml_err_msg_end,
@@ -2882,7 +2881,7 @@ get_name:
       qualifier_flag = 1;
 
       if ((c = next_char (dtp)) == EOF)
-	return FAILURE;
+	return false;
       unget_char (dtp, c);
     }
   else if (nl->var_rank > 0)
@@ -2901,14 +2900,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;
+	return false;
       goto get_name;
     }
 
@@ -2923,9 +2923,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)
-	  == FAILURE)
+      if (!nml_parse_qualifier (dtp, chd, ind, -1, nml_err_msg, 
+				nml_err_msg_size, &parsed_rank))
 	{
 	  char *nml_err_msg_end = strchr (nml_err_msg, '\0');
 	  snprintf (nml_err_msg_end,
@@ -2946,7 +2945,7 @@ get_name:
 	}
 
       if ((c = next_char (dtp)) == EOF)
-	return FAILURE;
+	return false;
       unget_char (dtp, c);
     }
 
@@ -2978,15 +2977,15 @@ get_name:
 
   eat_separator (dtp);
   if (dtp->u.p.input_complete)
-    return SUCCESS;
+    return true;
 
   if (dtp->u.p.at_eol)
     finish_separator (dtp);
   if (dtp->u.p.input_complete)
-    return SUCCESS;
+    return true;
 
   if ((c = next_char (dtp)) == EOF)
-    return FAILURE;
+    return false;
 
   if (c != '=')
     {
@@ -3013,15 +3012,15 @@ get_name:
 	nl = first_nl;
     }
 
-  if (nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
-		    clow, chigh) == FAILURE)
+  if (!nml_read_obj (dtp, nl, 0, pprev_nl, nml_err_msg, nml_err_msg_size,
+		    clow, chigh))
     goto nml_err_ret;
 
-  return SUCCESS;
+  return true;
 
 nml_err_ret:
 
-  return FAILURE;
+  return false;
 }
 
 /* Entry point for namelist input.  Goes through input until namelist name
@@ -3104,8 +3103,7 @@ find_nml_name:
 
   while (!dtp->u.p.input_complete)
     {
-      if (nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg)
-			    == FAILURE)
+      if (!nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg))
 	{
 	  if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
 	    goto nml_err_ret;