This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran 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] PR32157 - intrinsic function name conflicts with subroutine if present in the same file


:ADDPATCH fortran:

This PR arose because intrinsic procedures were not excluded in the list of things that are not external in the conditions found in resolve_function and resolve_call. This is simply accomplished and both conditions have been lifted and put in a new helper function. The testcase is the reporter's.

Regtested on Cygwin_NT/amd64.

I will commit as 'obvious' tomorrow morning, unless I hear views to the contrary.

Paul

2007-07-09 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/32157
   * reasolve.c (gfc_external_proc): New function.  Adds test that
   the symbol is not an intrinsic procedure.
   * (resolve_function, resolve_call): Replace logical expressions
   with call to gfc_external_proc.


2007-07-09 Paul Thomas <pault@gcc.gnu.org>


   PR fortran/32157
   * gfortran.dg/overload_2.f90: New test.

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 126461)
--- gcc/fortran/resolve.c	(working copy)
*************** set_type:
*** 1552,1557 ****
--- 1552,1573 ----
  }
  
  
+ /* Return true, if the symbol is an external procedure.  */
+ static bool
+ gfc_external_proc (gfc_symbol *sym)
+ {
+   if (!sym->attr.dummy && !sym->attr.contained
+ 	&& !(sym->attr.intrinsic
+ 	      || gfc_intrinsic_name (sym->name, sym->attr.subroutine))
+ 	&& sym->attr.proc != PROC_ST_FUNCTION
+ 	&& !sym->attr.use_assoc
+ 	&& sym->name)
+     return true;
+   else
+     return false;
+ }
+ 
+ 
  /* Figure out if a function reference is pure or not.  Also set the name
     of the function for a potential error message.  Return nonzero if the
     function is PURE, zero if not.  */
*************** resolve_function (gfc_expr *expr)
*** 1893,1904 ****
        return FAILURE;
      }
  
!   /* If the procedure is not internal, a statement function or a module
!      procedure,it must be external and should be checked for usage.  */
!   if (sym && !sym->attr.dummy && !sym->attr.contained
!       && sym->attr.proc != PROC_ST_FUNCTION
!       && !sym->attr.use_assoc
!       && sym->name  )
      resolve_global_procedure (sym, &expr->where, 0);
  
    /* Switch off assumed size checking and do this again for certain kinds
--- 1909,1916 ----
        return FAILURE;
      }
  
!   /* If the procedure is external, check for usage.  */
!   if (sym && gfc_external_proc (sym))
      resolve_global_procedure (sym, &expr->where, 0);
  
    /* Switch off assumed size checking and do this again for certain kinds
*************** resolve_call (gfc_code *c)
*** 2490,2501 ****
        return FAILURE;
      }
  
!   /* If the procedure is not internal or module, it must be external and
!      should be checked for usage.  */
!   if (c->symtree && c->symtree->n.sym
!       && !c->symtree->n.sym->attr.dummy
!       && !c->symtree->n.sym->attr.contained
!       && !c->symtree->n.sym->attr.use_assoc)
      resolve_global_procedure (c->symtree->n.sym, &c->loc, 1);
  
    /* Subroutines without the RECURSIVE attribution are not allowed to
--- 2502,2509 ----
        return FAILURE;
      }
  
!   /* If external, check for usage.  */
!   if (c->symtree && gfc_external_proc (c->symtree->n.sym))
      resolve_global_procedure (c->symtree->n.sym, &c->loc, 1);
  
    /* Subroutines without the RECURSIVE attribution are not allowed to
Index: gcc/testsuite/gfortran.dg/overload_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/overload_2.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/overload_2.f90	(revision 0)
***************
*** 0 ****
--- 1,28 ----
+ ! { dg-do compile }
+ ! Test the fix for PR32157, in which overloading 'LEN', as
+ ! in 'test' below would cause a compile error.
+ !
+ ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+ !
+ subroutine len(c)
+   implicit none
+   character :: c
+   c = "X"
+ end subroutine len
+ 
+ subroutine test()
+   implicit none
+   character :: str
+   external len
+   call len(str)
+   if(str /= "X") call abort()
+ end subroutine test
+ 
+ PROGRAM VAL
+  implicit none
+  external test
+  intrinsic len
+  call test()
+  if(len(" ") /= 1) call abort()
+ END
+ 

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