Commit c7eb642e by Jerry DeLisle

re PR fortran/80484 (Three syntax errors involving derived-type I/O)

2017-04-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/80484
	* io.c (format_lex): Check for '/' and set token to FMT_SLASH.
	(check_format): Move FMT_DT checking code to data_desc section.
	* module.c (gfc_match_use): Include the case of INTERFACE_DTIO.

	PR fortran/80484
	* gfortran.dg/dtio_29.f03: New test.

From-SVN: r247084
parent 60fc41bd
2017-04-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/80484
* io.c (format_lex): Check for '/' and set token to FMT_SLASH.
(check_format): Move FMT_DT checking code to data_desc section.
* module.c (gfc_match_use): Include the case of INTERFACE_DTIO.
2017-04-22 Janus Weil <janus@gcc.gnu.org> 2017-04-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/80121 PR fortran/80121
......
...@@ -491,6 +491,11 @@ format_lex (void) ...@@ -491,6 +491,11 @@ format_lex (void)
token = FMT_END; token = FMT_END;
break; break;
} }
if (c == '/')
{
token = FMT_SLASH;
break;
}
if (c == delim) if (c == delim)
continue; continue;
unget_char (); unget_char ();
...@@ -498,6 +503,11 @@ format_lex (void) ...@@ -498,6 +503,11 @@ format_lex (void)
} }
} }
} }
else if (c == '/')
{
token = FMT_SLASH;
break;
}
else else
unget_char (); unget_char ();
} }
...@@ -687,54 +697,6 @@ format_item_1: ...@@ -687,54 +697,6 @@ format_item_1:
return false; return false;
goto between_desc; goto between_desc;
case FMT_DT:
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
switch (t)
{
case FMT_RPAREN:
level--;
if (level < 0)
goto finished;
goto between_desc;
case FMT_COMMA:
goto format_item;
case FMT_LPAREN:
dtio_vlist:
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
if (t != FMT_POSINT)
{
error = posint_required;
goto syntax;
}
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
if (t == FMT_COMMA)
goto dtio_vlist;
if (t != FMT_RPAREN)
{
error = _("Right parenthesis expected at %C");
goto syntax;
}
goto between_desc;
default:
error = unexpected_element;
goto syntax;
}
goto format_item;
case FMT_SIGN: case FMT_SIGN:
case FMT_BLANK: case FMT_BLANK:
case FMT_DP: case FMT_DP:
...@@ -783,6 +745,7 @@ format_item_1: ...@@ -783,6 +745,7 @@ format_item_1:
case FMT_A: case FMT_A:
case FMT_D: case FMT_D:
case FMT_H: case FMT_H:
case FMT_DT:
goto data_desc; goto data_desc;
case FMT_END: case FMT_END:
...@@ -1004,6 +967,53 @@ data_desc: ...@@ -1004,6 +967,53 @@ data_desc:
break; break;
case FMT_DT:
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
switch (t)
{
case FMT_RPAREN:
level--;
if (level < 0)
goto finished;
goto between_desc;
case FMT_COMMA:
goto format_item;
case FMT_LPAREN:
dtio_vlist:
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
if (t != FMT_POSINT)
{
error = posint_required;
goto syntax;
}
t = format_lex ();
if (t == FMT_ERROR)
goto fail;
if (t == FMT_COMMA)
goto dtio_vlist;
if (t != FMT_RPAREN)
{
error = _("Right parenthesis expected at %C");
goto syntax;
}
goto between_desc;
default:
error = unexpected_element;
goto syntax;
}
break;
case FMT_F: case FMT_F:
t = format_lex (); t = format_lex ();
if (t == FMT_ERROR) if (t == FMT_ERROR)
......
...@@ -631,6 +631,7 @@ gfc_match_use (void) ...@@ -631,6 +631,7 @@ gfc_match_use (void)
case INTERFACE_USER_OP: case INTERFACE_USER_OP:
case INTERFACE_GENERIC: case INTERFACE_GENERIC:
case INTERFACE_DTIO:
m = gfc_match (" =>"); m = gfc_match (" =>");
if (type == INTERFACE_USER_OP && m == MATCH_YES if (type == INTERFACE_USER_OP && m == MATCH_YES
......
2017-04-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/80484
* gfortran.dg/dtio_29.f03: New test.
2017-04-22 Janus Weil <janus@gcc.gnu.org> 2017-04-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/80121 PR fortran/80121
......
! { dg-do compile }
! PR80484 Three syntax errors involving derived-type I/O
module dt_write_mod
type, public :: B_type
real :: amount
end type B_type
interface write (formatted)
procedure :: Write_b
end interface
contains
subroutine Write_b &
(amount, unit, b_edit_descriptor, v_list, iostat, iomsg)
class (B_type), intent(in) :: amount
integer, intent(in) :: unit
character (len=*), intent(in) :: b_edit_descriptor
integer, dimension(:), intent(in) :: v_list
integer, intent(out) :: iostat
character (len=*), intent(inout) :: iomsg
write (unit=unit, fmt="(f9.3)", iostat=iostat) amount%amount
end subroutine Write_b
end module dt_write_mod
program test
use dt_write_mod, only: B_type , write(formatted)
implicit none
real :: wage = 15.10
integer :: ios
character(len=99) :: iom = "OK"
write (unit=*, fmt="(DT'$$$Z.##')", iostat=ios, iomsg=iom) &
B_type(wage), B_type(wage)
print *, trim(iom)
write (unit=*, fmt="(2DT'$$$Z.##')", iostat=ios, iomsg=iom) &
B_type(wage), B_type(wage)
print *, trim(iom)
write (unit=*, fmt="(3DT'$$$Z.##')", iostat=ios, iomsg=iom) &
B_type(wage), B_type(wage)
print *, trim(iom)
write (unit=*, fmt="(DT'$$$Z.##'/)", iostat=ios, iomsg=iom) &
B_type(wage), B_type(wage)
print *, trim(iom)
end program test
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment