re PR libfortran/24787 ([libfortran] SCAN is broken)

PR libfortran/24787
* intrinsics/string_intrinsics.c (string_scan): Off by one; Fix
  typos in nearby comment.

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

From-SVN: r106828

4 files changed, 62 insertions, 25 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2767bb5..9545e76 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2005-11-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR libgfortran/24787
+	* gfortran.dg/scan_1.f90: New test.
+
 2005-11-12  Jan Hubicka  <jh@suse.cz>
 
 	* gcc.target/i386/minmax-1.c: New.
diff --git a/gcc/testsuite/gfortran.dg/scan_1.f90 b/gcc/testsuite/gfortran.dg/scan_1.f90
new file mode 100644
index 0000000..ceaa9eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scan_1.f90
@@ -0,0 +1,31 @@
+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
+   
+
+   
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6ee5271..793d440 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2005-11-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR libgfortran/24787
+	*  intrinsics/string_intrinsics.c (string_scan): Off by one; Fix typos
+	in nearby comment.
+
 2005-11-10  Andreas Jaeger  <aj@suse.de>
 
 	* libgfortran.h: Add proper defines where needed.
diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c
index f13d117..eed41d7 100644
--- a/libgfortran/intrinsics/string_intrinsics.c
+++ b/libgfortran/intrinsics/string_intrinsics.c
@@ -1,5 +1,5 @@
 /* String intrinsics helper functions.
-   Copyright 2002 Free Software Foundation, Inc.
+   Copyright 2002, 2005 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
 
 This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -89,12 +89,10 @@ copy_string (GFC_INTEGER_4 destlen, char * dest,
     {
       /* This will truncate if too long.  */
       memmove (dest, src, destlen);
-      /*memcpy (dest, src, destlen);*/
     }
   else
     {
       memmove (dest, src, srclen);
-      /*memcpy (dest, src, srclen);*/
       /* Pad with spaces.  */
       memset (&dest[srclen], ' ', destlen - srclen);
     }
@@ -304,35 +302,32 @@ GFC_INTEGER_4
 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;
-    }
-
-  i = 0;
-  for (; start != last; start += delta)
-    {
-      for (i = 0; i < setlen; i++)
-        {
-          if (str[start] == set[i])
-            return (start + 1);
-        }
+      for (i = 0; i < slen; i++)
+	{
+	  for (j = 0; j < setlen; j++)
+	    {
+	      if (str[i] == set[j])
+		return (i + 1);
+	    }
+	}
     }
 
   return 0;
@@ -340,8 +335,8 @@ string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
 
 
 /* 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.  */
+   string by identifying the position of the first character in a
+   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,