}
-/* Mid level data transfer statements. These subroutines do reading
- and writing in the style of salloc_r()/salloc_w() within the
- current record. */
+/* Mid level data transfer statements. */
/* When reading sequential formatted records we have a problem. We
don't know how long the line is until we read the trailing newline,
we hit the newline. For small allocations, we use a static buffer.
For larger allocations, we are forced to allocate memory on the
heap. Hopefully this won't happen very often. */
+
+/* Read sequential file - internal unit */
-char *
-read_sf (st_parameter_dt *dtp, int * length, int no_error)
+static char *
+read_sf_internal (st_parameter_dt *dtp, int * length)
{
static char *empty_string[0];
- char *base, *p, q;
- int n, lorig, memread, seen_comma;
+ char *base;
+ int lorig;
- /* If we hit EOF previously with the no_error flag set (i.e. X, T,
- TR edit descriptors), and we now try to read again, this time
- without setting no_error. */
- if (!no_error && dtp->u.p.at_eof)
+ /* Zero size array gives internal unit len of 0. Nothing to read. */
+ if (dtp->internal_unit_len == 0
+ && dtp->u.p.current_unit->pad_status == PAD_NO)
+ hit_eof (dtp);
+
+ /* If we have seen an eor previously, return a length of 0. The
+ caller is responsible for correctly padding the input field. */
+ if (dtp->u.p.sf_seen_eor)
{
*length = 0;
+ /* Just return something that isn't a NULL pointer, otherwise the
+ caller thinks an error occured. */
+ return (char*) empty_string;
+ }
+
+ lorig = *length;
+ base = mem_alloc_r (dtp->u.p.current_unit->s, length);
+ if (unlikely (lorig > *length))
+ {
hit_eof (dtp);
return NULL;
}
+ dtp->u.p.current_unit->bytes_left -= *length;
+
+ if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+ dtp->u.p.size_used += (GFC_IO_INT) *length;
+
+ return base;
+
+}
+
+/* Read sequential file - external unit */
+
+static char *
+read_sf (st_parameter_dt *dtp, int * length)
+{
+ static char *empty_string[0];
+ char *base, *p, q;
+ int n, lorig, seen_comma;
+
/* If we have seen an eor previously, return a length of 0. The
caller is responsible for correctly padding the input field. */
if (dtp->u.p.sf_seen_eor)
return (char*) empty_string;
}
- if (is_internal_unit (dtp))
- {
- memread = *length;
- base = mem_alloc_r (dtp->u.p.current_unit->s, length);
- if (unlikely (memread > *length))
- {
- hit_eof (dtp);
- return NULL;
- }
- n = *length;
- goto done;
- }
-
n = seen_comma = 0;
/* Read data into format buffer and scan through it. */
so we can just continue with a short read. */
if (dtp->u.p.current_unit->pad_status == PAD_NO)
{
- if (likely (no_error))
- break;
generate_error (&dtp->common, LIBERROR_EOR, NULL);
return NULL;
}
some other stuff. Set the relevant flags. */
if (lorig > *length && !dtp->u.p.sf_seen_eor && !seen_comma)
{
- if (n > 0 || no_error)
- dtp->u.p.at_eof = 1;
- else
+ if (n > 0)
{
- hit_eof (dtp);
- return NULL;
- }
+ if (dtp->u.p.advance_status == ADVANCE_NO)
+ {
+ if (dtp->u.p.current_unit->pad_status == PAD_NO)
+ {
+ hit_eof (dtp);
+ return NULL;
+ }
+ else
+ dtp->u.p.eor_condition = 1;
+ }
+ else
+ dtp->u.p.at_eof = 1;
+ }
+ else if (dtp->u.p.advance_status == ADVANCE_NO
+ || dtp->u.p.current_unit->pad_status == PAD_NO
+ || dtp->u.p.current_unit->bytes_left
+ == dtp->u.p.current_unit->recl)
+ {
+ hit_eof (dtp);
+ return NULL;
+ }
}
done:
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
else
{
- if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO))
+ if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO)
+ && !is_internal_unit (dtp))
{
/* Not enough data left. */
generate_error (&dtp->common, LIBERROR_EOR, NULL);
}
}
- if (unlikely (dtp->u.p.current_unit->bytes_left == 0))
+ if (unlikely (dtp->u.p.current_unit->bytes_left == 0
+ && !is_internal_unit(dtp)))
{
- hit_eof (dtp);
+ hit_eof (dtp);
return NULL;
}
(dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL ||
dtp->u.p.current_unit->flags.access == ACCESS_STREAM))
{
- source = read_sf (dtp, nbytes, 0);
+ if (is_internal_unit (dtp))
+ source = read_sf_internal (dtp, nbytes);
+ else
+ source = read_sf (dtp, nbytes);
+
dtp->u.p.current_unit->strm_pos +=
(gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor);
return source;
if (actual == expected)
return 0;
+ /* Adjust item_count before emitting error message. */
sprintf (buffer, "Expected %s for item %d in formatted transfer, got %s",
- type_name (expected), dtp->u.p.item_count, type_name (actual));
+ type_name (expected), dtp->u.p.item_count - 1, type_name (actual));
format_error (dtp, f, buffer);
return 1;
unget_format (dtp, f);
}
+ /* This function is first called from data_init_transfer to initiate the loop
+ over each item in the format, transferring data as required. Subsequent
+ calls to this function occur for each data item foound in the READ/WRITE
+ statement. The item_count is incremented for each call. Since the first
+ call is from data_transfer_init, the item_count is always one greater than
+ the actual count number of the item being transferred. */
static void
formatted_transfer (st_parameter_dt *dtp, bt type, void *p, int kind,
if (sseek (dtp->u.p.current_unit->s,
dtp->u.p.current_unit->bytes_left_subrecord, SEEK_CUR) < 0)
generate_error (&dtp->common, LIBERROR_OS, NULL);
+
+ dtp->u.p.current_unit->bytes_left_subrecord = 0;
}
else
{ /* Seek by reading data. */
/* Space to the next record for read mode. */
static void
-next_record_r (st_parameter_dt *dtp)
+next_record_r (st_parameter_dt *dtp, int done)
{
gfc_offset record;
int bytes_left;
case FORMATTED_DIRECT:
case UNFORMATTED_DIRECT:
- skip_record (dtp, 0);
+ skip_record (dtp, dtp->u.p.current_unit->bytes_left);
break;
case FORMATTED_STREAM:
case FORMATTED_SEQUENTIAL:
/* read_sf has already terminated input because of an '\n', or
we have hit EOF. */
- if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof)
+ if (dtp->u.p.sf_seen_eor)
{
dtp->u.p.sf_seen_eor = 0;
- dtp->u.p.at_eof = 0;
break;
}
record = next_array_record (dtp, dtp->u.p.current_unit->ls,
&finished);
+ if (!done && finished)
+ hit_eof (dtp);
/* Now seek to this record. */
record = record * dtp->u.p.current_unit->recl;
{
if (errno != 0)
generate_error (&dtp->common, LIBERROR_OS, NULL);
- else
- hit_eof (dtp);
+ else
+ {
+ if (is_stream_io (dtp)
+ || dtp->u.p.current_unit->pad_status == PAD_NO
+ || dtp->u.p.current_unit->bytes_left
+ == dtp->u.p.current_unit->recl)
+ hit_eof (dtp);
+ }
break;
}
dtp->u.p.current_unit->read_bad = 0;
if (dtp->u.p.mode == READING)
- next_record_r (dtp);
+ next_record_r (dtp, done);
else
next_record_w (dtp, done);
OSDN Git Service
