This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR34079 - Bind(C) support for ENTRY
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 18 Nov 2007 17:54:32 +0100
- Subject: [Patch, Fortran] PR34079 - Bind(C) support for ENTRY
:ADDPATCH fortran:
Fortran 2003 allows also to specify BIND(C) for ENTRY:
R1235 entry-stmt is ENTRY entry-name [ ( [ dummy-arg-list ] ) [ suffix ] ]
R1229 suffix is proc-language-binding-spec [ RESULT ( result-name ) ]
or RESULT ( result-name ) [ proc-language-binding-spec
This adds support for this.
Build and regtested on x86-64. OK for the trunk?
Tobias
2007-11-18 Tobias Burnus <burnus@net-b.de>
PR fortran/34079
* decl.c (gfc_match_entry): Support BIND(C).
2007-11-18 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.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (Revision 130267)
+++ gcc/fortran/decl.c (Arbeitskopie)
@@ -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
+ where 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;
+ }
}
}
Index: gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
===================================================================
--- gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c (Revision 0)
+++ gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c (Revision 0)
@@ -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;
+}
Index: gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
===================================================================
--- gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 (Revision 0)
+++ gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 (Revision 0)
@@ -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