GCC started to accept as legacy extension array-valued
non-characters, which works for integer (+ real/logical).
Some other – mostly unrelated patch regarding resolving
array constructors (r10-5607-gde89b5748d68b76b, PR92996)
turned this into an ICE.
While it might be in theory fixable for derived types,
just rejecting DT + CLASS + c_(fun)ptr makes more sense.
I am not quite sure about the error-message wording.
Better suggestions? In the 'rank > 0' branch, Hollerith
should not occur and (as legacy extension) integer etc.
are permitted. — Thoughts?
Otherwise: OK for GCC 11 and GCC 10?
(ICE is new in GCC 10.)
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank
Thürauf
Fortran: Reject DT as fmt in I/O statments [PR99111]
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.
gcc/fortran/io.c | 7 +++++
gcc/testsuite/gfortran.dg/fmt_nonchar_1.f90 | 46 +++++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/fmt_nonchar_2.f90 | 22 ++++++++++++++
3 files changed, 75 insertions(+)
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index da6ad177ec3..40cd76eb585 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -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;
diff --git a/gcc/testsuite/gfortran.dg/fmt_nonchar_1.f90 b/gcc/testsuite/gfortran.dg/fmt_nonchar_1.f90
new file mode 100644
index 00000000000..431b61569e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_nonchar_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/fmt_nonchar_2.f90 b/gcc/testsuite/gfortran.dg/fmt_nonchar_2.f90
new file mode 100644
index 00000000000..7c0f524c3c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_nonchar_2.f90
@@ -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" }
