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

re PR fortran/33541 (gfortran wrongly imports renamed-use-associated symbol unrenamed)

Browse Source 
2007-11-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33541
	*interface.c (compare_actual_formal): Exclude assumed size
	arrays from the possibility of scalar to array mapping.
	* decl.c (get_proc_name): Fix whitespace problem.

	PR fortran/34231
	* gfortran.h : Add 'use_rename' bit to symbol_attribute.
	* module.c : Add 'renamed' field to pointer_info.u.rsym.
	(load_generic_interfaces): Add 'renamed' that is set after the
	number_use_names is called.  This is used to set the attribute
	use_rename, which, in its turn identifies those symbols that
	have not been renamed.
	(load_needed): If pointer_info.u.rsym->renamed is set, then
	set the use_rename attribute of the symbol.
	(read_module): Correct an erroneous use of use_flag. Use the
	renamed flag and the use_rename attribute to determine which
	symbols are not renamed.

2007-11-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33541
	* gfortran.dg/use_11.f90: New test.

	PR fortran/34231
	* gfortran.dg/generic_15.f90: New test.

From-SVN: r130471
This commit is contained in:
Paul Thomas 2007-11-27 19:21:52 +00:00
parent f98e89380f
commit 0e5a218b31
8 changed files with 110 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/fortran/ChangeLog
View File

@ -1,3 +1,23 @@
2007-11-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33541
*interface.c (compare_actual_formal): Exclude assumed size
arrays from the possibility of scalar to array mapping.
* decl.c (get_proc_name): Fix whitespace problem.
PR fortran/34231
* gfortran.h : Add 'use_rename' bit to symbol_attribute.
* module.c : Add 'renamed' field to pointer_info.u.rsym.
(load_generic_interfaces): Add 'renamed' that is set after the
number_use_names is called. This is used to set the attribute
use_rename, which, in its turn identifies those symbols that
have not been renamed.
(load_needed): If pointer_info.u.rsym->renamed is set, then
set the use_rename attribute of the symbol.
(read_module): Correct an erroneous use of use_flag. Use the
renamed flag and the use_rename attribute to determine which
symbols are not renamed.
2007-11-26 Steven G. Kargl <kargls@comcast.net>
PR fortran/34203

4
gcc/fortran/decl.c
View File

@ -728,9 +728,9 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
/* If the ENTRY proceeds its specification, we need to ensure
that this does not raise a "has no IMPLICIT type" error. */
if (sym->ts.type == BT_UNKNOWN)
sym->attr.untyped = 1;
sym->attr.untyped = 1;
(*result)->ts = sym->ts;
(*result)->ts = sym->ts;
/* Put the symbol in the procedure namespace so that, should
the ENTRY preceed its specification, the specification

1
gcc/fortran/gfortran.h
View File

@ -618,6 +618,7 @@ typedef struct
protected:1, /* Symbol has been marked as protected. */
use_assoc:1, /* Symbol has been use-associated. */
use_only:1, /* Symbol has been use-associated, with ONLY. */
use_rename:1, /* Symbol has been use-associated and renamed. */
imported:1; /* Symbol has been associated by IMPORT. */
unsigned in_namelist:1, in_common:1, in_equivalence:1;

2
gcc/fortran/interface.c
View File

@ -1782,7 +1782,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|| f->sym->as->type == AS_DEFERRED);
if (f->sym->ts.type == BT_CHARACTER && a->expr->ts.type == BT_CHARACTER
&& a->expr->rank == 0
&& a->expr->rank == 0 && !ranks_must_agree
&& f->sym->as && f->sym->as->type != AS_ASSUMED_SHAPE)
{
if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)

22
gcc/fortran/module.c
View File

