if (dtp->u.p.current_unit->bytes_left < *length)
{
- if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ /* For preconnected units with default record length, set bytes left
+ to unit record length and proceed, otherwise error. */
+ if (dtp->u.p.current_unit->unit_number == options.stdin_unit
+ && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ else
{
- generate_error (&dtp->common, ERROR_EOR, NULL);
- /* Not enough data left. */
- return NULL;
+ if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ {
+ /* Not enough data left. */
+ generate_error (&dtp->common, ERROR_EOR, NULL);
+ return NULL;
+ }
}
*length = dtp->u.p.current_unit->bytes_left;
if (dtp->u.p.current_unit->bytes_left < *nbytes)
{
- if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ /* For preconnected units with default record length, set bytes left
+ to unit record length and proceed, otherwise error. */
+ if (dtp->u.p.current_unit->unit_number == options.stdin_unit
+ && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ else
{
- /* Not enough data left. */
- generate_error (&dtp->common, ERROR_EOR, NULL);
- return;
+ if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ {
+ /* Not enough data left. */
+ generate_error (&dtp->common, ERROR_EOR, NULL);
+ return;
+ }
}
*nbytes = dtp->u.p.current_unit->bytes_left;
write_block (st_parameter_dt *dtp, int length)
{
char *dest;
-
+
if (dtp->u.p.current_unit->bytes_left < length)
{
- generate_error (&dtp->common, ERROR_EOR, NULL);
- return NULL;
+ /* For preconnected units with default record length, set bytes left
+ to unit record length and proceed, otherwise error. */
+ if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
+ || dtp->u.p.current_unit->unit_number == options.stderr_unit)
+ && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+ else
+ {
+ generate_error (&dtp->common, ERROR_EOR, NULL);
+ return NULL;
+ }
}
dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
{
if (dtp->u.p.current_unit->bytes_left < nbytes)
{
- if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
- generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+ /* For preconnected units with default record length, set bytes left
+ to unit record length and proceed, otherwise error. */
+ if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
+ || dtp->u.p.current_unit->unit_number == options.stderr_unit)
+ && dtp->u.p.current_unit->recl == DEFAULT_RECL)
+ dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
else
- generate_error (&dtp->common, ERROR_EOR, NULL);
- return FAILURE;
+ {
+ if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
+ generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+ else
+ generate_error (&dtp->common, ERROR_EOR, NULL);
+ return FAILURE;
+ }
}
dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
/* Check to see if we might be reading what we wrote before */
- if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode == WRITING)
+ if (dtp->u.p.mode == READING
+ && dtp->u.p.current_unit->mode == WRITING
+ && !is_internal_unit (dtp))
flush(dtp->u.p.current_unit->s);
/* Check whether the record exists to be read. Only
{
/* Most systems buffer lines, so force the partial record
to be written out. */
- flush (dtp->u.p.current_unit->s);
+ if (!is_internal_unit (dtp))
+ flush (dtp->u.p.current_unit->s);
dtp->u.p.seen_dollar = 0;
return;
}
}
sfree (dtp->u.p.current_unit->s);
-
- if (is_internal_unit (dtp))
- {
- if (is_array_io (dtp) && dtp->u.p.current_unit->ls != NULL)
- free_mem (dtp->u.p.current_unit->ls);
- sclose (dtp->u.p.current_unit->s);
- }
}
-
/* Transfer function for IOLENGTH. It doesn't actually do any
data transfer, it just updates the length counter. */
free_mem (dtp->u.p.scratch);
if (dtp->u.p.current_unit != NULL)
unlock_unit (dtp->u.p.current_unit);
- if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL)
- free_mem (dtp->u.p.current_unit);
+
+ free_internal_unit (dtp);
+
library_end ();
}
free_mem (dtp->u.p.scratch);
if (dtp->u.p.current_unit != NULL)
unlock_unit (dtp->u.p.current_unit);
- if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL)
- free_mem (dtp->u.p.current_unit);
+
+ free_internal_unit (dtp);
+
library_end ();
}
memset (iunit, '\0', sizeof (gfc_unit));
iunit->recl = dtp->internal_unit_len;
+
+ /* For internal units we set the unit number to -1.
+ Otherwise internal units can be mistaken for a pre-connected unit or
+ some other file I/O unit. */
+ iunit->unit_number = -1;
/* Set up the looping specification from the array descriptor, if any. */
}
+/* free_internal_unit()-- Free memory allocated for internal units if any. */
+void
+free_internal_unit (st_parameter_dt *dtp)
+{
+ if (!is_internal_unit (dtp))
+ return;
+
+ if (dtp->u.p.current_unit->ls != NULL)
+ free_mem (dtp->u.p.current_unit->ls);
+
+ sclose (dtp->u.p.current_unit->s);
+
+ if (dtp->u.p.current_unit != NULL)
+ free_mem (dtp->u.p.current_unit);
+}
+
+
/* get_unit()-- Returns the unit structure associated with the integer
* unit or the internal file. */
/* Has to be an external unit */
dtp->u.p.unit_is_internal = 0;
+ dtp->internal_unit_desc = NULL;
return get_external_unit (dtp->common.unit, do_create);
}