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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130260 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4ed0421..b12355c 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
 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 325d012..8217c06 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 (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;
 }
   
   return found_match;
 }


@@ -4553,6 +4562,13 @@ gfc_match_subroutine (void)
 
   if (is_bind_c == MATCH_YES)
     {
 
   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");
       if (peek_char != '(')
         {
           gfc_error ("Missing required parentheses before BIND(C) at %C");

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8fce122..fcf6395 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
 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 ab816bf..3b2934f 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 }
 !
 ! { dg-do compile }
 !

+module mod_interf_abstract

 implicit none
 abstract interface :: one ! { dg-error "Syntax error in ABSTRACT INTERFACE statement" }
 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)
 
 abstract interface
   subroutine two() bind(C)


@@ -18,4 +19,4 @@ contains
   subroutine sub() bind(C,name="subC")
   end subroutine
 
   subroutine sub() bind(C,name="subC")
   end subroutine
 

-end
+end module mod_interf_abstract