FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Steven G. Kargl 2005-11-12 19:16:40 +00:00 • committed by Steven G. Kargl
parent 230dedb327
commit 02c92593ed
4 changed files with 62 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View file

@ -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.

31
gcc/testsuite/gfortran.dg/scan_1.f90 Normal file
View file

@ -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

6
libgfortran/ChangeLog
View file

@ -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.

45
libgfortran/intrinsics/string_intrinsics.c
View file

@ -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,