This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR32157 - intrinsic function name conflicts with subroutine if present in the same file
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, Fortran List <fortran at gcc dot gnu dot org>
- Date: Mon, 09 Jul 2007 07:01:04 +0200
- Subject: [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
+