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

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

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);
 

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.

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

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" } }