mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 20:01:28 +08:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Reject DT as fmt in I/O statments [PR99111]

Browse Source 
gcc/fortran/ChangeLog:

	PR fortran/99111
	* io.c (resolve_tag_format): Reject BT_DERIVED/CLASS/VOID
	as (array-valued) FORMAT tag.

gcc/testsuite/ChangeLog:

	PR fortran/99111
	* gfortran.dg/fmt_nonchar_1.f90: New test.
	* gfortran.dg/fmt_nonchar_2.f90: New test.
This commit is contained in:
Tobias Burnus 2021-02-16 14:17:35 +01:00
parent 3f16a16781
commit ebf9b6c13f
3 changed files with 75 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/io.c
View File

@ -1762,6 +1762,13 @@ resolve_tag_format (gfc_expr *e)
It may be assigned an Hollerith constant. */
if (e->ts.type != BT_CHARACTER)
{
if (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS
|| e->ts.type == BT_VOID)
{
gfc_error ("Non-character non-Hollerith in FORMAT tag at %L",
&e->where);
return false;
}
if (!gfc_notify_std (GFC_STD_LEGACY, "Non-character in FORMAT tag "
"at %L", &e->where))
return false;

46
gcc/testsuite/gfortran.dg/fmt_nonchar_1.f90 Normal file
View File

@ -0,0 +1,46 @@
! { dg-do compile }
!
! PR fortran/99111
!
program p
use iso_c_binding
implicit none
type t
integer :: a(1)
end type
type(t), parameter :: x(3) = [t(transfer('("he', 1)), &
t(transfer('llo ', 1)), &
t(transfer('W1")', 1))]
type t2
procedure(), pointer, nopass :: ppt
end type t2
type(t2) :: ppcomp(1)
interface
function fptr()
procedure(), pointer :: fptr
end function
end interface
class(t), allocatable :: cl(:)
type(c_ptr) :: cptr(1)
type(c_funptr) :: cfunptr(1)
procedure(), pointer :: proc
external proc2
print x ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
print cl ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
print cptr ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
print cfunptr ! { dg-error "Non-character non-Hollerith in FORMAT tag" }
print proc ! { dg-error "Syntax error in PRINT statement" }
print proc2 ! { dg-error "Syntax error in PRINT statement" }
print ppcomp%ppt ! { dg-error "Syntax error in PRINT statement" }
print fptr() ! { dg-error "must be of type default-kind CHARACTER or of INTEGER" }
call bar(1)
contains
subroutine bar (xx)
type(*) :: xx
print xx ! { dg-error "Assumed-type variable xx at ... may only be used as actual argument" }
end
end

22
gcc/testsuite/gfortran.dg/fmt_nonchar_2.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do run }
!
! PR fortran/99111
!
program p
implicit none
type t
integer :: a(1)
end type
type(t), parameter :: x(3) = [t(transfer('("he', 1)), &
t(transfer('llo ', 1)), &
t(transfer('W1")', 1))]
integer, parameter :: y(3) = transfer('("hello W2")', 1, size=3)
real, parameter :: z(3) = transfer('("hello W3")', 1.0, size=3)
print y ! { dg-warning "Legacy Extension: Non-character in FORMAT" }
print z ! { dg-warning "Legacy Extension: Non-character in FORMAT" }
print x%a(1) ! { dg-warning "Legacy Extension: Non-character in FORMAT" }
end
! { dg-output "hello W2(\n|\r\n|\r)hello W3(\n|\r\n|\r)hello W1" }