[gcc/devel/omp/gcc-9] re PR fortran/83113 (Bogus "duplicate allocatable attribute" error for submodule character function)
Tobias Burnus
burnus@gcc.gnu.org
Thu Mar 5 14:10:00 GMT 2020
https://gcc.gnu.org/g:07136dbc062b9a6f0cb8719ea0de1048d00a80bc
commit 07136dbc062b9a6f0cb8719ea0de1048d00a80bc
Author: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Thu Oct 17 16:30:25 2019 +0000
re PR fortran/83113 (Bogus "duplicate allocatable attribute" error for submodule character function)
2019-10-17 Steven G. Kargl <kargl@gcc.gnu.org>
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 <kargl@gcc.gnu.org>
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
Diff:
---
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(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2064cf1..66ff7f1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2019-10-17 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ 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 <kargl@gcc.gnu.org>
PR fortran/91715
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 7b87bb8..24002ed 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 9ee59f0..4de50ac 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+2019-10-17 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ 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 <wschmidt@linux.ibm.com>
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 0000000..3aa9c36
--- /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 <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
+
diff --git a/gcc/testsuite/gfortran.dg/pr89943_2.f90 b/gcc/testsuite/gfortran.dg/pr89943_2.f90
new file mode 100644
index 0000000..ac69ec3
--- /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 <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
+
diff --git a/gcc/testsuite/gfortran.dg/pr89943_3.f90 b/gcc/testsuite/gfortran.dg/pr89943_3.f90
new file mode 100644
index 0000000..38b723e
--- /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 0000000..8eba2ed
--- /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
More information about the Gcc-cvs
mailing list