From e49f4c1fa1154acb8f4366a0f0e6142d9bd38a77 Mon Sep 17 00:00:00 2001
From: burnus <burnus@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Mon, 4 Dec 2006 11:16:12 +0000
Subject: [PATCH] fortran/ 2006-12-04 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
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 d17b047aa82f..5dad6776199d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2006-12-04 Paul Thomas <pault@gcc.gnu.org>
+
+ 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 <pault@gcc.gnu.org>
PR fortran/29642
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 304d7c1f00d0..16e89f85c264 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 d682b223b453..75a6ca31b8f5 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 fadccd7f2666..219c66b5d209 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-12-04 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/29916
+ * gfortran.dg/host_dummy_index_1.f90: Added additional test.
+
2006-12-04 Jakub Jelinek <jakub@redhat.com>
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 cc045ff96bc9..62080f940f70 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 <pault@gcc.gnu.org>
!
+! Tests furthermore the fix for PR fortran/29916.
+! Test contributed by Marco Restelli <mrestelli@gmail.com>
+!
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
--
GitLab