From e5813a683a81001d3853cb3d2b1397a11e98c1dd Mon Sep 17 00:00:00 2001 From: peter klausler Date: Tue, 15 Jun 2021 15:15:34 -0700 Subject: [PATCH] [flang] Fix crashes on calls to non-procedures When a procedure reference is attempted to an entity that just isn't a procedure, say so. Differential Revision: https://reviews.llvm.org/D104329 --- flang/lib/Semantics/expression.cpp | 14 ++++++++++- flang/lib/Semantics/resolve-names.cpp | 10 ++------ flang/test/Semantics/call19.f90 | 34 +++++++++++++++++++++++++++ flang/test/Semantics/resolve09.f90 | 4 ++-- 4 files changed, 51 insertions(+), 11 deletions(-) create mode 100644 flang/test/Semantics/call19.f90 diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 2b3f6fb57d63..dd547ab87b88 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1827,6 +1827,12 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef( if (context_.HasError(sym)) { return std::nullopt; } + if (!IsProcedure(*sym)) { + AttachDeclaration( + Say(sc.component.source, "'%s' is not a procedure"_err_en_US, + sc.component.source), + *sym); + } if (auto *dtExpr{UnwrapExpr>(*base)}) { if (sym->has()) { AdjustActuals adjustment{ @@ -2091,10 +2097,16 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name, return CalleeAndArguments{ semantics::SymbolRef{*symbol}, std::move(arguments)}; } - } else { + } else if (IsProcedure(*symbol)) { return CalleeAndArguments{ ProcedureDesignator{*symbol}, std::move(arguments)}; } + if (!context_.HasError(*symbol)) { + AttachDeclaration( + Say(name.source, "'%s' is not a callable procedure"_err_en_US, + name.source), + *symbol); + } } else if (std::optional specificCall{ context_.intrinsics().Probe( CallCharacteristics{ diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 110114597d1f..efba039fe9b3 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -6164,16 +6164,10 @@ void ResolveNamesVisitor::HandleProcedureName( symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); } Resolve(name, *symbol); - if (symbol->has()) { - SayWithDecl(name, *symbol, - "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); - return; - } if (!symbol->attrs().test(Attr::INTRINSIC)) { - if (!CheckImplicitNoneExternal(name.source, *symbol)) { - return; + if (CheckImplicitNoneExternal(name.source, *symbol)) { + MakeExternal(*symbol); } - MakeExternal(*symbol); } ConvertToProcEntity(*symbol); SetProcFlag(name, *symbol, flag); diff --git a/flang/test/Semantics/call19.f90 b/flang/test/Semantics/call19.f90 new file mode 100644 index 000000000000..20edb167581f --- /dev/null +++ b/flang/test/Semantics/call19.f90 @@ -0,0 +1,34 @@ +! RUN: %S/test_errors.sh %s %t %flang_fc1 +! Ensures that things that aren't procedures aren't allowed to be called. +module m + integer :: i + integer, pointer :: ip + type :: t + end type + type :: pdt(k,len) + integer, kind :: k + integer, len :: len + end type + type(pdt(1,2)) :: x + namelist /nml/i + contains + subroutine s(d) + real d + !ERROR: 'm' is not a callable procedure + call m + !ERROR: Cannot call function 'i' like a subroutine + call i + !ERROR: Cannot call function 'ip' like a subroutine + call ip + !ERROR: 't' is not a callable procedure + call t + !ERROR: 'k' is not a procedure + call x%k + !ERROR: 'len' is not a procedure + call x%len + !ERROR: Use of 'nml' as a procedure conflicts with its declaration + call nml + !ERROR: Cannot call function 'd' like a subroutine + call d + end subroutine +end diff --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90 index e92eaf7fde50..c669b60471d7 100644 --- a/flang/test/Semantics/resolve09.f90 +++ b/flang/test/Semantics/resolve09.f90 @@ -71,9 +71,9 @@ subroutine s4 block import, none integer :: i - !ERROR: Use of 'm' as a procedure conflicts with its declaration + !ERROR: 'm' is not a callable procedure i = m() - !ERROR: Use of 'm' as a procedure conflicts with its declaration + !ERROR: 'm' is not a callable procedure call m() end block end