aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2007-07-05 06:49:54 +0000
committerPaul Thomas <pault@gcc.gnu.org>2007-07-05 06:49:54 +0000
commit6291f3ba48ae8d65a167f7f96469519a7a410fec (patch)
tree541aab681e941c2570dcf444d7e8887b63a5810e
parent200359e888d1230d8b0a2a2ba9731786856649c8 (diff)
downloadgcc-6291f3ba48ae8d65a167f7f96469519a7a410fec.zip
gcc-6291f3ba48ae8d65a167f7f96469519a7a410fec.tar.gz
gcc-6291f3ba48ae8d65a167f7f96469519a7a410fec.tar.bz2
re PR fortran/32526 (Spurious error: Name 'x' at (1) is an ambiguous reference to 'x' from module 'y')
2007-07-05 Paul Thomas <pault@gcc.gnu.org> PR fortran/32526 * match.c (gfc_match_call): Check, in all cases, that a symbol is neither generic nor a subroutine before trying to add it as a subroutine. PR fortran/32613 * match.c (gfc_match_do): Reset the implied_index attribute. 2007-07-05 Paul Thomas <pault@gcc.gnu.org> PR fortran/32526 * gfortran.dg/interface_14.f90: New test. PR fortran/32613 * gfortran.dg/do_iterator_2.f90: New test. From-SVN: r126354
-rw-r--r--gcc/fortran/ChangeLog10
-rw-r--r--gcc/fortran/match.c23
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/do_iterator_2.f9032
-rw-r--r--gcc/testsuite/gfortran.dg/interface_14.f9073
5 files changed, 138 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 77ec511..7504c71 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-07-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/32526
+ * match.c (gfc_match_call): Check, in all cases, that a symbol
+ is neither generic nor a subroutine before trying to add it as
+ a subroutine.
+
+ PR fortran/32613
+ * match.c (gfc_match_do): Reset the implied_index attribute.
+
2007-07-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31198
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8db0b63..cbce358 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1500,6 +1500,7 @@ gfc_match_do (void)
if (m == MATCH_ERROR)
goto cleanup;
+ iter.var->symtree->n.sym->attr.implied_index = 0;
gfc_check_do_variable (iter.var->symtree);
if (gfc_match_eos () != MATCH_YES)
@@ -2296,16 +2297,22 @@ gfc_match_call (void)
sym = st->n.sym;
- if (sym->ns != gfc_current_ns
- && !sym->attr.generic
- && !sym->attr.subroutine
- && gfc_get_sym_tree (name, NULL, &st) == 1)
- return MATCH_ERROR;
+ /* If it does not seem to be callable... */
+ if (!sym->attr.generic
+ && !sym->attr.subroutine)
+ {
+ /* ...create a symbol in this scope... */
+ if (sym->ns != gfc_current_ns
+ && gfc_get_sym_tree (name, NULL, &st) == 1)
+ return MATCH_ERROR;
- sym = st->n.sym;
+ if (sym != st->n.sym)
+ sym = st->n.sym;
- if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
- return MATCH_ERROR;
+ /* ...and then to try to make the symbol into a subroutine. */
+ if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+ return MATCH_ERROR;
+ }
gfc_set_sym_referenced (sym);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0c99d14..034f9cd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-05 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/32526
+ * gfortran.dg/interface_14.f90: New test.
+
+ PR fortran/32613
+ * gfortran.dg/do_iterator_2.f90: New test.
+
2007-07-04 H.J. Lu <hongjiu.lu@intel.com>
* gcc.dg/dfp/dfp-round.h (FE_DEC_TONEAREST): Redfined for BID.
diff --git a/gcc/testsuite/gfortran.dg/do_iterator_2.f90 b/gcc/testsuite/gfortran.dg/do_iterator_2.f90
new file mode 100644
index 0000000..58b65f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_iterator_2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for pr32613 - see:
+! http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/495c154ee188d7f1/ea292134fe68b1d0#ea292134fe68b1d0
+!
+! Contributed by Al Greynolds <awgreynolds@earthlink.net>
+!
+program main
+ call something
+end
+
+subroutine something
+! integer i !correct results from gfortran depend on this statement (before fix)
+ integer :: m = 0
+ character lit*1, line*100
+ lit(i) = line(i:i)
+ i = 1
+ n = 5
+ line = 'PZ0R1'
+ if (internal (0)) call abort ()
+ if (m .ne. 5) call abort ()
+contains
+ logical function internal (j)
+ intent(in) j
+ do i = j, n
+ k = index ('RE', lit (i))
+ m = m + 1
+ if (k == 0) cycle
+ if (i+1 == n) exit
+ enddo
+ internal = (k == 0)
+ end function
+end
diff --git a/gcc/testsuite/gfortran.dg/interface_14.f90 b/gcc/testsuite/gfortran.dg/interface_14.f90
new file mode 100644
index 0000000..ea4345b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_14.f90
@@ -0,0 +1,73 @@
+! { dg-do compile }
+! Checks the fix for a regression PR32526, which was caused by
+! the patch for PR31494. The problem here was that the symbol
+! 'new' was determined to be ambiguous.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+ module P_Class
+ implicit none
+ private :: init_Personnel
+ interface new
+ module procedure init_Personnel
+ end interface
+ contains
+ subroutine init_Personnel(this)
+ integer, intent (in) :: this
+ print *, "init personnel", this
+ end subroutine init_Personnel
+ end module P_Class
+
+ module S_Class
+ use P_Class
+ implicit none
+ private :: init_Student
+ type Student
+ private
+ integer :: personnel = 1
+ end type Student
+ interface new
+ module procedure init_Student
+ end interface
+ contains
+ subroutine init_Student(this)
+ type (Student), intent (in) :: this
+ call new(this%personnel)
+ end subroutine init_Student
+ end module S_Class
+
+ module T_Class
+ use P_Class
+ implicit none
+ private :: init_Teacher
+ type Teacher
+ private
+ integer :: personnel = 2
+ end type Teacher
+ interface new
+ module procedure init_Teacher
+ end interface
+ contains
+ subroutine init_Teacher(this)
+ type (Teacher), intent (in) :: this
+ call new(this%personnel)
+ end subroutine init_Teacher
+ end module T_Class
+
+ module poly_Class
+ use S_Class
+ use T_Class
+ end module poly_Class
+
+ module D_Class
+ use poly_Class
+ end module D_Class
+
+ use D_Class
+ type (Teacher) :: a
+ type (Student) :: b
+ call new (a)
+ call new (b)
+ end
+
+! { dg-final { cleanup-modules "P_class S_Class T_Class D_Class poly_Class" } }