From 9845246060ebc7f29b765d67746e481b90bc1f45 Mon Sep 17 00:00:00 2001 From: Dominique d'Humieres Date: Sun, 10 Dec 2017 20:11:18 +0100 Subject: [PATCH] re PR fortran/53478 (gfortran segfaults when module name clashes with C binding name of procedure) 2017-12-10 Dominique d'Humieres PR fortran/53478 * gfortran.h (gfc_find_case_gsymbol): New prototype. * symbol.c (gfc_find_case_gsymbol): New procedure, case insensistive version of gfc_find_gsymbol. * resolve.c (resolve_common_blocks): Use it. Replace %s with %qs where needed. * gfortran.dg/binding_label_tests_4.f03: Update dg-error. * gfortran.dg/binding_label_tests_6.f03: Likewise. * gfortran.dg/binding_label_tests_7.f03: Likewise. * gfortran.dg/binding_label_tests_8.f03: Likewise. * gfortran.dg/binding_label_tests_10_main.f03: Likewise. * gfortran.dg/binding_label_tests_11_main.f03: Likewise. * gfortran.dg/binding_label_tests_13_main.f03: Likewise. * gfortran.dg/test_common_binding_labels_3_main.f03: Likewise. * gfortran.dg/binding_label_tests_29.f90: New test. From-SVN: r255530 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/gfortran.h | 1 + gcc/fortran/resolve.c | 12 +++++------ gcc/fortran/symbol.c | 23 ++++++++++++++++++++++ gcc/testsuite/ChangeLog | 13 ++++++++++++ .../gfortran.dg/binding_label_tests_10_main.f03 | 5 ++--- .../gfortran.dg/binding_label_tests_11_main.f03 | 5 ++--- .../gfortran.dg/binding_label_tests_13_main.f03 | 5 ++--- .../gfortran.dg/binding_label_tests_29.f90 | 13 ++++++++++++ .../gfortran.dg/binding_label_tests_4.f03 | 4 ++-- .../gfortran.dg/binding_label_tests_6.f03 | 4 ++-- .../gfortran.dg/binding_label_tests_7.f03 | 4 ++-- .../gfortran.dg/binding_label_tests_8.f03 | 4 ++-- .../test_common_binding_labels_3_main.f03 | 5 ++--- 14 files changed, 81 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c98c64b..a668e12 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2017-12-10 Dominique d'Humieres + + PR fortran/53478 + * gfortran.h (gfc_find_case_gsymbol): New prototype. + * symbol.c (gfc_find_case_gsymbol): New procedure, case + insensistive version of gfc_find_gsymbol. + * resolve.c (resolve_common_blocks): Use it. + Replace %s with %qs where needed. + 2017-12-09 Steven G. Kargl PR fortran/82934 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 97db5b0..c5e62d7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3035,6 +3035,7 @@ void gfc_free_dt_list (void); gfc_gsymbol *gfc_get_gsymbol (const char *); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); +gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *); gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*); gfc_symbol* gfc_get_derived_super_type (gfc_symbol*); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 041ee0d..f819b71 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1056,7 +1056,7 @@ resolve_common_blocks (gfc_symtree *common_root) common_root->n.common->binding_label); if (gsym && gsym->type != GSYM_COMMON) { - gfc_error ("COMMON block at %L with binding label %s uses the same " + gfc_error ("COMMON block at %L with binding label %qs uses the same " "global identifier as entity at %L", &common_root->n.common->where, common_root->n.common->binding_label, &gsym->where); @@ -11542,7 +11542,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) || sym->attr.flavor == FL_DERIVED || !sym->binding_label) return; - gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label); + gsym = gfc_find_case_gsymbol (gfc_gsym_root, sym->binding_label); if (sym->module) module = sym->module; @@ -11578,7 +11578,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN) { - gfc_error ("Variable %s with binding label %s at %L uses the same global " + gfc_error ("Variable %qs with binding label %qs at %L uses the same global " "identifier as entity at %L", sym->name, sym->binding_label, &sym->declared_at, &gsym->where); /* Clear the binding label to prevent checking multiple times. */ @@ -11591,8 +11591,8 @@ gfc_verify_binding_labels (gfc_symbol *sym) { /* This can only happen if the variable is defined in a module - if it isn't the same module, reject it. */ - gfc_error ("Variable %s from module %s with binding label %s at %L uses " - "the same global identifier as entity at %L from module %s", + gfc_error ("Variable %qs from module %qs with binding label %qs at %L " + "uses the same global identifier as entity at %L from module %qs", sym->name, module, sym->binding_label, &sym->declared_at, &gsym->where, gsym->mod_name); sym->binding_label = NULL; @@ -11608,7 +11608,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) /* Print an error if the procedure is defined multiple times; we have to exclude references to the same procedure via module association or multiple checks for the same procedure. */ - gfc_error ("Procedure %s with binding label %s at %L uses the same " + gfc_error ("Procedure %qs with binding label %qs at %L uses the same " "global identifier as entity at %L", sym->name, sym->binding_label, &sym->declared_at, &gsym->where); sym->binding_label = NULL; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 11b6f60..dc1688a 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4291,6 +4291,29 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name) } +/* Case insensitive search a tree for the global symbol. */ + +gfc_gsymbol * +gfc_find_case_gsymbol (gfc_gsymbol *symbol, const char *name) +{ + int c; + + if (symbol == NULL) + return NULL; + + while (symbol) + { + c = strcasecmp (name, symbol->name); + if (!c) + return symbol; + + symbol = (c < 0) ? symbol->left : symbol->right; + } + + return NULL; +} + + /* Compare two global symbols. Used for managing the BB tree. */ static int diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fcd31bb..dbffa82 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2017-12-10 Dominique d'Humieres + + PR fortran/53478 + * gfortran.dg/binding_label_tests_4.f03: Update dg-error. + * gfortran.dg/binding_label_tests_6.f03: Likewise. + * gfortran.dg/binding_label_tests_7.f03: Likewise. + * gfortran.dg/binding_label_tests_8.f03: Likewise. + * gfortran.dg/binding_label_tests_10_main.f03: Likewise. + * gfortran.dg/binding_label_tests_11_main.f03: Likewise. + * gfortran.dg/binding_label_tests_13_main.f03: Likewise. + * gfortran.dg/test_common_binding_labels_3_main.f03: Likewise. + * gfortran.dg/binding_label_tests_29.f90: New test. + 2017-12-10 Jakub Jelinek PR tree-optimization/83337 diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 index bce5ef6..fc961a4 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 @@ -3,11 +3,10 @@ module binding_label_tests_10_main use iso_c_binding implicit none - integer(c_int), bind(c,name="c_one") :: one ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" } + integer(c_int), bind(c,name="c_one") :: one ! { dg-error "Variable 'one' from module 'binding_label_tests_10' with binding label 'c_one' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_10_main'" } end module binding_label_tests_10_main program main - use binding_label_tests_10 ! { dg-error "Variable one from module binding_label_tests_10 with binding label c_one at .1. uses the same global identifier as entity at .2. from module binding_label_tests_10_main" } + use binding_label_tests_10 ! { dg-error "Variable 'one' from module 'binding_label_tests_10' with binding label 'c_one' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_10_main'" } use binding_label_tests_10_main end program main -! { dg-final { cleanup-modules "binding_label_tests_10" } } diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 index 7ee0c8d..c7a75b5 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 @@ -4,14 +4,13 @@ module binding_label_tests_11_main use iso_c_binding, only: c_int implicit none contains - function one() bind(c, name="c_one") ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." } + function one() bind(c, name="c_one") ! { dg-error "Procedure 'one' with binding label 'c_one' at .1. uses the same global identifier as entity at .2." } integer(c_int) one one = 1 end function one end module binding_label_tests_11_main program main - use binding_label_tests_11 ! { dg-error "Procedure one with binding label c_one at .1. uses the same global identifier as entity at .2." } + use binding_label_tests_11 ! { dg-error "Procedure 'one' with binding label 'c_one' at .1. uses the same global identifier as entity at .2." } use binding_label_tests_11_main end program main -! { dg-final { cleanup-modules "binding_label_tests_11" } } diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 index 66ff7cf..55743b7 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 @@ -2,12 +2,11 @@ ! { dg-compile-aux-modules "binding_label_tests_13.f03" } module binding_label_tests_13_main use, intrinsic :: iso_c_binding, only: c_int - integer(c_int) :: c3 ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" } + integer(c_int) :: c3 ! { dg-error "Variable 'c3' from module 'binding_label_tests_13_main' with binding label 'c3' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_13'" } bind(c) c3 contains subroutine c_sub() BIND(c, name = "C_Sub") - use binding_label_tests_13 ! { dg-error "Variable c3 from module binding_label_tests_13_main with binding label c3 at .1. uses the same global identifier as entity at .2. from module binding_label_tests_13" } + use binding_label_tests_13 ! { dg-error "Variable 'c3' from module 'binding_label_tests_13_main' with binding label 'c3' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_13'" } end subroutine c_sub end module binding_label_tests_13_main -! { dg-final { cleanup-modules "binding_label_tests_13" } } diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 new file mode 100644 index 0000000..d4b6cfb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! PR53478 + +module test_bug ! { dg-error "Procedure 'test' with binding label 'Test_Bug' at .1. uses the same global identifier as entity at .2." } + +use, intrinsic :: ISO_C_BINDING + +contains + + subroutine test() bind (C, name = "Test_Bug") ! { dg-error "Procedure 'test' with binding label 'Test_Bug' at .1. uses the same global identifier as entity at .2." } + end subroutine + +end module diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 index 69db975..7214289 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 @@ -2,7 +2,7 @@ module A use, intrinsic :: iso_c_binding contains - subroutine pA() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." } + subroutine pA() bind(c, name='printf') ! { dg-error "Procedure 'pb' with binding label 'printf' at .1. uses the same global identifier as entity at .2." } print *, 'hello from pA' end subroutine pA end module A @@ -11,7 +11,7 @@ module B use, intrinsic :: iso_c_binding contains - subroutine pB() bind(c, name='printf') ! { dg-error "Procedure pb with binding label printf at .1. uses the same global identifier as entity at .2." } + subroutine pB() bind(c, name='printf') ! { dg-error "Procedure 'pb' with binding label 'printf' at .1. uses the same global identifier as entity at .2." } print *, 'hello from pB' end subroutine pB end module B diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 index d213819..52be7f15 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 @@ -1,6 +1,6 @@ ! { dg-do compile } module binding_label_tests_6 use, intrinsic :: iso_c_binding - integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" } - integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "Variable my_f90_int_2 from module binding_label_tests_6 with binding label my_int at .1. uses the same global identifier as entity at .2. from module binding_label_tests_6" } + integer(c_int), bind(c, name='my_int') :: my_f90_int_1 ! { dg-error "Variable 'my_f90_int_2' from module 'binding_label_tests_6' with binding label 'my_int' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_6'" } + integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "Variable 'my_f90_int_2' from module 'binding_label_tests_6' with binding label 'my_int' at .1. uses the same global identifier as entity at .2. from module 'binding_label_tests_6'" } end module binding_label_tests_6 diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 index 1e261a9..6811cea 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 @@ -1,13 +1,13 @@ ! { dg-do compile } module A use, intrinsic :: iso_c_binding, only: c_int - integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." } + integer(c_int), bind(c, name='my_c_print') :: my_int ! { dg-error "Procedure 'my_c_print' with binding label 'my_c_print' at .1. uses the same global identifier as entity at .2." } end module A program main use A interface - subroutine my_c_print() bind(c) ! { dg-error "Procedure my_c_print with binding label my_c_print at .1. uses the same global identifier as entity at .2." } + subroutine my_c_print() bind(c) ! { dg-error "Procedure 'my_c_print' with binding label 'my_c_print' at .1. uses the same global identifier as entity at .2." } end subroutine my_c_print end interface diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 index 2f507b9..be5d004 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 @@ -1,9 +1,9 @@ ! { dg-do compile } module binding_label_tests_8 use, intrinsic :: iso_c_binding, only: c_int - integer(c_int), bind(c, name='my_f90_sub') :: my_c_int ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." } + integer(c_int), bind(c, name='my_f90_sub') :: my_c_int ! { dg-error "Variable 'my_c_int' with binding label 'my_f90_sub' at .1. uses the same global identifier as entity at .2." } contains - subroutine my_f90_sub() bind(c) ! { dg-error "Variable my_c_int with binding label my_f90_sub at .1. uses the same global identifier as entity at .2." } + subroutine my_f90_sub() bind(c) ! { dg-error "Variable 'my_c_int' with binding label 'my_f90_sub' at .1. uses the same global identifier as entity at .2." } end subroutine my_f90_sub end module binding_label_tests_8 diff --git a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 index 9ad5515..4ee6cef 100644 --- a/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 +++ b/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 @@ -2,11 +2,10 @@ ! { dg-compile-aux-modules "test_common_binding_labels_3.f03" } module test_common_binding_labels_3_main use, intrinsic :: iso_c_binding, only: c_int - integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." } + integer(c_int), bind(c, name="my_common_block") :: my_int ! { dg-error "COMMON block at .1. with binding label 'my_common_block' uses the same global identifier as entity at .2." } end module test_common_binding_labels_3_main program main use test_common_binding_labels_3_main - use test_common_binding_labels_3 ! { dg-error "COMMON block at .1. with binding label my_common_block uses the same global identifier as entity at .2." } + use test_common_binding_labels_3 ! { dg-error "COMMON block at .1. with binding label 'my_common_block' uses the same global identifier as entity at .2." } end program main -! { dg-final { cleanup-modules "test_common_binding_labels_3" } } -- 2.7.4