diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -813,6 +813,7 @@ // Procedure and pointer detection predicates bool IsProcedure(const Expr &); +bool IsFunction(const Expr &); bool IsProcedurePointer(const Expr &); bool IsNullPointer(const Expr &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -703,6 +703,10 @@ bool IsProcedure(const Expr &expr) { return std::holds_alternative(expr.u); } +bool IsFunction(const Expr &expr) { + const auto *designator{std::get_if(&expr.u)}; + return designator && designator->GetType().has_value(); +} bool IsProcedurePointer(const Expr &expr) { return std::visit(common::visitors{ diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -98,11 +98,10 @@ class ArgumentAnalyzer { public: explicit ArgumentAnalyzer(ExpressionAnalyzer &context) - : context_{context}, allowAssumedType_{false} {} + : context_{context}, isProcedureCall_{false} {} ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source, - bool allowAssumedType = false) - : context_{context}, source_{source}, allowAssumedType_{ - allowAssumedType} {} + bool isProcedureCall = false) + : context_{context}, source_{source}, isProcedureCall_{isProcedureCall} {} bool fatalErrors() const { return fatalErrors_; } ActualArguments &&GetActuals() { CHECK(!fatalErrors_); @@ -167,7 +166,7 @@ ActualArguments actuals_; parser::CharBlock source_; bool fatalErrors_{false}; - const bool allowAssumedType_; + const bool isProcedureCall_; // false for user-defined op or assignment const Symbol *sawDefinedOp_{nullptr}; }; @@ -2003,7 +2002,7 @@ std::optional *structureConstructor) { const parser::Call &call{funcRef.v}; auto restorer{GetContextualMessages().SetLocation(call.source)}; - ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */}; + ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */}; for (const auto &arg : std::get>(call.t)) { analyzer.Analyze(arg, false /* not subroutine call */); } @@ -2042,7 +2041,7 @@ void ExpressionAnalyzer::Analyze(const parser::CallStmt &callStmt) { const parser::Call &call{callStmt.v}; auto restorer{GetContextualMessages().SetLocation(call.source)}; - ArgumentAnalyzer analyzer{*this, call.source, true /* allowAssumedType */}; + ArgumentAnalyzer analyzer{*this, call.source, true /* isProcedureCall */}; const auto &actualArgList{std::get>(call.t)}; for (const auto &arg : actualArgList) { analyzer.Analyze(arg, true /* is subroutine call */); @@ -2982,7 +2981,7 @@ source_.ExtendToCover(expr.source); if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) { expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter); - if (allowAssumedType_) { + if (isProcedureCall_) { return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}}; } else { context_.SayAt(expr.source, @@ -2990,6 +2989,16 @@ return std::nullopt; } } else if (MaybeExpr argExpr{context_.Analyze(expr)}) { + if (!isProcedureCall_ && IsProcedure(*argExpr)) { + if (IsFunction(*argExpr)) { + context_.SayAt( + expr.source, "Function call must have argument list"_err_en_US); + } else { + context_.SayAt( + expr.source, "Subroutine name is not allowed here"_err_en_US); + } + return std::nullopt; + } return ActualArgument{context_.Fold(std::move(*argExpr))}; } else { return std::nullopt; diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90 --- a/flang/test/Semantics/assign04.f90 +++ b/flang/test/Semantics/assign04.f90 @@ -132,3 +132,12 @@ real a(n) a(1:n) = 0.0 ! should not get a second error here end + +subroutine s11 + intrinsic :: sin + real :: a + !ERROR: Function call must have argument list + a = sin + !ERROR: Subroutine name is not allowed here + a = s11 +end diff --git a/flang/test/Semantics/resolve63.f90 b/flang/test/Semantics/resolve63.f90 --- a/flang/test/Semantics/resolve63.f90 +++ b/flang/test/Semantics/resolve63.f90 @@ -104,6 +104,7 @@ ! Invalid operand types when user-defined operator is not available module m2 + intrinsic :: sin type :: t end type type(t) :: x, y @@ -113,6 +114,10 @@ subroutine test_relational() !ERROR: Operands of .EQ. must have comparable types; have TYPE(t) and REAL(4) l = x == r + !ERROR: Subroutine name is not allowed here + l = r == test_numeric + !ERROR: Function call must have argument list + l = r == sin end subroutine test_numeric() !ERROR: Operands of + must be numeric; have REAL(4) and TYPE(t)