This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR24558, PR20877 and PR25047 - module function alternate entries.
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 31 May 2006 12:12:32 +0200
- Subject: [Patch, fortran] PR24558, PR20877 and PR25047 - module function alternate entries.
:ADDPATCH fortran:
This patch fixes PR24558 and, in so doing, PR20877 and PR25047. In all
three, a prior reference to a module function alternate entry would
produce the error: "insert_bbt(): Duplicate key found!" This occurs
because decl.c(get_proc_name) attempts to create a symtree for the entry
in the current namespace, when one has already been created as a result
of the reference.
The fix proceeds by adding a new argument to get_proc_name, which
signals that a module function entry is being processed. If this is
true, the new symtree is created in the module namespace and
gfc_add_procedure is called to add a module procedure.
Having cleared the duplicate key message a series of downstream steps
are required to persuade module function entries to work:
(i) In resolve.c(resolve_entries), the entry symbol needs to reference
the master entry namespace, so that the fake result mechanism works.
(ii) Trans-decl.c(gfc_create_module_variable) must return immediately on
seeing an entry because the subsequent check that the symbol namespace
is the module namespace fails.
(iii) Finally, the condition for parent_flag, in
trans-expr.c(gfc_conv_variable), must be corrected to deal with both
parent_decl and the proc_name backend_decl both being NULL. This pushed
gfc_get_fake_result_decl into segfaulting.
The first test case checks the functioning of module function entries
and the second checks that the correct errors are generated by the
incorrect code of PRs 20877 and 25047. PR20877 produces a slightly
strange error message, which comes from check_conflict and is due to the
order in which the PROCEDURE, ENTRY and RESULT attributes are
encountered. Changing this causes all manner of regressions and, since
the error message is correct and comprehensible, I have left well alone.
Regtested on FC5/Athlon1700. OK for trunk and 4.1?
Paul
2006-05-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24558
PR fortran/20877
PR fortran/25047
* decl.c (get_proc_name): Add new argument to flag that a
module function entry is being treated. If true, correct
error condition, add symtree to module namespace and add
a module procedure.
(gfc_match_function_decl, gfc_match_entry,
gfc_match_subroutine): Use the new argument in calls to
get_proc_name.
* resolve.c (resolve_entries): ENTRY symbol reference to
to master entry namespace if a module function.
* trans-decl.c (gfc_create_module_variable): Return if
the symbol is an entry.
* trans-exp.c (gfc_conv_variable): Check that parent_decl
is not NULL.
2006-05-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24558
* gfortran.dg/entry_6.f90: New test.
PR fortran/20877
PR fortran/25047
* gfortran.dg/entry_7.f90: New test.
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 114148)
--- gcc/fortran/decl.c (working copy)
*************** end:
*** 596,608 ****
parent, then the symbol is just created in the current unit. */
static int
! get_proc_name (const char *name, gfc_symbol ** result)
{
gfc_symtree *st;
gfc_symbol *sym;
int rc;
! if (gfc_current_ns->parent == NULL)
rc = gfc_get_symbol (name, NULL, result);
else
rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
--- 596,609 ----
parent, then the symbol is just created in the current unit. */
static int
! get_proc_name (const char *name, gfc_symbol ** result,
! bool module_fcn_entry)
{
gfc_symtree *st;
gfc_symbol *sym;
int rc;
! if (gfc_current_ns->parent == NULL || module_fcn_entry)
rc = gfc_get_symbol (name, NULL, result);
else
rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
*************** get_proc_name (const char *name, gfc_sym
*** 628,634 ****
if (sym->ts.kind != 0
&& sym->attr.proc == 0
&& gfc_current_ns->parent != NULL
! && sym->attr.access == 0)
gfc_error_now ("Procedure '%s' at %C has an explicit interface"
" and must not have attributes declared at %L",
name, &sym->declared_at);
--- 629,636 ----
if (sym->ts.kind != 0
&& sym->attr.proc == 0
&& gfc_current_ns->parent != NULL
! && sym->attr.access == 0
! && !module_fcn_entry)
gfc_error_now ("Procedure '%s' at %C has an explicit interface"
" and must not have attributes declared at %L",
name, &sym->declared_at);
*************** get_proc_name (const char *name, gfc_sym
*** 637,654 ****
if (gfc_current_ns->parent == NULL || *result == NULL)
return rc;
! st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
st->n.sym = sym;
sym->refs++;
/* See if the procedure should be a module procedure */
! if (sym->ns->proc_name != NULL
! && sym->ns->proc_name->attr.flavor == FL_MODULE
! && sym->attr.proc != PROC_MODULE
! && gfc_add_procedure (&sym->attr, PROC_MODULE,
! sym->name, NULL) == FAILURE)
rc = 2;
return rc;
--- 639,661 ----
if (gfc_current_ns->parent == NULL || *result == NULL)
return rc;
! /* Module function entries will already have a symtree in
! the current namespace but will need one at module level. */
! if (module_fcn_entry)
! st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
! else
! st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
st->n.sym = sym;
sym->refs++;
/* See if the procedure should be a module procedure */
! if (((sym->ns->proc_name != NULL
! && sym->ns->proc_name->attr.flavor == FL_MODULE
! && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
! && gfc_add_procedure (&sym->attr, PROC_MODULE,
! sym->name, NULL) == FAILURE)
rc = 2;
return rc;
*************** gfc_match_function_decl (void)
*** 2564,2570 ****
return MATCH_NO;
}
! if (get_proc_name (name, &sym))
return MATCH_ERROR;
gfc_new_block = sym;
--- 2571,2577 ----
return MATCH_NO;
}
! if (get_proc_name (name, &sym, false))
return MATCH_ERROR;
gfc_new_block = sym;
*************** gfc_match_entry (void)
*** 2667,2672 ****
--- 2674,2680 ----
match m;
gfc_entry_list *el;
locus old_loc;
+ bool module_procedure;
m = gfc_match_name (name);
if (m != MATCH_YES)
*************** gfc_match_entry (void)
*** 2727,2742 ****
return MATCH_ERROR;
}
if (gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
! && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE)
{
gfc_error("ENTRY statement at %C cannot appear in a "
"contained procedure");
return MATCH_ERROR;
}
! if (get_proc_name (name, &entry))
return MATCH_ERROR;
proc = gfc_current_block ();
--- 2735,2760 ----
return MATCH_ERROR;
}
+ module_procedure = gfc_current_ns->parent != NULL
+ && gfc_current_ns->parent->proc_name
+ && gfc_current_ns->parent->proc_name->attr.flavor == FL_MODULE;
+
if (gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
! && !module_procedure)
{
gfc_error("ENTRY statement at %C cannot appear in a "
"contained procedure");
return MATCH_ERROR;
}
! /* Module function entries need special care in get_proc_name
! because previous references within the function will have
! created symbols attached to the current namespace. */
! if (get_proc_name (name, &entry,
! gfc_current_ns->parent != NULL
! && module_procedure
! && gfc_current_ns->proc_name->attr.function))
return MATCH_ERROR;
proc = gfc_current_block ();
*************** gfc_match_subroutine (void)
*** 2865,2871 ****
if (m != MATCH_YES)
return m;
! if (get_proc_name (name, &sym))
return MATCH_ERROR;
gfc_new_block = sym;
--- 2883,2889 ----
if (m != MATCH_YES)
return m;
! if (get_proc_name (name, &sym, false))
return MATCH_ERROR;
gfc_new_block = sym;
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 114148)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_entries (gfc_namespace * ns)
*** 379,384 ****
--- 379,391 ----
ns->entries = el;
ns->proc_name->attr.entry = 1;
+ /* If it is a module function, it needs to be in the right namespace
+ so that gfc_get_fake_result_decl can gather up the results. */
+ if (ns->proc_name->attr.function
+ && ns->parent
+ && ns->parent->proc_name->attr.flavor == FL_MODULE)
+ el->sym->ns = ns;
+
/* Add an entry statement for it. */
c = gfc_get_code ();
c->op = EXEC_ENTRY;
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 114148)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_create_module_variable (gfc_symbol *
*** 2656,2661 ****
--- 2656,2666 ----
{
tree decl;
+ /* Module functions with alternate entries are dealt with later and
+ would get caught by the next condition. */
+ if (sym->attr.entry)
+ return;
+
/* Only output symbols from this module. */
if (sym->ns != module_namespace)
{
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 114148)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 359,364 ****
--- 359,365 ----
if ((se->expr == parent_decl && return_value)
|| (sym->ns && sym->ns->proc_name
+ && parent_decl
&& sym->ns->proc_name->backend_decl == parent_decl
&& (alternate_entry || entry_master)))
parent_flag = 1;
Index: gcc/testsuite/gfortran.dg/entry_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_6.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/entry_6.f90 (revision 0)
***************
*** 0 ****
--- 1,56 ----
+ ! { dg-do run }
+ ! Tests the fix for PR24558, which reported that module
+ ! alternate function entries did not work.
+ !
+ ! Contributed by Erik Edelmann <eedelman@gcc.gnu.org>
+ !
+ module foo
+ contains
+ function n1 (a)
+ integer :: n1, n2, a, b
+ integer, save :: c
+ c = a
+ n1 = c**3
+ return
+ entry n2 (b)
+ n2 = c * b
+ n2 = n2**2
+ return
+ end function n1
+ function z1 (u)
+ complex :: z1, z2, u, v
+ z1 = (1.0, 2.0) * u
+ return
+ entry z2 (v)
+ z2 = (3, 4) * v
+ return
+ end function z1
+ function n3 (d)
+ integer :: n3, d
+ n3 = n2(d) * n1(d) ! Check sibling references.
+ return
+ end function n3
+ function c1 (a)
+ character(4) :: c1, c2, a, b
+ c1 = a
+ if (a .eq. "abcd") c1 = "ABCD"
+ return
+ entry c2 (b)
+ c2 = b
+ if (b .eq. "wxyz") c2 = "WXYZ"
+ return
+ end function c1
+ end module foo
+ use foo
+ if (n1(9) .ne. 729) call abort ()
+ if (n2(2) .ne. 324) call abort ()
+ if (n3(19) .ne. 200564019) call abort ()
+ if (c1("lmno") .ne. "lmno") call abort ()
+ if (c1("abcd") .ne. "ABCD") call abort ()
+ if (c2("lmno") .ne. "lmno") call abort ()
+ if (c2("wxyz") .ne. "WXYZ") call abort ()
+ if (z1((3,4)) .ne. (-5, 10)) call abort ()
+ if (z2((5,6)) .ne. (-9, 38)) call abort ()
+ end
+
+ ! { dg-final { cleanup-modules "foo" } }
Index: gcc/testsuite/gfortran.dg/entry_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/entry_7.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/entry_7.f90 (revision 0)
***************
*** 0 ****
--- 1,25 ----
+ ! { dg-do compile }
+ ! Check that PR20877 and PR25047 are fixed by the patch for
+ ! PR24558. Both modules would emit the error:
+ ! insert_bbt(): Duplicate key found!
+ ! because of the prior references to a module function entry.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE TT
+ CONTAINS
+ FUNCTION K(I) RESULT(J)
+ ENTRY J() ! { dg-error "conflicts with PROCEDURE attribute" }
+ END FUNCTION K
+
+ integer function foo ()
+ character*4 bar ! { dg-error "type CHARACTER" }
+ foo = 21
+ return
+ entry bar ()
+ bar = "abcd"
+ end function
+ END MODULE TT
+
+
+ ! { dg-final { cleanup-modules "TT" } }
2006-05-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24558
PR fortran/20877
PR fortran/25047
* decl.c (get_proc_name): Add new argument to flag that a
module function entry is being treated. If true, correct
error condition, add symtree to module namespace and add
a module procedure.
(gfc_match_function_decl, gfc_match_entry,
gfc_match_subroutine): Use the new argument in calls to
get_proc_name.
* resolve.c (resolve_entries): ENTRY symbol reference to
to master entry namespace if a module function.
* trans-decl.c (gfc_create_module_variable): Return if
the symbol is an entry.
* trans-exp.c (gfc_conv_variable): Check that parent_decl
is not NULL.
2006-05-31 Paul Thomas <pault@gcc.gnu.org>
PR fortran/24558
* gfortran.dg/entry_6.f90: New test.
PR fortran/20877
PR fortran/25047
* gfortran.dg/entry_7.f90: New test.