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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 856f1e550c13b4d4c3f4973bf4e692f45eb6a7a0..aa1b037187696eeef6fc994b5069a7428c617424 100644 (file)
--- 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 e1564b21e2ee6faaec9474d4c4c22b40e79cc820..80a773e936ab158f22f05fc151c4a881486d2539 100644 (file)
--- 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 1d02c2083e0d87edd6f6d35aecc1812288743c40..eebe44833735c380654e66df571faa0be7330246 100644 (file)
--- 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 44ca7d9a22a2c7f75ad194bc17b1640dac9c60e4..a4d220ae744ae2b68ac509ba738b92f0ce13118d 100644 (file)
--- 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 84fee3b8198edfdfe129e062a11a61c5fd6c8b23..367d0fe0477dbe19d67560a411eda031231a65d1 100644 (file)
--- 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 (file)
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 (file)
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" } }