shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity

[flang] Allow PROCEDURE() with explicit type elsewhere (#82835)

Browse Source 
Fortran allows a procedure declaration statement with no interface or
type, with an explicit type declaration statement elsewhere being used
to define a function's result.

Fixes https://github.com/llvm/llvm-project/issues/82006.
This commit is contained in:
Peter Klausler 2024-03-01 16:31:13 -08:00 committed by GitHub
parent 189d89a92c
commit 8bcb1ceded
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
flang/include/flang/Semantics/symbol.h
View File

@ -419,7 +419,6 @@ public:
const Symbol *procInterface() const { return procInterface_; }
void set_procInterface(const Symbol &sym) { procInterface_ = &sym; }
bool IsInterfaceSet() { return procInterface_ || type(); }
inline bool HasExplicitInterface() const;
// Be advised: !init().has_value() => uninitialized pointer,

10
flang/lib/Semantics/resolve-names.cpp
View File

@ -4976,13 +4976,13 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
const parser::Name &name, Attrs attrs, const Symbol *interface) {
Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
if (details->IsInterfaceSet()) {
SayWithDecl(name, symbol,
"The interface for procedure '%s' has already been "
"declared"_err_en_US);
context().SetError(symbol);
if (context().HasError(symbol)) {
} else if (HasCycle(symbol, interface)) {
return symbol;
} else if (interface && (details->procInterface() || details->type())) {
SayWithDecl(name, symbol,
"The interface for procedure '%s' has already been declared"_err_en_US);
context().SetError(symbol);
} else if (interface) {
details->set_procInterface(*interface);
if (interface->test(Symbol::Flag::Function)) {

9
flang/test/Semantics/resolve91.f90
View File

@ -4,7 +4,7 @@ module m
procedure(real), pointer :: p
!ERROR: EXTERNAL attribute was already specified on 'p'
!ERROR: POINTER attribute was already specified on 'p'
!ERROR: The interface for procedure 'p' has already been declared
!ERROR: The type of 'p' has already been declared
procedure(integer), pointer :: p
end
@ -82,3 +82,10 @@ module m8
!ERROR: The type of 'pvar' has already been declared
integer, pointer :: pVar => kVar
end module m8
module m9
integer :: p, q
procedure() p ! ok
!ERROR: The type of 'q' has already been declared
procedure(real) q
end module m9