[patch, libgfortran] PR61640 KIND=4 Character Array Internal Unit Read Fail

[patch, libgfortran] PR61640 KIND=4 Character Array Internal Unit Read Fail

[Jerry DeLisle]

[-- Attachment #1: Type: text/plain, Size: 896 bytes --]

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  <jvdelisle@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.

[-- Attachment #2: pr61640.diff --]
[-- Type: text/x-patch, Size: 1240 bytes --]

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

[-- Attachment #3: arrayio_16.f90 --]
[-- Type: text/x-fortran, Size: 461 bytes --]

! { 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