[Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2886 bytes --]

:ADDPATCH fortran:

This turned out to be a bit of a sweat.  The PR report describes how

USE my_module
USE my_module, ONLY: xrename => x

would lead to x and xrename being available in the scope of the USE
statements.  This is contrary to 11.3.2 of the standard.  Being a bear
of little brain, I find this part of the standard to be quite obscure
and much prefer the description of the DEC Fortran manual:

<< If more than one USE statement for a given module appears in a
scoping unit, the following rules apply:

If one USE statement does not have the ONLY option, all public
entities in the module are accessible, and any rename- lists and
only-lists are interpreted as a single, concatenated rename-list.

If all the USE statements have ONLY options, all the only-lists are
interpreted as a single, concatenated only-list. Only those entities
named in one or more of the only-lists are accessible. >>

This is what I have implemented here for ordinary symbols and generic
interfaces. The former was easy but generic interfaces turned out to
be a complete pain.  I did not have the intestinal fortitude to move
on to operators.

In the case of ordinary symbols, all the action takes place in
'read_module'.  'find_symbol' was written to find a symtree that
refers to a given symbol name and module.  If this is found for a USE
without an ONLY clause and the found symbol was in an only-list, the
new symbol is not added.   When the new symbol is in a use-list and
the existing symbol was not, the symtree for the existing symbol is
renamed in such a way as to make it inaccessible.  Note, renaming the
symtree to the new, local-name does not work because its location in
the tree will, in general, not be correct.  Whilst it would be
possible to delete the symtree and recycle the symbol, the method
adopted here is simple and only costs the inaccessible symtree/symbol.

For generic interfaces, the same method is used to fix the PR.
However, this was made much more dificult by something that I had
encountered before and had compeletly forgotten: renaming of generic
interfaces did so to the symtree and the symbol. That is to say, the
use-name is completely lost, making a search for the symbol by
use-name "slightly impossible".  Thus, most of the work in
'load_generic_interfaces' was associated with setting the symtree to
the local_name and the sym to the use-name.

The testcase has three parts: a test that the original problem is
fixed, a test of its extension to generic interfaces and a check that
renaming to the original name in an only-list does not result in the
symbol being treated as if it were not in an only-list. Needless to
say, an intermediate version of the patch failed in this regard!

Bootstrapped and regtested on x86_ia64/FC5 - OK for trunk?

Whilst being reviewed, I will check it out on tonto-2.3 and one or two
of the other 'usual suspects'.

Paul

