re PR fortran/29992 ([4.1 only] INTERFACE equivalent to MODULE PROCEDURE?!)

2006-12-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29992
	* interface.c (check_sym_interfaces): Module procedures in a
	generic must be use associated or contained in the module.
	* decl.c (gfc_match_modproc): Set attribute mod_proc.
	* gfortran.h (symbol_attribute): Add mod_proc atribute.

	PR fortran/30081
	* resolve.c (resolve_generic_f, resolve_generic_s): Use
	gfc_intrinsic_name to find out if the function is intrinsic
	because it does not have to be a generic intrinsic to be
	overloaded.

2006-12-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/29992
	* gfortran.dg/generic_9.f90: New test.

	PR fortran/30081
	* gfortran.dg/generic_10.f90: New test.

From-SVN: r120072

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ee984b19a7a40c4903ad39cc7f5871d87c71b171..d283671cb0cdc5e313e3564fb5510c99c24a5f70 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2006-12-20  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/29992
+       * interface.c (check_sym_interfaces): Module procedures in a
+       generic must be use associated or contained in the module.
+       * decl.c (gfc_match_modproc): Set attribute mod_proc.
+       * gfortran.h (symbol_attribute): Add mod_proc atribute.
+
+       PR fortran/30081
+       * resolve.c (resolve_generic_f, resolve_generic_s): Use
+       gfc_intrinsic_name to find out if the function is intrinsic
+       because it does not have to be a generic intrinsic to be
+       overloaded.
+
 2006-12-19  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/39238

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index eb3323733ee86d04dbb7abacb4db01ee6deee11d..d8988fd201534950a3b5aeb91fafaf047f5afc53 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4289,6 +4289,8 @@ gfc_match_modproc (void)
       if (gfc_add_interface (sym) == FAILURE)
        return MATCH_ERROR;
 
+      sym->attr.mod_proc = 1;
+
       if (gfc_match_eos () == MATCH_YES)
        break;
       if (gfc_match_char (',') != MATCH_YES)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0c67d10cf7e2dbb4ba91887acfefdd7be98a4008..296004edbc85958a79ca1f5ddedfe550705411c2 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -494,7 +494,7 @@ typedef struct
 
   /* Function/subroutine attributes */
   unsigned sequence:1, elemental:1, pure:1, recursive:1;
-  unsigned unmaskable:1, masked:1, contained:1;
+  unsigned unmaskable:1, masked:1, contained:1, mod_proc:1;
 
   /* This is set if the subroutine doesn't return.  Currently, this
      is only possible for intrinsic subroutines.  */

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 611754ccbd9dab738f815c767aef43e58a33b98b..6ffa4b2e9820af41da212d8469bd551d050c3fad 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1011,6 +1011,7 @@ check_sym_interfaces (gfc_symbol * sym)
 {
   char interface_name[100];
   bool k;
+  gfc_interface *p;
 
   if (sym->ns != gfc_current_ns)
     return;
@@ -1021,6 +1022,18 @@ check_sym_interfaces (gfc_symbol * sym)
       if (check_interface0 (sym->generic, interface_name))
        return;
 
+      for (p = sym->generic; p; p = p->next)
+       {
+         if (!p->sym->attr.use_assoc
+               && p->sym->attr.mod_proc
+               && p->sym->attr.if_source != IFSRC_DECL)
+           {
+             gfc_error ("MODULE PROCEDURE '%s' at %L does not come "
+                        "from a module", p->sym->name, &p->where);
+             return;
+           }
+       }
+
       /* Originally, this test was aplied to host interfaces too;
         this is incorrect since host associated symbols, from any
         source, cannot be ambiguous with local symbols.  */

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 33ef7481470f687a89b8f363782deac6b8a3cc79..519d92ab9b7f138e7ba15824330964fd7a4a133a 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1215,9 +1215,9 @@ generic:
        goto generic;
     }
 
-  /* Last ditch attempt.  */
-
-  if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
+  /* Last ditch attempt.  See if the reference is to an intrinsic
+     that possesses a matching interface.  14.1.2.4  */
+  if (!gfc_intrinsic_name (sym->name, 0))
     {
       gfc_error ("There is no specific function for the generic '%s' at %L",
                 expr->symtree->n.sym->name, &expr->where);
@@ -1675,9 +1675,11 @@ generic:
        goto generic;
     }
 
