Malcolm Cohen's talk to the BCS 50th anniversary of FORTRAN meeting has this example: MODULE m REAL :: x(3) = (/ 1.5, 2.5, 3.5 /) CONTAINS SUBROUTINE s CALL inner CONTAINS SUBROUTINE inner PRINT *,x(7) ! This is not an error! END SUBROUTINE FUNCTION x(n) x = REAL(n)**n END FUNCTION END SUBROUTINE END MODULE use m call s() end to which, gfortran incorrectly returns PRINT *,x(7) ! This is not an error! 1 Warning: Array reference at (1) is out of bounds unless subroutine inner and function x are interchanged. Paul
Sorry, I forgot to add the keyword.
Confirmed. Sun and g95 also reject it, while Intel and Portland accept it.
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" } }
(In reply to comment #3) > The patch below does the job. Not quite - apart from 'n' not being declared, this patch causes a couple of regressions. These are easily fixed. However, if the function x has a different number of arguments to the rank of variable 'x', an error ensues. This is going to require a bit more work but it is promising. Paul
Subject: Bug number PR30746 A patch for this bug has been added to the patch tracker. The mailing list url for the patch is http://gcc.gnu.org/ml/gcc-patches/2007-05/msg00746.html
Subject: Bug 30746 Author: pault Date: Sat May 12 06:19:43 2007 New Revision: 124633 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=124633 Log: 2007-05-12 Paul Thomas <pault@gcc.gnu.org> PR fortran/30746 * resolve.c (check_host_association): New function that detects incorrect host association and corrects it. (gfc_resolve_expr): Call the new function for variables and functions. * match.h : Remove prototype for gfc_match_rvalue. * gfortran.h : Add prototype for gfc_match_rvalue. 2007-05-12 Paul Thomas <pault@gcc.gnu.org> PR fortran/30746 * gfortran.dg/host_assoc_function_1.f90: New test. Added: trunk/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 trunk/gcc/testsuite/gfortran.dg/recursive_reference_1.f90 Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/gfortran.h trunk/gcc/fortran/match.h trunk/gcc/fortran/resolve.c trunk/gcc/testsuite/ChangeLog
Fixed on trunk. Please note that recursive_reference_1.f90 was replaced, accidentally, by an identical copy of itself. Paul