From 86f0974ba6ff1bd2fca6c94ceabb269f1596fb4f Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 19 Nov 2007 12:30:17 +0000 Subject: [PATCH] 2007-11-19 Tobias Burnus PR fortran/34079 * decl.c (gfc_match_entry): Support BIND(C). (gfc_match_subroutine): Fix comment typo. 2007-11-19 Tobias Burnus PR fortran/34079 * gfortran.dg/bind_c_usage_10_c.c: New. * gfortran.dg/bind_c_usage_10.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130288 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/decl.c | 64 +++++++++++++++++++---- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 | 73 +++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c | 48 ++++++++++++++++++ 5 files changed, 188 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d8c11a5..dbd2c15 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-11-19 Tobias Burnus + + PR fortran/34079 + * decl.c (gfc_match_entry): Support BIND(C). + (gfc_match_subroutine): Fix comment typo. + 2007-11-18 Jerry DeLisle PR fortran/33317 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 8217c06..78b05c4 100644 --- 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 bf7d440..ae0adfb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-11-19 Tobias Burnus + + 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 * 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 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 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; +} -- 2.7.4