From e49f4c1fa1154acb8f4366a0f0e6142d9bd38a77 Mon Sep 17 00:00:00 2001 From: burnus Date: Mon, 4 Dec 2006 11:16:12 +0000 Subject: [PATCH] fortran/ 2006-12-04 Paul Thomas PR fortran/29916 * resolve.c (resolve_symbol): Allow host-associated variables in the specification expression of an array-valued function. * expr.c (check_restricted): Accept host-associated dummy array indices. testsuite/ 2006-12-04 Paul Thomas PR fortran/29916 * gfortran.dg/host_dummy_index_1.f90: Added additional test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@119489 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/expr.c | 5 +++-- gcc/fortran/resolve.c | 9 +++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 | 9 ++++++++- 5 files changed, 33 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d17b047aa82..5dad6776199 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2006-12-04 Paul Thomas + + PR fortran/29916 + * resolve.c (resolve_symbol): Allow host-associated variables + the specification expression of an array-valued function. + * expr.c (check_restricted): Accept host-associated dummy + array indices. + 2006-12-03 Paul Thomas PR fortran/29642 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 304d7c1f00d..16e89f85c26 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2047,14 +2047,15 @@ check_restricted (gfc_expr * e) /* gfc_is_formal_arg broadcasts that a formal argument list is being processed in resolve.c(resolve_formal_arglist). This is done so that host associated - dummy array indices are accepted (PR23446). */ + dummy array indices are accepted (PR23446). This mechanism also does the + same for the specification expressions of array-valued functions. */ if (sym->attr.in_common || sym->attr.use_assoc || sym->attr.dummy || sym->ns != gfc_current_ns || (sym->ns->proc_name != NULL && sym->ns->proc_name->attr.flavor == FL_MODULE) - || gfc_is_formal_arg ()) + || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) { t = SUCCESS; break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d682b223b45..75a6ca31b8f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -6043,8 +6043,17 @@ resolve_symbol (gfc_symbol * sym) on COMMON blocks. */ check_constant = sym->attr.in_common && !sym->attr.pointer; + + /* Set the formal_arg_flag so that check_conflict will not throw + an error for host associated variables in the specification + expression for an array_valued function. */ + if (sym->attr.function && sym->as) + formal_arg_flag = 1; + gfc_resolve_array_spec (sym->as, check_constant); + formal_arg_flag = 0; + /* Resolve formal namespaces. */ if (formal_ns_flag && sym != NULL && sym->formal_ns != NULL) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fadccd7f266..219c66b5d20 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-12-04 Paul Thomas + + PR fortran/29916 + * gfortran.dg/host_dummy_index_1.f90: Added additional test. + 2006-12-04 Jakub Jelinek PR middle-end/29965 diff --git a/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 b/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 index cc045ff96bc..62080f940f7 100644 --- a/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 +++ b/gcc/testsuite/gfortran.dg/host_dummy_index_1.f90 @@ -1,8 +1,10 @@ ! { dg-do run } ! Tests the fix for PR23446. Based on PR example. -! ! Contributed by Paul Thomas ! +! Tests furthermore the fix for PR fortran/29916. +! Test contributed by Marco Restelli +! PROGRAM TST INTEGER IMAX INTEGER :: A(4) = 1 @@ -12,6 +14,7 @@ PROGRAM TST CALL T(A) CALL U(A) if ( ALL(A.ne.(/2,2,3,4/))) CALL ABORT () + if ( ALL(F().ne.(/2.0,2.0/))) CALL ABORT() CONTAINS SUBROUTINE S(A) @@ -26,4 +29,8 @@ CONTAINS INTEGER A(2,IMAX) A(2,2) = 4 END SUBROUTINE U + FUNCTION F() + real :: F(IMAX) + F = 2.0 + END FUNCTION F ENDPROGRAM TST -- 2.11.0