Commit 51992f15 by Steven G. Kargl

re PR fortran/89943 (Submodule functions are not allowed to have C binding)

2019-10-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89943
	decl.c (gfc_match_function_decl): Ignore duplicate BIND(C) for function
	declaration in submodule.  Implement at check for F2018 C1550.
	(gfc_match_entry): Use temporary for locus, which allows removal of
	one gfc_error_now().
	(gfc_match_subroutine): Ignore duplicate BIND(C) for subroutine
	declaration in submodule.  Implement at check for F2018 C1550.

2019-10-14  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89943
	* gfortran.dg/pr89943_1.f90: New test.
	* gfortran.dg/pr89943_2.f90: Ditto.
	* gfortran.dg/pr89943_3.f90: Ditto.
	* gfortran.dg/pr89943_4.f90: Ditto.

From-SVN: r276983
parent 23605fec
2019-10-14 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/89943
decl.c (gfc_match_function_decl): Ignore duplicate BIND(C) for function
declaration in submodule. Implement at check for F2018 C1550.
(gfc_match_entry): Use temporary for locus, which allows removal of
one gfc_error_now().
(gfc_match_subroutine): Ignore duplicate BIND(C) for subroutine
declaration in submodule. Implement at check for F2018 C1550.
2019-10-14 Thomas Koenig <tkoenig@gcc.gnu.org> 2019-10-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92004 PR fortran/92004
......
...@@ -7263,13 +7263,16 @@ gfc_match_function_decl (void) ...@@ -7263,13 +7263,16 @@ gfc_match_function_decl (void)
if (sym->attr.is_bind_c == 1) if (sym->attr.is_bind_c == 1)
{ {
sym->attr.is_bind_c = 0; sym->attr.is_bind_c = 0;
if (sym->old_symbol != NULL)
gfc_error_now ("BIND(C) attribute at %L can only be used for " if (gfc_state_stack->previous
"variables or common blocks", && gfc_state_stack->previous->state != COMP_SUBMODULE)
&(sym->old_symbol->declared_at)); {
else locus loc;
gfc_error_now ("BIND(C) attribute at %L can only be used for " loc = sym->old_symbol != NULL
"variables or common blocks", &gfc_current_locus); ? sym->old_symbol->declared_at : gfc_current_locus;
gfc_error_now ("BIND(C) attribute at %L can only be used for "
"variables or common blocks", &loc);
}
} }
if (found_match != MATCH_YES) if (found_match != MATCH_YES)
...@@ -7283,6 +7286,24 @@ gfc_match_function_decl (void) ...@@ -7283,6 +7286,24 @@ gfc_match_function_decl (void)
found_match = suffix_match; found_match = suffix_match;
} }
/* F2018 C1550 (R1526) If MODULE appears in the prefix of a module
subprogram and a binding label is specified, it shall be the
same as the binding label specified in the corresponding module
procedure interface body. */
if (sym->attr.is_bind_c && sym->attr.module_procedure && sym->old_symbol
&& strcmp (sym->name, sym->old_symbol->name) == 0
&& strcmp (sym->binding_label, sym->old_symbol->binding_label) != 0)
{
const char *null = "NULL", *s1, *s2;
s1 = sym->binding_label;
if (!s1) s1 = null;
s2 = sym->old_symbol->binding_label;
if (!s2) s2 = null;
gfc_error ("Mismatch in BIND(C) names (%qs/%qs) at %C", s1, s2);
sym->refs++; /* Needed to avoid an ICE in gfc_release_symbol */
return MATCH_ERROR;
}
if(found_match != MATCH_YES) if(found_match != MATCH_YES)
m = MATCH_ERROR; m = MATCH_ERROR;
else else
...@@ -7521,15 +7542,15 @@ gfc_match_entry (void) ...@@ -7521,15 +7542,15 @@ gfc_match_entry (void)
not allowed for procedures. */ not allowed for procedures. */
if (entry->attr.is_bind_c == 1) if (entry->attr.is_bind_c == 1)
{ {
locus loc;
entry->attr.is_bind_c = 0; entry->attr.is_bind_c = 0;
if (entry->old_symbol != NULL)
gfc_error_now ("BIND(C) attribute at %L can only be used for " loc = entry->old_symbol != NULL
"variables or common blocks", ? entry->old_symbol->declared_at : gfc_current_locus;
&(entry->old_symbol->declared_at)); gfc_error_now ("BIND(C) attribute at %L can only be used for "
else "variables or common blocks", &loc);
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 /* Check what next non-whitespace character is so we can tell if there
is the required parens if we have a BIND(C). */ is the required parens if we have a BIND(C). */
...@@ -7729,13 +7750,16 @@ gfc_match_subroutine (void) ...@@ -7729,13 +7750,16 @@ gfc_match_subroutine (void)
if (sym->attr.is_bind_c == 1) if (sym->attr.is_bind_c == 1)
{ {
sym->attr.is_bind_c = 0; sym->attr.is_bind_c = 0;
if (sym->old_symbol != NULL)
gfc_error_now ("BIND(C) attribute at %L can only be used for " if (gfc_state_stack->previous
"variables or common blocks", && gfc_state_stack->previous->state != COMP_SUBMODULE)
&(sym->old_symbol->declared_at)); {
else locus loc;
gfc_error_now ("BIND(C) attribute at %L can only be used for " loc = sym->old_symbol != NULL
"variables or common blocks", &gfc_current_locus); ? sym->old_symbol->declared_at : gfc_current_locus;
gfc_error_now ("BIND(C) attribute at %L can only be used for "
"variables or common blocks", &loc);
}
} }
/* C binding names are not allowed for internal procedures. */ /* C binding names are not allowed for internal procedures. */
...@@ -7777,6 +7801,24 @@ gfc_match_subroutine (void) ...@@ -7777,6 +7801,24 @@ gfc_match_subroutine (void)
return MATCH_ERROR; return MATCH_ERROR;
} }
/* F2018 C1550 (R1526) If MODULE appears in the prefix of a module
subprogram and a binding label is specified, it shall be the
same as the binding label specified in the corresponding module
procedure interface body. */
if (sym->attr.module_procedure && sym->old_symbol
&& strcmp (sym->name, sym->old_symbol->name) == 0
&& strcmp (sym->binding_label, sym->old_symbol->binding_label) != 0)
{
const char *null = "NULL", *s1, *s2;
s1 = sym->binding_label;
if (!s1) s1 = null;
s2 = sym->old_symbol->binding_label;
if (!s2) s2 = null;
gfc_error ("Mismatch in BIND(C) names (%qs/%qs) at %C", s1, s2);
sym->refs++; /* Needed to avoid an ICE in gfc_release_symbol */
return MATCH_ERROR;
}
/* Scan the dummy arguments for an alternate return. */ /* Scan the dummy arguments for an alternate return. */
for (arg = sym->formal; arg; arg = arg->next) for (arg = sym->formal; arg; arg = arg->next)
if (!arg->sym) if (!arg->sym)
......
2019-10-14 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/89943
* gfortran.dg/pr89943_1.f90: New test.
* gfortran.dg/pr89943_2.f90: Ditto.
* gfortran.dg/pr89943_3.f90: Ditto.
* gfortran.dg/pr89943_4.f90: Ditto.
2019-10-14 Thomas Koenig <tkoenig@gcc.gnu.org> 2019-10-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92004 PR fortran/92004
......
! { dg-do compile }
! PR fortran/89943
! Code contributed by Alberto Luaces <aluaces at udc dot se>
module Foo_mod
implicit none
interface
module subroutine runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer(c_int32_t) , intent(in) :: ndim
end subroutine runFoo4C
end interface
contains
end module Foo_mod
submodule(Foo_mod) Foo_smod
contains
module subroutine runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer(c_int32_t) , intent(in) :: ndim
end subroutine runFoo4C
end submodule Foo_smod
! { dg-do compile }
! PR fortran/89943
! Code contributed by Alberto Luaces <aluaces at udc dot se>
module Foo_mod
implicit none
interface
module function runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer runFoo4c
integer(c_int32_t) , intent(in) :: ndim
end function runFoo4C
end interface
contains
end module Foo_mod
submodule(Foo_mod) Foo_smod
contains
module function runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer runFoo4c
integer(c_int32_t) , intent(in) :: ndim
end function runFoo4C
end submodule Foo_smod
! { dg-do compile }
module Foo_mod
implicit none
interface
module subroutine runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer(c_int32_t) , intent(in) :: ndim
end subroutine runFoo4C
end interface
contains
end module Foo_mod
submodule(Foo_mod) Foo_smod
contains
module subroutine runFoo4C(ndim) bind(C, name="runFu") ! { dg-error "Mismatch in BIND" }
use, intrinsic :: iso_c_binding ! { dg-error "Unexpected USE statement" }
implicit none ! { dg-error "Unexpected IMPLICIT NONE statement" }
integer(c_int32_t) , intent(in) :: ndim ! { dg-error "Unexpected data declaration" }
end subroutine runFoo4C ! { dg-error " Expecting END SUBMODULE" }
end submodule Foo_smod
! { dg-do compile }
module Foo_mod
implicit none
interface
module function runFoo4C(ndim) bind(C, name="runFoo")
use, intrinsic :: iso_c_binding
implicit none
integer runFoo4c
integer(c_int32_t) , intent(in) :: ndim
end function runFoo4C
end interface
contains
end module Foo_mod
submodule(Foo_mod) Foo_smod
contains
module function runFoo4C(ndim) bind(C, name="runFu") ! { dg-error "Mismatch in BIND" }
use, intrinsic :: iso_c_binding ! { dg-error "Unexpected USE statement in" }
implicit none ! { dg-error "Unexpected IMPLICIT NONE statement" }
integer(c_int32_t) , intent(in) :: ndim ! { dg-error "Unexpected data declaration" }
end function runFoo4C ! { dg-error "Expecting END SUBMODULE" }
end submodule Foo_smod
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment