re PR fortran/34079 (Bind(C): Character argument/return value problems)

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

        PR fortran/34079
        * decl.c (gfc_match_entry): Support BIND(C).
        (gfc_match_subroutine): Fix comment typo.

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

        PR fortran/34079
        * gfortran.dg/bind_c_usage_10_c.c: New.
        * gfortran.dg/bind_c_usage_10.f03: New.

From-SVN: r130288

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d8c11a543827faccbea3510544ab971baff47f40..dbd2c15feac986073dd90ad36d899209f1774aea 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-11-19  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34079
+       * decl.c (gfc_match_entry): Support BIND(C).
+       (gfc_match_subroutine): Fix comment typo.
+
 2007-11-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/33317

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8217c06399f257fca917eeed22afdcd7f1d19a9e..78b05c4af1e475e7f486261a720accb343e77c82 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4315,6 +4315,8 @@ gfc_match_entry (void)
   gfc_entry_list *el;
   locus old_loc;
   bool module_procedure;
+  char peek_char;
+  match is_bind_c;
 
   m = gfc_match_name (name);
   if (m != MATCH_YES)
@@ -4398,6 +4400,26 @@ gfc_match_entry (void)
 
   proc = gfc_current_block ();
 
+  /* Make sure that it isn't already declared as BIND(C).  If it is, it
+     must have been marked BIND(C) with a BIND(C) attribute and that is
+     not allowed for procedures.  */
+  if (entry->attr.is_bind_c == 1)
+    {
+      entry->attr.is_bind_c = 0;
+      if (entry->old_symbol != NULL)
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks",
+                       &(entry->old_symbol->declared_at));
+      else
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks", &gfc_current_locus);
+    }
+  
+  /* Check what next non-whitespace character is so we can tell if there
+     is the required parens if we have a BIND(C).  */
+  gfc_gobble_whitespace ();
+  peek_char = gfc_peek_char ();
+
   if (state == COMP_SUBROUTINE)
     {
       /* An entry in a subroutine.  */
@@ -4408,6 +4430,21 @@ gfc_match_entry (void)
       if (m != MATCH_YES)
        return MATCH_ERROR;
 
+      is_bind_c = gfc_match_bind_c (entry);
+      if (is_bind_c == MATCH_ERROR)
+       return MATCH_ERROR;
+      if (is_bind_c == MATCH_YES)
+       {
+         if (peek_char != '(')
+           {
+             gfc_error ("Missing required parentheses before BIND(C) at %C");
+             return MATCH_ERROR;
+           }
+           if (gfc_add_is_bind_c (&(entry->attr), entry->name, &(entry->declared_at), 1)
+               == FAILURE)
+             return MATCH_ERROR;
+       }
+
       if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
          || gfc_add_subroutine (&entry->attr, entry->name, NULL) == FAILURE)
        return MATCH_ERROR;
@@ -4452,19 +4489,28 @@ gfc_match_entry (void)
        }
       else
        {
-         m = match_result (proc, &result);
+         m = gfc_match_suffix (entry, &result);
          if (m == MATCH_NO)
            gfc_syntax_error (ST_ENTRY);
          if (m != MATCH_YES)
            return MATCH_ERROR;
 
-         if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
-             || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
-             || gfc_add_function (&entry->attr, result->name, NULL)
-                == FAILURE)
-           return MATCH_ERROR;
-
-         entry->result = result;
+          if (result)
+           {
+             if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
+                 || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
+                 || gfc_add_function (&entry->attr, result->name, NULL)
+                 == FAILURE)
+               return MATCH_ERROR;
+             entry->result = result;
+           }
+         else
+           {
+             if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+                 || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
+               return MATCH_ERROR;
+             entry->result = entry;
+           }
        }
     }
 
