re PR fortran/60144 (Misleading error message when missing "then" after "if" and...

2019-05-01 Dominique d'Humieres  <dominiq@gcc.gnu.org>

	PR fortran/60144
	* match.c (gfc_match_parens): Change the location for missing ')'.
	(gfc_match_if): Detect a missing '('. Remove the spurious named
	constant error. Change the wording of some errors.
	(gfc_match_else): Change the wording of an error.
	(gfc_match_elseif): Detect a missing '('. Improve the matching
	process to get a better syntax analysis.

	PR fortran/60144
	* gfortran.dg/block_name_2.f90: Adjust dg-error.
	* gfortran.dg/dec_type_print_3.f90.f90: Likewise
	* gfortran.dg/pr60144.f90: New test.

From-SVN: r270776

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 12cb55c2dcb9d9e18f69d6b106f0211152f04021..2d76d9cb5bb56257c068d84316f0fe9ab010f129 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2019-05-01 Dominique d'Humieres  <dominiq@gcc.gnu.org>
+
+       PR fortran/60144
+       * match.c (gfc_match_parens): Change the location for missing ')'.
+       (gfc_match_if): Detect a missing '('. Remove the spurious named
+       constant error. Change the wording of some errors.
+       (gfc_match_else): Change the wording of an error.
+       (gfc_match_elseif): Detect a missing '('. Improve the matching
+       process to get a better syntax analysis.
+
 2019-04-19  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/90166

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index eba428fd084171686cf2ab346a3dfdcf28f55aa1..268217a4a5fe62a0897c04aeecf2787492fabd8e 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -262,6 +262,8 @@ gfc_match_parens (void)
 
   for (;;)
     {
+      if (count > 0)
+       where = gfc_current_locus;
       c = gfc_next_char_literal (instring);
       if (c == '\n')
        break;
@@ -281,7 +283,6 @@ gfc_match_parens (void)
       if (c == '(' && quote == ' ')
        {
          count++;
-         where = gfc_current_locus;
        }
       if (c == ')' && quote == ' ')
        {
@@ -292,14 +293,10 @@ gfc_match_parens (void)
 
   gfc_current_locus = old_loc;
 
-  if (count > 0)
-    {
-      gfc_error ("Missing %<)%> in statement at or before %L", &where);
-      return MATCH_ERROR;
-    }
-  if (count < 0)
+  if (count != 0)
     {
-      gfc_error ("Missing %<(%> in statement at or before %L", &where);
+      gfc_error ("Missing %qs in statement at or before %L",
+                count > 0? ")":"(", &where);
       return MATCH_ERROR;
     }
 
@@ -1495,7 +1492,17 @@ gfc_match_if (gfc_statement *if_type)
 
   old_loc = gfc_current_locus;
 
-  m = gfc_match (" if ( %e", &expr);
+  m = gfc_match (" if ", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      gfc_error ("Missing %<(%> in IF-expression at %C");
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match ("%e", &expr);
   if (m != MATCH_YES)
     return m;
 
@@ -1648,30 +1655,17 @@ gfc_match_if (gfc_statement *if_type)
   if (flag_dec)
     match ("type", gfc_match_print, ST_WRITE)
 
-  /* The gfc_match_assignment() above may have returned a MATCH_NO
-     where the assignment was to a named constant.  Check that
-     special case here.  */
-  m = gfc_match_assignment ();
-  if (m == MATCH_NO)
-   {
-      gfc_error ("Cannot assign to a named constant at %C");
-      gfc_free_expr (expr);
-      gfc_undo_symbols ();
-      gfc_current_locus = old_loc;
-      return MATCH_ERROR;
-   }
-
   /* All else has failed, so give up.  See if any of the matchers has
      stored an error message of some sort.  */
   if (!gfc_error_check ())
-    gfc_error ("Unclassifiable statement in IF-clause at %C");
+    gfc_error ("Syntax error in IF-clause after %C");
 
   gfc_free_expr (expr);
   return MATCH_ERROR;
 
 got_match:
   if (m == MATCH_NO)
-    gfc_error ("Syntax error in IF-clause at %C");
+    gfc_error ("Syntax error in IF-clause after %C");
   if (m != MATCH_YES)
     {
       gfc_free_expr (expr);
@@ -1714,7 +1708,7 @@ gfc_match_else (void)
       || gfc_current_block () == NULL
       || gfc_match_eos () != MATCH_YES)
     {
-      gfc_error ("Unexpected junk after ELSE statement at %C");
+      gfc_error ("Invalid character(s) in ELSE statement after %C");
       return MATCH_ERROR;
     }
 
@@ -1735,31 +1729,59 @@ match
 gfc_match_elseif (void)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  gfc_expr *expr;
+  gfc_expr *expr, *then;
+  locus where;
   match m;
 
-  m = gfc_match (" ( %e ) then", &expr);
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      gfc_error ("Missing %<(%> in ELSE IF expression at %C");
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match (" %e ", &expr);
   if (m != MATCH_YES)
     return m;
 
-  if (gfc_match_eos () == MATCH_YES)
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      gfc_error ("Missing %<)%> in ELSE IF expression at %C");
+      goto cleanup;
+    }
+
+  m = gfc_match (" then ", &then);
+
+  where = gfc_current_locus;
+
+  if (m == MATCH_YES && (gfc_match_eos () == MATCH_YES
+                        || (gfc_current_block ()
+                            && gfc_match_name (name) == MATCH_YES)))
     goto done;
 
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      gfc_error ("Missing THEN in ELSE IF statement after %L", &where);
+      goto cleanup;
+    }
+
   if (gfc_match_name (name) != MATCH_YES
       || gfc_current_block () == NULL
       || gfc_match_eos () != MATCH_YES)
     {
-      gfc_error ("Unexpected junk after ELSE IF statement at %C");
+      gfc_error ("Syntax error in ELSE IF statement after %L", &where);
       goto cleanup;
     }
 
   if (strcmp (name, gfc_current_block ()->name) != 0)
     {
-      gfc_error ("Label %qs at %C doesn't match IF label %qs",
-                name, gfc_current_block ()->name);
+      gfc_error ("Label %qs after %L doesn't match IF label %qs",
+                name, &where, gfc_current_block ()->name);
       goto cleanup;
     }
 
+  if (m != MATCH_YES)
+    return m;
+
 done:
   new_st.op = EXEC_IF;
   new_st.expr1 = expr;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3620c23f82ed708134412fd3da3cbf81af8ffc5d..45b181a24f89383af398c22553530d805907e4b0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-05-01  Dominique d'Humieres  <dominiq@gcc.gnu.org>
+
+       PR fortran/60144
+       * gfortran.dg/block_name_2.f90: Adjust dg-error.
+       * gfortran.dg/dec_type_print_3.f90.f90: Likewise
+       * gfortran.dg/pr60144.f90: New test. 
+
 2019-05-01  Jeff Law  <law@redhat.com>
 
        PR tree-optimization/90037

diff --git a/gcc/testsuite/gfortran.dg/block_name_2.f90 b/gcc/testsuite/gfortran.dg/block_name_2.f90
index d86e77e7a8c93b93fa6855453c80282b1cd7d843..289ea99f26ce3ed2a10f4b17953779e3c35240c8 100644 (file)
--- a/gcc/testsuite/gfortran.dg/block_name_2.f90
+++ b/gcc/testsuite/gfortran.dg/block_name_2.f90
@@ -37,8 +37,8 @@ program blocks
   end do
 
   if (i > 0) then
-  else if (i ==0) then i2 ! { dg-error "Unexpected junk after ELSE IF statement" }
-  else i2 ! { dg-error "Unexpected junk after ELSE statement" }
+  else if (i ==0) then i2 ! { dg-error "Syntax error in ELSE IF statement" }
+  else i2 ! { dg-error "Invalid character.s. in ELSE statement" }
   end if i2 ! { dg-error "Syntax error in END IF statement" }
   end if
 
@@ -49,7 +49,7 @@ program blocks
   end select
 
   where (a > 0)
-  elsewhere w2  ! { dg-error "Unexpected junk after ELSE statement" }
+  elsewhere w2  ! { dg-error "Invalid character.s. in ELSE statement" }
   end where w2 ! { dg-error "Syntax error in END WHERE statement" }
   end where
 

diff --git a/gcc/testsuite/gfortran.dg/dec_type_print_3.f90 b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90
index e5b455eea26df50e52d83028f96d342db14eb9bb..409e991b84bb92fbf3fd3abb261f1b0009f62323 100644 (file)
--- a/gcc/testsuite/gfortran.dg/dec_type_print_3.f90
+++ b/gcc/testsuite/gfortran.dg/dec_type_print_3.f90
@@ -16,5 +16,5 @@ include 'dec_type_print.f90'
 ! { dg-error "Invalid character in name" "" { target *-*-* } 57 }
 ! { dg-error "Invalid character in name" "" { target *-*-* } 58 }
 ! { dg-error "conflicts with PROCEDURE" "" { target *-*-* } 60 }
-! { dg-error "Cannot assign to a named constant" "" { target *-*-* } 80 }
+! { dg-error "Syntax error in IF-clause" "" { target *-*-* } 80 }
 

diff --git a/gcc/testsuite/gfortran.dg/pr60144.f90 b/gcc/testsuite/gfortran.dg/pr60144.f90
new file mode 100644 (file)
index 0000000..fe6c182
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr60144.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! fortran PR/60144
+! Contributed by Sergio Losilla
+!
+program ifelif
+    if a=b                 ! { dg-error "Missing ... in IF-expression" }
+    if (a=b                ! { dg-error "Missing ... in statement at or before" }
+    if (a=b then           ! { dg-error "Missing ... in statement at or before" }
+    if ((a=b)              ! { dg-error "Expected a right parenthesis in expression" }
+    if ((a==b              ! { dg-error "Expected a right parenthesis in expression" }
+    if ((a==b)             ! { dg-error "Missing ... in statement at or before" }
+    if ((a==b) then        ! { dg-error "Missing ... in statement at or before" }
+    if (a=b))              ! { dg-error "Missing ... in statement at or before" }
+    if .TRUE.)             ! { dg-error "Missing ... in IF-expression" }
+    if (.TRUE.)            ! { dg-error "Syntax error in IF-clause after" }
+    if (.TRUE.) the        ! { dg-error "Syntax error in IF-clause after" }
+    if ((.TRUE.)           ! { dg-error "Missing ... in statement at or before" }
+    else if .FALSE.)       ! { dg-error "Missing ... in ELSE IF expression" }
+    else if (.FALSE.       ! { dg-error "Missing ... in ELSE IF expression" }
+    else if (.FALSE.)      ! { dg-error "Missing THEN in ELSE IF statement" }
+    else if (.FALSE.) the  ! { dg-error "doesn't match IF label" }
+    else (.true.)          ! { dg-error "Invalid character.s. in ELSE statement after" }
+    else a=1               ! { dg-error "Invalid character.s. in ELSE statement after" }
+    if a=b                 ! { dg-error "Missing ... in IF-expression" }
+!    end if
+end program