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
+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
/* 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
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;
|| 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)
enum
{ UNUSED, NEEDED, USED }
state;
- int ns, referenced;
+ int ns, referenced, renamed;
module_locus where;
fixup_t *stfixup;
gfc_symtree *symtree;
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 ();
mio_internal_string (module);
n = number_use_names (name, false);
+ renamed = n ? 1 : 0;
n = n ? n : 1;
for (i = 1; i <= n; i++)
{
/* 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)
}
sym->attr.use_only = only_flag;
+ sym->attr.use_rename = renamed;
if (i == 1)
{
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;
}
/* 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;
/* 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)
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))
/* 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);
+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
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
git://gcc.gnu.org / gcc.git / commitdiff