This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR33897 - Incorrect host association in modules


:ADDPATCH fortran:

As promissed: The second part of the patch Paul sent me this morning.

Assume "setbd" is a host- or module-associated function (which returns
an integer); then

subroutine foo
  print *, setbd()

calls that procedure. However,

subroutine foo
  integer :: setbd
  print *, setbd()

is not the host-/module-associated procedure but an external procedure
"setbd_".

Without the patch, gfortran (wrongly) called the associated procedure
also in the latter case.

The other problem is that "ENTRY foo" always ended up in the global name
space, even if it was only a module procedure.

Build and regression tested on x86-64-linux.

OK for the trunk?

Tobias
2007-10-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33897
	* decl.c (gfc_match_entry): Do not make ENTRY name
	global for contained procedures.
	* parse.c (gfc_fixup_sibling_symbols): Fix code for
	determining whether a procedure is external.

2007-10-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33897
	* gfortran.dg/contained_3.f90: New.

Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c	(revision 129504)
--- gcc/fortran/decl.c	(working copy)
*************** gfc_match_entry (void)
*** 4376,4382 ****
    if (state == COMP_SUBROUTINE)
      {
        /* An entry in a subroutine.  */
!       if (!add_global_entry (name, 1))
  	return MATCH_ERROR;
  
        m = gfc_match_formal_arglist (entry, 0, 1);
--- 4376,4382 ----
    if (state == COMP_SUBROUTINE)
      {
        /* An entry in a subroutine.  */
!       if (!gfc_current_ns->parent && !add_global_entry (name, 1))
  	return MATCH_ERROR;
  
        m = gfc_match_formal_arglist (entry, 0, 1);
*************** gfc_match_entry (void)
*** 4398,4404 ****
  	    ENTRY f() RESULT (r)
  	 can't be written as
  	    ENTRY f RESULT (r).  */
!       if (!add_global_entry (name, 0))
  	return MATCH_ERROR;
  
        old_loc = gfc_current_locus;
--- 4398,4404 ----
  	    ENTRY f() RESULT (r)
  	 can't be written as
  	    ENTRY f RESULT (r).  */
!       if (!gfc_current_ns->parent && !add_global_entry (name, 0))
  	return MATCH_ERROR;
  
        old_loc = gfc_current_locus;
Index: gcc/fortran/parse.c
===================================================================
*** gcc/fortran/parse.c	(revision 129504)
--- gcc/fortran/parse.c	(working copy)
*************** gfc_fixup_sibling_symbols (gfc_symbol *s
*** 2858,2868 ****
  	continue;
  
        old_sym = st->n.sym;
!       if ((old_sym->attr.flavor == FL_PROCEDURE
! 	   || old_sym->ts.type == BT_UNKNOWN)
! 	  && old_sym->ns == ns
! 	  && !old_sym->attr.contained
! 	  && old_sym->attr.flavor != FL_NAMELIST)
  	{
  	  /* Replace it with the symbol from the parent namespace.  */
  	  st->n.sym = sym;
--- 2858,2883 ----
  	continue;
  
        old_sym = st->n.sym;
!       if (old_sym->ns == ns
! 	    && !old_sym->attr.contained
! 
! 	    /* By 14.6.1.3, host association should be excluded
! 	       for the following.  */
! 	    && !(old_sym->attr.external
! 		  || (old_sym->ts.type != BT_UNKNOWN
! 			&& !old_sym->attr.implicit_type)
! 		  || old_sym->attr.flavor == FL_PARAMETER
! 		  || old_sym->attr.in_common
! 		  || old_sym->attr.in_equivalence
! 		  || old_sym->attr.data
! 		  || old_sym->attr.dummy
! 		  || old_sym->attr.result
! 		  || old_sym->attr.dimension
! 		  || old_sym->attr.allocatable
! 		  || old_sym->attr.intrinsic
! 		  || old_sym->attr.generic
! 		  || old_sym->attr.flavor == FL_NAMELIST
! 		  || old_sym->attr.proc == PROC_ST_FUNCTION))
  	{
  	  /* Replace it with the symbol from the parent namespace.  */
  	  st->n.sym = sym;
Index: gcc/testsuite/gfortran.dg/contained_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/contained_3.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/contained_3.f90	(revision 0)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do run }
+ ! Tests the fix for PR33897, in which gfortran missed that the
+ ! declaration of 'setbd' in 'nxtstg2' made it external.  Also
+ ! the ENTRY 'setbd' would conflict with the external 'setbd'.
+ !
+ ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+ !
+ MODULE ksbin1_aux_mod
+  CONTAINS
+   SUBROUTINE nxtstg1()
+     INTEGER :: i
+     i = setbd()  ! available by host association.
+     if (setbd () .ne. 99 ) call abort ()
+   END SUBROUTINE nxtstg1
+ 
+   SUBROUTINE nxtstg2()
+     INTEGER :: i
+     integer :: setbd  ! makes it external.
+     i = setbd()       ! this is the PR
+     if (setbd () .ne. 42 ) call abort ()
+   END SUBROUTINE nxtstg2
+ 
+   FUNCTION binden()
+     INTEGER :: binden
+     INTEGER :: setbd
+     binden = 0
+   ENTRY setbd()
+     setbd = 99
+   END FUNCTION binden
+ END MODULE ksbin1_aux_mod
+ 
+ PROGRAM test
+   USE ksbin1_aux_mod, only : nxtstg1, nxtstg2
+   integer setbd ! setbd is external, since not use assoc.
+   CALL nxtstg1()
+   CALL nxtstg2()
+   if (setbd () .ne. 42 ) call abort ()
+   call foo
+ contains
+   subroutine foo
+     USE ksbin1_aux_mod ! module setbd is available
+     if (setbd () .ne. 99 ) call abort ()
+   end subroutine
+ END PROGRAM test
+ 
+ INTEGER FUNCTION setbd()
+   setbd=42
+ END FUNCTION setbd
+ 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]