-  /* Last ditch attempt.  */
+  /* Last ditch attempt.  See if the reference is to an intrinsic
+     that possesses a matching interface.  14.1.2.4  */
   sym = c->symtree->n.sym;
-  if (!gfc_generic_intrinsic (sym->name))
+
+  if (!gfc_intrinsic_name (sym->name, 1))
     {
       gfc_error
        ("There is no specific subroutine for the generic '%s' at %L",

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2f5d6b7ae36ca65d563e2d3c3ba1abdc2b385ca0..2cc1c29e067c50c0196a9243cb9588b224469c3c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-12-20  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/29992
+       * gfortran.dg/generic_9.f90: New test.
+
+       PR fortran/30081
+       * gfortran.dg/generic_10.f90: New test.
+
 2006-12-19  Andrew Pinski  <pinskia@gmail.com>
 
        PR tree-opt/30045

diff --git a/gcc/testsuite/gfortran.dg/generic_10.f90 b/gcc/testsuite/gfortran.dg/generic_10.f90
new file mode 100644 (file)
index 0000000..8f9ff6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_10.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! Test the patch for PR30081 in which non-generic intrinsic
+! procedures could not be overloaded by generic interfaces.
+!
+! Contributed by Harald Anlauf  <anlauf@gmx.de>
+!
+module gfcbug46
+  interface random_seed
+     module procedure put_seed
+  end interface
+  interface random_number
+     module procedure random_vector
+  end interface
+  type t_t
+     real :: x(2)
+  end type t_t
+contains
+  subroutine put_seed (n, seed)
+    integer, intent(inout) :: n
+    integer, intent(in)    :: seed
+    call random_seed (size=n)
+  end subroutine put_seed
+  subroutine random_vector (t)
+    type(t_t) :: t
+    call random_number (t% x)
+  end subroutine random_vector
+end module gfcbug46
+
+  use gfcbug46
+  type(t_t) :: z
+  integer :: n = 2, seed = 1
+  call put_seed (n, seed)
+  call random_number (z)
+  print *, z
+end
+! { dg-final { cleanup-modules "gfcbug46" } }

diff --git a/gcc/testsuite/gfortran.dg/generic_9.f90 b/gcc/testsuite/gfortran.dg/generic_9.f90
new file mode 100644 (file)
index 0000000..2bd143f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/generic_9.f90
@@ -0,0 +1,45 @@
+! { dg-do compile }
+! Test the patch for PR29992. The standard requires that a
+! module procedure be contained in the same scope as the
+! interface or is use associated to it(12.3.2.1).
+!
+! Contributed by Daniel Franke  <franke.daniel@gmail.com>
+!
+MODULE class_foo_type
+  TYPE :: foo
+    INTEGER :: dummy
+  END TYPE
+contains
+  SUBROUTINE bar_init_set_int(this, value)
+    TYPE(foo), INTENT(out) :: this
+    integer, intent(in) :: value
+    this%dummy = value
+  END SUBROUTINE
+END MODULE
+
+MODULE class_foo
+USE class_foo_type, ONLY: foo, bar_init_set_int
+
+INTERFACE foo_init
+  MODULE PROCEDURE foo_init_default  ! { dg-error "does not come from a module" }
+END INTERFACE
+
+INTERFACE bar_init
+  MODULE PROCEDURE bar_init_default, bar_init_set_int  ! These are OK
+END INTERFACE
+
+INTERFACE
+  SUBROUTINE foo_init_default(this)
+    USE class_foo_type, ONLY: foo
+    TYPE(foo), INTENT(out) :: this
+  END SUBROUTINE
+END INTERFACE
+
+contains
+  SUBROUTINE bar_init_default(this)
+    TYPE(foo), INTENT(out) :: this
+    this%dummy = 42
+  END SUBROUTINE
+
+END MODULE
+! { dg-final { cleanup-modules "class_foo_type class_foo" } }