Hi Mikael!
Am 04.03.23 um 14:56 schrieb Mikael Morin:
I have found the time finally. It's not as bad as it seemed. See below.
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index eec0314cf4c..72d8c6f1c14 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
+ sym->attr.pointer = CLASS_DATA(sym)->attr.class_pointer;
+ sym->attr.allocatable = CLASS_DATA(sym)->attr.allocatable;
+ sym->attr.dimension = CLASS_DATA(sym)->attr.dimension;
+ sym->attr.codimension = CLASS_DATA(sym)->attr.codimension;
+ if (as && CLASS_DATA (sym)->as)
+ sym->as = gfc_copy_array_spec (CLASS_DATA (sym)->as);
Here the condition on 'CLASS_DATA(sym)->as' makes obviously sense, but I
don't see why there is also a condition on 'as'.
For example, if the array spec has been previously set on the class
container's first component, and there is no array spec information in
the current statement (i.e. as == NULL), sym->as will remain NULL, and a
non-array class container will be built in gfc_build_class_symbol below.
Very good catch! Indeed, this fixes the testcase variations.
@@ -8807,6 +8785,27 @@ attr_decl1 (void)
goto cleanup;
}
+ if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class
+ && !as && !current_attr.pointer && !current_attr.allocatable
+ && !current_attr.external)
+ {
+ sym->attr.pointer = 0;
+ sym->attr.allocatable = 0;
+ sym->attr.dimension = 0;
+ sym->attr.codimension = 0;
+ gfc_free_array_spec (sym->as);
sym->as should probably be reset to NULL here.
Done.
Maybe both calls to gfc_free_array_spec here and to gfc_copy_array_spec
above can be avoided by doing a simple pointer copy?
I tried that, but this produced a crash with a double-free.
The attached revised version uses the above proven changes,
and extends the new testcase class_74.f90 by variations of
the failures remaining with version 1 so that different
codepaths are tested.
Regtested again on x86_64-pc-linux-gnu.
Any further comments?
Thanks for your very helpful review!
Harald
From 70cba7da18023282546b9a5d80e976fc3744d732 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Wed, 5 Oct 2022 22:25:14 +0200
Subject: [PATCH] Fortran: reject procedures and procedure pointers as IO
element [PR107074]
gcc/fortran/ChangeLog:
PR fortran/107074
* resolve.cc (resolve_transfer): A procedure, type-bound procedure
or a procedure pointer cannot be an element of an IO list.
* simplify.cc (gfc_simplify_merge): Do not try to reset array lower
bound for scalars.
gcc/testsuite/ChangeLog:
PR fortran/107074
* gfortran.dg/pr107074.f90: New test.
* gfortran.dg/pr107074b.f90: New test.
---
gcc/fortran/resolve.cc | 31 +++++++++++++++++++++++++
gcc/fortran/simplify.cc | 3 ++-
gcc/testsuite/gfortran.dg/pr107074.f90 | 11 +++++++++
gcc/testsuite/gfortran.dg/pr107074b.f90 | 18 ++++++++++++++
4 files changed, 62 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr107074.f90
create mode 100644 gcc/testsuite/gfortran.dg/pr107074b.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d133bc2d034..d9d101775f6 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10137,6 +10137,37 @@ resolve_transfer (gfc_code *code)
"an assumed-size array", &code->loc);
return;
}
+
+ /* Check for procedures and procedure pointers. Fortran 2018 has:
+
+ C1233 (R1217) An expression that is an output-item shall not have a
+ value that is a procedure pointer.
+
+ There does not appear any reason to allow procedure pointers for
+ input, so we disallow them generally, and we reject procedures. */
+
+ if (exp->expr_type == EXPR_VARIABLE)
+ {
+ /* Check for type-bound procedures. */
+ for (ref = exp->ref; ref; ref = ref->next)
+ if (ref->type == REF_COMPONENT
+ && ref->u.c.component->attr.flavor == FL_PROCEDURE)
+ break;
+
+ /* Procedure or procedure pointer? */
+ if (exp->ts.type == BT_PROCEDURE
+ || (ref && ref->u.c.component->attr.flavor == FL_PROCEDURE))
+ {
+ if (exp->symtree->n.sym->attr.proc_pointer
+ || (ref && ref->u.c.component->attr.proc_pointer))
+ gfc_error ("Data transfer element at %L cannot be a procedure "
+ "pointer", &code->loc);
+ else
+ gfc_error ("Data transfer element at %L cannot be a procedure",
+ &code->loc);
+ return;
+ }
+ }
}
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 6ac92cf9db8..f0482d349af 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -4915,7 +4915,8 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
{
result = gfc_copy_expr (mask->value.logical ? tsource : fsource);
/* Parenthesis is needed to get lower bounds of 1. */
- result = gfc_get_parentheses (result);
+ if (result->rank)
+ result = gfc_get_parentheses (result);
gfc_simplify_expr (result, 1);
return result;
}
diff --git a/gcc/testsuite/gfortran.dg/pr107074.f90 b/gcc/testsuite/gfortran.dg/pr107074.f90
new file mode 100644
index 00000000000..1363c285912
--- /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
diff --git a/gcc/testsuite/gfortran.dg/pr107074b.f90 b/gcc/testsuite/gfortran.dg/pr107074b.f90
new file mode 100644
index 00000000000..98c3fc0b90a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr107074b.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! Additional test for PR fortran/107074
+! Contributed by M.Morin
+
+program p
+ implicit none
+ type :: t
+ procedure(f), pointer, nopass :: b
+ end type t
+ type(t) :: a
+
+ interface
+ real function f()
+ end function f
+ end interface
+
+ print *, merge (a%b, a%b, .true.) ! { dg-error "procedure pointer" }
+end
--
2.35.3
