diff mbox series

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

Message ID trinity-101ecbef-9191-4532-b100-478605966705-1681243959761@3c-app-gmx-bs42
State New
Headers
Series Fortran: fix functions with entry and pointer/allocatable result [PR104312] |

Commit Message

Harald Anlauf April 11, 2023, 8:12 p.m. UTC 
  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

Comments

Paul Richard Thomas April 12, 2023, 6:56 a.m. UTC | #1 
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
>
>
diff mbox series

Patch

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