2010-09-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / libgfortran / io / list_read.c

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 2f0f931..b3c1cf6 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -1199,6 +1199,18 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
       push_char (dtp, 'n');
       push_char (dtp, 'a');
       push_char (dtp, 'n');
+      
+      /* Match "NAN(alphanum)".  */
+      if (c == '(')
+       {
+         for ( ; c != ')'; c = next_char (dtp))
+           if (is_separator (c))
+             goto bad;
+
+         c = next_char (dtp);
+         if (is_separator (c))
+           unget_char (dtp, c);
+       }
       goto done;
     }
 
@@ -1576,6 +1588,20 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
        goto unwind;
       c = next_char (dtp);
       l_push_char (dtp, c);
+
+      /* Match NAN(alphanum).  */
+      if (c == '(')
+       {
+         for (c = next_char (dtp); c != ')'; c = next_char (dtp))
+           if (is_separator (c))
+             goto unwind;
+           else
+             l_push_char (dtp, c);
+
+         l_push_char (dtp, ')');
+         c = next_char (dtp);
+         l_push_char (dtp, c);
+       }
     }
 
   if (!is_separator (c))
@@ -2077,7 +2103,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
                  /*  If -std=f95/2003 or an array section is specified,
                      do not allow excess data to be processed.  */
                   if (is_array_section == 1
-                     || compile_options.allow_std < GFC_STD_GNU)
+                     || !(compile_options.allow_std & GFC_STD_GNU))
                    ls[dim].end = ls[dim].start;
                  else
                    dtp->u.p.expanded_read = 1;
@@ -2731,10 +2757,11 @@ get_name:
          goto nml_err_ret;
        }
 
-      if (!component_flag)
+      if (*pprev_nl == NULL || !component_flag)
        first_nl = nl;
 
       root_nl = nl;
+
       component_flag = 1;
 
       c = next_char (dtp);
@@ -2933,21 +2960,11 @@ find_nml_name:
       if (nml_get_obj_data (dtp, &prev_nl, nml_err_msg, sizeof nml_err_msg)
                            == FAILURE)
        {
-         gfc_unit *u;
-
          if (dtp->u.p.current_unit->unit_number != options.stdin_unit)
            goto nml_err_ret;
-
-         u = find_unit (options.stderr_unit);
-         st_printf ("%s\n", nml_err_msg);
-         if (u != NULL)
-           {
-             sflush (u->s);
-             unlock_unit (u);
-           }
+         generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
         }
-
-   }
+    }
 
   dtp->u.p.eof_jump = NULL;
   free_saved (dtp);