re PR fortran/34133 (Bind(c,name="") should be rejected for dummies; F2008:…

re PR fortran/34133 (Bind(c,name="") should be rejected for dummies; F2008: allow bind(c) for internal procs)

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

        PR fortran/34133
        * decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow
        bind(c) attribute for internal procedures.

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

        PR fortran/34133
        * gfortran.dg/bind_c_usage_9.f03: New.
        * gfortran.dg/interface_abstract_1.f90: Fix testcase.

From-SVN: r130260

gcc/fortran/ChangeLog

+2007-11-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34133
+	* decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow
+	bind(c) attribute for internal procedures.
+
 2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/25252

gcc/fortran/decl.c

@@ -3895,9 +3895,18 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
     }
 
   if (is_bind_c == MATCH_YES)
-    if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
-        == FAILURE)
-      return MATCH_ERROR;
+    {
+      if (gfc_current_state () == COMP_CONTAINS
+	  && sym->ns->proc_name->attr.flavor != FL_MODULE)
+	{
+          gfc_error ("BIND(C) attribute at %L may not be specified for an "
+		     "internal procedure", &gfc_current_locus);
+	  return MATCH_ERROR;
+	}
+      if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
+	  == FAILURE)
+     	return MATCH_ERROR;
+    }
   
   return found_match;
 }
@@ -4553,6 +4562,13 @@ gfc_match_subroutine (void)
 
   if (is_bind_c == MATCH_YES)
     {
+      if (gfc_current_state () == COMP_CONTAINS
+	  && sym->ns->proc_name->attr.flavor != FL_MODULE)
+	{
+          gfc_error ("BIND(C) attribute at %L may not be specified for an "
+		     "internal procedure", &gfc_current_locus);
+	  return MATCH_ERROR;
+	}
       if (peek_char != '(')
         {
           gfc_error ("Missing required parentheses before BIND(C) at %C");

gcc/testsuite/ChangeLog

+2007-11-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34133
+	* gfortran.dg/bind_c_usage_9.f03: New.
+	* gfortran.dg/interface_abstract_1.f90: Fix testcase.
+
 2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/25252

gcc/testsuite/gfortran.dg/bind_c_usage_9.f03

+! { dg-do compile }
+! PR fortran/34133
+!
+! The compiler should reject internal procedures with BIND(c) attribute.
+!
+subroutine foo() bind(c)
+contains
+  subroutine bar() bind (c) ! { dg-error "may not be specified for an internal" }
+  end subroutine bar ! { dg-error "Expected label" }
+end subroutine foo ! { dg-warning "Extension: CONTAINS statement" }
+
+subroutine foo2() bind(c)
+  use iso_c_binding
+contains
+  integer(c_int) function barbar() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function barbar ! { dg-error "Expecting END SUBROUTINE" }
+end subroutine foo2 ! { dg-warning "Extension: CONTAINS statement" }
+
+function one() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one
+  one = 1
+contains
+  integer(c_int) function two() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function two ! { dg-error "Expected label" }
+end function one ! { dg-warning "Extension: CONTAINS statement" }
+
+function one2() bind(c)
+  use iso_c_binding
+  integer(c_int) :: one2
+  one2 = 1
+contains
+  subroutine three() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function three ! { dg-error "Expected label" }
+end function one2 ! { dg-warning "Extension: CONTAINS statement" }
+
+program main
+  use iso_c_binding
+  implicit none
+contains
+  subroutine test() bind(c) ! { dg-error "may not be specified for an internal" }
+  end subroutine test ! { dg-error "Expecting END PROGRAM" }
+  function test2() bind (c) ! { dg-error "may not be specified for an internal" }
+  end function test2  ! { dg-error "Expecting END PROGRAM" }
+end program main ! { dg-warning "Extension: CONTAINS statement" }

gcc/testsuite/gfortran.dg/interface_abstract_1.f90

 ! { dg-do compile }
 !
+module mod_interf_abstract
 implicit none
 abstract interface :: one ! { dg-error "Syntax error in ABSTRACT INTERFACE statement" }
-end interface ! { dg-error "Expecting END PROGRAM statement" }
+end interface ! { dg-error "Expecting END MODULE statement" }
 
 abstract interface
   subroutine two() bind(C)
@@ -18,4 +19,4 @@ contains
   subroutine sub() bind(C,name="subC")
   end subroutine
 
-end
+end module mod_interf_abstract