From 458653cc067362d84835bc39bd849dcdb4c13127 Mon Sep 17 00:00:00 2001 From: John David Anglin Date: Sat, 19 Mar 2011 17:25:18 +0000 Subject: [PATCH] re PR libfortran/35667 (HP-UX 10 has broken strtod) 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 --- libgfortran/ChangeLog | 8 +++++ libgfortran/io/io.h | 3 ++ libgfortran/io/list_read.c | 23 ++++++++++-- libgfortran/io/read.c | 71 +++++++++++++++++++++++++++++++++++++- 4 files changed, 101 insertions(+), 4 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 70cf85b42a6..1f9da0a2bb0 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2011-03-19 John David Anglin + + 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 PR libfortran/47439 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index ebe7f7cc1f0..b48582d9781 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index ea232327f48..6e1cb699ab9 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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) diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index 50b1b408e9b..d8d2a81a6d3 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -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; } -- 2.30.2