@@ -4523,7 +4569,7 @@ gfc_match_subroutine (void)
   gfc_new_block = sym;
 
   /* Check what next non-whitespace character is so we can tell if there
-     where the required parens if we have a BIND(C).  */
+     is the required parens if we have a BIND(C).  */
   gfc_gobble_whitespace ();
   peek_char = gfc_peek_char ();
   

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bf7d440b363510b4befbe1fddab3277eb534eec7..ae0adfb5671bc61702e3755078a64280c9591e77 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-11-19  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34079
+       * gfortran.dg/bind_c_usage_10_c.c: New.
+       * gfortran.dg/bind_c_usage_10.f03: New.
+
 2007-11-19  Eric Botcazou  <ebotcazou@libertysurf.fr>
 
        * gcc.dg/pr33007.c: Expect new warning.

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
new file mode 100644 (file)
index 0000000..c6f2b79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
@@ -0,0 +1,73 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_10_c.c }
+!
+! PR fortran/34079
+!
+! Check BIND(C) for ENTRY
+!
+module mod
+ use iso_c_binding
+ implicit none
+contains
+  subroutine sub1(j) bind(c, name="mySub1")
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 5
+    return
+   entry sub1ent(x)
+     x = 55.0
+  end subroutine sub1
+  subroutine sub2(j)
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 6
+    return
+   entry sub2ent(x) bind(c, name="mySubEnt2")
+    x = 66.0
+  end subroutine sub2
+  subroutine sub3(j) bind(c, name="mySub3")
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 7
+    return
+   entry sub3ent(x) bind(c, name="mySubEnt3")
+     x = 77.0
+  end subroutine sub3
+  subroutine sub4(j)
+    integer(c_int) :: j
+    real(c_float)  :: x
+    j = 8
+    return
+   entry sub4ent(x) bind(c)
+     x = 88.0
+  end subroutine sub4
+
+  integer(c_int) function func1() bind(c, name="myFunc1")
+    real(c_float) :: func1ent
+    func1 = -5
+    return
+   entry func1ent()
+    func1ent = -55.0
+  end function func1
+  integer(c_int) function func2()
+    real(c_float) :: func2ent
+    func2 = -6
+    return
+   entry func2ent() bind(c, name="myFuncEnt2")
+    func2ent = -66.0
+  end function func2
+  integer(c_int) function func3() bind(c, name="myFunc3")
+    real(c_float) :: func3ent
+    func3 = -7
+    return
+   entry func3ent() bind(c, name="myFuncEnt3")
+    func3ent = -77.0
+  end function func3
+  integer(c_int) function func4()
+    real(c_float) :: func4ent
+    func4 = -8
+    return
+   entry func4ent() bind(c)
+    func4ent = -88.0
+  end function func4
+end module mod

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
new file mode 100644 (file)
index 0000000..91871c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
@@ -0,0 +1,48 @@
+/* Check BIND(C) for ENTRY
+   PR fortran/34079
+   To be linked with bind_c_usage_10.c
+*/
+
+void mySub1(int *);
+void mySub3(int *);
+void mySubEnt2(float *);
+void mySubEnt3(float *);
+void sub4ent(float *);
+
+int myFunc1(void);
+int myFunc3(void);
+float myFuncEnt2(void);
+float myFuncEnt3(void);
+float func4ent(void);
+
+extern void abort(void);
+
+int main()
+{
+  int i = -1;
+  float r = -3.0f;
+
+  mySub1(&i);
+  if(i != 5) abort();
+  mySub3(&i);
+  if(i != 7) abort();
+  mySubEnt2(&r);
+  if(r != 66.0f) abort();
+  mySubEnt3(&r);
+  if(r != 77.0f) abort();
+  sub4ent(&r);
+  if(r != 88.0f) abort();
+
+  i = myFunc1();
+  if(i != -5) abort();
+  i = myFunc3();
+  if(i != -7) abort();
+  r = myFuncEnt2();
+  if(r != -66.0f) abort();
+  r = myFuncEnt3();
+  if(r != -77.0f) abort();
+  r = func4ent();
+  if(r != -88.0f) abort();
+
+  return 0;
+}