From 07136dbc062b9a6f0cb8719ea0de1048d00a80bc Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Thu, 17 Oct 2019 16:30:25 +0000 Subject: [PATCH] re PR fortran/83113 (Bogus "duplicate allocatable attribute" error for submodule character function) 2019-10-17 Steven G. Kargl PR fortran/83113 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-17 Steven G. Kargl PR fortran/83113 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: r277122 --- gcc/fortran/ChangeLog | 11 ++++ gcc/fortran/decl.c | 86 ++++++++++++++++++------- gcc/testsuite/ChangeLog | 9 +++ gcc/testsuite/gfortran.dg/pr89943_1.f90 | 31 +++++++++ gcc/testsuite/gfortran.dg/pr89943_2.f90 | 33 ++++++++++ gcc/testsuite/gfortran.dg/pr89943_3.f90 | 28 ++++++++ gcc/testsuite/gfortran.dg/pr89943_4.f90 | 29 +++++++++ 7 files changed, 205 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr89943_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr89943_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr89943_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr89943_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2064cf1314b1..66ff7f143fe8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2019-10-17 Steven G. Kargl + + PR fortran/83113 + 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-11 Steven G. Kargl PR fortran/91715 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 7b87bb88a30e..24002ed1c6e8 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -7230,13 +7230,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) @@ -7250,6 +7253,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 @@ -7488,15 +7509,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). */ @@ -7696,13 +7717,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. */ @@ -7744,6 +7768,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 9ee59f0c43ea..4de50acd4824 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2019-10-17 Steven G. Kargl + + PR fortran/83113 + 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-17 Bill Schmidt Backport from mainline diff --git a/gcc/testsuite/gfortran.dg/pr89943_1.f90 b/gcc/testsuite/gfortran.dg/pr89943_1.f90 new file mode 100644 index 000000000000..3aa9c36d6286 --- /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 000000000000..ac69ec3af561 --- /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 000000000000..38b723e24585 --- /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 000000000000..8eba2eda1718 --- /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 -- 2.47.2