re PR fortran/35832 (Better error message for wrong arguments to I/O statements)

2008-04-06  Tobias Schlter  <tobi@gcc.gnu.org>

PR fortran/35832
fortran/
* io.c (io_tag): Add field 'value'.  Split 'spec' field in
existing io_tags.
(match_etag, match_vtag, match_ltag): Split parsing in two steps
to give better error messages.
testsuite/
* gfortran.dg/io_constraints_2.f90: Adapt to new error message.

From-SVN: r133964

4 files changed, 95 insertions, 59 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 49c8a0c..160d602 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2008-04-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/35832
+	* io.c (io_tag): Add field 'value'.  Split 'spec' field in
+	existing io_tags.
+	(match_etag, match_vtag, match_ltag): Split parsing in two steps
+	to give better error messages.
+
 2008-04-06  Tobias Burnus  <burnus@net-b.de>
 
 	* io.c (check_io_constraints): Add constrains. ID= requires
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 034039f..5ea051c 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -32,63 +32,63 @@ format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
 
 typedef struct
 {
-  const char *name, *spec;
+  const char *name, *spec, *value;
   bt type;
 }
 io_tag;
 
 static const io_tag
-	tag_file	= { "FILE", " file = %e", BT_CHARACTER },
-	tag_status	= { "STATUS", " status = %e", BT_CHARACTER},
-	tag_e_access	= {"ACCESS", " access = %e", BT_CHARACTER},
-	tag_e_form	= {"FORM", " form = %e", BT_CHARACTER},
-	tag_e_recl	= {"RECL", " recl = %e", BT_INTEGER},
-	tag_e_blank	= {"BLANK", " blank = %e", BT_CHARACTER},
-	tag_e_position	= {"POSITION", " position = %e", BT_CHARACTER},
-	tag_e_action	= {"ACTION", " action = %e", BT_CHARACTER},
-	tag_e_delim	= {"DELIM", " delim = %e", BT_CHARACTER},
-	tag_e_pad	= {"PAD", " pad = %e", BT_CHARACTER},
-	tag_e_decimal	= {"DECIMAL", " decimal = %e", BT_CHARACTER},
-	tag_e_encoding	= {"ENCODING", " encoding = %e", BT_CHARACTER},
-	tag_e_round	= {"ROUND", " round = %e", BT_CHARACTER},
-	tag_e_sign	= {"SIGN", " sign = %e", BT_CHARACTER},
-	tag_unit	= {"UNIT", " unit = %e", BT_INTEGER},
-	tag_advance	= {"ADVANCE", " advance = %e", BT_CHARACTER},
-	tag_rec		= {"REC", " rec = %e", BT_INTEGER},
-	tag_spos	= {"POSITION", " pos = %e", BT_INTEGER},
-	tag_format	= {"FORMAT", NULL, BT_CHARACTER},
-	tag_iomsg	= {"IOMSG", " iomsg = %e", BT_CHARACTER},
-	tag_iostat	= {"IOSTAT", " iostat = %v", BT_INTEGER},
-	tag_size	= {"SIZE", " size = %v", BT_INTEGER},
-	tag_exist	= {"EXIST", " exist = %v", BT_LOGICAL},
-	tag_opened	= {"OPENED", " opened = %v", BT_LOGICAL},
-	tag_named	= {"NAMED", " named = %v", BT_LOGICAL},
-	tag_name	= {"NAME", " name = %v", BT_CHARACTER},
-	tag_number	= {"NUMBER", " number = %v", BT_INTEGER},
-	tag_s_access	= {"ACCESS", " access = %v", BT_CHARACTER},
-	tag_sequential	= {"SEQUENTIAL", " sequential = %v", BT_CHARACTER},
-	tag_direct	= {"DIRECT", " direct = %v", BT_CHARACTER},
-	tag_s_form	= {"FORM", " form = %v", BT_CHARACTER},
-	tag_formatted	= {"FORMATTED", " formatted = %v", BT_CHARACTER},
-	tag_unformatted	= {"UNFORMATTED", " unformatted = %v", BT_CHARACTER},
-	tag_s_recl	= {"RECL", " recl = %v", BT_INTEGER},
-	tag_nextrec	= {"NEXTREC", " nextrec = %v", BT_INTEGER},
-	tag_s_blank	= {"BLANK", " blank = %v", BT_CHARACTER},
-	tag_s_position	= {"POSITION", " position = %v", BT_CHARACTER},
-	tag_s_action	= {"ACTION", " action = %v", BT_CHARACTER},
-	tag_read	= {"READ", " read = %v", BT_CHARACTER},
-	tag_write	= {"WRITE", " write = %v", BT_CHARACTER},
-	tag_readwrite	= {"READWRITE", " readwrite = %v", BT_CHARACTER},
-	tag_s_delim	= {"DELIM", " delim = %v", BT_CHARACTER},
-	tag_s_pad	= {"PAD", " pad = %v", BT_CHARACTER},
-	tag_iolength	= {"IOLENGTH", " iolength = %v", BT_INTEGER},
-	tag_convert     = {"CONVERT", " convert = %e", BT_CHARACTER},
-	tag_strm_out    = {"POS", " pos = %v", BT_INTEGER},
-	tag_err		= {"ERR", " err = %l", BT_UNKNOWN},
-	tag_end		= {"END", " end = %l", BT_UNKNOWN},
-	tag_eor		= {"EOR", " eor = %l", BT_UNKNOWN},
-	tag_async	= {"ASYNCHRONOUS", " asynchronous = %e", BT_CHARACTER},
-	tag_id		= {"ID", " id = %v", BT_INTEGER};
+	tag_file	= { "FILE", " file =", " %e", BT_CHARACTER },
+	tag_status	= { "STATUS", " status =", " %e", BT_CHARACTER},
+	tag_e_access	= {"ACCESS", " access =", " %e", BT_CHARACTER},
+	tag_e_form	= {"FORM", " form =", " %e", BT_CHARACTER},
+	tag_e_recl	= {"RECL", " recl =", " %e", BT_INTEGER},
+	tag_e_blank	= {"BLANK", " blank =", " %e", BT_CHARACTER},
+	tag_e_position	= {"POSITION", " position =", " %e", BT_CHARACTER},
+	tag_e_action	= {"ACTION", " action =", " %e", BT_CHARACTER},
+	tag_e_delim	= {"DELIM", " delim =", " %e", BT_CHARACTER},
+	tag_e_pad	= {"PAD", " pad =", " %e", BT_CHARACTER},
+	tag_e_decimal	= {"DECIMAL", " decimal =", " %e", BT_CHARACTER},
+	tag_e_encoding	= {"ENCODING", " encoding =", " %e", BT_CHARACTER},
+	tag_e_round	= {"ROUND", " round =", " %e", BT_CHARACTER},
+	tag_e_sign	= {"SIGN", " sign =", " %e", BT_CHARACTER},
+	tag_unit	= {"UNIT", " unit =", " %e", BT_INTEGER},
+	tag_advance	= {"ADVANCE", " advance =", " %e", BT_CHARACTER},
+	tag_rec		= {"REC", " rec =", " %e", BT_INTEGER},
+	tag_spos	= {"POSITION", " pos =", " %e", BT_INTEGER},
+	tag_format	= {"FORMAT", NULL, NULL, BT_CHARACTER},
+	tag_iomsg	= {"IOMSG", " iomsg =", " %e", BT_CHARACTER},
+	tag_iostat	= {"IOSTAT", " iostat =", " %v", BT_INTEGER},
+	tag_size	= {"SIZE", " size =", " %v", BT_INTEGER},
+	tag_exist	= {"EXIST", " exist =", " %v", BT_LOGICAL},
+	tag_opened	= {"OPENED", " opened =", " %v", BT_LOGICAL},
+	tag_named	= {"NAMED", " named =", " %v", BT_LOGICAL},
+	tag_name	= {"NAME", " name =", " %v", BT_CHARACTER},
+	tag_number	= {"NUMBER", " number =", " %v", BT_INTEGER},
+	tag_s_access	= {"ACCESS", " access =", " %v", BT_CHARACTER},
+	tag_sequential	= {"SEQUENTIAL", " sequential =", " %v", BT_CHARACTER},
+	tag_direct	= {"DIRECT", " direct =", " %v", BT_CHARACTER},
+	tag_s_form	= {"FORM", " form =", " %v", BT_CHARACTER},
+	tag_formatted	= {"FORMATTED", " formatted =", " %v", BT_CHARACTER},
+	tag_unformatted	= {"UNFORMATTED", " unformatted =", " %v", BT_CHARACTER},
+	tag_s_recl	= {"RECL", " recl =", " %v", BT_INTEGER},
+	tag_nextrec	= {"NEXTREC", " nextrec =", " %v", BT_INTEGER},
+	tag_s_blank	= {"BLANK", " blank =", " %v", BT_CHARACTER},
+	tag_s_position	= {"POSITION", " position =", " %v", BT_CHARACTER},
+	tag_s_action	= {"ACTION", " action =", " %v", BT_CHARACTER},
+	tag_read	= {"READ", " read =", " %v", BT_CHARACTER},
+	tag_write	= {"WRITE", " write =", " %v", BT_CHARACTER},
+	tag_readwrite	= {"READWRITE", " readwrite =", " %v", BT_CHARACTER},
+	tag_s_delim	= {"DELIM", " delim =", " %v", BT_CHARACTER},
+	tag_s_pad	= {"PAD", " pad =", " %v", BT_CHARACTER},
+	tag_iolength	= {"IOLENGTH", " iolength =", " %v", BT_INTEGER},
+	tag_convert     = {"CONVERT", " convert =", " %e", BT_CHARACTER},
+	tag_strm_out    = {"POS", " pos =", " %v", BT_INTEGER},
+	tag_err		= {"ERR", " err =", " %l", BT_UNKNOWN},
+	tag_end		= {"END", " end =", " %l", BT_UNKNOWN},
+	tag_eor		= {"EOR", " eor =", " %l", BT_UNKNOWN},
+	tag_async	= {"ASYNCHRONOUS", " asynchronous =", " %e", BT_CHARACTER},
+	tag_id		= {"ID", " id =", " %v", BT_INTEGER};
 
 static gfc_dt *current_dt;
 
