aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2007-10-18 12:48:37 +0000
committerPaul Thomas <pault@gcc.gnu.org>2007-10-18 12:48:37 +0000
commita944c79a88afb91706e4b29db4224981fe0c91eb (patch)
treeec5ef02923b8c25783183f624b111244cb04dff8 /gcc
parenta7f638eca471ae667d2aea8d634869d1f0809887 (diff)
downloadgcc-a944c79a88afb91706e4b29db4224981fe0c91eb.zip
gcc-a944c79a88afb91706e4b29db4224981fe0c91eb.tar.gz
gcc-a944c79a88afb91706e4b29db4224981fe0c91eb.tar.bz2
re PR fortran/33233 (Parent and contained procedure: Wrongly treated as generic procedures)
2007-10-18 Paul Thomas <pault@gcc.gnu.org> PR fortran/33233 * resolve.c (check_host_association): Check singly contained namespaces and start search for symbol in current namespace. 2007-10-18 Paul Thomas <pault@gcc.gnu.org> PR fortran/33233 * gfortran.dg/host_assoc_function_1.f90: Correct references. * gfortran.dg/host_assoc_function_3.f90: New test. From-SVN: r129437
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/resolve.c7
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/host_assoc_function_1.f904
-rw-r--r--gcc/testsuite/gfortran.dg/host_assoc_function_3.f9027
5 files changed, 45 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24dfe5e..3a73653 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,10 @@
2007-10-18 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/33233
+ * resolve.c (check_host_association): Check singly contained
+ namespaces and start search for symbol in current namespace.
+
+2007-10-18 Paul Thomas <pault@gcc.gnu.org>
Dominique d'Humieres <dominiq@lps.ens.fr>
PR fortran/33733
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f16fe28..dffa76e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4014,11 +4014,12 @@ check_host_association (gfc_expr *e)
return retval;
if (gfc_current_ns->parent
- && gfc_current_ns->parent->parent
&& 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)
+ gfc_find_symbol (old_sym->name, gfc_current_ns, 1, &sym);
+ if (sym && old_sym != sym
+ && sym->attr.flavor == FL_PROCEDURE
+ && sym->attr.contained)
{
temp_locus = gfc_current_locus;
gfc_current_locus = e->where;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 86885ee..cbda26d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,11 @@
2007-10-18 Paul Thomas <pault@gcc.gnu.org>
+ PR fortran/33233
+ * gfortran.dg/host_assoc_function_1.f90: Correct references.
+ * gfortran.dg/host_assoc_function_3.f90: New test.
+
+2007-10-18 Paul Thomas <pault@gcc.gnu.org>
+
PR fortran/33733
* gfortran.dg/transfer_simplify_6.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
index 019fc61..f80f97a 100644
--- a/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
@@ -19,8 +19,8 @@ MODULE m
end interface
CONTAINS
SUBROUTINE s
- if (x(2) .ne. 2.5) call abort ()
- if (z(3) .ne. real (3)**3) call abort ()
+ if (x(2, 3) .ne. real (2)**3) call abort ()
+ if (z(3, 3) .ne. real (3)**3) call abort ()
CALL inner
CONTAINS
SUBROUTINE inner
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
new file mode 100644
index 0000000..a83fa17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! Tests the fix for the bug PR33233, in which the reference to 'x'
+! in 'inner' wrongly host-associated with the variable 'x' rather
+! than the function.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE m
+ REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
+CONTAINS
+ SUBROUTINE s
+ if (x(2) .eq. 2.5) call abort ()
+ CONTAINS
+ FUNCTION x(n, m)
+ integer, optional :: m
+ if (present(m)) then
+ x = REAL(n)**m
+ else
+ x = 0.0
+ end if
+ END FUNCTION
+ END SUBROUTINE s
+END MODULE m
+ use m
+ call s
+end
+! { dg-final { cleanup-modules "m" } }