[-- Attachment #2: Change.Logs --]
[-- Type: text/plain, Size: 664 bytes --]

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

	PR fortran/33541
	* module.c (find_symtree_for_symbol): Move to new location.
	(find_symbol): New function.
	(load_generic_interfaces): Rework completely so that symtrees
	have the local name and symbols have the use name.  Renamed
	generic interfaces exclude the use of the interface without an
	ONLY clause (11.3.2).
	(read_module): Implement 11.3.2 in the same way as for generic
	interfaces.

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

	PR fortran/33541
	* gfortran.dg/nested_modules_1.f90: Change the reference to
	FOO, forbidden by the standard, to a reference to W.
	* gfortran.dg/use_only_1.f90: New test.

[-- Attachment #3: pr33541.diff --]
[-- Type: text/plain, Size: 11739 bytes --]

Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(révision 130286)
--- gcc/fortran/module.c	(copie de travail)
*************** mio_symbol (gfc_symbol *sym)
*** 3104,3109 ****
--- 3104,3166 ----
  
  /************************* Top level subroutines *************************/
  
+ /* Given a root symtree node and a symbol, try to find a symtree that
+    references the symbol that is not a unique name.  */
+ 
+ static gfc_symtree *
+ find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
+ {
+   gfc_symtree *s = NULL;
+ 
+   if (st == NULL)
+     return s;
+ 
+   s = find_symtree_for_symbol (st->right, sym);
+   if (s != NULL)
+     return s;
+   s = find_symtree_for_symbol (st->left, sym);
+   if (s != NULL)
+     return s;
+ 
+   if (st->n.sym == sym && !check_unique_name (st->name))
+     return st;
+ 
+   return s;
+ }
+ 
+ 
+ /* A recursive function to look for a speficic symbol by name and by
+    module.  Whilst several symtrees might point to one symbol, its
+    is sufficient for the purposes here than one exist.  Note that
+    generic interfaces are distinguished.  */
+ static gfc_symtree *
+ find_symbol (gfc_symtree *st, const char *name,
+ 	     const char *module, int generic)
+ {
+   int c;
+   gfc_symtree *retval;
+ 
+   if (st == NULL || st->n.sym == NULL)
+     return NULL;
+ 
+   c = strcmp (name, st->n.sym->name);
+   if (c == 0 && st->n.sym->module
+ 	     && strcmp (module, st->n.sym->module) == 0)
+     {
+       if ((!generic && !st->n.sym->attr.generic)
+ 	     || (generic && st->n.sym->attr.generic))
+ 	return st;
+     }
+ 
+   retval = find_symbol (st->left, name, module, generic);
+ 
+   if (retval == NULL)
+     retval = find_symbol (st->right, name, module, generic);
+ 
+   return retval;
+ }
+ 
+ 
  /* Skip a list between balanced left and right parens.  */
  
  static void
*************** load_generic_interfaces (void)
*** 3219,3259 ****
  
        for (i = 1; i <= n; i++)
  	{
  	  /* Decide if we need to load this one or not.  */
  	  p = find_use_name_n (name, &i, false);
  
! 	  if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
  	    {
! 	      while (parse_atom () != ATOM_RPAREN);
  	      continue;
  	    }
  
! 	  if (sym == NULL)
! 	    {
! 	      gfc_get_symbol (p, NULL, &sym);
! 
! 	      sym->attr.flavor = FL_PROCEDURE;
! 	      sym->attr.generic = 1;
! 	      sym->attr.use_assoc = 1;
  	    }
  	  else
  	    {
  	      /* Unless sym is a generic interface, this reference
  		 is ambiguous.  */
! 	      gfc_symtree *st;
! 	      p = p ? p : name;
! 	      st = gfc_find_symtree (gfc_current_ns->sym_root, p);
! 	      if (!sym->attr.generic
! 		  && sym->module != NULL
! 		  && strcmp(module, sym->module) != 0)
  		st->ambiguous = 1;
  	    }
  	  if (i == 1)
  	    {
  	      mio_interface_rest (&sym->generic);
  	      generic = sym->generic;
  	    }
! 	  else
  	    {
  	      sym->generic = generic;
  	      sym->attr.generic_copy = 1;
--- 3276,3352 ----
  
        for (i = 1; i <= n; i++)
  	{
+ 	  gfc_symtree *st;
  	  /* Decide if we need to load this one or not.  */
  	  p = find_use_name_n (name, &i, false);
  
! 	  st = find_symbol (gfc_current_ns->sym_root,
! 			    name, module_name, 1);
! 
! 	  if (!p || gfc_find_symbol (p, NULL, 0, &sym))
  	    {
! 	      /* Skip the specific names for these cases.  */
! 	      while (i == 1 && parse_atom () != ATOM_RPAREN);
! 
  	      continue;
  	    }
  
! 	  /* If the symbol exists already and is being USEd without being
! 	     in an ONLY clause, do not load a new symtree(11.3.2).  */
! 	  if (!only_flag && st)
! 	    sym = st->n.sym;
! 
! 	  if (!sym)
! 	    {
! 	      /* 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
! 		     && strcmp (st->n.sym->module, module_name) == 0)
! 		st->name = gfc_get_string ("hidden.%s", name);
! 	      else if (st)
! 		{
! 		  sym = st->n.sym;
! 		  if (strcmp (st->name, p) != 0)
! 		    {
! 	              st = gfc_new_symtree (&gfc_current_ns->sym_root, p);
! 		      st->n.sym = sym;
! 		      sym->refs++;
! 		    }
! 		}
! 
! 	      /* Since we haven't found a valid generic interface, we had
! 		 better make one.  */
! 	      if (!sym)
! 		{
! 		  gfc_get_symbol (p, NULL, &sym);
! 		  sym->name = gfc_get_string (name);
! 		  sym->module = gfc_get_string (module_name);
! 		  sym->attr.flavor = FL_PROCEDURE;
! 		  sym->attr.generic = 1;
! 		  sym->attr.use_assoc = 1;
! 		}
  	    }
  	  else
  	    {
  	      /* Unless sym is a generic interface, this reference
  		 is ambiguous.  */
! 	      if (st == NULL)
! 	        st = gfc_find_symtree (gfc_current_ns->sym_root, p);
! 
! 	      sym = st->n.sym;
! 
! 	      if (st && !sym->attr.generic
! 		     && sym->module
! 		     && strcmp(module, sym->module))
  		st->ambiguous = 1;
  	    }
+ 
  	  if (i == 1)
  	    {
  	      mio_interface_rest (&sym->generic);
  	      generic = sym->generic;
  	    }
! 	  else if (!sym->generic)
  	    {
  	      sym->generic = generic;
  	      sym->attr.generic_copy = 1;
*************** read_cleanup (pointer_info *p)
*** 3467,3497 ****
  }
  
  
- /* Given a root symtree node and a symbol, try to find a symtree that
-    references the symbol that is not a unique name.  */
- 
- static gfc_symtree *
- find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
- {
-   gfc_symtree *s = NULL;
- 
-   if (st == NULL)
-     return s;
- 
-   s = find_symtree_for_symbol (st->right, sym);
-   if (s != NULL)
-     return s;
-   s = find_symtree_for_symbol (st->left, sym);
-   if (s != NULL)
-     return s;
- 
-   if (st->n.sym == sym && !check_unique_name (st->name))
-     return st;
- 
-   return s;
- }
- 
- 
  /* Read a module file.  */
  
  static void
--- 3560,3565 ----
*************** read_module (void)
*** 3608,3614 ****
  
  	  /* Skip symtree nodes not in an ONLY clause, unless there
  	     is an existing symtree loaded from another USE statement.  */
! 	  if (p == NULL)
  	    {
  	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
  	      if (st != NULL)
--- 3676,3682 ----
  
  	  /* Skip symtree nodes not in an ONLY clause, unless there
  	     is an existing symtree loaded from another USE statement.  */
! 	  if (p == NULL && only_flag)
  	    {
  	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
  	      if (st != NULL)
*************** read_module (void)
*** 3616,3621 ****
--- 3684,3699 ----
  	      continue;
  	    }
  
+ 	  /* If a symbol of the same name and module exists already,
+ 	     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
+ 		&& strcmp (name, module_name) != 0
+ 		&& find_symbol (gfc_current_ns->sym_root, name,
+ 				module_name, 0))
+ 	    continue;
+ 
  	  st = gfc_find_symtree (gfc_current_ns->sym_root, p);
  
  	  if (st != NULL)
*************** read_module (void)
*** 3627,3632 ****
--- 3705,3718 ----
  	    }
  	  else
  	    {
+ 	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ 
+ 	      /* 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
+ 		     && strcmp (st->n.sym->module, module_name) == 0)
+ 		st->name = gfc_get_string ("hidden.%s", name);
+ 
  	      /* Create a symtree node in the current namespace for this
  		 symbol.  */
  	      st = check_unique_name (p)
Index: D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90
===================================================================
*** D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90	(révision 130286)
--- D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90	(copie de travail)
***************
*** 35,41 ****
  
         use mod2
         use mod0, only: w=>foo
!        FOO = (0.0d0, 1.0d0)
         KANGA = (0.0d0, -1.0d0)
         ROBIN = (99.0d0, 99.0d0)
         call eyeore ()
--- 35,41 ----
  
         use mod2
         use mod0, only: w=>foo
!        w = (0.0d0, 1.0d0)  ! Was foo but this is forbidden (11.3.2)
         KANGA = (0.0d0, -1.0d0)
         ROBIN = (99.0d0, 99.0d0)
         call eyeore ()
Index: D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90
===================================================================
*** D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90	(révision 0)
--- D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90	(révision 0)
***************
*** 0 ****
--- 1,91 ----
+ ! { dg-do run }
+ ! { dg-options "-O1" }
+ ! Checks the fix for PR33541, in which a requirement of
+ ! F95 11.3.2 was not being met: The local names 'x' and
+ ! 'y' coming from the USE statements without an ONLY clause
+ ! should not survive in the presence of the locally renamed
+ ! versions. In fixing the PR, the same correction has been
+ ! made to generic interfaces.
+ !
+ ! Reported by Reported by John Harper in
+ ! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html
+ !
+ MODULE xmod
+   integer(4) :: x = -666
+   private foo, bar
+   interface xfoobar
+     module procedure foo, bar
+   end interface
+ contains
+   integer function foo ()
+     foo = 42
+   end function
+   integer function bar (a)
+     integer a
+     bar = a
+   end function
+ END MODULE xmod
+ 
+ MODULE ymod
+   integer(4) :: y = -666
+   private foo, bar
+   interface yfoobar
+     module procedure foo, bar
+   end interface
+ contains
+   integer function foo ()
+     foo = 42
+   end function
+   integer function bar (a)
+     integer a
+     bar = a
+   end function
+ END MODULE ymod
+ 
+   integer function xfoobar () ! These function as defaults should...
+     xfoobar = 99
+   end function
+ 
+   integer function yfoobar () ! ...the rename works correctly.
+     yfoobar = 99
+   end function
+ 
+ PROGRAM test2uses
+   implicit integer(2) (a-z)
+   x = 666  ! These assignments generate implicitly typed
+   y = 666  ! local variables 'x' and 'y'.
+   call test1
+   call test2
+   call test3
+ contains
+   subroutine test1  ! Test the fix of the original PR
+     USE xmod
+     USE xmod, ONLY: xrenamed => x
+     USE ymod, ONLY: yrenamed => y
+     USE ymod
+     implicit integer(2) (a-z)
+     if (kind(xrenamed) == kind(x)) call abort ()
+     if (kind(yrenamed) == kind(y)) call abort ()
+   end subroutine
+ 
+   subroutine test2  ! Test the fix applies to generic interfaces
+     USE xmod
+     USE xmod, ONLY: xfoobar_renamed => xfoobar
+     USE ymod, ONLY: yfoobar_renamed => yfoobar
+     USE ymod
+     if (xfoobar_renamed (42) == xfoobar ()) call abort ()
+     if (yfoobar_renamed (42) == yfoobar ()) call abort ()
+   end subroutine
+ 
+   subroutine test3  ! Check that USE_NAME == LOCAL_NAME is OK
+     USE xmod
+     USE xmod, ONLY: x => x, xfoobar => xfoobar
+     USE ymod, ONLY: y => y, yfoobar => yfoobar
+     USE ymod
+     if (kind (x) /= 4) call abort ()    
+     if (kind (y) /= 4) call abort ()    
+     if (xfoobar (77) /= 77_4) call abort ()
+     if (yfoobar (77) /= 77_4) call abort ()
+   end subroutine
+ END PROGRAM test2uses
+ ! { dg-final { cleanup-modules "xmod ymod" } }

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Paul Richard Thomas]

Please hold this for 24 hours - there is one regression in the final
version that I had failed to notice.

Paul

On 11/22/07, Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> :ADDPATCH fortran:
>
> This turned out to be a bit of a sweat.  The PR report describes how
>
> USE my_module
> USE my_module, ONLY: xrename => x
>
> would lead to x and xrename being available in the scope of the USE
> statements.  This is contrary to 11.3.2 of the standard.  Being a bear
> of little brain, I find this part of the standard to be quite obscure
> and much prefer the description of the DEC Fortran manual:
>
> << If more than one USE statement for a given module appears in a
> scoping unit, the following rules apply:
>
> If one USE statement does not have the ONLY option, all public
> entities in the module are accessible, and any rename- lists and
> only-lists are interpreted as a single, concatenated rename-list.
>
> If all the USE statements have ONLY options, all the only-lists are
> interpreted as a single, concatenated only-list. Only those entities
> named in one or more of the only-lists are accessible. >>
>
> This is what I have implemented here for ordinary symbols and generic
> interfaces. The former was easy but generic interfaces turned out to
> be a complete pain.  I did not have the intestinal fortitude to move
> on to operators.
>
> In the case of ordinary symbols, all the action takes place in
> 'read_module'.  'find_symbol' was written to find a symtree that
> refers to a given symbol name and module.  If this is found for a USE
> without an ONLY clause and the found symbol was in an only-list, the
> new symbol is not added.   When the new symbol is in a use-list and
> the existing symbol was not, the symtree for the existing symbol is
> renamed in such a way as to make it inaccessible.  Note, renaming the
> symtree to the new, local-name does not work because its location in
> the tree will, in general, not be correct.  Whilst it would be
> possible to delete the symtree and recycle the symbol, the method
> adopted here is simple and only costs the inaccessible symtree/symbol.
>
> For generic interfaces, the same method is used to fix the PR.
> However, this was made much more dificult by something that I had
> encountered before and had compeletly forgotten: renaming of generic
> interfaces did so to the symtree and the symbol. That is to say, the
> use-name is completely lost, making a search for the symbol by
> use-name "slightly impossible".  Thus, most of the work in
> 'load_generic_interfaces' was associated with setting the symtree to
> the local_name and the sym to the use-name.
>
> The testcase has three parts: a test that the original problem is
> fixed, a test of its extension to generic interfaces and a check that
> renaming to the original name in an only-list does not result in the
> symbol being treated as if it were not in an only-list. Needless to
> say, an intermediate version of the patch failed in this regard!
>
> Bootstrapped and regtested on x86_ia64/FC5 - OK for trunk?
>
> Whilst being reviewed, I will check it out on tonto-2.3 and one or two
> of the other 'usual suspects'.
>
> Paul
>
>


-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 296 bytes --]

Cancel that:

> Please hold this for 24 hours - there is one regression in the final
> version that I had failed to notice.

I slipped up during the final cleanup and lost the line

+
+ 	  sym->attr.use_only = only_flag;
+

Please find attached the corrected patch.

Sorry about the muddle

Paul

[-- Attachment #2: pr33541.diff --]
[-- Type: text/plain, Size: 11781 bytes --]

Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c	(révision 130286)
--- gcc/fortran/module.c	(copie de travail)
*************** mio_symbol (gfc_symbol *sym)
*** 3104,3109 ****
--- 3104,3166 ----
  
  /************************* Top level subroutines *************************/
  
+ /* Given a root symtree node and a symbol, try to find a symtree that
+    references the symbol that is not a unique name.  */
+ 
+ static gfc_symtree *
+ find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
+ {
+   gfc_symtree *s = NULL;
+ 
+   if (st == NULL)
+     return s;
+ 
+   s = find_symtree_for_symbol (st->right, sym);
+   if (s != NULL)
+     return s;
+   s = find_symtree_for_symbol (st->left, sym);
+   if (s != NULL)
+     return s;
+ 
+   if (st->n.sym == sym && !check_unique_name (st->name))
+     return st;
+ 
+   return s;
+ }
+ 
+ 
+ /* A recursive function to look for a speficic symbol by name and by
+    module.  Whilst several symtrees might point to one symbol, its
+    is sufficient for the purposes here than one exist.  Note that
+    generic interfaces are distinguished.  */
+ static gfc_symtree *
+ find_symbol (gfc_symtree *st, const char *name,
+ 	     const char *module, int generic)
+ {
+   int c;
+   gfc_symtree *retval;
+ 
+   if (st == NULL || st->n.sym == NULL)
+     return NULL;
+ 
+   c = strcmp (name, st->n.sym->name);
+   if (c == 0 && st->n.sym->module
+ 	     && strcmp (module, st->n.sym->module) == 0)
+     {
+       if ((!generic && !st->n.sym->attr.generic)
+ 	     || (generic && st->n.sym->attr.generic))
+ 	return st;
+     }
+ 
+   retval = find_symbol (st->left, name, module, generic);
+ 
+   if (retval == NULL)
+     retval = find_symbol (st->right, name, module, generic);
+ 
+   return retval;
+ }
+ 
+ 
  /* Skip a list between balanced left and right parens.  */
  
  static void
*************** load_generic_interfaces (void)
*** 3219,3259 ****
  
        for (i = 1; i <= n; i++)
  	{
  	  /* Decide if we need to load this one or not.  */
  	  p = find_use_name_n (name, &i, false);
  
! 	  if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
  	    {
! 	      while (parse_atom () != ATOM_RPAREN);
  	      continue;
  	    }
  
! 	  if (sym == NULL)
! 	    {
! 	      gfc_get_symbol (p, NULL, &sym);
! 
! 	      sym->attr.flavor = FL_PROCEDURE;
! 	      sym->attr.generic = 1;
! 	      sym->attr.use_assoc = 1;
  	    }
  	  else
  	    {
  	      /* Unless sym is a generic interface, this reference
  		 is ambiguous.  */
! 	      gfc_symtree *st;
! 	      p = p ? p : name;
! 	      st = gfc_find_symtree (gfc_current_ns->sym_root, p);
! 	      if (!sym->attr.generic
! 		  && sym->module != NULL
! 		  && strcmp(module, sym->module) != 0)
  		st->ambiguous = 1;
  	    }
  	  if (i == 1)
  	    {
  	      mio_interface_rest (&sym->generic);
  	      generic = sym->generic;
  	    }
! 	  else
  	    {
  	      sym->generic = generic;
  	      sym->attr.generic_copy = 1;
--- 3276,3354 ----
  
        for (i = 1; i <= n; i++)
  	{
+ 	  gfc_symtree *st;
  	  /* Decide if we need to load this one or not.  */
  	  p = find_use_name_n (name, &i, false);
  
! 	  st = find_symbol (gfc_current_ns->sym_root,
! 			    name, module_name, 1);
! 
! 	  if (!p || gfc_find_symbol (p, NULL, 0, &sym))
  	    {
! 	      /* Skip the specific names for these cases.  */
! 	      while (i == 1 && parse_atom () != ATOM_RPAREN);
! 
  	      continue;
  	    }
  
! 	  /* If the symbol exists already and is being USEd without being
! 	     in an ONLY clause, do not load a new symtree(11.3.2).  */
! 	  if (!only_flag && st)
! 	    sym = st->n.sym;
! 
! 	  if (!sym)
! 	    {
! 	      /* 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
! 		     && strcmp (st->n.sym->module, module_name) == 0)
! 		st->name = gfc_get_string ("hidden.%s", name);
! 	      else if (st)
! 		{
! 		  sym = st->n.sym;
! 		  if (strcmp (st->name, p) != 0)
! 		    {
! 	              st = gfc_new_symtree (&gfc_current_ns->sym_root, p);
! 		      st->n.sym = sym;
! 		      sym->refs++;
! 		    }
! 		}
! 
! 	      /* Since we haven't found a valid generic interface, we had
! 		 better make one.  */
! 	      if (!sym)
! 		{
! 		  gfc_get_symbol (p, NULL, &sym);
! 		  sym->name = gfc_get_string (name);
! 		  sym->module = gfc_get_string (module_name);
! 		  sym->attr.flavor = FL_PROCEDURE;
! 		  sym->attr.generic = 1;
! 		  sym->attr.use_assoc = 1;
! 		}
  	    }
  	  else
  	    {
  	      /* Unless sym is a generic interface, this reference
  		 is ambiguous.  */
! 	      if (st == NULL)
! 	        st = gfc_find_symtree (gfc_current_ns->sym_root, p);
! 
! 	      sym = st->n.sym;
! 
! 	      if (st && !sym->attr.generic
! 		     && sym->module
! 		     && strcmp(module, sym->module))
  		st->ambiguous = 1;
  	    }
+ 
+ 	  sym->attr.use_only = only_flag;
+ 
  	  if (i == 1)
  	    {
  	      mio_interface_rest (&sym->generic);
  	      generic = sym->generic;
  	    }
! 	  else if (!sym->generic)
  	    {
  	      sym->generic = generic;
  	      sym->attr.generic_copy = 1;
*************** read_cleanup (pointer_info *p)
*** 3467,3497 ****
  }
  
  
- /* Given a root symtree node and a symbol, try to find a symtree that
-    references the symbol that is not a unique name.  */
- 
- static gfc_symtree *
- find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
- {
-   gfc_symtree *s = NULL;
- 
-   if (st == NULL)
-     return s;
- 
-   s = find_symtree_for_symbol (st->right, sym);
-   if (s != NULL)
-     return s;
-   s = find_symtree_for_symbol (st->left, sym);
-   if (s != NULL)
-     return s;
- 
-   if (st->n.sym == sym && !check_unique_name (st->name))
-     return st;
- 
-   return s;
- }
- 
- 
  /* Read a module file.  */
  
  static void
--- 3562,3567 ----
*************** read_module (void)
*** 3608,3614 ****
  
  	  /* Skip symtree nodes not in an ONLY clause, unless there
  	     is an existing symtree loaded from another USE statement.  */
! 	  if (p == NULL)
  	    {
  	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
  	      if (st != NULL)
--- 3678,3684 ----
  
  	  /* Skip symtree nodes not in an ONLY clause, unless there
  	     is an existing symtree loaded from another USE statement.  */
! 	  if (p == NULL && only_flag)
  	    {
  	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
  	      if (st != NULL)
*************** read_module (void)
*** 3616,3621 ****
--- 3686,3701 ----
  	      continue;
  	    }
  
+ 	  /* If a symbol of the same name and module exists already,
+ 	     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
+ 		&& strcmp (name, module_name) != 0
+ 		&& find_symbol (gfc_current_ns->sym_root, name,
+ 				module_name, 0))
+ 	    continue;
+ 
  	  st = gfc_find_symtree (gfc_current_ns->sym_root, p);
  
  	  if (st != NULL)
*************** read_module (void)
*** 3627,3632 ****
--- 3707,3720 ----
  	    }
  	  else
  	    {
+ 	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+ 
+ 	      /* 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
+ 		     && strcmp (st->n.sym->module, module_name) == 0)
+ 		st->name = gfc_get_string ("hidden.%s", name);
+ 
  	      /* Create a symtree node in the current namespace for this
  		 symbol.  */
  	      st = check_unique_name (p)
Index: D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90
===================================================================
*** D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90	(révision 130286)
--- D:/svn/trunk/gcc/testsuite/gfortran.dg/nested_modules_1.f90	(copie de travail)
***************
*** 35,41 ****
  
         use mod2
         use mod0, only: w=>foo
!        FOO = (0.0d0, 1.0d0)
         KANGA = (0.0d0, -1.0d0)
         ROBIN = (99.0d0, 99.0d0)
         call eyeore ()
--- 35,41 ----
  
         use mod2
         use mod0, only: w=>foo
!        w = (0.0d0, 1.0d0)  ! Was foo but this is forbidden (11.3.2)
         KANGA = (0.0d0, -1.0d0)
         ROBIN = (99.0d0, 99.0d0)
         call eyeore ()
Index: D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90
===================================================================
*** D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90	(révision 0)
--- D:/svn/trunk/gcc/testsuite/gfortran.dg/use_only_1.f90	(révision 0)
***************
*** 0 ****
--- 1,91 ----
+ ! { dg-do run }
+ ! { dg-options "-O1" }
+ ! Checks the fix for PR33541, in which a requirement of
+ ! F95 11.3.2 was not being met: The local names 'x' and
+ ! 'y' coming from the USE statements without an ONLY clause
+ ! should not survive in the presence of the locally renamed
+ ! versions. In fixing the PR, the same correction has been
+ ! made to generic interfaces.
+ !
+ ! Reported by Reported by John Harper in
+ ! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html
+ !
+ MODULE xmod
+   integer(4) :: x = -666
+   private foo, bar
+   interface xfoobar
+     module procedure foo, bar
+   end interface
+ contains
+   integer function foo ()
+     foo = 42
+   end function
+   integer function bar (a)
+     integer a
+     bar = a
+   end function
+ END MODULE xmod
+ 
+ MODULE ymod
+   integer(4) :: y = -666
+   private foo, bar
+   interface yfoobar
+     module procedure foo, bar
+   end interface
+ contains
+   integer function foo ()
+     foo = 42
+   end function
+   integer function bar (a)
+     integer a
+     bar = a
+   end function
+ END MODULE ymod
+ 
+   integer function xfoobar () ! These function as defaults should...
+     xfoobar = 99
+   end function
+ 
+   integer function yfoobar () ! ...the rename works correctly.
+     yfoobar = 99
+   end function
+ 
+ PROGRAM test2uses
+   implicit integer(2) (a-z)
+   x = 666  ! These assignments generate implicitly typed
+   y = 666  ! local variables 'x' and 'y'.
+   call test1
+   call test2
+   call test3
+ contains
+   subroutine test1  ! Test the fix of the original PR
+     USE xmod
+     USE xmod, ONLY: xrenamed => x
+     USE ymod, ONLY: yrenamed => y
+     USE ymod
+     implicit integer(2) (a-z)
+     if (kind(xrenamed) == kind(x)) call abort ()
+     if (kind(yrenamed) == kind(y)) call abort ()
+   end subroutine
+ 
+   subroutine test2  ! Test the fix applies to generic interfaces
+     USE xmod
+     USE xmod, ONLY: xfoobar_renamed => xfoobar
+     USE ymod, ONLY: yfoobar_renamed => yfoobar
+     USE ymod
+     if (xfoobar_renamed (42) == xfoobar ()) call abort ()
+     if (yfoobar_renamed (42) == yfoobar ()) call abort ()
+   end subroutine
+ 
+   subroutine test3  ! Check that USE_NAME == LOCAL_NAME is OK
+     USE xmod
+     USE xmod, ONLY: x => x, xfoobar => xfoobar
+     USE ymod, ONLY: y => y, yfoobar => yfoobar
+     USE ymod
+     if (kind (x) /= 4) call abort ()    
+     if (kind (y) /= 4) call abort ()    
+     if (xfoobar (77) /= 77_4) call abort ()
+     if (yfoobar (77) /= 77_4) call abort ()
+   end subroutine
+ END PROGRAM test2uses
+ ! { dg-final { cleanup-modules "xmod ymod" } }

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Toon Moene]

Paul Richard Thomas wrote:

> I find this part of the standard to be quite obscure
> and much prefer the description of the DEC Fortran manual:
> 
> << If more than one USE statement for a given module appears in a
> scoping unit, the following rules apply:
> 
> If one USE statement does not have the ONLY option, all public
> entities in the module are accessible, and any rename- lists and
> only-lists are interpreted as a single, concatenated rename-list.
> 
> If all the USE statements have ONLY options, all the only-lists are
> interpreted as a single, concatenated only-list. Only those entities
> named in one or more of the only-lists are accessible. >>

Well, then perhaps we (J3) should add that (or something similar) as a note.

Kind regards,

-- 
Toon Moene - e-mail: toon@moene.indiv.nluug.nl - phone: +31 346 214290
Saturnushof 14, 3738 XG  Maartensdijk, The Netherlands
At home: http://moene.indiv.nluug.nl/~toon/
GNU Fortran's path to Fortran 2003: http://gcc.gnu.org/wiki/Fortran2003

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Paul Richard Thomas]

Dear All,

> > Please hold this for 24 hours - there is one regression in the final
> > version that I had failed to notice.

I should like to confirm that this last version of the patch
bootstraps and regtests on x86_ia64/FC5 and that tonto-2.3 builds OK
with it.

Cheers

Paul

PS Fixes for PR31213 and PR33499 were tested with it - see tomorrow's list.

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Jerry DeLisle]

Paul Richard Thomas wrote:
> Cancel that:
> 
>> Please hold this for 24 hours - there is one regression in the final
>> version that I had failed to notice.
> 
> I slipped up during the final cleanup and lost the line
> 
> +
> + 	  sym->attr.use_only = only_flag;
> +
> 
> Please find attached the corrected patch.
> 
> Sorry about the muddle
> 
> Paul
> 
Fixup this comment and OK to commit.  ;)

Jerry

s/its/it/
s/than/that/

+
+ /* A recursive function to look for a speficic symbol by name and by
+    module.  Whilst several symtrees might point to one symbol, its
+    is sufficient for the purposes here than one exist.  Note that
+    generic interfaces are distinguished.  */
+ static gfc_symtree *

Re: [Patch, fortran] PR33541 - gfortran wrongly imports renamed-use-associated symbol unrenamed

[Paul Richard Thomas]

Dear All,

Dominique and Tobias have pointed out a regression caused by the
patch.  I had completely neglected renaming that is not part of an
only-list.  Since all the mechanisms are in place to get this right, I
propose to spend 48hours on it and to update from here.  I have one
version of a patch regtesting right now but will need to examine it
very carefully against all the possible conditions.

Sorry that this is not right first go but it is quite complex!

Cheers

Paul

On Nov 22, 2007 4:44 PM, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> :ADDPATCH fortran:
>
> This turned out to be a bit of a sweat.  The PR report describes how
>
> USE my_module
> USE my_module, ONLY: xrename => x
>
> would lead to x and xrename being available in the scope of the USE
> statements.  This is contrary to 11.3.2 of the standard.  Being a bear
> of little brain, I find this part of the standard to be quite obscure
> and much prefer the description of the DEC Fortran manual:
>
> << If more than one USE statement for a given module appears in a
> scoping unit, the following rules apply:
>
> If one USE statement does not have the ONLY option, all public
> entities in the module are accessible, and any rename- lists and
> only-lists are interpreted as a single, concatenated rename-list.
>
> If all the USE statements have ONLY options, all the only-lists are
> interpreted as a single, concatenated only-list. Only those entities
> named in one or more of the only-lists are accessible. >>
>
> This is what I have implemented here for ordinary symbols and generic
> interfaces. The former was easy but generic interfaces turned out to
> be a complete pain.  I did not have the intestinal fortitude to move
> on to operators.
>
> In the case of ordinary symbols, all the action takes place in
> 'read_module'.  'find_symbol' was written to find a symtree that
> refers to a given symbol name and module.  If this is found for a USE
> without an ONLY clause and the found symbol was in an only-list, the
> new symbol is not added.   When the new symbol is in a use-list and
> the existing symbol was not, the symtree for the existing symbol is
> renamed in such a way as to make it inaccessible.  Note, renaming the
> symtree to the new, local-name does not work because its location in
> the tree will, in general, not be correct.  Whilst it would be
> possible to delete the symtree and recycle the symbol, the method
> adopted here is simple and only costs the inaccessible symtree/symbol.
>
> For generic interfaces, the same method is used to fix the PR.
> However, this was made much more dificult by something that I had
> encountered before and had compeletly forgotten: renaming of generic
> interfaces did so to the symtree and the symbol. That is to say, the
> use-name is completely lost, making a search for the symbol by
> use-name "slightly impossible".  Thus, most of the work in
> 'load_generic_interfaces' was associated with setting the symtree to
> the local_name and the sym to the use-name.
>
> The testcase has three parts: a test that the original problem is
> fixed, a test of its extension to generic interfaces and a check that
> renaming to the original name in an only-list does not result in the
> symbol being treated as if it were not in an only-list. Needless to
> say, an intermediate version of the patch failed in this regard!
>
> Bootstrapped and regtested on x86_ia64/FC5 - OK for trunk?
>
> Whilst being reviewed, I will check it out on tonto-2.3 and one or two
> of the other 'usual suspects'.
>
> Paul
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy