From: Paul Thomas Date: Fri, 9 Jun 2006 22:16:08 +0000 (+0000) Subject: re PR fortran/24558 (ENTRY doesn't work in module procedures) X-Git-Tag: releases/gcc-4.2.0~2504 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=1a492601a1e4a1e5e16a2de9c10065ce062394e4;p=thirdparty%2Fgcc.git re PR fortran/24558 (ENTRY doesn't work in module procedures) 2006-06-10 Paul Thomas 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-06-10 Paul Thomas PR fortran/24558 * gfortran.dg/entry_6.f90: New test. PR fortran/20877 PR fortran/25047 * gfortran.dg/entry_7.f90: New test. From-SVN: r114526 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a576a2e35dd6..c68fd8c72d43 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2006-06-10 Paul Thomas + + 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-06-09 Jakub Jelinek PR fortran/27916 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0f2436a3e183..e8b1626609ae 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -596,13 +596,20 @@ end: parent, then the symbol is just created in the current unit. */ static int -get_proc_name (const char *name, gfc_symbol ** result) +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 functions have to be left in their own namespace because + they have potentially (almost certainly!) already been referenced. + In this sense, they are rather like external functions. This is + fixed up in resolve.c(resolve_entries), where the symbol name- + space is set to point to the master function, so that the fake + result mechanism can work. */ + if (module_fcn_entry) rc = gfc_get_symbol (name, NULL, result); else rc = gfc_get_symbol (name, gfc_current_ns->parent, result); @@ -628,7 +635,8 @@ get_proc_name (const char *name, gfc_symbol ** result) if (sym->ts.kind != 0 && sym->attr.proc == 0 && gfc_current_ns->parent != NULL - && sym->attr.access == 0) + && 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); @@ -637,18 +645,23 @@ get_proc_name (const char *name, gfc_symbol ** result) if (gfc_current_ns->parent == NULL || *result == NULL) return rc; - st = gfc_new_symtree (&gfc_current_ns->sym_root, name); + /* 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 - && gfc_add_procedure (&sym->attr, PROC_MODULE, - sym->name, NULL) == FAILURE) + 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; @@ -2564,7 +2577,7 @@ gfc_match_function_decl (void) return MATCH_NO; } - if (get_proc_name (name, &sym)) + if (get_proc_name (name, &sym, false)) return MATCH_ERROR; gfc_new_block = sym; @@ -2667,6 +2680,7 @@ gfc_match_entry (void) match m; gfc_entry_list *el; locus old_loc; + bool module_procedure; m = gfc_match_name (name); if (m != MATCH_YES) @@ -2727,16 +2741,26 @@ gfc_match_entry (void) 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 - && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE) + && !module_procedure) { gfc_error("ENTRY statement at %C cannot appear in a " "contained procedure"); return MATCH_ERROR; } - if (get_proc_name (name, &entry)) + /* 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 (); @@ -2865,7 +2889,7 @@ gfc_match_subroutine (void) if (m != MATCH_YES) return m; - if (get_proc_name (name, &sym)) + if (get_proc_name (name, &sym, false)) return MATCH_ERROR; gfc_new_block = sym; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 33e21df4ee8a..384b5a4e343d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -385,6 +385,16 @@ resolve_entries (gfc_namespace * ns) 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. The + need for this arose in get_proc_name, where these beasts were + left in their own namespace, to keep prior references linked to + the entry declaration.*/ + 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; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 30d51b996ca6..b4fa7f503a9a 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2653,6 +2653,11 @@ gfc_create_module_variable (gfc_symbol * sym) { 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) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9e5524f09c38..44143d168e2e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -361,6 +361,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e3bd0e4324a9..04f2d73d61b7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2006-06-10 Paul Thomas + + PR fortran/24558 + * gfortran.dg/entry_6.f90: New test. + + PR fortran/20877 + PR fortran/25047 + * gfortran.dg/entry_7.f90: New test. + 2006-06-09 Jakub Jelinek PR c/27747 diff --git a/gcc/testsuite/gfortran.dg/entry_6.f90 b/gcc/testsuite/gfortran.dg/entry_6.f90 new file mode 100644 index 000000000000..103392606b99 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_6.f90 @@ -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 +! +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" } } diff --git a/gcc/testsuite/gfortran.dg/entry_7.f90 b/gcc/testsuite/gfortran.dg/entry_7.f90 new file mode 100644 index 000000000000..fbe4b8e2af15 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_7.f90 @@ -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 +! +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" } }