OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/16940 (Failure to perform host association correctly)

Browse Source 
2005-07-19 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16940
	* resolve.c (resolve_symbol): A symbol with FL_UNKNOWN
	is matched against interfaces in parent namespaces. If there
	the symtree is set to point to the interface.

2005-07-19 Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16940
	* gfortran.dg/module_interface_1.f90: New test.

From-SVN: r102167
This commit is contained in:
Paul Thomas 2005-07-19 20:13:53 +00:00
parent 6a9a79a866
commit 24d36d28c4
4 changed files with 73 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2005-07-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/16940
* resolve.c (resolve_symbol): A symbol with FL_UNKNOWN
is matched against interfaces in parent namespaces. If there
the symtree is set to point to the interface.
2005-07-16 David Edelsohn <edelsohn@gnu.org>
PR fortran/21730

25
gcc/fortran/resolve.c
View File

@ -4031,9 +4031,34 @@ resolve_symbol (gfc_symbol * sym)
int i;
const char *whynot;
gfc_namelist *nl;
gfc_symtree * symtree;
gfc_symtree * this_symtree;
gfc_namespace * ns;
if (sym->attr.flavor == FL_UNKNOWN)
{
/* If we find that a flavorless symbol is an interface in one of the
parent namespaces, find its symtree in this namespace, free the
symbol and set the symtree to point to the interface symbol. */
for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
{
symtree = gfc_find_symtree (ns->sym_root, sym->name);
if (symtree && symtree->n.sym->generic)
{
this_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
sym->name);
sym->refs--;
if (!sym->refs)
gfc_free_symbol (sym);
symtree->n.sym->refs++;
this_symtree->n.sym = symtree->n.sym;
return;
}
}
/* Otherwise give it a flavor according to such attributes as
it has. */
if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
sym->attr.flavor = FL_VARIABLE;
else

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2005-07-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/16940
* gfortran.dg/module_interface_1.f90: New test.
2005-07-19 Danny Berlin <dberlin@dberlin.org>
Kenneth Zadeck <zadeck@naturalbridge.com>

36
gcc/testsuite/gfortran.dg/module_interface_1.f90 Normal file
View File

@ -0,0 +1,36 @@
! { dg-do run }
! This tests the fix for PR16940, module interfaces to
! contained functions caused ICEs.
! This is a simplified version of the example in the PR
! discussion, which was due to L.Meissner.
!
! Submitted by Paul Thomas pault@gcc.gnu.org
!
module Max_Loc_Mod
implicit none
interface Max_Location
module procedure I_Max_Loc
end interface
contains
function I_Max_Loc (Vector) result(Ans)
integer, intent (in), dimension(:) :: Vector
integer, dimension(1) :: Ans
Ans = maxloc(Vector)
return
end function I_Max_Loc
end module Max_Loc_Mod
program module_interface
use Max_Loc_Mod
implicit none
integer :: Vector (7)
Vector = (/1,6,3,5,19,1,2/)
call Selection_Sort (Vector)
contains
subroutine Selection_Sort (Unsorted)
integer, intent (in), dimension(:) :: Unsorted
integer, dimension (1) :: N
N = Max_Location (Unsorted)
if (N(1).ne.5) call abort ()
return
end subroutine Selection_Sort
end program module_interface