[PATCH] fortran/24787 -- SCAN is broken

[Steve Kargl]

:ADDPATCH fortran:

Bubblestrap and regression tested on i386-*-freebsd.

The problem is the CS 101 off-by-one because the programmer
is trying to be too clever.

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

	* intrinsics/string_intrinsics.c (string_scan): Off by one.

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

	* gfortran.dg/scan_1.f90: New test.

-- 
Steve
-------------- next part --------------
Index: string_intrinsics.c
===================================================================
--- string_intrinsics.c	(revision 106778)
+++ string_intrinsics.c	(working copy)
@@ -304,44 +304,41 @@
 string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
              const char * set, GFC_LOGICAL_4 back)
 {
-  int start;
-  int last;
-  int i;
-  int delta;
+  int i, j;
 
   if (slen == 0 || setlen == 0)
     return 0;
 
   if (back)
     {
-      last =  0;
-      start = slen - 1;
-      delta = -1;
+      for (i = slen - 1; i >= 0; i--)
+	{
+	  for (j = 0; j < setlen; j++)
+	    {
+	      if (str[i] == set[j])
+		return (i + 1);
+	    }
+	}
     }
   else
     {
-      last = slen - 1;
-      start = 0;
-      delta = 1;
+      for (i = 0; i < slen; i++)
+	{
+	  for (j = 0; j < setlen; j++)
+	    {
+	      if (str[i] == set[j])
+		return (i + 1);
+	    }
+	}
     }
 
-  i = 0;
-  for (; start != last; start += delta)
-    {
-      for (i = 0; i < setlen; i++)
-        {
-          if (str[start] == set[i])
-            return (start + 1);
-        }
-    }
-
   return 0;
 }
 
 
 /* Verify that a set of characters contains all the characters in a
    string by indentifying the position of the first character in a
-   characters that dose not appear in a given set of characters.  */
+   characters that does not appear in a given set of characters.  */
 
 GFC_INTEGER_4
 string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
-------------- next part --------------
program b
   integer w
   character(len=2) s, t
   s = 'xi'

   w = scan(s, 'iI')
   if (w /= 2) call abort
   w = scan(s, 'xX', .true.)
   if (w /= 1) call abort
   w = scan(s, 'ab')
   if (w /= 0) call abort
   w = scan(s, 'ab', .true.)
   if (w /= 0) call abort

   s = 'xi'
   t = 'iI'
   w = scan(s, t)
   if (w /= 2) call abort
   t = 'xX'
   w = scan(s, t, .true.)
   if (w /= 1) call abort
   t = 'ab'
   w = scan(s, t)
   if (w /= 0) call abort
   w = scan(s, t, .true.)
   if (w /= 0) call abort

end program b