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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4ed0421e4dcf33aa9a14d502fcd4e19da1a20ebc..b12355c729e5900e4d5ad034d7d59b046eb30375 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 325d012e476f15474629f9fa0197b4cb2f201831..8217c06399f257fca917eeed22afdcd7f1d19a9e 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/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");

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8fce1223608fbc573c7147d46d15820c1eeae1e4..fcf6395b4b98477b82eeac188d1304590defe9a2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
new file mode 100644 (file)
index 0000000..f8682e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_9.f03
@@ -0,0 +1,45 @@
+! { 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" }

diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
index ab816bff7a147dcef175ec4909ee09c26c5a7074..3b2934fd1cfe6bdfb3fca5cd2e492c6271cc927c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
@@ -1,8 +1,9 @@
 ! { 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