Skip to content
Snippets Groups Projects
Commit d6418fe2 authored by Harald Anlauf's avatar Harald Anlauf
Browse files

Fortran: host association issue with symbol in COMMON block [PR108454]

When resolving a flavorless symbol that is already registered with a COMMON
block, and which neither has the intrinsic, generic, or external attribute,
skip searching among interfaces to avoid false resolution to a derived type
of the same name.

	PR fortran/108454

gcc/fortran/ChangeLog:

	* resolve.cc (resolve_common_blocks): Initialize variable.
	(resolve_symbol): If a symbol is already registered with a COMMON
	block, do not search for an interface with the same name.

gcc/testsuite/ChangeLog:

	* gfortran.dg/common_29.f90: New test.
parent af51fe95
No related branches found
No related tags found
No related merge requests found
...@@ -1049,7 +1049,7 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common) ...@@ -1049,7 +1049,7 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
static void static void
resolve_common_blocks (gfc_symtree *common_root) resolve_common_blocks (gfc_symtree *common_root)
{ {
gfc_symbol *sym; gfc_symbol *sym = NULL;
gfc_gsymbol * gsym; gfc_gsymbol * gsym;
   
if (common_root == NULL) if (common_root == NULL)
...@@ -17693,6 +17693,12 @@ resolve_symbol (gfc_symbol *sym) ...@@ -17693,6 +17693,12 @@ resolve_symbol (gfc_symbol *sym)
&& sym->attr.if_source == IFSRC_UNKNOWN && sym->attr.if_source == IFSRC_UNKNOWN
&& sym->ts.type == BT_UNKNOWN)) && sym->ts.type == BT_UNKNOWN))
{ {
/* A symbol in a common block might not have been resolved yet properly.
Do not try to find an interface with the same name. */
if (sym->attr.flavor == FL_UNKNOWN && !sym->attr.intrinsic
&& !sym->attr.generic && !sym->attr.external
&& sym->attr.in_common)
goto skip_interfaces;
   
/* If we find that a flavorless symbol is an interface in one of the /* If we find that a flavorless symbol is an interface in one of the
parent namespaces, find its symtree in this namespace, free the parent namespaces, find its symtree in this namespace, free the
...@@ -17716,6 +17722,7 @@ resolve_symbol (gfc_symbol *sym) ...@@ -17716,6 +17722,7 @@ resolve_symbol (gfc_symbol *sym)
} }
} }
   
skip_interfaces:
/* Otherwise give it a flavor according to such attributes as /* Otherwise give it a flavor according to such attributes as
it has. */ it has. */
if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0 if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
......
! { dg-do compile }
! PR fortran/108454
!
! Contributed by G.Steinmetz
module m
type t
end type
contains
subroutine s
common t
end
end
module m2
implicit none
type t
end type
contains
subroutine s
real :: t
common /com/ t
end
end
module m3
type t
end type
contains
subroutine s
type(t) :: x ! { dg-error "cannot be host associated at .1." }
common t ! { dg-error "incompatible object of the same name" }
end
end
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment