diff options
author | Tobias Burnus <burnus@net-b.de> | 2013-05-20 22:08:05 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-05-20 22:08:05 +0200 |
commit | 77f8682b0524f6b534b1da716ee2565757ec7b86 (patch) | |
tree | fc7c0d49f2d0a4562c373f1fa4ca56994cf1ea43 | |
parent | f11de7c5f898a5a613f7ccb47f999312f505f125 (diff) | |
download | gcc-77f8682b0524f6b534b1da716ee2565757ec7b86.zip gcc-77f8682b0524f6b534b1da716ee2565757ec7b86.tar.gz gcc-77f8682b0524f6b534b1da716ee2565757ec7b86.tar.bz2 |
re PR fortran/48858 (Incorrect error for same binding label on two generic interface specifics)
2013-05-20 Tobias Burnus <burnus@net-b.de>
PR fortran/48858
PR fortran/55465
* decl.c (add_global_entry): Add sym_name.
* parse.c (add_global_procedure): Ditto.
* resolve.c (resolve_bind_c_derived_types): Handle multiple decl for
a procedure.
(resolve_global_procedure): Handle gsym->ns pointing to a module.
* trans-decl.c (gfc_get_extern_function_decl): Ditto.
2013-05-20 Tobias Burnus <burnus@net-b.de>
PR fortran/48858
PR fortran/55465
* gfortran.dg/binding_label_tests_10_main.f03: Update dg-error.
* gfortran.dg/binding_label_tests_11_main.f03: Ditto.
* gfortran.dg/binding_label_tests_13_main.f03: Ditto.
* gfortran.dg/binding_label_tests_3.f03: Ditto.
* gfortran.dg/binding_label_tests_4.f03: Ditto.
* gfortran.dg/binding_label_tests_5.f03: Ditto.
* gfortran.dg/binding_label_tests_6.f03: Ditto.
* gfortran.dg/binding_label_tests_7.f03: Ditto.
* gfortran.dg/binding_label_tests_8.f03: Ditto.
* gfortran.dg/c_loc_tests_12.f03: Fix test case.
* gfortran.dg/binding_label_tests_24.f90: New.
* gfortran.dg/binding_label_tests_25.f90: New.
From-SVN: r199120
-rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 2 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 14 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 156 | ||||
-rw-r--r-- | gcc/fortran/trans-decl.c | 19 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 17 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_24.f90 | 28 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_25.f90 | 61 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_7.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/binding_label_tests_8.f03 | 4 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 | 2 |
18 files changed, 248 insertions, 98 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 08b4602..7b48c4d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,6 +1,17 @@ 2013-05-20 Tobias Burnus <burnus@net-b.de> PR fortran/48858 + PR fortran/55465 + * decl.c (add_global_entry): Add sym_name. + * parse.c (add_global_procedure): Ditto. + * resolve.c (resolve_bind_c_derived_types): Handle multiple decl for + a procedure. + (resolve_global_procedure): Handle gsym->ns pointing to a module. + * trans-decl.c (gfc_get_extern_function_decl): Ditto. + +2013-05-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/48858 * decl.c (add_global_entry): Use nonbinding name only for F2003 or if no binding label exists. (gfc_match_entry): Update calls. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index cb449a2..6ab9cc7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5375,6 +5375,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub) else { s->type = type; + s->sym_name = name; s->where = gfc_current_locus; s->defined = 1; s->ns = gfc_current_ns; @@ -5396,6 +5397,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub) else { s->type = type; + s->sym_name = name; s->binding_label = binding_label; s->where = gfc_current_locus; s->defined = 1; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index ba1730a..a223a2c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -4359,10 +4359,15 @@ add_global_procedure (bool sub) if (s->defined || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) - gfc_global_used(s, NULL); + { + gfc_global_used (s, NULL); + /* Silence follow-up errors. */ + gfc_new_block->binding_label = NULL; + } else { s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; + s->sym_name = gfc_new_block->name; s->where = gfc_current_locus; s->defined = 1; s->ns = gfc_current_ns; @@ -4379,10 +4384,15 @@ add_global_procedure (bool sub) if (s->defined || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION))) - gfc_global_used(s, NULL); + { + gfc_global_used (s, NULL); + /* Silence follow-up errors. */ + gfc_new_block->binding_label = NULL; + } else { s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; + s->sym_name = gfc_new_block->name; s->binding_label = gfc_new_block->binding_label; s->where = gfc_current_locus; s->defined = 1; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f3607b4..74e0aa4 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2389,6 +2389,11 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, } def_sym = gsym->ns->proc_name; + + /* This can happen if a binding name has been specified. */ + if (gsym->binding_label && gsym->sym_name != def_sym->name) + gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &def_sym); + if (def_sym->attr.entry_master) { gfc_entry_list *entry; @@ -10023,90 +10028,91 @@ resolve_bind_c_derived_types (gfc_symbol *derived_sym) /* Verify that any binding labels used in a given namespace do not collide - with the names or binding labels of any global symbols. */ + with the names or binding labels of any global symbols. Multiple INTERFACE + for the same procedure are permitted. */ static void gfc_verify_binding_labels (gfc_symbol *sym) { - int has_error = 0; + gfc_gsymbol *gsym; + const char *module; - if (sym != NULL && sym->attr.is_bind_c && sym->attr.is_iso_c == 0 - && sym->attr.flavor != FL_DERIVED && sym->binding_label) - { - gfc_gsymbol *bind_c_sym; + if (!sym || !sym->attr.is_bind_c || sym->attr.is_iso_c + || sym->attr.flavor == FL_DERIVED || !sym->binding_label) + return; - bind_c_sym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label); - if (bind_c_sym != NULL - && strcmp (bind_c_sym->name, sym->binding_label) == 0) - { - if (sym->attr.if_source == IFSRC_DECL - && (bind_c_sym->type != GSYM_SUBROUTINE - && bind_c_sym->type != GSYM_FUNCTION) - && ((sym->attr.contained == 1 - && strcmp (bind_c_sym->sym_name, sym->name) != 0) - || (sym->attr.use_assoc == 1 - && (strcmp (bind_c_sym->mod_name, sym->module) != 0)))) - { - /* Make sure global procedures don't collide with anything. */ - gfc_error ("Binding label '%s' at %L collides with the global " - "entity '%s' at %L", sym->binding_label, - &(sym->declared_at), bind_c_sym->name, - &(bind_c_sym->where)); - has_error = 1; - } - else if (sym->attr.contained == 0 - && (sym->attr.if_source == IFSRC_IFBODY - && sym->attr.flavor == FL_PROCEDURE) - && (bind_c_sym->sym_name != NULL - && strcmp (bind_c_sym->sym_name, sym->name) != 0)) - { - /* Make sure procedures in interface bodies don't collide. */ - gfc_error ("Binding label '%s' in interface body at %L collides " - "with the global entity '%s' at %L", - sym->binding_label, - &(sym->declared_at), bind_c_sym->name, - &(bind_c_sym->where)); - has_error = 1; - } - else if (sym->attr.contained == 0 - && sym->attr.if_source == IFSRC_UNKNOWN) - if ((sym->attr.use_assoc && bind_c_sym->mod_name - && strcmp (bind_c_sym->mod_name, sym->module) != 0) - || sym->attr.use_assoc == 0) - { - gfc_error ("Binding label '%s' at %L collides with global " - "entity '%s' at %L", sym->binding_label, - &(sym->declared_at), bind_c_sym->name, - &(bind_c_sym->where)); - has_error = 1; - } - - if (has_error != 0) - /* Clear the binding label to prevent checking multiple times. */ - sym->binding_label = NULL; - } - else if (bind_c_sym == NULL) - { - bind_c_sym = gfc_get_gsymbol (sym->binding_label); - bind_c_sym->where = sym->declared_at; - bind_c_sym->sym_name = sym->name; + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label); + + if (sym->module) + module = sym->module; + else if (sym->ns && sym->ns->proc_name + && sym->ns->proc_name->attr.flavor == FL_MODULE) + module = sym->ns->proc_name->name; + else if (sym->ns && sym->ns->parent + && sym->ns && sym->ns->parent->proc_name + && sym->ns->parent->proc_name->attr.flavor == FL_MODULE) + module = sym->ns->parent->proc_name->name; + else + module = NULL; + + if (!gsym + || (!gsym->defined + && (gsym->type == GSYM_FUNCTION || gsym->type == GSYM_SUBROUTINE))) + { + if (!gsym) + gsym = gfc_get_gsymbol (sym->binding_label); + gsym->where = sym->declared_at; + gsym->sym_name = sym->name; + gsym->binding_label = sym->binding_label; + gsym->binding_label = sym->binding_label; + gsym->ns = sym->ns; + gsym->mod_name = module; + if (sym->attr.function) + gsym->type = GSYM_FUNCTION; + else if (sym->attr.subroutine) + gsym->type = GSYM_SUBROUTINE; + /* Mark as variable/procedure as defined, unless its an INTERFACE. */ + gsym->defined = sym->attr.if_source != IFSRC_IFBODY; + return; + } - if (sym->attr.use_assoc == 1) - bind_c_sym->mod_name = sym->module; - else - if (sym->ns->proc_name != NULL) - bind_c_sym->mod_name = sym->ns->proc_name->name; + if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN) + { + gfc_error ("Variable %s with binding label %s 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. */ + sym->binding_label = NULL; - if (sym->attr.contained == 0) - { - if (sym->attr.subroutine) - bind_c_sym->type = GSYM_SUBROUTINE; - else if (sym->attr.function) - bind_c_sym->type = GSYM_FUNCTION; - } - } } - return; + else if (sym->attr.flavor == FL_VARIABLE + && (strcmp (module, gsym->mod_name) != 0 + || strcmp (sym->name, gsym->sym_name) != 0)) + { + /* 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", + sym->name, module, sym->binding_label, + &sym->declared_at, &gsym->where, gsym->mod_name); + sym->binding_label = NULL; + } + else if ((sym->attr.function || sym->attr.subroutine) + && ((gsym->type != GSYM_SUBROUTINE && gsym->type != GSYM_FUNCTION) + || (gsym->defined && sym->attr.if_source != IFSRC_IFBODY)) + && sym != gsym->ns->proc_name + && (strcmp (gsym->sym_name, sym->name) != 0 + || module != gsym->mod_name + || (module && strcmp (module, gsym->mod_name) != 0))) + { + /* Print an error if the procdure 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 " + "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/trans-decl.c b/gcc/fortran/trans-decl.c index 795057b..100ec18 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1646,6 +1646,14 @@ gfc_get_extern_function_decl (gfc_symbol * sym) gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label ? sym->binding_label : sym->name); + if (gsym && !gsym->defined) + gsym = NULL; + + /* This can happen because of C binding. */ + if (gsym && gsym->ns && gsym->ns->proc_name + && gsym->ns->proc_name->attr.flavor == FL_MODULE) + goto module_sym; + if ((!sym->attr.use_assoc || sym->attr.if_source != IFSRC_DECL) && !sym->backend_decl && gsym && gsym->ns @@ -1702,12 +1710,19 @@ gfc_get_extern_function_decl (gfc_symbol * sym) if (sym->module) gsym = gfc_find_gsymbol (gfc_gsym_root, sym->module); - if (gsym && gsym->ns && gsym->type == GSYM_MODULE) +module_sym: + if (gsym && gsym->ns + && (gsym->type == GSYM_MODULE + || (gsym->ns->proc_name && gsym->ns->proc_name->attr.flavor == FL_MODULE))) { gfc_symbol *s; s = NULL; - gfc_find_symbol (sym->name, gsym->ns, 0, &s); + if (gsym->type == GSYM_MODULE) + gfc_find_symbol (sym->name, gsym->ns, 0, &s); + else + gfc_find_symbol (gsym->sym_name, gsym->ns, 0, &s); + if (s && s->backend_decl) { if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d6b531c..41c2ce4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,23 @@ 2013-05-20 Tobias Burnus <burnus@net-b.de> PR fortran/48858 + PR fortran/55465 + * gfortran.dg/binding_label_tests_10_main.f03: Update dg-error. + * gfortran.dg/binding_label_tests_11_main.f03: Ditto. + * gfortran.dg/binding_label_tests_13_main.f03: Ditto. + * gfortran.dg/binding_label_tests_3.f03: Ditto. + * gfortran.dg/binding_label_tests_4.f03: Ditto. + * gfortran.dg/binding_label_tests_5.f03: Ditto. + * gfortran.dg/binding_label_tests_6.f03: Ditto. + * gfortran.dg/binding_label_tests_7.f03: Ditto. + * gfortran.dg/binding_label_tests_8.f03: Ditto. + * gfortran.dg/c_loc_tests_12.f03: Fix test case. + * gfortran.dg/binding_label_tests_24.f90: New. + * gfortran.dg/binding_label_tests_25.f90: New. + +2013-05-20 Tobias Burnus <burnus@net-b.de> + + PR fortran/48858 * gfortran.dg/binding_label_tests_17.f90: New. * gfortran.dg/binding_label_tests_18.f90: New. * gfortran.dg/binding_label_tests_19.f90: New. 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 8424922..2a4a53b 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_10_main.f03 @@ -4,10 +4,10 @@ module binding_label_tests_10_main use iso_c_binding implicit none - integer(c_int), bind(c,name="c_one") :: one ! { dg-error "collides" } + 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 "collides" } + 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 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 ef7cfce..851c32c 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_11_main.f03 @@ -5,14 +5,14 @@ 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 "collides" } + 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 "collides" } + 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 355f11a..da93a8b 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_13_main.f03 @@ -4,12 +4,12 @@ ! binding_label_tests_13.mod can not be removed until after this test is done. module binding_label_tests_13_main use, intrinsic :: iso_c_binding, only: c_int - integer(c_int) :: c3 ! { dg-error "collides" } + 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 "collides" } + 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_24.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_24.f90 new file mode 100644 index 0000000..56e6858 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_24.f90 @@ -0,0 +1,28 @@ +! { dg-do compile } +! +! PR fortran/48858 +! PR fortran/55465 +! +! Was rejected before but it perfectly valid +! +module m + interface + subroutine f() bind(C, name="func") + end subroutine + end interface +contains + subroutine sub() + call f() + end subroutine +end module m + +module m2 + interface + subroutine g() bind(C, name="func") + end subroutine + end interface +contains + subroutine sub2() + call g() + end subroutine +end module m2 diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_25.f90 b/gcc/testsuite/gfortran.dg/binding_label_tests_25.f90 new file mode 100644 index 0000000..0769eb0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_25.f90 @@ -0,0 +1,61 @@ +! { dg-do compile } +! +! PR fortran/48858 +! PR fortran/55465 +! +! Seems to be regarded as valid, even if it is doubtful +! + + +module m_odbc_if + implicit none + + interface sql_set_env_attr + function sql_set_env_attr_int( input_handle,attribute,value,length ) & + result(res) bind(C,name="SQLSetEnvAttr") + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: input_handle + integer(c_int), value :: attribute + integer(c_int), value :: value ! <<<< HERE: int passed by value (int with ptr address) + integer(c_int), value :: length + integer(c_short) :: res + end function + function sql_set_env_attr_ptr( input_handle,attribute,value,length ) & + result(res) bind(C,name="SQLSetEnvAttr") + use, intrinsic :: iso_c_binding + implicit none + type(c_ptr), value :: input_handle + integer(c_int), value :: attribute + type(c_ptr), value :: value ! <<< HERE: "void *" (pointer address) + integer(c_int), value :: length + integer(c_short) :: res + end function + end interface +end module + +module graph_partitions + use,intrinsic :: iso_c_binding + + interface Cfun + subroutine cfunc1 (num, array) bind(c, name="Cfun") + import :: c_int + integer(c_int),value :: num + integer(c_int) :: array(*) ! <<< HERE: int[] + end subroutine cfunc1 + + subroutine cfunf2 (num, array) bind(c, name="Cfun") + import :: c_int, c_ptr + integer(c_int),value :: num + type(c_ptr),value :: array ! <<< HERE: void* + end subroutine cfunf2 + end interface +end module graph_partitions + +program test + use graph_partitions + integer(c_int) :: a(100) + + call Cfun (1, a) + call Cfun (2, C_NULL_PTR) +end program test diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 index 6e12447..429fa0b 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_3.f03 @@ -2,14 +2,14 @@ program main use iso_c_binding interface - subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" } + subroutine p1(f, a1, a2, a3, a4) bind(c, name='printf') ! Doubtful use ... import :: c_ptr, c_int, c_double type(c_ptr), value :: f integer(c_int), value :: a1, a3 real(c_double), value :: a2, a4 end subroutine p1 - subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! { dg-error "collides" } + subroutine p2(f, a1, a2, a3, a4) bind(c, name='printf') ! ... with incompatible interfaces import :: c_ptr, c_int, c_double type(c_ptr), value :: f real(c_double), value :: a1, a3 diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_4.f03 index 5a0767d..455726e7 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 "collides" } + 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 "collides" } + 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_5.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 index c8aa4e8..41999b3 100644 --- a/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 +++ b/gcc/testsuite/gfortran.dg/binding_label_tests_5.f03 @@ -3,10 +3,10 @@ module binding_label_tests_5 use, intrinsic :: iso_c_binding interface - subroutine sub0() bind(c, name='c_sub') ! { dg-error "collides" } + subroutine sub0() bind(c, name='c_sub') ! Odd declaration but perfectly valid end subroutine sub0 - subroutine sub1() bind(c, name='c_sub') ! { dg-error "collides" } + subroutine sub1() bind(c, name='c_sub') ! Ditto. end subroutine sub1 end interface end module binding_label_tests_5 diff --git a/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 b/gcc/testsuite/gfortran.dg/binding_label_tests_6.f03 index 0784de1..d213819 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 "collides" } - integer(c_int), bind(c, name='my_int') :: my_f90_int_2 ! { dg-error "collides" } + 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 1234bb5..1e261a9 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 "collides" } + 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 "collides" } + 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 c49ee62..2f507b9 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 "collides" } + 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 "collides" } + 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/c_loc_tests_12.f03 b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 index cfc7be5..9ebfd08 100644 --- a/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 +++ b/gcc/testsuite/gfortran.dg/c_loc_tests_12.f03 @@ -23,7 +23,7 @@ program test2 interface subroutine sub1(argv) bind(c) import - type(c_ptr) :: argv + type(c_ptr), intent(in) :: argv end subroutine sub1 end interface call sub1(c_loc(argv)) |