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