OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/35667 (HP-UX 10 has broken strtod)

Browse Source 
PR fortran/35667
	* io/io.h (convert_infnan): Declare.
	* io/read.c (convert_infnan): New.
	(read_f): Use convert_infnan to convert INFs and NANs.
	* list_read.c (parse_real, read_real): Likewise.

From-SVN: r171182
This commit is contained in:
John David Anglin 2011-03-19 17:25:18 +00:00 committed by John David Anglin
parent 16e329fbae
commit 458653cc06
4 changed files with 101 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2011-03-19 John David Anglin <dave.anglin@nrc-cnrc.gc.ca>
PR fortran/35667
* io/io.h (convert_infnan): Declare.
* io/read.c (convert_infnan): New.
(read_f): Use convert_infnan to convert INFs and NANs.
* list_read.c (parse_real, read_real): Likewise.
2011-03-19 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR libfortran/47439

3
libgfortran/io/io.h
View File

@ -674,6 +674,9 @@ internal_proto(max_value);
extern int convert_real (st_parameter_dt *, void *, const char *, int);
internal_proto(convert_real);
extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
internal_proto(convert_infnan);
extern void read_a (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_a);

23
libgfortran/io/list_read.c
View File

@ -1215,6 +1215,15 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
return m;
done_infnan:
unget_char (dtp, c);
push_char (dtp, '\0');
m = convert_infnan (dtp, buffer, dtp->u.p.saved_string, length);
free_saved (dtp);
return m;
inf_nan:
/* Match INF and Infinity. */
if ((c == 'i' || c == 'I')
@ -1235,7 +1244,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
push_char (dtp, 'i');
push_char (dtp, 'n');
push_char (dtp, 'f');
goto done;
goto done_infnan;
}
} /* Match NaN. */
else if (((c = next_char (dtp)) == 'a' || c == 'A')
@ -1259,7 +1268,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
if (is_separator (c))
unget_char (dtp, c);
}
goto done;
goto done_infnan;
}
bad:
@ -1718,7 +1727,15 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
}
free_line (dtp);
goto done;
unget_char (dtp, c);
eat_separator (dtp);
push_char (dtp, '\0');
if (convert_infnan (dtp, dest, dtp->u.p.saved_string, length))
return;
free_saved (dtp);
dtp->u.p.saved_type = BT_REAL;
return;
unwind:
if (dtp->u.p.namelist_mode)

71
libgfortran/io/read.c
View File

@ -189,6 +189,75 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
return 0;
}
/* convert_infnan()-- Convert character INF/NAN representation to the
machine number. Note: many architectures (e.g. IA-64, HP-PA) require
that the storage pointed to by the dest argument is properly aligned
for the type in question. */
int
convert_infnan (st_parameter_dt *dtp, void *dest, const char *buffer,
int length)
{
const char *s = buffer;
int is_inf, plus = 1;
if (*s == '+')
s++;
else if (*s == '-')
{
s++;
plus = 0;
}
is_inf = *s == 'i';
switch (length)
{
case 4:
if (is_inf)
*((GFC_REAL_4*) dest) = plus ? __builtin_inff () : -__builtin_inff ();
else
*((GFC_REAL_4*) dest) = plus ? __builtin_nanf ("") : -__builtin_nanf ("");
break;
case 8:
if (is_inf)
*((GFC_REAL_8*) dest) = plus ? __builtin_inf () : -__builtin_inf ();
else
*((GFC_REAL_8*) dest) = plus ? __builtin_nan ("") : -__builtin_nan ("");
break;
#if defined(HAVE_GFC_REAL_10)
case 10:
if (is_inf)
*((GFC_REAL_10*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
else
*((GFC_REAL_10*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
break;
#endif
#if defined(HAVE_GFC_REAL_16)
# if defined(GFC_REAL_16_IS_FLOAT128)
case 16:
*((GFC_REAL_16*) dest) = __qmath_(strtoflt128) (buffer, NULL);
break;
# else
case 16:
if (is_inf)
*((GFC_REAL_16*) dest) = plus ? __builtin_infl () : -__builtin_infl ();
else
*((GFC_REAL_16*) dest) = plus ? __builtin_nanl ("") : -__builtin_nanl ("");
break;
# endif
#endif
default:
internal_error (&dtp->common, "Unsupported real kind during IO");
}
return 0;
}
/* read_l()-- Read a logical value */
@ -896,7 +965,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
else if (strcmp (save, "nan") != 0)
goto bad_float;
convert_real (dtp, dest, buffer, length);
convert_infnan (dtp, dest, buffer, length);
return;
}