OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/78662 ([F03] Incorrect parsing of quotes in the char-literal-constant of the DT data descriptor) 

2016-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/78622
	* io.c (format_lex): Continue of string delimiter seen.

	* io/transfer.c (get_dt_format): New static function to alloc
	and set the DT iotype string, handling doubled quotes.
	(formatted_transfer_scalar_read,
	formatted_transfer_scalar_write): Use new function.

	* gfortran.dg/dtio_20.f03: New test.

From-SVN: r243765
This commit is contained in:
Jerry DeLisle 2016-12-16 20:27:51 +00:00
parent c2d42d1619
commit 5cdc4b0ef0
6 changed files with 82 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/78622
* io.c (format_lex): Continue of string delimiter seen.
2016-12-16 Jakub Jelinek <jakub@redhat.com>
PR fortran/78757

3
gcc/fortran/io.c
View File

@ -486,12 +486,13 @@ format_lex (void)
if (c == delim)
{
c = next_char (NONSTRING);
if (c == '\0')
{
token = FMT_END;
break;
}
if (c == delim)
continue;
unget_char ();
break;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/78622
* gfortran.dg/dtio_20.f03: New test.
2016-12-16 Jakub Jelinek <jakub@redhat.com>
PR fortran/78757

31
gcc/testsuite/gfortran.dg/dtio_20.f03 Normal file
View File

@ -0,0 +1,31 @@
MODULE m
IMPLICIT NONE
TYPE :: t
CHARACTER :: c
CONTAINS
PROCEDURE :: write_formatted
GENERIC :: WRITE(FORMATTED) => write_formatted
END TYPE t
CONTAINS
SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
CLASS(t), INTENT(IN) :: dtv
INTEGER, INTENT(IN) :: unit
CHARACTER(*), INTENT(IN) :: iotype
INTEGER, INTENT(IN) :: v_list(:)
INTEGER, INTENT(OUT) :: iostat
CHARACTER(*), INTENT(INOUT) :: iomsg
WRITE (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) iotype
END SUBROUTINE write_formatted
END MODULE m
PROGRAM p
USE m
IMPLICIT NONE
CHARACTER(25) :: str
TYPE(t) :: x
WRITE (str, "(DT'a''b')") x
if (str.ne."DTa'b") call abort
END PROGRAM p

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/78622
* io/transfer.c (get_dt_format): New static function to alloc
and set the DT iotype string, handling doubled quotes.
(formatted_transfer_scalar_read,
formatted_transfer_scalar_write): Use new function.
2016-12-12 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
* configure.ac: Call GCC_CHECK_LINKER_HWCAP.

47
libgfortran/io/transfer.c
View File

@ -1264,6 +1264,33 @@ require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f)
return 1;
}
static char *
get_dt_format (char *p, gfc_charlen_type *length)
{
char delim = p[-1]; /* The delimiter is always the first character back. */
char c, *q, *res;
gfc_charlen_type len = *length; /* This length already correct, less 'DT'. */
res = q = xmalloc (len + 2);
/* Set the beginning of the string to 'DT', length adjusted below. */
*q++ = 'D';
*q++ = 'T';
/* The string may contain doubled quotes so scan and skip as needed. */
for (; len > 0; len--)
{
c = *q++ = *p++;
if (c == delim)
p++; /* Skip the doubled delimiter. */
}
/* Adjust the string length by two now that we are done. */
*length += 2;
return res;
}
/* This function is in the main loop for a formatted data transfer
statement. It would be natural to implement this as a coroutine
@ -1420,7 +1447,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
gfc_charlen_type child_iomsg_len;
int noiostat;
int *child_iostat = NULL;
char *iotype = f->u.udf.string;
char *iotype;
gfc_charlen_type iotype_len = f->u.udf.string_len;
/* Build the iotype string. */
@ -1430,13 +1457,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
iotype = dt;
}
else
{
iotype_len += 2;
iotype = xmalloc (iotype_len);
iotype[0] = dt[0];
iotype[1] = dt[1];
memcpy (iotype + 2, f->u.udf.string, f->u.udf.string_len);
}
iotype = get_dt_format (f->u.udf.string, &iotype_len);
/* Set iostat, intent(out). */
noiostat = 0;
@ -1890,7 +1911,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
gfc_charlen_type child_iomsg_len;
int noiostat;
int *child_iostat = NULL;
char *iotype = f->u.udf.string;
char *iotype;
gfc_charlen_type iotype_len = f->u.udf.string_len;
/* Build the iotype string. */
@ -1900,13 +1921,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
iotype = dt;
}
else
{
iotype_len += 2;
iotype = xmalloc (iotype_len);
iotype[0] = dt[0];
iotype[1] = dt[1];
memcpy (iotype + 2, f->u.udf.string, f->u.udf.string_len);
}
iotype = get_dt_format (f->u.udf.string, &iotype_len);
/* Set iostat, intent(out). */
noiostat = 0;