2005-12-10 Steven G. Kargl <kargls@comcast.net>

        PR fortran/25106
        PR fortran/25055
        * match.c (gfc_match_small_literal_int): Add cnt argument;
        (gfc_match_st_label,gfc_match_stopcode): Account for cnt argument.
        * match.h (gfc_match_small_literal_int): Update prototype.
        * decl.c (match_char_length,gfc_match_old_kind_spec): Account for cnt.
        * parse.c (next_free): Ditto.
        * primary.c (match_kind_param): Ditto.

        gfortran.dg/label_1.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@108692 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d23f6b0..eb85853 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2005-12-16  Steven G. Kargl <kargls@comcast.net>
+ 
+       PR fortran/25106
+       PR fortran/25055
+       * match.c (gfc_match_small_literal_int): Add cnt argument;
+       (gfc_match_st_label,gfc_match_stopcode): Account for cnt argument.
+       * match.h (gfc_match_small_literal_int): Update prototype.
+       * decl.c (match_char_length,gfc_match_old_kind_spec): Account for cnt.
+       * parse.c (next_free): Ditto.
+       * primary.c (match_kind_param): Ditto.
+
 2005-12-16  Richard Guenther  <rguenther@suse.de>
 
        * trans.h (tree): Remove declaration of gfc_build_function_call.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6f04734..45a0442 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -508,14 +508,15 @@ char_len_param_value (gfc_expr ** expr)
 static match
 match_char_length (gfc_expr ** expr)
 {
-  int length;
+  int length, cnt;
   match m;
 
   m = gfc_match_char ('*');
   if (m != MATCH_YES)
     return m;
 
-  m = gfc_match_small_literal_int (&length);
+  /* cnt is unused, here.  */
+  m = gfc_match_small_literal_int (&length, &cnt);
   if (m == MATCH_ERROR)
     return m;
 
@@ -1279,12 +1280,13 @@ match
 gfc_match_old_kind_spec (gfc_typespec * ts)
 {
   match m;
-  int original_kind;
+  int original_kind, cnt;
 
   if (gfc_match_char ('*') != MATCH_YES)
     return MATCH_NO;
 
-  m = gfc_match_small_literal_int (&ts->kind);
+  /* cnt is unsed, here.  */
+  m = gfc_match_small_literal_int (&ts->kind, &cnt);
   if (m != MATCH_YES)
     return MATCH_ERROR;
 

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index fd4fe33..501a091 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -141,11 +141,11 @@ gfc_match_eos (void)
    old-style character length specifications.  */
 
 match
-gfc_match_small_literal_int (int *value)
+gfc_match_small_literal_int (int *value, int *cnt)
 {
   locus old_loc;
   char c;
-  int i;
+  int i, j;
 
   old_loc = gfc_current_locus;
 
@@ -159,6 +159,7 @@ gfc_match_small_literal_int (int *value)
     }
 
   i = c - '0';
+  j = 1;
 
   for (;;)
     {
@@ -169,6 +170,7 @@ gfc_match_small_literal_int (int *value)
        break;
 
       i = 10 * i + c - '0';
+      j++;
 
       if (i > 99999999)
        {
@@ -180,6 +182,7 @@ gfc_match_small_literal_int (int *value)
   gfc_current_locus = old_loc;
 
   *value = i;
+  *cnt = j;
   return MATCH_YES;
 }
 
@@ -221,24 +224,31 @@ gfc_match_st_label (gfc_st_label ** label)
 {
   locus old_loc;
   match m;
-  int i;
+  int i, cnt;
 
   old_loc = gfc_current_locus;
 
-  m = gfc_match_small_literal_int (&i);
+  m = gfc_match_small_literal_int (&i, &cnt);
   if (m != MATCH_YES)
     return m;
 
-  if (i > 0 && i <= 99999)
+  if (cnt > 5)
     {
-      *label = gfc_get_st_label (i);
-      return MATCH_YES;
+      gfc_error ("Too many digits in statement label at %C");
+      goto cleanup;
     }
 
   if (i == 0)
-    gfc_error ("Statement label at %C is zero");
-  else
-    gfc_error ("Statement label at %C is out of range");
+    {
+      gfc_error ("Statement label at %C is zero");
+      goto cleanup;
+    }
+
+  *label = gfc_get_st_label (i);
+  return MATCH_YES;
+
+cleanup:
+
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -1407,21 +1417,22 @@ gfc_match_stopcode (gfc_statement st)
   int stop_code;
   gfc_expr *e;
   match m;
+  int cnt;
 
   stop_code = -1;
   e = NULL;
 
   if (gfc_match_eos () != MATCH_YES)
     {
-      m = gfc_match_small_literal_int (&stop_code);
+      m = gfc_match_small_literal_int (&stop_code, &cnt);
       if (m == MATCH_ERROR)
         goto cleanup;
 
-      if (m == MATCH_YES && stop_code > 99999)
-        {
-          gfc_error ("STOP code out of range at %C");
-          goto cleanup;
-        }
+      if (m == MATCH_YES && cnt > 5)
+       {
+         gfc_error ("Too many digits in STOP code at %C");
+         goto cleanup;
+       }
 
       if (m == MATCH_NO)
         {

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index a3c1d81..1c5115e 100644 (file)
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -40,7 +40,7 @@ extern gfc_st_label *gfc_statement_label;
 /* Generic match subroutines */
 match gfc_match_space (void);
 match gfc_match_eos (void);
-match gfc_match_small_literal_int (int *);
+match gfc_match_small_literal_int (int *, int *);
 match gfc_match_st_label (gfc_st_label **);
 match gfc_match_label (void);
 match gfc_match_small_int (int *);

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 311d10a..f53a2e4 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -309,7 +309,7 @@ static gfc_statement
 next_free (void)
 {
   match m;
-  int c, d;
+  int c, d, cnt;
 
   gfc_gobble_whitespace ();
 
@@ -323,11 +323,13 @@ next_free (void)
       d = gfc_peek_char ();
       if (m != MATCH_YES || !gfc_is_whitespace (d))
        {
-         gfc_match_small_literal_int (&c);
+         gfc_match_small_literal_int (&c, &cnt);
+
+          if (cnt > 5)
+           gfc_error_now ("Too many digits in statement label at %C");
+         
          if (c == 0)
            gfc_error_now ("Statement label at %C is zero");
-         else
-           gfc_error_now ("Statement label at %C is out of range");
 
          do
            c = gfc_next_char ();

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 234a803..b60e0c1 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -40,8 +40,10 @@ match_kind_param (int *kind)
   gfc_symbol *sym;
   const char *p;
   match m;
+  int cnt;
 
-  m = gfc_match_small_literal_int (kind);
+  /* cnt is unused, here.  */
+  m = gfc_match_small_literal_int (kind, &cnt);
   if (m != MATCH_NO)
     return m;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c28f546..bd4561a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2005-12-16  Steven G. Kargl <kargls@comcast.net>
+
+       gfortran.dg/label_1.f90: New test.
+
 2005-12-15  Ben Elliston  <bje@au.ibm.com>
 
        PR testsuite/25422

diff --git a/gcc/testsuite/gfortran.dg/label_1.f90 b/gcc/testsuite/gfortran.dg/label_1.f90
new file mode 100644 (file)
index 0000000..149c79f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/label_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! Test the fix for PR 25106 and 25055.
+
+program a
+0056780 continue    ! { dg-error "Too many digits" }
+0 continue          ! { dg-error "Statement label at" }
+  stop 001234       ! { dg-error "Too many digits" }
+end program a
+
+