#include "semantics.h"
#include "flang/Common/Fortran.h"
#include "flang/Common/indirection.h"
+#include "flang/Common/restorer.h"
#include "flang/Evaluate/characteristics.h"
#include "flang/Evaluate/check-expression.h"
#include "flang/Evaluate/expression.h"
// its INTEGER kind type parameter.
std::optional<int> IsImpliedDo(parser::CharBlock) const;
+ // Allows a whole assumed-size array to appear for the lifetime of
+ // the returned value.
+ common::Restorer<bool> AllowWholeAssumedSizeArray() {
+ return common::ScopedSet(isWholeAssumedSizeArrayOk_, true);
+ }
+
Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
const std::optional<parser::KindSelector> &);
FoldingContext &foldingContext_{context_.foldingContext()};
std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
bool fatalErrors_{false};
+ bool isWholeAssumedSizeArrayOk_{false};
friend class ArgumentAnalyzer;
};
std::vector<const char *>, parser::MessageFixedText &&);
MaybeExpr TryBoundOp(const Symbol &, int passIndex);
std::optional<ActualArgument> AnalyzeExpr(const parser::Expr &);
+ MaybeExpr AnalyzeExprOrWholeAssumedSizeArray(const parser::Expr &);
bool AreConformable() const;
const Symbol *FindBoundOp(parser::CharBlock, int passIndex);
void AddAssignmentConversion(
n.symbol->attrs().reset(semantics::Attr::VOLATILE);
}
}
+ if (!isWholeAssumedSizeArrayOk_ &&
+ semantics::IsAssumedSizeArray(*n.symbol)) { // C1002, C1014, C1231
+ AttachDeclaration(
+ SayAt(n,
+ "Whole assumed-size array '%s' may not appear here without subscripts"_err_en_US,
+ n.source),
+ *n.symbol);
+ }
return Designate(DataRef{*n.symbol});
}
}
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayElement &ae) {
- if (MaybeExpr baseExpr{Analyze(ae.base)}) {
+ MaybeExpr baseExpr;
+ {
+ auto restorer{AllowWholeAssumedSizeArray()};
+ baseExpr = Analyze(ae.base);
+ }
+ if (baseExpr) {
if (ae.subscripts.empty()) {
// will be converted to function call later or error reported
return std::nullopt;
void ArgumentAnalyzer::Analyze(
const parser::ActualArgSpec &arg, bool isSubroutine) {
- // TODO: C1002: Allow a whole assumed-size array to appear if the dummy
- // argument would accept it. Handle by special-casing the context
- // ActualArg -> Variable -> Designator.
// TODO: Actual arguments that are procedures and procedure pointers need to
// be detected and represented (they're not expressions).
// TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
}
}
}
+
std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
const parser::Expr &expr) {
source_.ExtendToCover(expr.source);
expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
if (isProcedureCall_) {
return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
- } else {
- context_.SayAt(expr.source,
- "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
- 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;
+ context_.SayAt(expr.source,
+ "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
+ } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) {
+ if (isProcedureCall_ || !IsProcedure(*argExpr)) {
+ return ActualArgument{context_.Fold(std::move(*argExpr))};
+ }
+ context_.SayAt(expr.source,
+ IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US
+ : "Subroutine name is not allowed here"_err_en_US);
+ }
+ return std::nullopt;
+}
+
+MaybeExpr ArgumentAnalyzer::AnalyzeExprOrWholeAssumedSizeArray(
+ const parser::Expr &expr) {
+ // If an expression's parse tree is a whole assumed-size array:
+ // Expr -> Designator -> DataRef -> Name
+ // treat it as a special case for argument passing and bypass
+ // the C1002/C1014 constraint checking in expression semantics.
+ if (const auto *name{parser::Unwrap<parser::Name>(expr)}) {
+ if (name->symbol && semantics::IsAssumedSizeArray(*name->symbol)) {
+ auto restorer{context_.AllowWholeAssumedSizeArray()};
+ return context_.Analyze(expr);
}
- return ActualArgument{context_.Fold(std::move(*argExpr))};
- } else {
- return std::nullopt;
}
+ return context_.Analyze(expr);
}
bool ArgumentAnalyzer::AreConformable() const {