[Patch, fortran] PR29992 - failure to detect module procedures that are not procedures from modules

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This PR is simple enough in concept - gfortran fails to detect the 
invalid reference in module procedure declarations of procedures that 
are not contained by the interface scope or use associated.  The only 
difficulty was detecting if a procedure had been declared a module 
procedure in a generic interface.  The only way that I found to do this 
was to add a mod_proc attribute.  The attr.proc == PROC_MODULE applies 
to all procedures in modules.  Since the attribute is unique in its 
application to a module namespace, it is neither copied nor is it use 
associated.

The patch that was posted to the PR is too restrictive - it does not 
allow use associated procedures; so please ignore it.

Regtested on Cygwin_NT/amd64 - OK for trunk and 4.2?

Paul


2006-12-16  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.

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

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


Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(revision 119697)
--- gcc/fortran/interface.c	(working copy)
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1009,1014 ****
--- 1009,1015 ----
  {
    char interface_name[100];
    int k;
+   gfc_interface *p;
  
    if (sym->ns != gfc_current_ns)
      return;
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1019,1024 ****
--- 1020,1037 ----
        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.  */
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h	(revision 119697)
--- gcc/fortran/gfortran.h	(working copy)
*************** typedef struct
*** 493,499 ****
  
    /* Function/subroutine attributes */
    unsigned sequence:1, elemental:1, pure:1, recursive:1;
!   unsigned unmaskable:1, masked:1, contained:1;
  
    /* This is set if the subroutine doesn't return.  Currently, this
       is only possible for intrinsic subroutines.  */
--- 493,499 ----
  
    /* Function/subroutine attributes */
    unsigned sequence:1, elemental:1, pure:1, recursive: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.  */
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 119694)
--- gcc/fortran/decl.c	(working copy)
*************** gfc_match_modproc (void)
*** 4206,4211 ****
--- 4206,4213 ----
        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)
Index: gcc/testsuite/gfortran.dg/generic_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_9.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/generic_9.f90	(revision 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" } }