mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-25 08:10:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2019-03-13  Thomas Koenig  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	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
This commit is contained in:
Thomas Koenig 2019-03-13 07:21:33 +00:00
parent 599b9f723e
commit 55b9c61257
12 changed files with 167 additions and 17 deletions

24
gcc/fortran/ChangeLog

@ -1,3 +1,27 @@
2019-03-13 Thomas Koenig <tkoenig@gcc.gnu.org>
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 <tkoenig@gcc.gnu.org>
PR fortran/87673

4
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))
{

3
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 *);

10
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);

9
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;

3
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);

21
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;

10
gcc/testsuite/ChangeLog

@ -1,3 +1,13 @@
2019-03-13 Thomas Koenig <tkoenig@gcc.gnu.org>
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 <ibuclaw@gdcproject.org>
* gdc.dg/pr88957.d: Move to gdc.dg/ubsan.

7
gcc/testsuite/gfortran.dg/binding_label_tests_30.f90 Normal file

@ -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

19
gcc/testsuite/gfortran.dg/binding_label_tests_31.f90 Normal file

@ -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

35
gcc/testsuite/gfortran.dg/binding_label_tests_32.f90 Normal file

@ -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

39
gcc/testsuite/gfortran.dg/binding_label_tests_33.f90 Normal file

@ -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