View | Details | Return to bug 29627 | Differences between
and this patch

Collapse All | Expand All

(-)runtime/error.c (+4 lines)
Lines 435-440 translate_error (int code) Link Here
435
      p = "Write exceeds length of DIRECT access record";
435
      p = "Write exceeds length of DIRECT access record";
436
      break;
436
      break;
437
437
438
    case ERROR_SHORT_RECORD:
439
      p = "Short record on unformatted read";
440
      break;
441
438
    default:
442
    default:
439
      p = "Unknown error code";
443
      p = "Unknown error code";
440
      break;
444
      break;
(-)libgfortran.h (+1 lines)
Lines 413-418 typedef enum Link Here
413
  ERROR_INTERNAL_UNIT,
413
  ERROR_INTERNAL_UNIT,
414
  ERROR_ALLOCATION,
414
  ERROR_ALLOCATION,
415
  ERROR_DIRECT_EOR,
415
  ERROR_DIRECT_EOR,
416
  ERROR_SHORT_RECORD,
416
  ERROR_LAST			/* Not a real error, the last error # + 1.  */
417
  ERROR_LAST			/* Not a real error, the last error # + 1.  */
417
}
418
}
418
error_codes;
419
error_codes;
(-)io/transfer.c (-49 / +41 lines)
Lines 359-440 read_block (st_parameter_dt *dtp, int *l Link Here
359
static void
359
static void
360
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
360
read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes)
361
{
361
{
362
  int *length;
363
  void *data;
364
  size_t nread;
362
  size_t nread;
363
  int short_record;
365
364
366
  if (!is_stream_io (dtp))
365
  if (is_stream_io (dtp))
367
    {
366
    {
368
      if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
367
      if (sseek (dtp->u.p.current_unit->s,
368
		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
369
	{
369
	{
370
	  /* For preconnected units with default record length, set
370
	  generate_error (&dtp->common, ERROR_END, NULL);
371
	     bytes left to unit record length and proceed, otherwise
371
	  return;
372
	     error.  */
373
	  if (dtp->u.p.current_unit->unit_number == options.stdin_unit
374
	      && dtp->u.p.current_unit->recl == DEFAULT_RECL)
375
	    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
376
	  else
377
	    {
378
	      if (dtp->u.p.current_unit->flags.pad == PAD_NO)
379
		{
380
		  /* Not enough data left.  */
381
		  generate_error (&dtp->common, ERROR_EOR, NULL);
382
		  return;
383
		}
384
	    }
385
	  
386
	  if (dtp->u.p.current_unit->bytes_left == 0)
387
	    {
388
	      dtp->u.p.current_unit->endfile = AT_ENDFILE;
389
	      generate_error (&dtp->common, ERROR_END, NULL);
390
	      return;
391
	    }
392
393
	  *nbytes = (size_t) dtp->u.p.current_unit->bytes_left;
394
	}
372
	}
395
373
396
      if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED &&
374
      nread = *nbytes;
397
	  dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL)
375
      if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
398
	{
376
	{
399
	  length = (int *) nbytes;
377
	  generate_error (&dtp->common, ERROR_OS, NULL);
400
	  data = read_sf (dtp, length, 0);	/* Special case.  */
401
	  memcpy (buf, data, (size_t) *length);
402
	  return;
378
	  return;
403
	}
379
	}
404
380
405
      dtp->u.p.current_unit->bytes_left -= (gfc_offset) *nbytes;
381
      dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
382
383
      if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
384
	generate_error (&dtp->common, ERROR_END, NULL);	  
385
386
      return;
406
    }
387
    }
407
  else
388
389
  /* Unformatted file with records */
390
  if (dtp->u.p.current_unit->bytes_left < (gfc_offset) *nbytes)
408
    {
391
    {
409
      if (sseek (dtp->u.p.current_unit->s,
392
      short_record = 1;
410
		 dtp->u.p.current_unit->strm_pos - 1) == FAILURE)
393
      nread = (size_t) dtp->u.p.current_unit->bytes_left;
394
      *nbytes = nread;
395
396
      if (dtp->u.p.current_unit->bytes_left == 0)
411
	{
397
	{
398
	  dtp->u.p.current_unit->endfile = AT_ENDFILE;
412
	  generate_error (&dtp->common, ERROR_END, NULL);
399
	  generate_error (&dtp->common, ERROR_END, NULL);
413
	  return;
400
	  return;
414
	}
401
	}
415
    }
402
    }
416
403
417
  nread = *nbytes;
404
  else
405
    {
406
      short_record = 0;
407
      nread = *nbytes;
408
    }
409
410
  dtp->u.p.current_unit->bytes_left -= nread;
411
418
  if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
412
  if (sread (dtp->u.p.current_unit->s, buf, &nread) != 0)
419
    {
413
    {
420
      generate_error (&dtp->common, ERROR_OS, NULL);
414
      generate_error (&dtp->common, ERROR_OS, NULL);
421
      return;
415
      return;
422
    }
416
    }
423
417
424
  if (!is_stream_io (dtp))
418
  if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
425
    {
419
    {
426
      if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
420
      *nbytes = nread;
427
	dtp->u.p.size_used += (gfc_offset) nread;
421
      generate_error (&dtp->common, ERROR_END, NULL);
422
      return;
428
    }
423
    }
429
  else
430
    dtp->u.p.current_unit->strm_pos += (gfc_offset) nread; 
431
424
432
  if (nread != *nbytes)  /* Short read, e.g. if we hit EOF.  */
425
  if (short_record)
433
    {
426
    {
434
      if (!is_stream_io (dtp))
427
      generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL);
435
	generate_error (&dtp->common, ERROR_EOR, NULL);
428
      return;
436
      else
437
	generate_error (&dtp->common, ERROR_END, NULL);	  
438
    }
429
    }
439
}
430
}
440
431
Lines 595-601 unformatted_read (st_parameter_dt *dtp, Link Here
595
      /* By now, all complex variables have been split into their
586
      /* By now, all complex variables have been split into their
596
	 constituent reals.  For types with padding, we only need to
587
	 constituent reals.  For types with padding, we only need to
597
	 read kind bytes.  We don't care about the contents
588
	 read kind bytes.  We don't care about the contents
598
	 of the padding.  */
589
	 of the padding.  If we hit a short record, then sz is
590
	 adjusted accordingly, making later reads no-ops.  */
599
      
591
      
600
      sz = kind;
592
      sz = kind;
601
      for (i=0; i<nelems; i++)
593
      for (i=0; i<nelems; i++)

Return to bug 29627