From: Steven G. Kargl Date: Tue, 15 Oct 2019 00:28:47 +0000 (+0000) Subject: re PR fortran/89943 (Submodule functions are not allowed to have C binding) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=51992f15a7d9adce1016f8c31d37409e50d5797f;p=gcc.git re PR fortran/89943 (Submodule functions are not allowed to have C binding) 2019-10-14 Steven G. Kargl 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 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7e05e9105aa..5e3c78e11ad 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2019-10-14 Steven G. Kargl + + 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 PR fortran/92004 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 9cda824ac05..59e0eac1f32 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -7263,13 +7263,16 @@ gfc_match_function_decl (void) if (sym->attr.is_bind_c == 1) { sym->attr.is_bind_c = 0; - if (sym->old_symbol != NULL) - gfc_error_now ("BIND(C) attribute at %L can only be used for " - "variables or common blocks", - &(sym->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); + + if (gfc_state_stack->previous + && gfc_state_stack->previous->state != COMP_SUBMODULE) + { + locus loc; + loc = sym->old_symbol != NULL + ? 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) @@ -7283,6 +7286,24 @@ gfc_match_function_decl (void) 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) m = MATCH_ERROR; else @@ -7521,15 +7542,15 @@ gfc_match_entry (void) not allowed for procedures. */ if (entry->attr.is_bind_c == 1) { + locus loc; + 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); - } + + loc = entry->old_symbol != NULL + ? entry->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); + } /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ @@ -7729,13 +7750,16 @@ gfc_match_subroutine (void) if (sym->attr.is_bind_c == 1) { sym->attr.is_bind_c = 0; - if (sym->old_symbol != NULL) - gfc_error_now ("BIND(C) attribute at %L can only be used for " - "variables or common blocks", - &(sym->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); + + if (gfc_state_stack->previous + && gfc_state_stack->previous->state != COMP_SUBMODULE) + { + locus loc; + loc = sym->old_symbol != NULL + ? 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. */ @@ -7777,6 +7801,24 @@ gfc_match_subroutine (void) 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. */ for (arg = sym->formal; arg; arg = arg->next) if (!arg->sym) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0f4eb9f45c0..0285490cd6c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-10-14 Steven G. Kargl + + 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 PR fortran/92004 diff --git a/gcc/testsuite/gfortran.dg/pr89943_1.f90 b/gcc/testsuite/gfortran.dg/pr89943_1.f90 new file mode 100644 index 00000000000..3aa9c36d628 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr89943_1.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } +! PR fortran/89943 +! Code contributed by Alberto Luaces +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 + diff --git a/gcc/testsuite/gfortran.dg/pr89943_2.f90 b/gcc/testsuite/gfortran.dg/pr89943_2.f90 new file mode 100644 index 00000000000..ac69ec3af56 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr89943_2.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! PR fortran/89943 +! Code contributed by Alberto Luaces +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 + diff --git a/gcc/testsuite/gfortran.dg/pr89943_3.f90 b/gcc/testsuite/gfortran.dg/pr89943_3.f90 new file mode 100644 index 00000000000..38b723e2458 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr89943_3.f90 @@ -0,0 +1,28 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/pr89943_4.f90 b/gcc/testsuite/gfortran.dg/pr89943_4.f90 new file mode 100644 index 00000000000..8eba2eda171 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr89943_4.f90 @@ -0,0 +1,29 @@ +! { 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