62520b2004
2003-04-11 Bud Davis <bdavis9659@comcast.net> PR Fortran/9263 * gcc/f/data.c (ffedata_advance_): Check initial, final and increment values for INTEGER typeness. PR Fortran/1832 * libf2c/libI77/iio.c (z_putc): Check for overflowing length of output string. * gcc/f/news.texi: Document these fixes. PR Fortran/9263 * g77.f-torture/noncompile/9263.f: New test PR Fortran/1832 * g77.f-torture/execute/1832.f: New test From-SVN: r65481
158 lines
2.7 KiB
C
158 lines
2.7 KiB
C
#include "f2c.h"
|
|
#include "fio.h"
|
|
#include "fmt.h"
|
|
extern char *f__icptr;
|
|
char *f__icend;
|
|
extern icilist *f__svic;
|
|
int f__icnum;
|
|
extern int f__hiwater;
|
|
int
|
|
z_getc (void)
|
|
{
|
|
if (f__recpos++ < f__svic->icirlen)
|
|
{
|
|
if (f__icptr >= f__icend)
|
|
err (f__svic->iciend, (EOF), "endfile");
|
|
return (*(unsigned char *) f__icptr++);
|
|
}
|
|
return '\n';
|
|
}
|
|
|
|
void
|
|
z_putc (int c)
|
|
{
|
|
if (f__recpos++ < f__svic->icirlen && f__icptr < f__icend)
|
|
*f__icptr++ = c;
|
|
}
|
|
int
|
|
z_rnew (void)
|
|
{
|
|
f__icptr = f__svic->iciunit + (++f__icnum) * f__svic->icirlen;
|
|
f__recpos = 0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
return 1;
|
|
}
|
|
|
|
static int
|
|
z_endp (void)
|
|
{
|
|
(*f__donewrec) ();
|
|
return 0;
|
|
}
|
|
|
|
int
|
|
c_si (icilist * a)
|
|
{
|
|
if (f__init & 2)
|
|
f__fatal (131, "I/O recursion");
|
|
f__init |= 2;
|
|
f__elist = (cilist *) a;
|
|
f__fmtbuf = a->icifmt;
|
|
f__curunit = 0;
|
|
f__sequential = f__formatted = 1;
|
|
f__external = 0;
|
|
if (pars_f (f__fmtbuf) < 0)
|
|
err (a->icierr, 100, "startint");
|
|
fmt_bg ();
|
|
f__cblank = f__cplus = f__scale = 0;
|
|
f__svic = a;
|
|
f__icnum = f__recpos = 0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
f__icptr = a->iciunit;
|
|
f__icend = f__icptr + a->icirlen * a->icirnum;
|
|
f__cf = 0;
|
|
return (0);
|
|
}
|
|
|
|
int
|
|
iw_rev (void)
|
|
{
|
|
if (f__workdone)
|
|
z_endp ();
|
|
f__hiwater = f__recpos = f__cursor = 0;
|
|
return (f__workdone = 0);
|
|
}
|
|
|
|
integer
|
|
s_rsfi (icilist * a)
|
|
{
|
|
int n;
|
|
if ((n = c_si (a)))
|
|
return (n);
|
|
f__reading = 1;
|
|
f__doed = rd_ed;
|
|
f__doned = rd_ned;
|
|
f__getn = z_getc;
|
|
f__dorevert = z_endp;
|
|
f__donewrec = z_rnew;
|
|
f__doend = z_endp;
|
|
return (0);
|
|
}
|
|
|
|
int
|
|
z_wnew (void)
|
|
{
|
|
if (f__recpos < f__hiwater)
|
|
{
|
|
f__icptr += f__hiwater - f__recpos;
|
|
f__recpos = f__hiwater;
|
|
}
|
|
while (f__recpos++ < f__svic->icirlen)
|
|
*f__icptr++ = ' ';
|
|
f__recpos = 0;
|
|
f__cursor = 0;
|
|
f__hiwater = 0;
|
|
f__icnum++;
|
|
return 1;
|
|
}
|
|
|
|
integer
|
|
s_wsfi (icilist * a)
|
|
{
|
|
int n;
|
|
if ((n = c_si (a)))
|
|
return (n);
|
|
f__reading = 0;
|
|
f__doed = w_ed;
|
|
f__doned = w_ned;
|
|
f__putn = z_putc;
|
|
f__dorevert = iw_rev;
|
|
f__donewrec = z_wnew;
|
|
f__doend = z_endp;
|
|
return (0);
|
|
}
|
|
|
|
integer
|
|
e_rsfi (void)
|
|
{
|
|
int n;
|
|
f__init &= ~2;
|
|
n = en_fio ();
|
|
f__fmtbuf = NULL;
|
|
return (n);
|
|
}
|
|
|
|
integer
|
|
e_wsfi (void)
|
|
{
|
|
int n;
|
|
f__init &= ~2;
|
|
n = en_fio ();
|
|
f__fmtbuf = NULL;
|
|
if (f__svic->icirnum != 1
|
|
&& (f__icnum > f__svic->icirnum
|
|
|| (f__icnum == f__svic->icirnum && (f__recpos | f__hiwater))))
|
|
err (f__svic->icierr, 110, "inwrite");
|
|
if (f__recpos < f__hiwater)
|
|
f__recpos = f__hiwater;
|
|
if (f__recpos >= f__svic->icirlen)
|
|
err (f__svic->icierr, 110, "recend");
|
|
if (!f__recpos && f__icnum)
|
|
return n;
|
|
while (f__recpos++ < f__svic->icirlen)
|
|
*f__icptr++ = ' ';
|
|
return n;
|
|
}
|