Dear all,
the testcase in the PR by Gerhard exhibited a mis-treatment of
the function decl of the entry master if the function result
had a pointer attribute and the translation unit was compiled
with -ff2c. We actually should not use the peculiar special
treatment for default-real functions in that case, as -ff2c is
reserved for function results that can be expressed in Fortran77,
and POINTER was not allowed in that standard. Same for complex.
Furthermore, it turned out that ALLOCATABLE function results
were not yet handled for functions with entries, even without
-ff2c. Adding support for this was straightforward.
I also fixed a potential buffer overflow for a generated
internal symbol.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 60e81b97cf3715347de30ed4fd579be54fdb1997 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 11 Apr 2023 21:44:20 +0200
Subject: [PATCH] Fortran: fix functions with entry and pointer/allocatable
result [PR104312]
gcc/fortran/ChangeLog:
PR fortran/104312
* resolve.cc (resolve_entries): Handle functions with ENTRY and
ALLOCATABLE results.
* trans-expr.cc (gfc_conv_procedure_call): Functions with a result
with the POINTER or ALLOCATABLE attribute shall not get any special
treatment with -ff2c, as they cannot be written in Fortran 77.
* trans-types.cc (gfc_return_by_reference): Likewise.
(gfc_get_function_type): Likewise.
gcc/testsuite/ChangeLog:
PR fortran/104312
* gfortran.dg/entry_26.f90: New test.
* gfortran.dg/entry_27.f90: New test.
---
gcc/fortran/resolve.cc | 19 +++++++-
gcc/fortran/trans-expr.cc | 2 +
gcc/fortran/trans-types.cc | 4 ++
gcc/testsuite/gfortran.dg/entry_26.f90 | 64 ++++++++++++++++++++++++++
gcc/testsuite/gfortran.dg/entry_27.f90 | 64 ++++++++++++++++++++++++++
5 files changed, 152 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/entry_26.f90
create mode 100644 gcc/testsuite/gfortran.dg/entry_27.f90
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 6e42397c2ea..58013d48dff 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -702,7 +702,8 @@ resolve_entries (gfc_namespace *ns)
gfc_code *c;
gfc_symbol *proc;
gfc_entry_list *el;
- char name[GFC_MAX_SYMBOL_LEN + 1];
+ /* Provide sufficient space to hold "master.%d.%s". */
+ char name[GFC_MAX_SYMBOL_LEN + 1 + 18];
static int master_count = 0;
if (ns->proc_name == NULL)
@@ -827,6 +828,9 @@ resolve_entries (gfc_namespace *ns)
"entries returning variables of different "
"string lengths", ns->entries->sym->name,
&ns->entries->sym->declared_at);
+ else if (el->sym->result->attr.allocatable
+ != ns->entries->sym->result->attr.allocatable)
+ break;
}
if (el == NULL)
@@ -838,6 +842,8 @@ resolve_entries (gfc_namespace *ns)
gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL);
if (sym->attr.pointer)
gfc_add_pointer (&proc->attr, NULL);
+ if (sym->attr.allocatable)
+ gfc_add_allocatable (&proc->attr, NULL);
}
else
{
@@ -869,6 +875,17 @@ resolve_entries (gfc_namespace *ns)
"FUNCTION %s at %L", sym->name,
ns->entries->sym->name, &sym->declared_at);
}
+ else if (sym->attr.allocatable)
+ {
+ if (el == ns->entries)
+ gfc_error ("FUNCTION result %s cannot be ALLOCATABLE in "
+ "FUNCTION %s at %L", sym->name,
+ ns->entries->sym->name, &sym->declared_at);
+ else
+ gfc_error ("ENTRY result %s cannot be ALLOCATABLE in "
+ "FUNCTION %s at %L", sym->name,
+ ns->entries->sym->name, &sym->declared_at);
+ }
else
{
ts = &sym->ts;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f052d6b9440..79367fa2ae0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -7800,6 +7800,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
*/
if (flag_f2c && sym->ts.type == BT_REAL
&& sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.pointer
+ && !sym->attr.allocatable
&& !sym->attr.always_explicit)
se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 9c9489a42bd..fc5c221a301 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2962,6 +2962,8 @@ gfc_return_by_reference (gfc_symbol * sym)
require an explicit interface, as no compatibility problems can
arise there. */
if (flag_f2c && sym->ts.type == BT_COMPLEX
+ && !sym->attr.pointer
+ && !sym->attr.allocatable
&& !sym->attr.intrinsic && !sym->attr.always_explicit)
return 1;
@@ -3273,6 +3275,8 @@ arg_type_list_done:
type = gfc_get_mixed_entry_union (sym->ns);
else if (flag_f2c && sym->ts.type == BT_REAL
&& sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.pointer
+ && !sym->attr.allocatable
&& !sym->attr.always_explicit)
{
/* Special case: f2c calling conventions require that (scalar)
diff --git a/gcc/testsuite/gfortran.dg/entry_26.f90 b/gcc/testsuite/gfortran.dg/entry_26.f90
new file mode 100644
index 00000000000..018aedc7854
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_26.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-additional-options "-fno-f2c" }
+!
+! PR fortran/104312 - ICE in fold_convert_loc with entry, -ff2c: control
+! Contributed by G.Steinmetz
+
+module m
+ implicit none
+contains
+ function f()
+ real, pointer :: f, e
+ real, target :: a(2) = [1,2]
+ f => a(1)
+ return
+ entry e()
+ e => a(2)
+ end
+ function g()
+ complex, pointer :: g,h
+ complex, target :: a(2) = [3,4]
+ g => a(1)
+ return
+ entry h()
+ h => a(2)
+ end
+ function f3()
+ real, allocatable :: f3, e3
+ allocate (f3, source=1.0)
+ return
+ entry e3()
+ allocate (e3, source=2.0)
+ end
+ function g3()
+ complex, allocatable :: g3, h3
+ allocate (g3, source=(3.0,0.0))
+ return
+ entry h3()
+ allocate (h3, source=(4.0,0.0))
+ end
+end
+
+program p
+ use m
+ real, pointer :: x
+ complex, pointer :: c
+ real :: y
+ complex :: d
+ x => f()
+ if (x /= 1.0) stop 1
+ x => e()
+ if (x /= 2.0) stop 2
+ c => g()
+ if (c /= (3.0,0.0)) stop 3
+ c => h()
+ if (c /= (4.0,0.0)) stop 4
+ y = f3()
+ if (y /= 1.0) stop 5
+ y = e3()
+ if (y /= 2.0) stop 6
+ d = g3()
+ if (d /= (3.0,0.0)) stop 7
+ d = h3()
+ if (d /= (4.0,0.0)) stop 8
+end
diff --git a/gcc/testsuite/gfortran.dg/entry_27.f90 b/gcc/testsuite/gfortran.dg/entry_27.f90
new file mode 100644
index 00000000000..f1e28fda935
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_27.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-additional-options "-ff2c" }
+!
+! PR fortran/104312 - ICE in fold_convert_loc with entry, -ff2c: test
+! Contributed by G.Steinmetz
+
+module m
+ implicit none
+contains
+ function f()
+ real, pointer :: f, e
+ real, target :: a(2) = [1,2]
+ f => a(1)
+ return
+ entry e()
+ e => a(2)
+ end
+ function g()
+ complex, pointer :: g,h
+ complex, target :: a(2) = [3,4]
+ g => a(1)
+ return
+ entry h()
+ h => a(2)
+ end
+ function f3()
+ real, allocatable :: f3, e3
+ allocate (f3, source=1.0)
+ return
+ entry e3()
+ allocate (e3, source=2.0)
+ end
+ function g3()
+ complex, allocatable :: g3, h3
+ allocate (g3, source=(3.0,0.0))
+ return
+ entry h3()
+ allocate (h3, source=(4.0,0.0))
+ end
+end
+
+program p
+ use m
+ real, pointer :: x
+ complex, pointer :: c
+ real :: y
+ complex :: d
+ x => f()
+ if (x /= 1.0) stop 1
+ x => e()
+ if (x /= 2.0) stop 2
+ c => g()
+ if (c /= (3.0,0.0)) stop 3
+ c => h()
+ if (c /= (4.0,0.0)) stop 4
+ y = f3()
+ if (y /= 1.0) stop 5
+ y = e3()
+ if (y /= 2.0) stop 6
+ d = g3()
+ if (d /= (3.0,0.0)) stop 7
+ d = h3()
+ if (d /= (4.0,0.0)) stop 8
+end
--
2.35.3
