* [RFC gfortran] PR53478 - gfortran segfaults when module name clashes with C binding name of procedure
@ 2017-11-12 13:51 Dominique d'Humières
0 siblings, 0 replies; only message in thread
From: Dominique d'Humières @ 2017-11-12 13:51 UTC (permalink / raw)
To: Thomas Koenig; +Cc: gfortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1413 bytes --]
This patch implement the requirement
> ... Furthermore, a binding label shall not be
> the same as the global identifier of any other global entity, ignoring
> differences in case."
While looking at the code, I noticed that several %s should be %qs. This is fixed as well by the patch along with the needed adjustment of the test suite.
Tested on darwin.
TIA
Dominique
2017-1-12 Dominique d'Humieres <dominiq@lps.ens.fr>
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-11-12 Dominique d'Humieres <dominiq@lps.ens.fr>
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.
[-- Attachment #2: patch-56440 --]
[-- Type: application/octet-stream, Size: 14343 bytes --]
diff -up ../_clean/gcc/fortran/gfortran.h gcc/fortran/gfortran.h
--- ../_clean/gcc/fortran/gfortran.h 2017-10-19 10:07:45.000000000 +0200
+++ gcc/fortran/gfortran.h 2017-10-22 14:11:07.000000000 +0200
@@ -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 -up ../_clean/gcc/fortran/resolve.c gcc/fortran/resolve.c
--- ../_clean/gcc/fortran/resolve.c 2017-10-21 11:31:29.000000000 +0200
+++ gcc/fortran/resolve.c 2017-10-22 14:23:49.000000000 +0200
@@ -1056,7 +1056,7 @@ resolve_common_blocks (gfc_symtree *comm
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);
@@ -11536,7 +11536,7 @@ gfc_verify_binding_labels (gfc_symbol *s
|| 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;
@@ -11572,7 +11572,7 @@ gfc_verify_binding_labels (gfc_symbol *s
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. */
@@ -11585,8 +11585,8 @@ gfc_verify_binding_labels (gfc_symbol *s
{
/* 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;
@@ -11602,7 +11602,7 @@ gfc_verify_binding_labels (gfc_symbol *s
/* 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 -up ../_clean/gcc/fortran/symbol.c gcc/fortran/symbol.c
--- ../_clean/gcc/fortran/symbol.c 2017-10-21 11:31:29.000000000 +0200
+++ gcc/fortran/symbol.c 2017-10-22 13:20:21.000000000 +0200
@@ -4291,6 +4291,29 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, c
}
+/* 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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 2014-11-15 12:40:18.000000000 +0100
+++ gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 2017-10-21 14:55:24.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 2013-05-21 08:15:38.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 2017-10-21 15:11:49.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 2013-05-21 08:15:39.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 2017-10-21 15:13:07.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 2013-05-21 08:15:38.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 2017-10-21 17:19:29.000000000 +0200
@@ -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
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 2017-10-21 15:16:20.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 2017-10-21 15:17:36.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 2017-10-21 15:21:32.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 2014-09-15 22:36:58.000000000 +0200
+++ gcc/testsuite/gfortran.dg/test_common_binding_labels_3_main.f03 2017-10-22 14:38:27.000000000 +0200
@@ -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" } }
--- ../_clean/gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 1970-01-01 01:00:00.000000000 +0100
+++ gcc/testsuite/gfortran.dg/binding_label_tests_29.f90 2017-10-22 16:12:10.000000000 +0200
@@ -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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2017-11-12 13:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-11-12 13:51 [RFC gfortran] PR53478 - gfortran segfaults when module name clashes with C binding name of procedure Dominique d'Humières
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).