[patch, fortran] PR34325 Wrong error message for syntax error

[Jerry DeLisle <jvdelisle at verizon dot net>]

Seasons Greetings,

This patch adds a new function to check for missing parenthesis in a statement. 
 I tried to use this up front in decode_statement but it regresses several test 
cases that are finding the error by other means.

You have to be careful where you use this as well since some matchers get called 
several times.  So you will see in gfc_match_if where I use this that I put the 
check after the match for the IF has occurred.  This requires some back 
tracking, but it is fairly painless..

The patch just fixes this one bug in this one place in gfc_match_if.  The new 
function can be used selectively in other places as we discover them. 
(Especially after this email and people start looking for them :) )

I attempted to make sure we ignore quoted strings.  See the test case.

Regression tested on x86-64.

OK to commit?

Jerry

2007-12-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/34325
	* match.h: New function declaration.
	* match.c (gfc_match_parens): New function to look for mismatched
	parenthesis. (gfc_match_if): Use new function to catch missing '('.

Index: match.c
===================================================================
--- match.c	(revision 130927)
+++ match.c	(working copy)
@@ -104,6 +104,68 @@ gfc_op2string (gfc_intrinsic_op op)
 
 /******************** Generic matching subroutines ************************/
 
+/* This function scans the current statement counting the opened and closed
+   parenthesis to make sure they are balanced.  */
+
+match
+gfc_match_parens (void)
+{
+  locus old_loc, where;
+  int c, count, instring;
+  char quote;
+
+  old_loc = gfc_current_locus;
+  count = 0;
+  instring = 0;
+  quote = ' ';
+
+  for (;;)
+    {
+      c = gfc_next_char_literal (instring);
+      if (c == '\n')
+	break;
+      if (quote == ' ' && ((c == '\'') || (c == '"')))
+	{
+	  quote = (char) c;
+          instring = 1;
+	  continue;
+	}
+      if (quote != ' ' && c == quote)
+	{
+	  quote = ' ';
+          instring = 0;
+	  continue;
+	}
+
+      if (c == '(' && quote == ' ')
+	{
+	  count++;
+	  where = gfc_current_locus;
+	}
+      if (c == ')' && quote == ' ')
+	{
+	  count--;
+	  where = gfc_current_locus;
+	}
+    }
+
+  gfc_current_locus = old_loc;
+
+  if (count > 0)
+    {
+      gfc_error ("Missing ')' in statement at %L", &where);
+      return MATCH_ERROR;
+    }
+  if (count < 0)
+    {
+      gfc_error ("Missing '(' in statement at %L", &where);
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
 /* See if the next character is a special character that has
    escaped by a \ via the -fbackslash option.  */
 
@@ -1321,7 +1383,7 @@ gfc_match_if (gfc_statement *if_type)
 {
   gfc_expr *expr;
   gfc_st_label *l1, *l2, *l3;
-  locus old_loc;
+  locus old_loc, old_loc2;
   gfc_code *p;
   match m, n;
 
@@ -1335,6 +1397,14 @@ gfc_match_if (gfc_statement *if_type)
   if (m != MATCH_YES)
     return m;
 
+  old_loc2 = gfc_current_locus;
+  gfc_current_locus = old_loc;
+  
+  if (gfc_match_parens () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  gfc_current_locus = old_loc2;
+
   if (gfc_match_char (')') != MATCH_YES)
     {
       gfc_error ("Syntax error in IF-expression at %C");
@@ -1386,7 +1456,7 @@ gfc_match_if (gfc_statement *if_type)
 
   if (n == MATCH_YES)
     {
-      gfc_error ("Block label is not appropriate IF statement at %C");
+      gfc_error ("Block label is not appropriate for IF statement at %C");
       gfc_free_expr (expr);
       return MATCH_ERROR;
     }
Index: match.h
===================================================================
--- match.h	(revision 130927)
+++ match.h	(working copy)
@@ -54,6 +54,7 @@ match gfc_match_intrinsic_op (gfc_intrin
 match gfc_match_char (char);
 match gfc_match (const char *, ...);
 match gfc_match_iterator (gfc_iterator *, int);
+match gfc_match_parens (void);
 
 /* Statement matchers.  */
 match gfc_match_program (void);

! { dg-do compile }
! PR34325 Wrong error message for syntax error
program aa
implicit none
real(kind=8)::r1=0
character(25) :: a
a = 'I am not a )))))'')''.'
if ((((((a /= "I am not a )))))')'.")))))) call abort
if ((((((a /= 'I am not a )))))'')''.')))))) call abort
a = "I am not a )))))"")""."
if ((((((a /= "I am not a )))))"")"".")))))) call abort
if (((3*r1)**2)>= 0) a = "good"
if ((3*r1)**2)>= 0) a = "bad" ! { dg-error "Missing '\\(' in statement" }
end