[Patch, Fortran] PR34137 ENTRY fixes: allow in modules, fix diagnostics

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

Hi all,

when trying to fix PR34079 (incl. ENTRY), I encountered first that
BIND(C) does not work for ENTRY and, secondly, some deficits in the
Fortran 95 support of ENTRY.


a) ENTRY was rejected in a module as the master function had no type.

Entry may not be used as internal procedure, but it is allowed as module
procedure. Or in words of the standard (F95/F2003):

Constraint: An entry-stmt may appear only in an external-subprogram or
module-subprogram. An entry-stmt shall not appear within an
executable-construct.

C1253 (R1235) An entry-stmt shall appear only in an external-subprogram
or module-subprogram. An entry-stmt shall not appear within an
executable-construct.


b) It was possible to assign to the ENTRY name, even if a RESULT was
specified. This lead to an ICE later on.

Build and regression tested on x86-64. OK for the trunk?

Tobias

PS: I find the following strange (decl.c):

      /* An entry in a function.
[...]
         m = match_result (proc, &result);

I wonder whether this should not be "match_result (entry, &result)"
instead? I tried both and they seem both to work. I will re-check this
part for BIND(C) support of ENTRY.

2007-11-18  Tobias Burnus  <burnus@net-b.de>

	PR fortran/34137
	* primary.c (match_variable): Reject non-result entry symbols.
	* resolve.c (resolve_contained_fntype): Do not check entry master
	functions.

2007-11-18  Tobias Burnus  <burnus@net-b.de>

	PR fortran/34137
	* gfortran.dg/entry_14.f90: New.
	* gfortran.dg/entry_15.f90: New.

Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 130267)
+++ gcc/fortran/primary.c	(working copy)
@@ -2525,8 +2525,7 @@ match_variable (gfc_expr **result, int e
 
     case FL_PROCEDURE:
       /* Check for a nonrecursive function result */
-      if (sym->attr.function && (sym->result == sym || sym->attr.entry)
-	  && !sym->attr.external)
+      if (sym->attr.function && sym->result == sym && !sym->attr.external)
 	{
 	  /* If a function result is a derived type, then the derived
 	     type may still have to be resolved.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 130267)
+++ gcc/fortran/resolve.c	(working copy)
@@ -284,8 +284,10 @@ resolve_contained_fntype (gfc_symbol *sy
 {
   try t;
 
-  /* If this namespace is not a function, ignore it.  */
-  if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE))
+  /* If this namespace is not a function or an entry master function,
+     ignore it.  */
+  if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE)
+      || sym->attr.entry_master)
     return;
 
   /* Try to find out of what the return type is.  */
Index: gcc/testsuite/gfortran.dg/entry_14.f90
===================================================================
--- gcc/testsuite/gfortran.dg/entry_14.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/entry_14.f90	(revision 0)
@@ -0,0 +1,103 @@
+! { dg-do run }
+! 
+! PR fortran/34137
+!
+! Entry was previously not possible in a module.
+! Checks also whether the different result combinations
+! work properly.
+!
+module m1
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: ent
+  func = a*4
+  return
+entry ent(a)
+  ent = -a*2.0
+  return
+end function func
+end module m1
+
+module m2
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: func2
+  func = a*8
+  return
+entry ent(a) result(func2)
+  func2 = -a*4.0
+  return
+end function func
+end module m2
+
+module m3
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: func2
+  res = a*12
+  return
+entry ent(a) result(func2)
+  func2 = -a*6.0
+  return
+end function func
+end module m3
+
+
+module m4
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: ent
+  res = a*16
+  return
+entry ent(a)
+  ent = -a*8.0
+  return
+end function func
+end module m4
+
+program main
+  implicit none
+  call test1()
+  call test2()
+  call test3()
+  call test4()
+contains
+  subroutine test1()
+    use m1
+    implicit none
+    if(func(3) /= 12) call abort()
+    if(abs(ent(7) + 14.0) > tiny(1.0)) call abort()
+  end subroutine test1
+  subroutine test2()
+    use m2
+    implicit none
+    if(func(9) /= 72) call abort()
+    if(abs(ent(11) + 44.0) > tiny(1.0)) call abort()
+  end subroutine test2
+  subroutine test3()
+    use m3
+    implicit none
+    if(func(13) /= 156) call abort()
+    if(abs(ent(17) + 102.0) > tiny(1.0)) call abort()
+  end subroutine test3
+  subroutine test4()
+    use m4
+    implicit none
+    if(func(23) /= 368) call abort()
+    if(abs(ent(27) + 216.0) > tiny(1.0)) call abort()
+  end subroutine test4
+end program main
+
+! { dg-final { cleanup-modules "m1 m2 m3 m4" } }
Index: gcc/testsuite/gfortran.dg/entry_15.f90
===================================================================
--- gcc/testsuite/gfortran.dg/entry_15.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/entry_15.f90	(revision 0)
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! 
+! PR fortran/34137
+!
+! Entry was previously not possible in a module.
+! Checks also whether the different result combinations
+! work properly.
+!
+module m2
+  implicit none
+contains
+function func(a)
+  implicit none
+  integer :: a, func
+  real :: func2
+  func = a*8
+  return
+entry ent(a) result(func2)
+  ent = -a*4.0 ! { dg-error "Expected VARIABLE" }
+  return
+end function func
+end module m2
+
+module m3
+  implicit none
+contains
+function func(a) result(res)
+  implicit none
+  integer :: a, res
+  real :: func2
+  res = a*12
+  return
+entry ent(a) result(func2)
+  ent = -a*6.0 ! { dg-error "Expected VARIABLE" }
+  return
+end function func
+end module m3