@@ -1031,10 +1031,17 @@ match_etag (const io_tag *tag, gfc_expr **v)
   gfc_expr *result;
   match m;
 
-  m = gfc_match (tag->spec, &result);
+  m = gfc_match (tag->spec);
   if (m != MATCH_YES)
     return m;
 
+  m = gfc_match (tag->value, &result);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
   if (*v != NULL)
     {
       gfc_error ("Duplicate %s specification at %C", tag->name);
@@ -1055,10 +1062,17 @@ match_vtag (const io_tag *tag, gfc_expr **v)
   gfc_expr *result;
   match m;
 
-  m = gfc_match (tag->spec, &result);
+  m = gfc_match (tag->spec);
   if (m != MATCH_YES)
     return m;
 
+  m = gfc_match (tag->value, &result);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
   if (*v != NULL)
     {
       gfc_error ("Duplicate %s specification at %C", tag->name);
@@ -1109,15 +1123,24 @@ match_ltag (const io_tag *tag, gfc_st_label ** label)
   gfc_st_label *old;
 
   old = *label;
-  m = gfc_match (tag->spec, label);
-  if (m == MATCH_YES && old != 0)
+  m = gfc_match (tag->spec);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match (tag->value, label);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
+  if (old)
     {
       gfc_error ("Duplicate %s label specification at %C", tag->name);
       return MATCH_ERROR;
     }
 
-  if (m == MATCH_YES 
-      && gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE)
+  if (gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE)
     return MATCH_ERROR;
 
   return m;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 528bafa..9f9caa6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-04-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/35832
+	* gfortran.dg/io_constraints_2.f90: Adapt to new error message.
+
 2008-04-06  Tobias Burnus  <burnus@net-b.de>
 
 	* gfortran.dg/f2003_io_1.f03: Make standard conform.
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_2.f90 b/gcc/testsuite/gfortran.dg/io_constraints_2.f90
index fa6cbdb..8bf48d7 100644
--- a/gcc/testsuite/gfortran.dg/io_constraints_2.f90
+++ b/gcc/testsuite/gfortran.dg/io_constraints_2.f90
@@ -66,7 +66,7 @@ end module global
 
  READ(1, fmt='(i6)', advance='NO', size = buffer) a ! { dg-error "INTEGER" }
 !Was correctly picked up before patch. -correct syntax error
- READ(1, fmt='(i6)', advance='YES', size = 10) a    ! { dg-error "Syntax error" }
+ READ(1, fmt='(i6)', advance='YES', size = 10) a    ! { dg-error "Invalid value for SIZE specification" }
 
  READ(1, fmt='(i6)', advance='MAYBE')               !  { dg-error "YES or NO" }