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

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

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 830 bytes --]

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

[-- Attachment #2: fmt-fix.diff --]
[-- Type: text/x-patch, Size: 3830 bytes --]

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" }

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

[Paul Richard Thomas]

Hi Tobias,

The fix and the message are just fine for me. I am trying to imagine how
few people will ever encounter this!

OK for 10- and 11-branches

Thanks

Paul


On Tue, 16 Feb 2021 at 11:28, Tobias Burnus <tobias@codesourcery.com> wrote:

> 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
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein