From 55b9c612573a120ea39f0a80a51b3b1757248f12 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Wed, 13 Mar 2019 07:21:33 +0000 Subject: [PATCH] [multiple changes] 2019-03-13 Thomas Koenig PR fortran/66695 PR fortran/77746 PR fortran/79485 * gfortran.h (gfc_symbol): Add bind_c component. (gfc_get_gsymbol): Add argument bind_c. * decl.c (add_global_entry): Add bind_c argument to gfc_get_symbol. * parse.c (parse_block_data): Likewise. (parse_module): Likewise. (add_global_procedure): Likewise. (add_global_program): Likewise. * resolve.c (resolve_common_blocks): Likewise. (resolve_global_procedure): Likewise. (gfc_verify_binding_labels): Likewise. * symbol.c (gfc_get_gsymbol): Add argument bind_c. Set bind_c in gsym. * trans-decl.c (gfc_get_module_backend_decl): Add bind_c argument to gfc_get_symbol. (gfc_get_extern_function_decl): If the sym has a binding label and it cannot be found in the global symbol tabel, it is the wrong one and vice versa. 2019-03-13 Thomas Koenig PR fortran/66695 PR fortran/77746 PR fortran/79485 * gfortran.dg/binding_label_tests_30.f90: New test. * gfortran.dg/binding_label_tests_31.f90: New test. * gfortran.dg/binding_label_tests_32.f90: New test. * gfortran.dg/binding_label_tests_33.f90: New test. From-SVN: r269635 --- gcc/fortran/ChangeLog | 24 ++++++++++++ gcc/fortran/decl.c | 4 +- gcc/fortran/gfortran.h | 3 +- gcc/fortran/parse.c | 10 ++--- gcc/fortran/resolve.c | 9 +++-- gcc/fortran/symbol.c | 3 +- gcc/fortran/trans-decl.c | 21 ++++++++-- gcc/testsuite/ChangeLog | 10 +++++ .../gfortran.dg/binding_label_tests_30.f90 | 7 ++++ .../gfortran.dg/binding_label_tests_31.f90 | 19 +++++++++ .../gfortran.dg/binding_label_tests_32.f90 | 35 +++++++++++++++++ .../gfortran.dg/binding_label_tests_33.f90 | 39 +++++++++++++++++++ 12 files changed, 167 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 create mode 100644 gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 create mode 100644 gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 create mode 100644 gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index edcacf50231..ee39ad8d398 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,27 @@ +2019-03-13 Thomas Koenig + + PR fortran/66695 + PR fortran/77746 + PR fortran/79485 + * gfortran.h (gfc_symbol): Add bind_c component. + (gfc_get_gsymbol): Add argument bind_c. + * decl.c (add_global_entry): Add bind_c argument to + gfc_get_symbol. + * parse.c (parse_block_data): Likewise. + (parse_module): Likewise. + (add_global_procedure): Likewise. + (add_global_program): Likewise. + * resolve.c (resolve_common_blocks): Likewise. + (resolve_global_procedure): Likewise. + (gfc_verify_binding_labels): Likewise. + * symbol.c (gfc_get_gsymbol): Add argument bind_c. Set bind_c + in gsym. + * trans-decl.c (gfc_get_module_backend_decl): Add bind_c argument + to gfc_get_symbol. + (gfc_get_extern_function_decl): If the sym has a binding label + and it cannot be found in the global symbol tabel, it is the wrong + one and vice versa. + 2019-03-12 Thomas Koenig PR fortran/87673 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f6411f14875..2f335b24835 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -7248,7 +7248,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub, name is a global identifier. */ if (!binding_label || gfc_notification_std (GFC_STD_F2008)) { - s = gfc_get_gsymbol (name); + s = gfc_get_gsymbol (name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { @@ -7270,7 +7270,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub, && (!gfc_notification_std (GFC_STD_F2008) || strcmp (name, binding_label) != 0)) { - s = gfc_get_gsymbol (binding_label); + s = gfc_get_gsymbol (binding_label, true); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3e0f634c3a8..dd959e6403e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1891,6 +1891,7 @@ typedef struct gfc_gsymbol enum gfc_symbol_type type; int defined, used; + bool bind_c; locus where; gfc_namespace *ns; } @@ -3114,7 +3115,7 @@ void gfc_enforce_clean_symbol_state (void); void gfc_free_dt_list (void); -gfc_gsymbol *gfc_get_gsymbol (const char *); +gfc_gsymbol *gfc_get_gsymbol (const char *, bool bind_c); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 5dcd91af6cf..14cda5f9fba 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -5839,7 +5839,7 @@ parse_block_data (void) } else { - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA)) gfc_global_used (s, &gfc_new_block->declared_at); @@ -5921,7 +5921,7 @@ parse_module (void) gfc_gsymbol *s; bool error; - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) gfc_global_used (s, &gfc_new_block->declared_at); else @@ -5985,7 +5985,7 @@ add_global_procedure (bool sub) name is a global identifier. */ if (!gfc_new_block->binding_label || gfc_notification_std (GFC_STD_F2008)) { - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN @@ -6010,7 +6010,7 @@ add_global_procedure (bool sub) && (!gfc_notification_std (GFC_STD_F2008) || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0)) { - s = gfc_get_gsymbol (gfc_new_block->binding_label); + s = gfc_get_gsymbol (gfc_new_block->binding_label, true); if (s->defined || (s->type != GSYM_UNKNOWN @@ -6042,7 +6042,7 @@ add_global_program (void) if (gfc_new_block == NULL) return; - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM)) gfc_global_used (s, &gfc_new_block->declared_at); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 6677deb3bdc..62c7d376b92 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1050,7 +1050,7 @@ resolve_common_blocks (gfc_symtree *common_root) } if (!gsym) { - gsym = gfc_get_gsymbol (common_root->n.common->name); + gsym = gfc_get_gsymbol (common_root->n.common->name, false); gsym->type = GSYM_COMMON; gsym->where = common_root->n.common->where; gsym->defined = 1; @@ -1072,7 +1072,7 @@ resolve_common_blocks (gfc_symtree *common_root) } if (!gsym) { - gsym = gfc_get_gsymbol (common_root->n.common->binding_label); + gsym = gfc_get_gsymbol (common_root->n.common->binding_label, true); gsym->type = GSYM_COMMON; gsym->where = common_root->n.common->where; gsym->defined = 1; @@ -2487,7 +2487,8 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; - gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name); + gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name, + sym->binding_label != NULL); if ((gsym->type != GSYM_UNKNOWN && gsym->type != type)) gfc_global_used (gsym, where); @@ -11847,7 +11848,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) && (gsym->type == GSYM_FUNCTION || gsym->type == GSYM_SUBROUTINE))) { if (!gsym) - gsym = gfc_get_gsymbol (sym->binding_label); + gsym = gfc_get_gsymbol (sym->binding_label, true); gsym->where = sym->declared_at; gsym->sym_name = sym->name; gsym->binding_label = sym->binding_label; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 4dfa836dddf..882a4f323f8 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4330,7 +4330,7 @@ gsym_compare (void *_s1, void *_s2) /* Get a global symbol, creating it if it doesn't exist. */ gfc_gsymbol * -gfc_get_gsymbol (const char *name) +gfc_get_gsymbol (const char *name, bool bind_c) { gfc_gsymbol *s; @@ -4341,6 +4341,7 @@ gfc_get_gsymbol (const char *name) s = XCNEW (gfc_gsymbol); s->type = GSYM_UNKNOWN; s->name = gfc_get_string ("%s", name); + s->bind_c = bind_c; gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 36b7fdd2701..ada6370899a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -843,7 +843,7 @@ gfc_get_module_backend_decl (gfc_symbol *sym) { if (!gsym) { - gsym = gfc_get_gsymbol (sym->module); + gsym = gfc_get_gsymbol (sym->module, false); gsym->type = GSYM_MODULE; gsym->ns = gfc_get_namespace (NULL, 0); } @@ -2002,9 +2002,22 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args) return get_proc_pointer_decl (sym); /* See if this is an external procedure from the same file. If so, - return the backend_decl. */ - gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label - ? sym->binding_label : sym->name); + return the backend_decl. If we are looking at a BIND(C) + procedure and the symbol is not BIND(C), or vice versa, we + haven't found the right procedure. */ + + if (sym->binding_label) + { + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label); + if (gsym && !gsym->bind_c) + gsym = NULL; + } + else + { + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name); + if (gsym && gsym->bind_c) + gsym = NULL; + } if (gsym && !gsym->defined) gsym = NULL; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d09651c5a97..c41914e6f38 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2019-03-13 Thomas Koenig + + PR fortran/66695 + PR fortran/77746 + PR fortran/79485 + * gfortran.dg/binding_label_tests_30.f90: New test. + * gfortran.dg/binding_label_tests_31.f90: New test. + * gfortran.dg/binding_label_tests_32.f90: New test. + * gfortran.dg/binding_label_tests_33.f90: New test. + 2019-03-13 Iain Buclaw * gdc.dg/pr88957.d: Move to gdc.dg/ubsan. diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 new file mode 100644 index 00000000000..168d4b52f2d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 @@ -0,0 +1,7 @@ +! { dg-do compile } +! Make sure this error is flagged. +subroutine foo() ! { dg-error "is already being used as a SUBROUTINE" } +end subroutine foo + +subroutine bar() bind(C,name="foo") ! { dg-error "is already being used as a SUBROUTINE" } +end subroutine bar diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 new file mode 100644 index 00000000000..e914c66a7b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! PR fortran/66695 - this used to ICE. +! Original test case by Vladimir Fuka. +module mod + implicit none +contains + integer function F() + end function +end module + +module mod_C + use mod + implicit none +contains + subroutine s() bind(C, name="f") + integer :: x + x = F() + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 new file mode 100644 index 00000000000..f18df66a2cc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 @@ -0,0 +1,35 @@ +! { dg-do run } +! PR 77746 - this used to crash during execution. +! Original test case by Vladimir Fuka. +module first + private + public execute + + interface execute + module procedure random_name + end interface + +contains + + subroutine random_name() + end subroutine +end module + +module test + use first + + implicit none + +contains + + subroutine p_execute(i) bind(C, name="random_name") + integer :: i + + call execute() + end subroutine + +end module + + use test + call p_execute(1) +end diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 new file mode 100644 index 00000000000..fdb9a887f60 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! PR 79485 - used to crash because the wrong routine was called. +module fmod1 + + contains + + subroutine foo(i) + implicit none + + integer, intent(inout) :: i + + i=i+1 + + end subroutine foo + +end module fmod1 + +module fmod2 + use iso_c_binding + use fmod1, only : foo_first => foo + + contains + + subroutine foo(i) bind(c) + implicit none + + integer, intent(inout) :: i + + i=i+2 + call foo_first(i) + + end subroutine foo + +end module fmod2 + + use fmod2 + + call foo(i) +end -- 2.30.2