Dear all,
when looking at output item lists we didn't catch procedures
and procedure pointers and ran into a gfc_internal_error().
Such items are not allowed by the Fortran standard, e.g. for
procedure pointers there is
C1233 (R1217) An expression that is an output-item shall not
have a value that is a procedure pointer.
Attached patch generates an error instead.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 3b15fe83830c1e75339114e0241e9d2158393017 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 4 Oct 2022 21:19:21 +0200
Subject: [PATCH] Fortran: reject procedures and procedure pointers as output
item [PR107074]
gcc/fortran/ChangeLog:
PR fortran/107074
* trans-io.cc (transfer_expr): A procedure or a procedure pointer
cannot be output items.
gcc/testsuite/ChangeLog:
PR fortran/107074
* gfortran.dg/pr107074.f90: New test.
---
gcc/fortran/trans-io.cc | 14 ++++++++++++++
gcc/testsuite/gfortran.dg/pr107074.f90 | 11 +++++++++++
2 files changed, 25 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/pr107074.f90
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 9f86815388c..c4e1537eed6 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2430,6 +2430,20 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
break;
+ case BT_PROCEDURE:
+ if (code->expr1
+ && code->expr1->symtree
+ && code->expr1->symtree->n.sym)
+ {
+ if (code->expr1->symtree->n.sym->attr.proc_pointer)
+ gfc_error ("Procedure pointer at %C cannot be an output item");
+ else
+ gfc_error ("Procedure at %C cannot be an output item");
+ return;
+ }
+ /* If a PROCEDURE item gets through to here, fall through and ICE. */
+ gcc_fallthrough ();
+
case_bt_struct:
case BT_CLASS:
if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS)
diff --git a/gcc/testsuite/gfortran.dg/pr107074.f90 b/gcc/testsuite/gfortran.dg/pr107074.f90
new file mode 100644
index 00000000000..a09088c2e9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107074.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! PR fortran/107074 - ICE: Bad IO basetype (8)
+! Contributed by G.Steinmetz
+
+program p
+ implicit none
+ integer, external :: a
+ procedure(real), pointer :: b
+ print *, merge (a, a, .true.) ! { dg-error "Procedure" }
+ print *, merge (b, b, .true.) ! { dg-error "Procedure pointer" }
+end
--
2.35.3
