Fortran - reject function entries with mismatched characteristics

gcc/fortran/ChangeLog:

	PR fortran/87737
	* resolve.c (resolve_entries): For functions of type CHARACTER
	tighten the checks for matching characteristics.

gcc/testsuite/ChangeLog:

	PR fortran/87737
	* gfortran.dg/entry_24.f90: New test.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5b9ba43780e54dea2ad5bf8dfe152ec2c5e90aa9..f641d0d4dae01e1f00d58911b1e58a719bda7a38 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -804,6 +804,15 @@ resolve_entries (gfc_namespace *ns)
             the same string length, i.e. both len=*, or both len=4.
             Having both len=<variable> is also possible, but difficult to
             check at compile time.  */
+         else if (ts->type == BT_CHARACTER
+                  && (el->sym->result->attr.allocatable
+                      != ns->entries->sym->result->attr.allocatable))
+           {
+             gfc_error ("Function %s at %L has entry %s with mismatched "
+                        "characteristics", ns->entries->sym->name,
+                        &ns->entries->sym->declared_at, el->sym->name);
+             return;
+           }
          else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
                   && (((ts->u.cl->length && !fts->u.cl->length)
                        ||(!ts->u.cl->length && fts->u.cl->length))

diff --git a/gcc/testsuite/gfortran.dg/entry_24.f90 b/gcc/testsuite/gfortran.dg/entry_24.f90
new file mode 100644 (file)
index 0000000..9773597
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_24.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! PR fortran/87737 - improve check on function entry characteristics
+
+function f() ! { dg-error "mismatched characteristics" }
+  character(:), allocatable :: f
+  character(1)              :: g
+  f = 'f'
+  return
+entry g()
+  g = 'g'
+end
+
+function f2() ! { dg-error "mismatched characteristics" }
+  character(1)              :: f2
+  character(1), allocatable :: g2
+  f2 = 'f'
+  return
+entry g2()
+  g2 = 'g'
+end