[PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312]

[PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312]

[Harald Anlauf]

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

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr104312.diff --]
[-- Type: text/x-patch, Size: 7527 bytes --]

From 60e81b97cf3715347de30ed4fd579be54fdb1997 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@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

Re: [PATCH] Fortran: fix functions with entry and pointer/allocatable result [PR104312]

[Paul Richard Thomas]

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

Hi Harald,

The patch looks good to me - OK for mainline.

Thanks

Paul


On Tue, 11 Apr 2023 at 21:12, Harald Anlauf via Fortran <fortran@gcc.gnu.org>
wrote:

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

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