This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Fix PR 52724, internal list-directed read/write with kind=4
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 24 Sep 2012 23:50:24 +0200
- Subject: [patch, fortran] Fix PR 52724, internal list-directed read/write with kind=4
Hello world,
not much to say, the patch is pretty straightforward.
Regression-tested. OK for trunk?
Thomas
2012-09-24 Thomas König <tkoenig@gcc.gnu.org>
PR fortran/52724
* list_read.c (next_char): Handle kind=4 characters.
* unix.c (open_internal4): Correct lenth of internal file.
2012-09-24 Thomas König <tkoenig@gcc.gnu.org>
PR fortran/52724
* gfortran.dg/internal_readwrite_3.f90: New test.
Index: list_read.c
===================================================================
--- list_read.c (Revision 191649)
+++ list_read.c (Arbeitskopie)
@@ -199,9 +199,16 @@ next_char (st_parameter_dt *dtp)
if (is_internal_unit (dtp))
{
- char cc;
- length = sread (dtp->u.p.current_unit->s, &cc, 1);
- c = cc;
+ /* Check for kind=4 internal unit. */
+ if (dtp->common.unit)
+ length = sread (dtp->u.p.current_unit->s, &c, sizeof (gfc_char4_t));
+ else
+ {
+ char cc;
+ length = sread (dtp->u.p.current_unit->s, &cc, 1);
+ c = cc;
+ }
+
if (length < 0)
{
generate_error (&dtp->common, LIBERROR_OS, NULL);
Index: unix.c
===================================================================
--- unix.c (Revision 191649)
+++ unix.c (Arbeitskopie)
@@ -959,7 +959,7 @@ open_internal4 (char *base, int length, gfc_offset
s->buffer = base;
s->buffer_offset = offset;
- s->active = s->file_length = length;
+ s->active = s->file_length = length * sizeof (gfc_char4_t);
s->st.vptr = &mem4_vtable;
! { dg-do run }
! PR 52724 - this used to generate a "Bad integer" error.
program main
implicit none
integer :: i
character(len=100,kind=4) :: buffer, a
buffer = 4_"123"
read(buffer,*) i
write (a,'(I3)') i
if (a /= 4_"123") call abort
end program main