[flang] Don't allow function calls to PROCEDURE() (#165786)

PROCEDURE() declares a procedure with no interface or result type. (When
used to declare a derived type component, it must also be a NOPASS
POINTER.) Document that we allow such procedures to be called as
subroutines with implicit interfaces, despite the ISO standard -- this
is a universal extension to the language.

However, no longer allow such procedure entities to be referenced as
implicitly-typed functions -- this usage is neither portable nor
well-defined, as the compilers that do allow it do not respect the
implicit typing rules established at the point of declaration.
This commit is contained in:
Peter Klausler
2025-10-31 10:27:30 -07:00
committed by GitHub
parent 5354681c6d
commit 2abcb19af2
3 changed files with 23 additions and 12 deletions

View File

@@ -182,6 +182,13 @@ end
Note that internally the main program symbol name is all uppercase, unlike
the names of all other symbols, which are usually all lowercase. This
may make a difference in testing/debugging.
* A `PROCEDURE()` with no interface name or type may be called as an
subroutine with an implicit interface, F'2023 15.4.3.6 paragraph 4 and
C1525 notwithstanding.
This is a universally portable feature, and it also applies to
`PROCEDURE(), POINTER, NOPASS` derived type components.
Such procedures may *not* be referenced as implicitly typed functions
without first being associated with a function pointer.
## Extensions, deletions, and legacy features supported by default
@@ -954,4 +961,3 @@ print *, [(j,j=1,10)]
"&GRP A(1:)=1. 2. 3./".
This extension is necessarily disabled when the type of the array
has an accessible defined formatted READ subroutine.

View File

@@ -9435,13 +9435,18 @@ bool ResolveNamesVisitor::SetProcFlag(
SayWithDecl(name, symbol,
"Implicit declaration of function '%s' has a different result type than in previous declaration"_err_en_US);
return false;
} else if (symbol.has<ProcEntityDetails>()) {
symbol.set(flag); // in case it hasn't been set yet
if (flag == Symbol::Flag::Function) {
ApplyImplicitRules(symbol);
}
if (symbol.attrs().test(Attr::INTRINSIC)) {
AcquireIntrinsicProcedureFlags(symbol);
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (IsPointer(symbol) && !proc->type() && !proc->procInterface()) {
// PROCEDURE(), POINTER -- errors will be emitted later about a lack
// of known characteristics if used as a function
} else {
symbol.set(flag); // in case it hasn't been set yet
if (flag == Symbol::Flag::Function) {
ApplyImplicitRules(symbol);
}
if (symbol.attrs().test(Attr::INTRINSIC)) {
AcquireIntrinsicProcedureFlags(symbol);
}
}
} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
SayWithDecl(

View File

@@ -140,11 +140,11 @@ subroutine s9
procedure(), nopass, pointer :: p1, p2
end type
type(t) x
!ERROR: Function result characteristics are not known
print *, x%p1()
call x%p2
!ERROR: Cannot call function 'p1' like a subroutine
call x%p1
!ERROR: Cannot call subroutine 'p2' like a function
call x%p2 ! ok
call x%p1 ! ok
!ERROR: Function result characteristics are not known
print *, x%p2()
end subroutine