Ping: [Patch, fortran] PR24558, PR20877 and PR25047 - module function alternate entries.
Paul Thomas
paulthomas2@wanadoo.fr
Mon Jun 5 20:14:00 GMT 2006
This is in many ways a more significant patch than the PR25058/25090
patch; it fixes a feature that should be present but is broken at the
moment. However, unlike this latter, I would really like it to be
reviewed before I apply it. That said, I really must set a deadline of
Friday 6-7h00 CET before I patch trunk.
Paul
PS I am not convinced that alternate entries in module functions are a
GOOD THING, in the Pooh Bear sense, but there we are. This makes them work!
> :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.
>
>
More information about the Gcc-patches
mailing list