re PR fortran/46705 (Spurious "Missing '&' in continued character constant" warning occurs twice)

2010-12-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/46705
	* gfortran.h: New enum gfc_instring.
	(gfc_next_char_literal): Update prototype.
	* scanner.c (gfc_next_char_literal): Use new enum. Only give missing
	'&' warning for INSTRING_WARN. (gfc_next_char): Use new enum.
	(gfc_gobble_whitespace): Likewise.
	* io.c (next_char): Use new enum. (next_char_not_space): Likewise.
	(format_lex): Likewise.
	* match.c (gfc_match_parens): Likewise.
	(gfc_match_special_char): Likewise. (gfc_match_name_C): Likewise.
	* parse.c (next_fixed): Likewise.
	* primary.c (match_hollerith_constant): Likewise.
	(next_string_char): Likewise.

From-SVN: r167716

7 files changed, 54 insertions, 31 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7c3fca8..90337d2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2010-12-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46705
+	* gfortran.h: New enum gfc_instring.
+	(gfc_next_char_literal): Update prototype.
+	* scanner.c (gfc_next_char_literal): Use new enum. Only give missing
+	'&' warning for INSTRING_WARN. (gfc_next_char): Use new enum.
+	(gfc_gobble_whitespace): Likewise.
+	* io.c (next_char): Use new enum. (next_char_not_space): Likewise.
+	(format_lex): Likewise.
+	* match.c (gfc_match_parens): Likewise.
+	(gfc_match_special_char): Likewise. (gfc_match_name_C): Likewise.
+	* parse.c (next_fixed): Likewise.
+	* primary.c (match_hollerith_constant): Likewise.
+	(next_string_char): Likewise.
+
 2010-12-11  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/46370
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 52f11c5..6f6a9f4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -96,6 +96,13 @@ typedef enum
 { SUCCESS = 1, FAILURE }
 gfc_try;
 
+/* These are flags for identifying whether we are reading a character literal
+   between quotes or normal source code.  */
+   
+typedef enum
+{ NONSTRING = 0, INSTRING_WARN, INSTRING_NOWARN }
+gfc_instring;
+
 /* This is returned by gfc_notification_std to know if, given the flags
    that were given (-std=, -pedantic) we should issue an error, a warning
    or nothing.  */
@@ -113,6 +120,7 @@ typedef enum
 { MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
 match;
 
+/* Used for different Fortran source forms in places like scanner.c.  */
 typedef enum
 { FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
 gfc_source_form;
@@ -160,7 +168,6 @@ typedef enum
 }
 gfc_intrinsic_op;
 
-
 /* This macro is the number of intrinsic operators that exist.
    Assumptions are made about the numbering of the interface_op enums.  */
 #define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
@@ -206,7 +213,6 @@ typedef enum
 }
 gfc_statement;
 
-
 /* Types of interfaces that we can have.  Assignment interfaces are
    considered to be intrinsic operators.  */
 typedef enum
@@ -2332,7 +2338,7 @@ gfc_char_t *gfc_char_to_widechar (const char *);
 #define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
 
 void gfc_skip_comments (void);
-gfc_char_t gfc_next_char_literal (int);
+gfc_char_t gfc_next_char_literal (gfc_instring);
 gfc_char_t gfc_next_char (void);
 char gfc_next_ascii_char (void);
 gfc_char_t gfc_peek_char (void);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index e80202f..938dc9a 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -136,7 +136,7 @@ mode;
 /* Return the next character in the format string.  */
 
 static char
