re PR fortran/20880 (USE association of procedure's own interface)

2006-11-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/20880
	* parse.c (parse_interface): Error if procedure name is that of
	encompassing scope.
	* resolve.c (resolve_fl_procedure): Error if procedure is
	ambiguous.

	PR fortran/29387
	* interface.c (compare_actual_formal): Add missing condition
	that 'where' be present for error that asserts that actual
	arguments be definable.

2006-11-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/20880
	* gfortran.dg/interface_3.f90: New test.

	PR fortran/29387
	* gfortran.dg/generic_8.f90: New test.

From-SVN: r119173

7 files changed, 119 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 856f1e5..aa1b037 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2006-11-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20880
+	* parse.c (parse_interface): Error if procedure name is that of
+	encompassing scope.
+	* resolve.c (resolve_fl_procedure): Error if procedure is
+	ambiguous.
+
+	PR fortran/29387
+	* interface.c (compare_actual_formal): Add missing condition
+	that 'where' be present for error that asserts that actual
+	arguments be definable.
+
 2006-11-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	* resolve.c (resolve_actual_arglist): Remove the special case for
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index e1564b2..80a773e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1379,8 +1379,9 @@ compare_actual_formal (gfc_actual_arglist ** ap,
 	     && (f->sym->attr.intent == INTENT_OUT
 		   || f->sym->attr.intent == INTENT_INOUT))
 	{
-	  gfc_error ("Actual argument at %L must be definable to "
-		     "match dummy INTENT = OUT/INOUT", &a->expr->where);
+	  if (where)
+	    gfc_error ("Actual argument at %L must be definable to "
+		       "match dummy INTENT = OUT/INOUT", &a->expr->where);
           return 0;
         }
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1d02c20..eebe448 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1694,6 +1694,7 @@ parse_interface (void)
   gfc_interface_info save;
   gfc_state_data s1, s2;
   gfc_statement st;
+  locus proc_locus;
 
   accept_statement (ST_INTERFACE);
 
@@ -1781,6 +1782,7 @@ loop:
   accept_statement (st);
   prog_unit = gfc_new_block;
   prog_unit->formal_ns = gfc_current_ns;
+  proc_locus = gfc_current_locus;
 
 decl:
   /* Read data declaration statements.  */
@@ -1796,8 +1798,15 @@ decl:
 
   current_interface = save;
   gfc_add_interface (prog_unit);
-
   pop_state ();
+
+  if (current_interface.ns
+	&& current_interface.ns->proc_name
+	&& strcmp (current_interface.ns->proc_name->name,
+		   prog_unit->name) == 0)
+    gfc_error ("INTERFACE procedure '%s' at %L has the same name as the "
+	       "enclosing procedure", prog_unit->name, &proc_locus);
+
   goto loop;
 
 done:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 44ca7d9..a4d220a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5516,11 +5516,20 @@ static try
 resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
 {
   gfc_formal_arglist *arg;
+  gfc_symtree *st;
 
   if (sym->attr.function
 	&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
     return FAILURE;
 
+  st = gfc_find_symtree (gfc_current_ns->sym_root, sym->name);
+  if (st && st->ambiguous && !sym->attr.generic)
+    {
+      gfc_error ("Procedure %s at %L is ambiguous",
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
   if (sym->ts.type == BT_CHARACTER)
     {
       gfc_charlen *cl = sym->ts.cl;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 84fee3b..367d0fe 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-11-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20880
+	* gfortran.dg/interface_3.f90: New test.
+
+	PR fortran/29387
+	* gfortran.dg/generic_8.f90: New test.
+
 2006-11-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
 	* gfortran.dg/specifics_1.f90: Remove check for CHAR.
diff --git a/gcc/testsuite/gfortran.dg/generic_8.f90 b/gcc/testsuite/gfortran.dg/generic_8.f90
new file mode 100644
index 0000000..bf2ff78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_8.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! Tests the fix for PR29837, in which the following valid code
+! would emit an error because of mistaken INTENT; the wrong
+! specific interface would be used for the comparison.
+!
+! Contributed by 
+!
+MODULE M
+  IMPLICIT NONE
+  INTERFACE A
+    MODULE PROCEDURE A1,A2
+  END INTERFACE
+CONTAINS
+
+  SUBROUTINE A2(X)
+    INTEGER, INTENT(INOUT) :: X
+  END SUBROUTINE A2
+
+  SUBROUTINE A1(X,Y)
+    INTEGER, INTENT(IN) :: X
+    INTEGER, INTENT(OUT) :: Y
+    Y=X
+  END SUBROUTINE A1
+
+  SUBROUTINE T(X)
+    INTEGER, INTENT(IN) :: X(:)
+    INTEGER Y
+    CALL A(MAXVAL(X),Y)
+  END SUBROUTINE T
+END MODULE M
+! { dg-final { cleanup-modules "M" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_3.f90 b/gcc/testsuite/gfortran.dg/interface_3.f90
new file mode 100644
index 0000000..3832415
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_3.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Tests the fix for PR20880, which was due to failure to the failure
+! to detect the USE association of a nameless interface for a
+! procedure with the same name as the encompassing scope.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+module test_mod
+interface
+  subroutine my_sub (a)
+    real a
+  end subroutine
+end interface
+interface
+  function my_fun (a)
+    real a, my_fun
+  end function
+end interface
+end module
+
+! This is the original PR
+subroutine my_sub (a) ! { dg-error "is ambiguous" }
+  use test_mod
+  real a
+  print *, a
+end subroutine
+
+integer function my_fun (a) ! { dg-error "is ambiguous" }
+  use test_mod
+  real a
+  print *, a
+  my_fun = 1  ! { dg-error "ambiguous reference" }
+end function
+
+! This was found whilst investigating => segfault
+subroutine thy_sub (a)
+  interface 
+    subroutine thy_sub (a) ! { dg-error "enclosing procedure" }
+      real a
+    end subroutine
+  end interface
+  real a
+  print *, a
+end subroutine
+! { dg-final { cleanup-modules "test_mod" } }