@ -136,7 +136,7 @@ typedef struct pointer_info
enum
{ UNUSED, NEEDED, USED }
state;
int ns, referenced;
int ns, referenced, renamed;
module_locus where;
fixup_t *stfixup;
gfc_symtree *symtree;
@ -3260,7 +3260,7 @@ load_generic_interfaces (void)
char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
gfc_interface *generic = NULL;
int n, i;
int n, i, renamed;
mio_lparen ();
@ -3272,6 +3272,7 @@ load_generic_interfaces (void)
mio_internal_string (module);
n = number_use_names (name, false);
renamed = n ? 1 : 0;
n = n ? n : 1;
for (i = 1; i <= n; i++)
@ -3300,7 +3301,9 @@ load_generic_interfaces (void)
{
/* Make symtree inaccessible by renaming if the symbol has
been added by a USE statement without an ONLY(11.3.2). */
if (st && !st->n.sym->attr.use_only && only_flag
if (st && only_flag
&& !st->n.sym->attr.use_only
&& !st->n.sym->attr.use_rename
&& strcmp (st->n.sym->module, module_name) == 0)
st->name = gfc_get_string ("hidden.%s", name);
else if (st)
@ -3342,6 +3345,7 @@ load_generic_interfaces (void)
}
sym->attr.use_only = only_flag;
sym->attr.use_rename = renamed;
if (i == 1)
{
@ -3523,6 +3527,8 @@ load_needed (pointer_info *p)
sym->attr.use_assoc = 1;
if (only_flag)
sym->attr.use_only = 1;
if (p->u.rsym.renamed)
sym->attr.use_rename = 1;
return 1;
}
@ -3666,6 +3672,8 @@ read_module (void)
/* See how many use names there are. If none, go through the start
of the loop at least once. */
nuse = number_use_names (name, false);
info->u.rsym.renamed = nuse ? 1 : 0;
if (nuse == 0)
nuse = 1;
@ -3679,7 +3687,7 @@ read_module (void)
/* Skip symtree nodes not in an ONLY clause, unless there
is an existing symtree loaded from another USE statement. */
if (p == NULL && only_flag)
if (p == NULL)
{
st = gfc_find_symtree (gfc_current_ns->sym_root, name);
if (st != NULL)
@ -3691,7 +3699,7 @@ read_module (void)
this symbol, which is not in an ONLY clause, must not be
added to the namespace(11.3.2). Note that find_symbol
only returns the first occurrence that it finds. */
if (!only_flag
if (!only_flag && !info->u.rsym.renamed
&& strcmp (name, module_name) != 0
&& find_symbol (gfc_current_ns->sym_root, name,
module_name, 0))
@ -3712,7 +3720,9 @@ read_module (void)
/* Make symtree inaccessible by renaming if the symbol has
been added by a USE statement without an ONLY(11.3.2). */
if (st && !st->n.sym->attr.use_only && only_flag
if (st && only_flag
&& !st->n.sym->attr.use_only
&& !st->n.sym->attr.use_rename
&& strcmp (st->n.sym->module, module_name) == 0)
st->name = gfc_get_string ("hidden.%s", name);

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2007-11-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33541
* gfortran.dg/use_11.f90: New test.
PR fortran/34231
* gfortran.dg/generic_15.f90: New test.
2007-11-27 Jakub Jelinek <jakub@redhat.com>
PR target/34225

44
gcc/testsuite/gfortran.dg/generic_15.f90 Normal file
View File

@ -0,0 +1,44 @@
! { dg-do run }
! Test the fix for PR34231, in which the assumed size 'cnames'
! would be wrongly associated with the scalar argument.
!
! Contributed by <francois.jacq@irsn.fr>
!
MODULE test
TYPE odbase ; INTEGER :: value ; END TYPE
INTERFACE odfname
MODULE PROCEDURE odfamilycname,odfamilycnames
END INTERFACE
CONTAINS
SUBROUTINE odfamilycnames(base,nfam,cnames)
TYPE(odbase),INTENT(in) :: base
INTEGER ,INTENT(out) :: nfam
CHARACTER(*),INTENT(out) :: cnames(*)
cnames(1:nfam)='odfamilycnames'
END SUBROUTINE
SUBROUTINE odfamilycname(base,pos,cname)
TYPE(odbase),INTENT(in) :: base
INTEGER ,INTENT(in) :: pos
CHARACTER(*),INTENT(out) :: cname
cname='odfamilycname'
END SUBROUTINE
END MODULE
PROGRAM main
USE test
TYPE(odbase) :: base
INTEGER :: i=1
CHARACTER(14) :: cname
CHARACTER(14) :: cnames(1)
CALL odfname(base,i,cname)
if (trim (cname) .ne. "odfamilycname") call abort
CALL odfname(base,i,cnames)
if (trim (cnames(1)) .ne. "odfamilycnames") call abort
END PROGRAM
! { dg-final { cleanup-modules "test" } }

18
gcc/testsuite/gfortran.dg/use_11.f90 Normal file
View File

@ -0,0 +1,18 @@
! { dg-do run }
! Test the fix for a regression caused by the fix for PR33541,
! in which the second local version of a would not be associated.
!
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
! and Tobias Burnus <burnus@gcc.gnu.org>
!
module m
integer :: a
end module m
use m, local1 => a
use m, local2 => a
local1 = 5
local2 = 3
if (local1 .ne. local2) call abort ()
end
! { dg-final { cleanup-modules "test" } }