re PR fortran/34137 (Module function with ENTRY rejected)

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.

From-SVN: r130270

gcc/fortran/ChangeLog

@@ -1,3 +1,10 @@
+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-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	* trans-types.c (gfc_init_types): Use wider buffer.

gcc/fortran/primary.c

@@ -2525,8 +2525,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
 
     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.  */

gcc/fortran/resolve.c

@@ -284,8 +284,10 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
 {
   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.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2007-11-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34137
+	* gfortran.dg/entry_14.f90: New.
+	* gfortran.dg/entry_15.f90: New.
+
 2007-11-18  Richard Guenther  <rguenther@suse.de>
 
 	PR tree-optimization/34127

gcc/testsuite/gfortran.dg/entry_14.f90

@@ -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" } }

gcc/testsuite/gfortran.dg/entry_15.f90

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