[Bug fortran/18878] Erronous error message on vaild USE statement

["tobi at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- Additional Comments From tobi at gcc dot gnu dot org  2005-08-23 17:24 -------
I just received this e-mail:
...
Whilst at the airport, I saw a solution to PR18878, whose existence has 
bugged me for ages because it looks as if it should be easy.  I though 
that I would get it to you, via my sister's ISP but cannot do a proper 
submit until I am back home (1st Sept).  If either of you want to bang 
it in, please feel free; it is independent of the other patches.  This 
works:

! PR18878 example from Steve Kargl
!
module a
   integer, parameter :: b = kind(1.e0)
end module a
program d
   use a, only : e => b, f => b
   real(e) x
   real(f) y
   x = 1.e0_e
   y = 1.e0_f
   print *, x, y
end program d

as does this:

module global
  real a
end module global
program test_use
  use global, only: b=>a, c=>a
  b = 5
  if (c /= 5) call abort ()
end program test_use

it regtests fine under Cygwin/Athlon2200M

Best regards

Paul T

PS Cutting and pasting from Cygwin to XP is not good for my head.  
Excuses if it is a bit grunged up.

Index: gcc/gcc/fortran/module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.35
diff -c -p -r1.35 module.c
*** gcc/gcc/fortran/module.c    19 Aug 2005 09:05:03 -0000    1.35
--- gcc/gcc/fortran/module.c    23 Aug 2005 16:51:57 -0000
*************** cleanup:
*** 585,601 ****
  }
 
 
! /* Given a name, return the name under which to load this symbol.
!    Returns NULL if this symbol shouldn't be loaded.  */
 
  static const char *
! find_use_name (const char *name)
  {
    gfc_use_rename *u;
 
    for (u = gfc_rename_list; u; u = u->next)
!     if (strcmp (u->use_name, name) == 0)
!       break;
 
    if (u == NULL)
      return only_flag ? NULL : name;
--- 588,618 ----
  }
 
 
! /* Given a name and a number, inst, return the inst name
!    under which to load this symbol. Returns NULL if this
!    symbol shouldn't be loaded. If inst is zero, returns
!    the number of instances of this name.  */
 
  static const char *
! find_n_use_name (const char *name, int *inst)
  {
    gfc_use_rename *u;
+   int i;
 
+   i = 0;
    for (u = gfc_rename_list; u; u = u->next)
!     {
!       if (strcmp (u->use_name, name) != 0)
!     continue;
!       if (++i == *inst)
!     break;
!     }
!
!   if (!*inst)
!     {
!       *inst = i;
!       return NULL;
!     }
 
    if (u == NULL)
      return only_flag ? NULL : name;
*************** find_use_name (const char *name)
*** 605,610 ****
--- 622,649 ----
    return (u->local_name[0] != '\0') ? u->local_name : name;
  }
 
+ /* Given a name, return the name under which to load this symbol.
+    Returns NULL if this symbol shouldn't be loaded.  */
+
+ static const char *
+ find_use_name (const char *name)
+ {
+   int i = 1;
+   return find_n_use_name (name, &i);
+ }
+
+ /* Given a real name, return the number of use names associated
+    with it.  */
+
+ static int
+ number_use_names (const char *name)
+ {
+   int i = 0;
+   const char *c;
+   c = find_n_use_name (name, &i);
+   return i;
+ }
+
 
  /* Try to find the operator in the current list.  */
 
*************** read_module (void)
*** 3020,3026 ****
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1];
    gfc_intrinsic_op i;
!   int ambiguous, symbol;
    pointer_info *info;
    gfc_use_rename *u;
    gfc_symtree *st;
--- 3101,3107 ----
    const char *p;
    char name[GFC_MAX_SYMBOL_LEN + 1];
    gfc_intrinsic_op i;
!   int ambiguous, symbol, j, nuse;
    pointer_info *info;
    gfc_use_rename *u;
    gfc_symtree *st;
*************** read_module (void)
*** 3084,3133 ****
 
        info = get_integer (symbol);
 
!       /* Get the local name for this symbol.  */
!       p = find_use_name (name);
!
!       /* Skip symtree nodes not in an ONLY caluse.  */
!       if (p == NULL)
!     continue;
!
!       /* Check for ambiguous symbols.  */
!       st = gfc_find_symtree (gfc_current_ns->sym_root, p);
 
!       if (st != NULL)
!     {
!       if (st->n.sym != info->u.rsym.sym)
!         st->ambiguous = 1;
!           info->u.rsym.symtree = st;
!     }
!       else
      {
!           /* Create a symtree node in the current namespace for this 
symbol.  */
!       st = check_unique_name (p) ? get_unique_symtree (gfc_current_ns) :
!         gfc_new_symtree (&gfc_current_ns->sym_root, p);
 
!       st->ambiguous = ambiguous;
 
!       sym = info->u.rsym.sym;
 
!           /* Create a symbol node if it doesn't already exist.  */
!       if (sym == NULL)
          {
!           sym = info->u.rsym.sym =
!         gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns);
!
!           sym->module = gfc_get_string (info->u.rsym.module);
          }
 
!       st->n.sym = sym;
!       st->n.sym->refs++;
 
!           /* Store the symtree pointing to this symbol.  */
!           info->u.rsym.symtree = st;
 
!       if (info->u.rsym.state == UNUSED)
!         info->u.rsym.state = NEEDED;
!       info->u.rsym.referenced = 1;
      }
      }
 
--- 3168,3226 ----
 
        info = get_integer (symbol);
 
!       /* See how many use names there are.  If none, go through the start
!       of the loop at least once.  */
!       nuse = number_use_names (name);
!       if (nuse == 0)
!     nuse = 1;
 
!       for (j = 1; j <= nuse; j++)
      {
!       /* Get the jth local name for this symbol.  */
!        p = find_n_use_name (name, &j);
 
!       /* Skip symtree nodes not in an ONLY clause.  */
!        if (p == NULL)
!         continue;
 
!       /* Check for ambiguous symbols.  */
!       st = gfc_find_symtree (gfc_current_ns->sym_root, p);
 
!       if (st != NULL)
          {
!           if (st->n.sym != info->u.rsym.sym)
!         st->ambiguous = 1;
!           info->u.rsym.symtree = st;
          }
+       else
+         {
+           /* Create a symtree node in the current namespace for this 
symbol.  */
+           st = check_unique_name (p) ? get_unique_symtree 
(gfc_current_ns) :
+         gfc_new_symtree (&gfc_current_ns->sym_root, p);
+
+           st->ambiguous = ambiguous;
+
+           sym = info->u.rsym.sym;
+
+           /* Create a symbol node if it doesn't already exist.  */
+           if (sym == NULL)
+         {
+           sym = info->u.rsym.sym =
+             gfc_new_symbol (info->u.rsym.true_name, gfc_current_ns);
 
!           sym->module = gfc_get_string (info->u.rsym.module);
!         }
!
!           st->n.sym = sym;
!           st->n.sym->refs++;
 
!           /* Store the symtree pointing to this symbol.  */
!           info->u.rsym.symtree = st;
 
!           if (info->u.rsym.state == UNUSED)
!         info->u.rsym.state = NEEDED;
!           info->u.rsym.referenced = 1;
!         }
      }
      }
 

-- 
           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |tobi at gcc dot gnu dot org


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=18878