This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH, gfortran] PR18878


:ADDPATCH fortran:

(Sorry, forgot the Patch Queue and the New comment in the ChangeLog.)

This problem is best described by the testcase that is proposed to test the patch;

==============module_double_reuse.f90=================
! { dg-do run }
!
! Test of fix for PR18878
!
! Based on example in PR by Steve Kargl
!
module a
integer, parameter :: b = kind(1.d0)
real(b)            :: z
end module a
program d
use a, only : e => b, f => b, u => z, v => z
real(e) x
real(f) y
x = 1.e0_e
y = 1.e0_f
u = 99.0
if (kind(x).ne.kind(y)) call abort ()
if (v.ne.u) call abort ()
end program d
=======================================================

As things stand, gfortran only does one pass for each real name in the USE statement. Thus, in the above, the second renaming of b and of z get lost. A fix is to insert another USE a with the missing renames. This patch works by counting the number of instances of each real name and ensuring that they are all loaded.

Bublestrapped and regtested on Athlon/FC3.

OK for mainline and 4.0?

Best regards

Paul T


------------------------------------------------------------------------


2005-09-06 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/18878
	* module.c (find_use_name_n): Based on original
	find_use_name. Either counts number of use names for a
	given real name or returns use name n.
	(find_use_name, number_use_names): Interfaces to the
	function find_use_name_n.
	(read_module): Add the logic and calls to these functions,
	so that mutiple reuses of the same real name are loaded.

2005-09-06 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/18878
	* gfortran.dg/module_double_reuse.f90: New.

------------------------------------------------------------------------

*** module.c 2005-09-06 19:48:02.526590344 +0200
--- gcc/gcc/fortran/module.c 2005-09-06 20:49:15.984139912 +0200
*************** syntax:
*** 585,604 ****
cleanup:
free_rename ();
return MATCH_ERROR;
! }
! /* 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;
--- 585,618 ----
cleanup:
free_rename ();
return MATCH_ERROR;
! }
! /* 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_use_name_n (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)
*** 608,613 ****
--- 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_use_name_n (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_use_name_n (name, &i);
+ return i;
+ }
+ /* Try to find the operator in the current list. */
*************** read_module (void)
*** 3065,3071 ****
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)
*** 3132,3181 ****
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,3227 ----
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_use_name_n (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;
! }
}
}




Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]