Commit 02c92593 by Steven G. Kargl Committed by Steven G. Kargl

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
parent 230dedb3
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> 2005-11-12 Jan Hubicka <jh@suse.cz>
* gcc.target/i386/minmax-1.c: New. * gcc.target/i386/minmax-1.c: New.
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
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> 2005-11-10 Andreas Jaeger <aj@suse.de>
* libgfortran.h: Add proper defines where needed. * libgfortran.h: Add proper defines where needed.
......
/* String intrinsics helper functions. /* String intrinsics helper functions.
Copyright 2002 Free Software Foundation, Inc. Copyright 2002, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org> Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran). This file is part of the GNU Fortran 95 runtime library (libgfortran).
...@@ -89,12 +89,10 @@ copy_string (GFC_INTEGER_4 destlen, char * dest, ...@@ -89,12 +89,10 @@ copy_string (GFC_INTEGER_4 destlen, char * dest,
{ {
/* This will truncate if too long. */ /* This will truncate if too long. */
memmove (dest, src, destlen); memmove (dest, src, destlen);
/*memcpy (dest, src, destlen);*/
} }
else else
{ {
memmove (dest, src, srclen); memmove (dest, src, srclen);
/*memcpy (dest, src, srclen);*/
/* Pad with spaces. */ /* Pad with spaces. */
memset (&dest[srclen], ' ', destlen - srclen); memset (&dest[srclen], ' ', destlen - srclen);
} }
...@@ -304,35 +302,32 @@ GFC_INTEGER_4 ...@@ -304,35 +302,32 @@ GFC_INTEGER_4
string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
const char * set, GFC_LOGICAL_4 back) const char * set, GFC_LOGICAL_4 back)
{ {
int start; int i, j;
int last;
int i;
int delta;
if (slen == 0 || setlen == 0) if (slen == 0 || setlen == 0)
return 0; return 0;
if (back) if (back)
{ {
last = 0; for (i = slen - 1; i >= 0; i--)
start = slen - 1; {
delta = -1; for (j = 0; j < setlen; j++)
{
if (str[i] == set[j])
return (i + 1);
}
}
} }
else else
{ {
last = slen - 1; for (i = 0; i < slen; i++)
start = 0; {
delta = 1; for (j = 0; j < setlen; j++)
} {
if (str[i] == set[j])
i = 0; return (i + 1);
for (; start != last; start += delta) }
{ }
for (i = 0; i < setlen; i++)
{
if (str[start] == set[i])
return (start + 1);
}
} }
return 0; return 0;
...@@ -340,8 +335,8 @@ string_scan (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, ...@@ -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 /* Verify that a set of characters contains all the characters in a
string by indentifying the position of the first character in a string by identifying 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 GFC_INTEGER_4
string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen, string_verify (GFC_INTEGER_4 slen, const char * str, GFC_INTEGER_4 setlen,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment