Commit b896e674 by Jerry DeLisle

re PR libfortran/61499 (Internal read of negative integer broken)

2014-06-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/61499
	* io/list_read.c (eat_spaces): Use a 'for' loop instead of
	'while' loop to skip the loop if there are no bytes left in the
	string. Only seek if actual spaces can be skipped.

From-SVN: r212059
parent 5450a05c
2014-06-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/61499
* io/list_read.c (eat_spaces): Use a 'for' loop instead of
'while' loop to skip the loop if there are no bytes left in the
string. Only seek if actual spaces can be skipped.
2014-06-25 Tobias Burnus <burnus@net-b.de> 2014-06-25 Tobias Burnus <burnus@net-b.de>
* caf/single.c (assign_char4_from_char1, assign_char1_from_char4, * caf/single.c (assign_char4_from_char1, assign_char1_from_char4,
......
...@@ -387,50 +387,39 @@ eat_spaces (st_parameter_dt *dtp) ...@@ -387,50 +387,39 @@ eat_spaces (st_parameter_dt *dtp)
int c; int c;
/* If internal character array IO, peak ahead and seek past spaces. /* If internal character array IO, peak ahead and seek past spaces.
This is an optimazation to eliminate numerous calls to This is an optimization unique to character arrays with large
next character unique to character arrays with large character character lengths (PR38199). This code eliminates numerous calls
lengths (PR38199). */ to next_character. */
if (is_array_io (dtp)) if (is_array_io (dtp) && (dtp->u.p.last_char == EOF - 1))
{ {
gfc_offset offset = stell (dtp->u.p.current_unit->s); gfc_offset offset = stell (dtp->u.p.current_unit->s);
gfc_offset limit = offset + dtp->u.p.current_unit->bytes_left; gfc_offset i;
if (dtp->common.unit) /* kind=4 */ if (dtp->common.unit) /* kind=4 */
{ {
gfc_char4_t cc; for (i = 0; i < dtp->u.p.current_unit->bytes_left; i++)
limit *= (sizeof (gfc_char4_t));
do
{ {
cc = dtp->internal_unit[offset]; if (dtp->internal_unit[offset + i * sizeof (gfc_char4_t)]
offset += (sizeof (gfc_char4_t)); != (gfc_char4_t)' ')
dtp->u.p.current_unit->bytes_left--; break;
} }
while (offset < limit && cc == (gfc_char4_t)' ');
/* Back up, seek ahead, and fall through to complete the
process so that END conditions are handled correctly. */
dtp->u.p.current_unit->bytes_left++;
cc = dtp->internal_unit[offset];
if (cc != (gfc_char4_t)' ')
sseek (dtp->u.p.current_unit->s,
offset-(sizeof (gfc_char4_t)), SEEK_SET);
} }
else else
{ {
do for (i = 0; i < dtp->u.p.current_unit->bytes_left; i++)
{ {
c = dtp->internal_unit[offset++]; if (dtp->internal_unit[offset + i] != ' ')
dtp->u.p.current_unit->bytes_left--; break;
} }
while (offset < limit && c == ' '); }
/* Back up, seek ahead, and fall through to complete the
process so that END conditions are handled correctly. */
dtp->u.p.current_unit->bytes_left++;
if (dtp->internal_unit[offset] != ' ') if (i != 0)
sseek (dtp->u.p.current_unit->s, offset - 1, SEEK_SET); {
sseek (dtp->u.p.current_unit->s, offset + i, SEEK_SET);
dtp->u.p.current_unit->bytes_left -= i;
} }
} }
/* Now skip spaces, EOF and EOL are handled in next_char. */ /* Now skip spaces, EOF and EOL are handled in next_char. */
do do
c = next_char (dtp); c = next_char (dtp);
......
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