mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 14:51:06 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Tobias Burnus 2007-11-19 13:30:17 +01:00 committed by Tobias Burnus
parent 4aba7b1186
commit bc3e7a8cfc
5 changed files with 188 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

64
gcc/fortran/decl.c
View File

@ -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 ();

6
gcc/testsuite/ChangeLog
View File

@ -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.

73
gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 Normal file
View File

@ -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

48
gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c Normal file
View File

@ -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;
}