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

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

gcc/fortran/ChangeLog

+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

gcc/fortran/decl.c

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

gcc/fortran/gfortran.h

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

gcc/fortran/interface.c

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

gcc/fortran/module.c

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

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/generic_15.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/use_11.f90

+! { 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" } }