The attached patch is obvious and simple. I will commit to trunk soon.
There are two things obvious about this.
1) Using the wrong function for wide characters.
2) No one must be using this feature of Fortran since the bug exists at least
back to 4.5
;)
Regression tested on x86-64-linux-gnu.
Test case attached. I would suggest since it is a wrong code bug, we should at
least port to 4.9.1. I will wait a while before doing that and won't if anyone
feels strongly about not doing so. A portion of the patch in eat_spaces is a
correction to the fix for PR61499 for KIND=4.
Regards,
Jerry
2014-06-28 Jerry DeLisle <jvdeli...@gcc.gnu.org>
PR libgfortran/61640
* io/list_read.c (next_char_internal): Adjust the read length to
a single wide character. (eat_spaces): Add missing paren.
* io/unix.c (mem_read4): Use the correct mem_alloc function for
wide character internal reads.
Index: list_read.c
===================================================================
--- list_read.c (revision 212104)
+++ list_read.c (working copy)
@@ -273,7 +273,7 @@ next_char_internal (st_parameter_dt *dtp)
/* Get the next character and handle end-of-record conditions. */
if (dtp->common.unit) /* Check for kind=4 internal unit. */
- length = sread (dtp->u.p.current_unit->s, &c, sizeof (gfc_char4_t));
+ length = sread (dtp->u.p.current_unit->s, &c, 1);
else
{
char cc;
@@ -399,7 +399,7 @@ eat_spaces (st_parameter_dt *dtp)
{
for (i = 0; i < dtp->u.p.current_unit->bytes_left; i++)
{
- if (dtp->internal_unit[offset + i * sizeof (gfc_char4_t)]
+ if (dtp->internal_unit[(offset + i) * sizeof (gfc_char4_t)]
!= (gfc_char4_t)' ')
break;
}
Index: unix.c
===================================================================
--- unix.c (revision 212104)
+++ unix.c (working copy)
@@ -808,10 +808,10 @@ mem_read4 (stream * s, void * buf, ssize_t nbytes)
void *p;
int nb = nbytes;
- p = mem_alloc_r (s, &nb);
+ p = mem_alloc_r4 (s, &nb);
if (p)
{
- memcpy (buf, p, nb);
+ memcpy (buf, p, nb * 4);
return (ssize_t) nb;
}
else
! { dg-do run }
! PR61640 KIND=4 Character Array Internal Unit Read Fail
program read_internal
integer :: x(9),i
integer :: y(9)
character(kind=4,len=30), dimension(3) :: source
y = reshape ((/ 1,1,-1,1,-1,1,-1,1,1 /), shape(x))
source=[4_" 1 1 -1",4_" 1 -1 1",4_" -1 1 1"]
!print *, (trim(source(i)), i=1,3)
read(source,*) (x(i), i=1,9) ! This read fails for KIND=4 character
if (any(x /= y )) call abort
end program read_internal