-next_char (int in_string)
+next_char (gfc_instring in_string)
 {
   static gfc_char_t c;
 
@@ -197,7 +197,7 @@ next_char_not_space (bool *error)
   char c;
   do
     {
-      error_element = c = next_char (0);
+      error_element = c = next_char (NONSTRING);
       if (c == '\t')
 	{
 	  if (gfc_option.allow_std & GFC_STD_GNU)
@@ -374,7 +374,7 @@ format_lex (void)
 
       for (;;)
 	{
-	  c = next_char (1);
+	  c = next_char (INSTRING_WARN);
 	  if (c == '\0')
 	    {
 	      token = FMT_END;
@@ -383,7 +383,7 @@ format_lex (void)
 
 	  if (c == delim)
 	    {
-	      c = next_char (1);
+	      c = next_char (INSTRING_NOWARN);
 
 	      if (c == '\0')
 		{
@@ -981,7 +981,7 @@ data_desc:
 	{
 	  while (repeat >0)
 	   {
-	     next_char (1);
+	     next_char (INSTRING_WARN);
 	     repeat -- ;
 	   }
 	}
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 6cd1c46..44da1bb 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -118,12 +118,13 @@ match
 gfc_match_parens (void)
 {
   locus old_loc, where;
-  int count, instring;
+  int count;
+  gfc_instring instring;
   gfc_char_t c, quote;
 
   old_loc = gfc_current_locus;
   count = 0;
-  instring = 0;
+  instring = NONSTRING;
   quote = ' ';
 
   for (;;)
@@ -134,13 +135,13 @@ gfc_match_parens (void)
       if (quote == ' ' && ((c == '\'') || (c == '"')))
 	{
 	  quote = c;
-	  instring = 1;
+	  instring = INSTRING_WARN;
 	  continue;
 	}
       if (quote != ' ' && c == quote)
 	{
 	  quote = ' ';
-	  instring = 0;
+	  instring = NONSTRING;
 	  continue;
 	}
 
@@ -185,7 +186,7 @@ gfc_match_special_char (gfc_char_t *res)
 
   m = MATCH_YES;
 
-  switch ((c = gfc_next_char_literal (1)))
+  switch ((c = gfc_next_char_literal (INSTRING_WARN)))
     {
     case 'a':
       *res = '\a';
@@ -225,7 +226,7 @@ gfc_match_special_char (gfc_char_t *res)
 	{
 	  char buf[2] = { '\0', '\0' };
 
-	  c = gfc_next_char_literal (1);
+	  c = gfc_next_char_literal (INSTRING_WARN);
 	  if (!gfc_wide_fits_in_byte (c)
 	      || !gfc_check_digit ((unsigned char) c, 16))
 	    return MATCH_NO;
@@ -592,7 +593,7 @@ gfc_match_name_C (char *buffer)
 
   /* Get the next char (first possible char of name) and see if
      it's valid for C (either a letter or an underscore).  */
-  c = gfc_next_char_literal (1);
+  c = gfc_next_char_literal (INSTRING_WARN);
 
   /* If the user put nothing expect spaces between the quotes, it is valid
      and simply means there is no name= specifier and the name is the fortran
@@ -632,7 +633,7 @@ gfc_match_name_C (char *buffer)
       old_loc = gfc_current_locus;
       
       /* Get next char; param means we're in a string.  */
-      c = gfc_next_char_literal (1);
+      c = gfc_next_char_literal (INSTRING_WARN);
     } while (ISALNUM (c) || c == '_');
 
   buffer[i] = '\0';
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 2e43824..ea9667d 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -745,7 +745,7 @@ next_fixed (void)
 
   for (i = 0; i < 5; i++)
     {
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
 
       switch (c)
 	{
@@ -771,18 +771,18 @@ next_fixed (void)
 	     here, except for GCC attributes and OpenMP directives.  */
 
 	case '*':
-	  c = gfc_next_char_literal (0);
+	  c = gfc_next_char_literal (NONSTRING);
 	  
 	  if (TOLOWER (c) == 'g')
 	    {
-	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
 		gcc_assert (TOLOWER (c) == "gcc$"[i]);
 
 	      return decode_gcc_attribute ();
 	    }
 	  else if (c == '$' && gfc_option.gfc_flag_openmp)
 	    {
-	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (0))
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
 		gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
 
 	      if (c != ' ' && c != '0')
@@ -821,7 +821,7 @@ next_fixed (void)
      of a previous statement.  If we see something here besides a
      space or zero, it must be a bad continuation line.  */
 
-  c = gfc_next_char_literal (0);
+  c = gfc_next_char_literal (NONSTRING);
   if (c == '\n')
     goto blank_line;
 
@@ -839,7 +839,7 @@ next_fixed (void)
   do
     {
       loc = gfc_current_locus;
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
     }
   while (gfc_is_whitespace (c));
 
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 1ec677b..da028b4 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -288,7 +288,7 @@ match_hollerith_constant (gfc_expr **result)
 
 	  for (i = 0; i < num; i++)
 	    {
-	      gfc_char_t c = gfc_next_char_literal (1);
+	      gfc_char_t c = gfc_next_char_literal (INSTRING_WARN);
 	      if (! gfc_wide_fits_in_byte (c))
 		{
 		  gfc_error ("Invalid Hollerith constant at %L contains a "
@@ -761,7 +761,7 @@ next_string_char (gfc_char_t delimiter, int *ret)
   locus old_locus;
   gfc_char_t c;
 
-  c = gfc_next_char_literal (1);
+  c = gfc_next_char_literal (INSTRING_WARN);
   *ret = 0;
 
   if (c == '\n')
@@ -785,7 +785,7 @@ next_string_char (gfc_char_t delimiter, int *ret)
     return c;
 
   old_locus = gfc_current_locus;
-  c = gfc_next_char_literal (0);
+  c = gfc_next_char_literal (NONSTRING);
 
   if (c == delimiter)
     return c;
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 24fb60a..c226bae 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -997,7 +997,7 @@ gfc_skip_comments (void)
    context or not.  */
 
 gfc_char_t
-gfc_next_char_literal (int in_string)
+gfc_next_char_literal (gfc_instring in_string)
 {
   locus old_loc;
   int i, prev_openmp_flag;
@@ -1146,10 +1146,10 @@ restart:
 	{
 	  if (in_string)
 	    {
-	      if (gfc_option.warn_ampersand)
-		gfc_warning_now ("Missing '&' in continued character "
-				 "constant at %C");
 	      gfc_current_locus.nextc--;
+	      if (gfc_option.warn_ampersand && in_string == INSTRING_WARN)
+		gfc_warning ("Missing '&' in continued character "
+			     "constant at %C");
 	    }
 	  /* Both !$omp and !$ -fopenmp continuation lines have & on the
 	     continuation line only optionally.  */
@@ -1270,7 +1270,7 @@ gfc_next_char (void)
 
   do
     {
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
     }
   while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
 
@@ -1371,7 +1371,7 @@ gfc_gobble_whitespace (void)
   do
     {
       old_loc = gfc_current_locus;
-      c = gfc_next_char_literal (0);
+      c = gfc_next_char_literal (NONSTRING);
       /* Issue a warning for nonconforming tabs.  We keep track of the line
 	 number because the Fortran matchers will often back up and the same
 	 line will be scanned multiple times.  */