public inbox for gcc-bugs@sourceware.org help / color / mirror / Atom feed
From: "pault at gcc dot gnu dot org" <gcc-bugzilla@gcc.gnu.org> To: gcc-bugs@gcc.gnu.org Subject: [Bug fortran/30746] 50th Anniversary Bug - Forward reference to contained function Date: Thu, 10 May 2007 08:12:00 -0000 [thread overview] Message-ID: <20070510081159.16347.qmail@sourceware.org> (raw) In-Reply-To: <bug-30746-10374@http.gcc.gnu.org/bugzilla/> [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #1: Type: text/plain, Size: 5809 bytes --] ------- Comment #3 from pault at gcc dot gnu dot org 2007-05-10 09:11 ------- The patch below does the job. Before submitting, I want to check how much the compile time is hit. If it is a lot, I will try to streamline detection of the wrong host association. Paul Index: gcc/fortran/gfortran.h =================================================================== *** gcc/fortran/gfortran.h (révision 124567) --- gcc/fortran/gfortran.h (copie de travail) *************** bool gfc_check_access (gfc_access, gfc_a *** 2160,2165 **** --- 2160,2166 ---- /* primary.c */ symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_expr_attr (gfc_expr *); + match gfc_match_rvalue (gfc_expr **); /* trans.c */ void gfc_generate_code (gfc_namespace *); Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (révision 124567) --- gcc/fortran/resolve.c (copie de travail) *************** resolve_variable (gfc_expr *e) *** 3204,3209 **** --- 3204,3274 ---- } + /* Checks to see that the correct symbol has been host associated. + The only situation where this arises is that in which a contained + function is parsed after the host association is made. Therefore, + on detecting this, the line is rematched, having got rid of the + existing references and actual_arg_list. */ + static bool + check_host_association (gfc_expr *e) + { + gfc_symbol *sym, *old_sym; + locus temp_locus; + gfc_expr *expr; + + old_sym = e->symtree->n.sym; + if (!old_sym->attr.use_assoc && old_sym->ns != gfc_current_ns) + { + gfc_find_symbol (old_sym->name, gfc_current_ns->parent, 1, &sym); + if (sym && old_sym != sym && sym->attr.flavor == FL_PROCEDURE) + { + temp_locus = gfc_current_locus; + gfc_current_locus = e->where; + + gfc_buffer_error (1); + + gfc_free_ref_list (e->ref); + e->ref = NULL; + + if (e->expr_type == EXPR_FUNCTION) + { + gfc_free_actual_arglist (e->value.function.actual); + e->value.function.actual = NULL; + } + + if (e->shape != NULL) + { + for (n = 0; n < e->rank; n++) + mpz_clear (e->shape[n]); + + gfc_free (e->shape); + } + + + gfc_match_rvalue (&expr); + + gcc_assert (expr && sym == expr->symtree->n.sym); + + *e = *expr; + gfc_free (expr); + sym->refs++; + + /* Free the old symbol. */ + if (old_sym->ns->proc_name->attr.flavor != FL_MODULE) + { + old_sym->refs--; + if (old_sym->refs == 0) + gfc_free_symbol (old_sym); + } + + gfc_current_locus = temp_locus; + } + } + + return e->expr_type == EXPR_FUNCTION; + } + + /* Resolve an expression. That is, make sure that types of operands agree with their operators, intrinsic operators are converted to function calls for overloaded types and unresolved function references are resolved. */ *************** gfc_resolve_expr (gfc_expr *e) *** 3223,3235 **** break; case EXPR_FUNCTION: - t = resolve_function (e); - break; - case EXPR_VARIABLE: ! t = resolve_variable (e); ! if (t == SUCCESS) ! expression_rank (e); break; case EXPR_SUBSTRING: --- 3288,3303 ---- break; case EXPR_FUNCTION: case EXPR_VARIABLE: ! ! if (check_host_association (e)) ! t = resolve_function (e); ! else ! { ! t = resolve_variable (e); ! if (t == SUCCESS) ! expression_rank (e); ! } break; case EXPR_SUBSTRING: Index: gcc/fortran/match.h =================================================================== *** gcc/fortran/match.h (révision 124567) --- gcc/fortran/match.h (copie de travail) *************** match gfc_match_volatile (void); *** 153,159 **** /* primary.c */ match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **); - match gfc_match_rvalue (gfc_expr **); match gfc_match_variable (gfc_expr **, int); match gfc_match_equiv_variable (gfc_expr **); match gfc_match_actual_arglist (int, gfc_actual_arglist **); --- 153,158 ---- Index: gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 =================================================================== *** gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 (révision 0) --- gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 (révision 0) *************** *** 0 **** --- 1,26 ---- + ! { dg-do run } + ! Tests the fix for the bug PR30746, in which the reference to 'x' + ! in 'inner' wrongly host-associated with the variable 'x' rather + ! than the function. + ! + ! Testcase is due to Malcolm Cohen, NAG. + ! + MODULE m + REAL :: x(3) = (/ 1.5, 2.5, 3.5 /) + CONTAINS + SUBROUTINE s + CALL inner + CONTAINS + SUBROUTINE inner + i = 7 + if (x(7) .ne. real (7)**7) call abort () + END SUBROUTINE + FUNCTION x(n) + x = REAL(n)**n + END FUNCTION + END SUBROUTINE + END MODULE + use m + call s() + end + ! { dg-final { cleanup-modules "m" } } -- pault at gcc dot gnu dot org changed: What |Removed |Added ---------------------------------------------------------------------------- AssignedTo|unassigned at gcc dot gnu |pault at gcc dot gnu dot org |dot org | Status|NEW |ASSIGNED Last reconfirmed|2007-02-09 17:06:57 |2007-05-10 09:11:58 date| | http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30746
next prev parent reply other threads:[~2007-05-10 8:12 UTC|newest] Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top 2007-02-09 15:18 [Bug fortran/30746] New: 50th Anniversary Bug - scoping error pault at gcc dot gnu dot org 2007-02-09 15:19 ` [Bug fortran/30746] " pault at gcc dot gnu dot org 2007-02-09 17:07 ` fxcoudert at gcc dot gnu dot org 2007-05-10 8:12 ` pault at gcc dot gnu dot org [this message] 2007-05-10 11:19 ` [Bug fortran/30746] 50th Anniversary Bug - Forward reference to contained function pault at gcc dot gnu dot org 2007-05-10 20:11 ` patchapp at dberlin dot org 2007-05-12 6:20 ` pault at gcc dot gnu dot org 2007-05-12 6:22 ` pault at gcc dot gnu dot org
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20070510081159.16347.qmail@sourceware.org \ --to=gcc-bugzilla@gcc.gnu.org \ --cc=gcc-bugs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).