2020-02-25 23:11:52 +08:00
|
|
|
//===-- lib/Semantics/check-call.cpp --------------------------------------===//
|
2019-09-17 07:58:13 +08:00
|
|
|
//
|
2019-12-21 04:52:07 +08:00
|
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
|
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
|
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
2019-09-17 07:58:13 +08:00
|
|
|
//
|
2020-01-11 04:12:03 +08:00
|
|
|
//===----------------------------------------------------------------------===//
|
2019-09-17 07:58:13 +08:00
|
|
|
|
|
|
|
|
#include "check-call.h"
|
2020-01-07 01:16:18 +08:00
|
|
|
#include "pointer-assignment.h"
|
2020-02-25 23:11:52 +08:00
|
|
|
#include "flang/Evaluate/characteristics.h"
|
|
|
|
|
#include "flang/Evaluate/check-expression.h"
|
|
|
|
|
#include "flang/Evaluate/shape.h"
|
|
|
|
|
#include "flang/Evaluate/tools.h"
|
|
|
|
|
#include "flang/Parser/characters.h"
|
|
|
|
|
#include "flang/Parser/message.h"
|
|
|
|
|
#include "flang/Semantics/scope.h"
|
|
|
|
|
#include "flang/Semantics/tools.h"
|
2019-09-17 07:58:13 +08:00
|
|
|
#include <map>
|
|
|
|
|
#include <string>
|
|
|
|
|
|
|
|
|
|
using namespace Fortran::parser::literals;
|
2019-10-10 07:30:34 +08:00
|
|
|
namespace characteristics = Fortran::evaluate::characteristics;
|
2019-09-17 07:58:13 +08:00
|
|
|
|
2019-10-10 07:30:34 +08:00
|
|
|
namespace Fortran::semantics {
|
2019-09-17 07:58:13 +08:00
|
|
|
|
|
|
|
|
static void CheckImplicitInterfaceArg(
|
2019-10-10 07:30:34 +08:00
|
|
|
evaluate::ActualArgument &arg, parser::ContextualMessages &messages) {
|
2022-02-12 08:58:01 +08:00
|
|
|
auto restorer{
|
|
|
|
|
messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
|
2019-12-06 02:24:18 +08:00
|
|
|
if (auto kw{arg.keyword()}) {
|
2019-09-17 07:58:13 +08:00
|
|
|
messages.Say(*kw,
|
2019-10-11 07:06:05 +08:00
|
|
|
"Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
|
2019-09-17 07:58:13 +08:00
|
|
|
*kw);
|
|
|
|
|
}
|
|
|
|
|
if (auto type{arg.GetType()}) {
|
|
|
|
|
if (type->IsAssumedType()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Assumed type argument requires an explicit interface"_err_en_US);
|
|
|
|
|
} else if (type->IsPolymorphic()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Polymorphic argument requires an explicit interface"_err_en_US);
|
2019-12-17 06:28:23 +08:00
|
|
|
} else if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
|
|
|
|
|
if (!derived->parameters().empty()) {
|
2019-09-17 07:58:13 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"Parameterized derived type argument requires an explicit interface"_err_en_US);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (const auto *expr{arg.UnwrapExpr()}) {
|
2021-07-28 01:40:34 +08:00
|
|
|
if (IsBOZLiteral(*expr)) {
|
2021-07-27 05:28:36 +08:00
|
|
|
messages.Say("BOZ argument requires an explicit interface"_err_en_US);
|
2021-09-17 23:19:10 +08:00
|
|
|
} else if (evaluate::IsNullPointer(*expr)) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Null pointer argument requires an explicit interface"_err_en_US);
|
|
|
|
|
} else if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
|
2019-10-10 07:30:34 +08:00
|
|
|
const Symbol &symbol{named->GetLastSymbol()};
|
2019-09-17 07:58:13 +08:00
|
|
|
if (symbol.Corank() > 0) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Coarray argument requires an explicit interface"_err_en_US);
|
|
|
|
|
}
|
2019-10-10 07:30:34 +08:00
|
|
|
if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
|
2019-09-17 07:58:13 +08:00
|
|
|
if (details->IsAssumedRank()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Assumed rank argument requires an explicit interface"_err_en_US);
|
|
|
|
|
}
|
|
|
|
|
}
|
2019-10-10 07:30:34 +08:00
|
|
|
if (symbol.attrs().test(Attr::ASYNCHRONOUS)) {
|
2019-09-17 07:58:13 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"ASYNCHRONOUS argument requires an explicit interface"_err_en_US);
|
|
|
|
|
}
|
2019-10-10 07:30:34 +08:00
|
|
|
if (symbol.attrs().test(Attr::VOLATILE)) {
|
2019-09-17 07:58:13 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"VOLATILE argument requires an explicit interface"_err_en_US);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-17 06:36:54 +08:00
|
|
|
// When scalar CHARACTER actual arguments are known to be short,
|
|
|
|
|
// we extend them on the right with spaces and a warning.
|
|
|
|
|
static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
|
|
|
|
|
const characteristics::TypeAndShape &dummyType,
|
2020-10-02 02:46:24 +08:00
|
|
|
characteristics::TypeAndShape &actualType,
|
|
|
|
|
evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
|
2019-10-17 06:36:54 +08:00
|
|
|
if (dummyType.type().category() == TypeCategory::Character &&
|
|
|
|
|
actualType.type().category() == TypeCategory::Character &&
|
|
|
|
|
dummyType.type().kind() == actualType.type().kind() &&
|
|
|
|
|
GetRank(actualType.shape()) == 0) {
|
2020-10-02 02:46:24 +08:00
|
|
|
if (dummyType.LEN() && actualType.LEN()) {
|
|
|
|
|
auto dummyLength{ToInt64(Fold(context, common::Clone(*dummyType.LEN())))};
|
|
|
|
|
auto actualLength{
|
|
|
|
|
ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
|
|
|
|
|
if (dummyLength && actualLength && *actualLength < *dummyLength) {
|
|
|
|
|
messages.Say(
|
2022-03-08 05:57:37 +08:00
|
|
|
"Actual length '%jd' is less than expected length '%jd'"_warn_en_US,
|
2020-10-02 02:46:24 +08:00
|
|
|
*actualLength, *dummyLength);
|
|
|
|
|
auto converted{ConvertToType(dummyType.type(), std::move(actual))};
|
|
|
|
|
CHECK(converted);
|
|
|
|
|
actual = std::move(*converted);
|
|
|
|
|
actualType.set_LEN(SubscriptIntExpr{*dummyLength});
|
2019-10-17 06:36:54 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-12-20 11:13:16 +08:00
|
|
|
// Automatic conversion of different-kind INTEGER scalar actual
|
|
|
|
|
// argument expressions (not variables) to INTEGER scalar dummies.
|
|
|
|
|
// We return nonstandard INTEGER(8) results from intrinsic functions
|
|
|
|
|
// like SIZE() by default in order to facilitate the use of large
|
|
|
|
|
// arrays. Emit a warning when downconverting.
|
|
|
|
|
static void ConvertIntegerActual(evaluate::Expr<evaluate::SomeType> &actual,
|
|
|
|
|
const characteristics::TypeAndShape &dummyType,
|
|
|
|
|
characteristics::TypeAndShape &actualType,
|
|
|
|
|
parser::ContextualMessages &messages) {
|
|
|
|
|
if (dummyType.type().category() == TypeCategory::Integer &&
|
|
|
|
|
actualType.type().category() == TypeCategory::Integer &&
|
|
|
|
|
dummyType.type().kind() != actualType.type().kind() &&
|
|
|
|
|
GetRank(dummyType.shape()) == 0 && GetRank(actualType.shape()) == 0 &&
|
|
|
|
|
!evaluate::IsVariable(actual)) {
|
|
|
|
|
auto converted{
|
|
|
|
|
evaluate::ConvertToType(dummyType.type(), std::move(actual))};
|
|
|
|
|
CHECK(converted);
|
|
|
|
|
actual = std::move(*converted);
|
|
|
|
|
if (dummyType.type().kind() < actualType.type().kind()) {
|
|
|
|
|
messages.Say(
|
2022-03-08 05:57:37 +08:00
|
|
|
"Actual argument scalar expression of type INTEGER(%d) was converted to smaller dummy argument type INTEGER(%d)"_port_en_US,
|
2019-12-20 11:13:16 +08:00
|
|
|
actualType.type().kind(), dummyType.type().kind());
|
|
|
|
|
}
|
|
|
|
|
actualType = dummyType;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-25 07:08:06 +08:00
|
|
|
static bool DefersSameTypeParameters(
|
|
|
|
|
const DerivedTypeSpec &actual, const DerivedTypeSpec &dummy) {
|
|
|
|
|
for (const auto &pair : actual.parameters()) {
|
|
|
|
|
const ParamValue &actualValue{pair.second};
|
|
|
|
|
const ParamValue *dummyValue{dummy.FindParameter(pair.first)};
|
|
|
|
|
if (!dummyValue || (actualValue.isDeferred() != dummyValue->isDeferred())) {
|
|
|
|
|
return false;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return true;
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-09 06:21:09 +08:00
|
|
|
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
|
2019-10-17 06:36:54 +08:00
|
|
|
const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
|
2019-12-20 11:13:16 +08:00
|
|
|
characteristics::TypeAndShape &actualType, bool isElemental,
|
2021-01-22 06:50:57 +08:00
|
|
|
evaluate::FoldingContext &context, const Scope *scope,
|
2021-10-20 02:34:57 +08:00
|
|
|
const evaluate::SpecificIntrinsic *intrinsic,
|
|
|
|
|
bool allowIntegerConversions) {
|
2019-10-11 07:06:05 +08:00
|
|
|
|
|
|
|
|
// Basic type & rank checking
|
|
|
|
|
parser::ContextualMessages &messages{context.messages()};
|
2020-10-02 02:46:24 +08:00
|
|
|
PadShortCharacterActual(actual, dummy.type, actualType, context, messages);
|
2021-10-20 02:34:57 +08:00
|
|
|
if (allowIntegerConversions) {
|
|
|
|
|
ConvertIntegerActual(actual, dummy.type, actualType, messages);
|
|
|
|
|
}
|
2020-10-01 04:34:23 +08:00
|
|
|
bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())};
|
2019-12-21 05:03:30 +08:00
|
|
|
if (typesCompatible) {
|
|
|
|
|
if (isElemental) {
|
|
|
|
|
} else if (dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedRank)) {
|
|
|
|
|
} else if (!dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedShape) &&
|
2021-11-27 05:26:50 +08:00
|
|
|
!dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::DeferredShape) &&
|
2021-01-22 06:50:57 +08:00
|
|
|
(actualType.Rank() > 0 || IsArrayElement(actual))) {
|
2019-12-21 05:03:30 +08:00
|
|
|
// Sequence association (15.5.2.11) applies -- rank need not match
|
2021-11-27 05:26:50 +08:00
|
|
|
// if the actual argument is an array or array element designator,
|
|
|
|
|
// and the dummy is not assumed-shape or an INTENT(IN) pointer
|
|
|
|
|
// that's standing in for an assumed-shape dummy.
|
2019-12-21 05:03:30 +08:00
|
|
|
} else {
|
[flang] Improve initializer semantics, esp. for component default values
This patch plugs many holes in static initializer semantics, improves error
messages for default initial values and other component properties in
parameterized derived type instantiations, and cleans up several small
issues noticed during development. We now do proper scalar expansion,
folding, and type, rank, and shape conformance checking for component
default initializers in derived types and PDT instantiations.
The initial values of named constants are now guaranteed to have been folded
when installed in the symbol table, and are no longer folded or
scalar-expanded at each use in expression folding. Semantics documentation
was extended with information about the various kinds of initializations
in Fortran and when each of them are processed in the compiler.
Some necessary concomitant changes have bulked this patch out a bit:
* contextual messages attachments, which are now produced for parameterized
derived type instantiations so that the user can figure out which
instance caused a problem with a component, have been added as part
of ContextualMessages, and their implementation was debugged
* several APIs in evaluate::characteristics was changed so that a FoldingContext
is passed as an argument rather than just its intrinsic procedure table;
this affected client call sites in many files
* new tools in Evaluate/check-expression.cpp to determine when an Expr
actually is a single constant value and to validate a non-pointer
variable initializer or object component default value
* shape conformance checking has additional arguments that control
whether scalar expansion is allowed
* several now-unused functions and data members noticed and removed
* several crashes and bogus errors exposed by testing this new code
were fixed
* a -fdebug-stack-trace option to enable LLVM's stack tracing on
a crash, which might be useful in the future
TL;DR: Initialization processing does more and takes place at the right
times for all of the various kinds of things that can be initialized.
Differential Review: https://reviews.llvm.org/D92783
2020-12-08 04:08:58 +08:00
|
|
|
// Let CheckConformance accept scalars; storage association
|
|
|
|
|
// cases are checked here below.
|
2019-12-21 05:03:30 +08:00
|
|
|
CheckConformance(messages, dummy.type.shape(), actualType.shape(),
|
2021-06-04 06:48:16 +08:00
|
|
|
evaluate::CheckConformanceFlags::EitherScalarExpandable,
|
|
|
|
|
"dummy argument", "actual argument");
|
2019-12-21 05:03:30 +08:00
|
|
|
}
|
|
|
|
|
} else {
|
2020-01-15 09:31:25 +08:00
|
|
|
const auto &len{actualType.LEN()};
|
2019-12-21 05:03:30 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument type '%s' is not compatible with dummy argument type '%s'"_err_en_US,
|
2020-01-15 09:31:25 +08:00
|
|
|
actualType.type().AsFortran(len ? len->AsFortran() : ""),
|
2019-12-21 05:03:30 +08:00
|
|
|
dummy.type.type().AsFortran());
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-09 06:21:09 +08:00
|
|
|
bool actualIsPolymorphic{actualType.type().IsPolymorphic()};
|
|
|
|
|
bool dummyIsPolymorphic{dummy.type.type().IsPolymorphic()};
|
|
|
|
|
bool actualIsCoindexed{ExtractCoarrayRef(actual).has_value()};
|
|
|
|
|
bool actualIsAssumedSize{actualType.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedSize)};
|
|
|
|
|
bool dummyIsAssumedSize{dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedSize)};
|
2019-10-11 07:06:05 +08:00
|
|
|
bool dummyIsAsynchronous{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Asynchronous)};
|
|
|
|
|
bool dummyIsVolatile{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Volatile)};
|
|
|
|
|
bool dummyIsValue{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Value)};
|
|
|
|
|
|
2019-10-09 06:21:09 +08:00
|
|
|
if (actualIsPolymorphic && dummyIsPolymorphic &&
|
2020-03-29 12:00:16 +08:00
|
|
|
actualIsCoindexed) { // 15.5.2.4(2)
|
2019-10-09 06:21:09 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Coindexed polymorphic object may not be associated with a polymorphic %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
|
|
|
|
if (actualIsPolymorphic && !dummyIsPolymorphic &&
|
2020-03-29 12:00:16 +08:00
|
|
|
actualIsAssumedSize) { // 15.5.2.4(2)
|
2019-10-09 06:21:09 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Assumed-size polymorphic array may not be associated with a monomorphic %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2019-10-11 07:06:05 +08:00
|
|
|
|
2019-10-25 07:08:06 +08:00
|
|
|
// Derived type actual argument checks
|
2019-10-18 01:57:01 +08:00
|
|
|
const Symbol *actualFirstSymbol{evaluate::GetFirstSymbol(actual)};
|
|
|
|
|
bool actualIsAsynchronous{
|
|
|
|
|
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::ASYNCHRONOUS)};
|
|
|
|
|
bool actualIsVolatile{
|
|
|
|
|
actualFirstSymbol && actualFirstSymbol->attrs().test(Attr::VOLATILE)};
|
2019-12-17 06:28:23 +08:00
|
|
|
if (const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())}) {
|
2019-10-09 06:21:09 +08:00
|
|
|
if (dummy.type.type().IsAssumedType()) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (!derived->parameters().empty()) { // 15.5.2.4(2)
|
2019-10-09 06:21:09 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Actual argument associated with TYPE(*) %s may not have a parameterized derived type"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2019-10-18 06:29:26 +08:00
|
|
|
if (const Symbol *
|
2019-12-17 06:28:23 +08:00
|
|
|
tbp{FindImmediateComponent(*derived, [](const Symbol &symbol) {
|
2019-10-23 07:53:29 +08:00
|
|
|
return symbol.has<ProcBindingDetails>();
|
2020-03-29 12:00:16 +08:00
|
|
|
})}) { // 15.5.2.4(2)
|
2019-11-23 05:20:58 +08:00
|
|
|
evaluate::SayWithDeclaration(messages, *tbp,
|
2019-11-02 04:08:16 +08:00
|
|
|
"Actual argument associated with TYPE(*) %s may not have type-bound procedure '%s'"_err_en_US,
|
|
|
|
|
dummyName, tbp->name());
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2020-10-01 04:34:23 +08:00
|
|
|
const auto &finals{
|
|
|
|
|
derived->typeSymbol().get<DerivedTypeDetails>().finals()};
|
|
|
|
|
if (!finals.empty()) { // 15.5.2.4(2)
|
|
|
|
|
if (auto *msg{messages.Say(
|
|
|
|
|
"Actual argument associated with TYPE(*) %s may not have derived type '%s' with FINAL subroutine '%s'"_err_en_US,
|
|
|
|
|
dummyName, derived->typeSymbol().name(),
|
|
|
|
|
finals.begin()->first)}) {
|
|
|
|
|
msg->Attach(finals.begin()->first,
|
|
|
|
|
"FINAL subroutine '%s' in derived type '%s'"_en_US,
|
|
|
|
|
finals.begin()->first, derived->typeSymbol().name());
|
|
|
|
|
}
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
|
|
|
|
}
|
2019-11-08 08:01:38 +08:00
|
|
|
if (actualIsCoindexed) {
|
|
|
|
|
if (dummy.intent != common::Intent::In && !dummyIsValue) {
|
2019-11-13 07:43:09 +08:00
|
|
|
if (auto bad{
|
2020-03-29 12:00:16 +08:00
|
|
|
FindAllocatableUltimateComponent(*derived)}) { // 15.5.2.4(6)
|
2019-11-23 05:20:58 +08:00
|
|
|
evaluate::SayWithDeclaration(messages, *bad,
|
2019-11-08 08:01:38 +08:00
|
|
|
"Coindexed actual argument with ALLOCATABLE ultimate component '%s' must be associated with a %s with VALUE or INTENT(IN) attributes"_err_en_US,
|
2019-11-13 07:43:09 +08:00
|
|
|
bad.BuildResultDesignatorName(), dummyName);
|
2019-11-08 08:01:38 +08:00
|
|
|
}
|
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (auto coarrayRef{evaluate::ExtractCoarrayRef(actual)}) { // C1537
|
2019-11-08 08:01:38 +08:00
|
|
|
const Symbol &coarray{coarrayRef->GetLastSymbol()};
|
|
|
|
|
if (const DeclTypeSpec * type{coarray.GetType()}) {
|
|
|
|
|
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
|
2019-11-13 07:43:09 +08:00
|
|
|
if (auto bad{semantics::FindPointerUltimateComponent(*derived)}) {
|
2019-11-23 05:20:58 +08:00
|
|
|
evaluate::SayWithDeclaration(messages, coarray,
|
2019-11-08 08:01:38 +08:00
|
|
|
"Coindexed object '%s' with POINTER ultimate component '%s' cannot be associated with %s"_err_en_US,
|
2019-11-13 07:43:09 +08:00
|
|
|
coarray.name(), bad.BuildResultDesignatorName(), dummyName);
|
2019-11-08 08:01:38 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
if (actualIsVolatile != dummyIsVolatile) { // 15.5.2.4(22)
|
2019-12-17 06:28:23 +08:00
|
|
|
if (auto bad{semantics::FindCoarrayUltimateComponent(*derived)}) {
|
2019-11-23 05:20:58 +08:00
|
|
|
evaluate::SayWithDeclaration(messages, *bad,
|
2019-11-02 04:08:16 +08:00
|
|
|
"VOLATILE attribute must match for %s when actual argument has a coarray ultimate component '%s'"_err_en_US,
|
2019-11-13 07:43:09 +08:00
|
|
|
dummyName, bad.BuildResultDesignatorName());
|
2019-10-11 07:06:05 +08:00
|
|
|
}
|
|
|
|
|
}
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2019-10-11 07:06:05 +08:00
|
|
|
|
2019-10-25 07:08:06 +08:00
|
|
|
// Rank and shape checks
|
2019-10-10 07:30:34 +08:00
|
|
|
const auto *actualLastSymbol{evaluate::GetLastSymbol(actual)};
|
2019-11-08 08:01:38 +08:00
|
|
|
if (actualLastSymbol) {
|
[flang] Fix classification of shape inquiries in specification exprs
In some contexts, including the motivating case of determining whether
the expressions that define the shape of a variable are "constant expressions"
in the sense of the Fortran standard, expression rewriting via Fold()
is not necessary, and should not be required. The inquiry intrinsics LBOUND,
UBOUND, and SIZE work correctly now in specification expressions and are
classified correctly as being constant expressions (or not). Getting this right
led to a fair amount of API clean-up as a consequence, including the
folding of shapes and TypeAndShape objects, and new APIs for shapes
that do not fold for those cases where folding isn't needed. Further,
the symbol-testing predicate APIs in Evaluate/tools.h now all resolve any
associations of their symbols and work transparently on use-, host-, and
construct-association symbols; the tools used to resolve those associations have
been defined and documented more precisely, and their clients adjusted as needed.
Differential Revision: https://reviews.llvm.org/D94561
2021-01-13 07:36:45 +08:00
|
|
|
actualLastSymbol = &ResolveAssociations(*actualLastSymbol);
|
2019-10-25 07:08:06 +08:00
|
|
|
}
|
2019-10-10 07:30:34 +08:00
|
|
|
const ObjectEntityDetails *actualLastObject{actualLastSymbol
|
[flang] Fix classification of shape inquiries in specification exprs
In some contexts, including the motivating case of determining whether
the expressions that define the shape of a variable are "constant expressions"
in the sense of the Fortran standard, expression rewriting via Fold()
is not necessary, and should not be required. The inquiry intrinsics LBOUND,
UBOUND, and SIZE work correctly now in specification expressions and are
classified correctly as being constant expressions (or not). Getting this right
led to a fair amount of API clean-up as a consequence, including the
folding of shapes and TypeAndShape objects, and new APIs for shapes
that do not fold for those cases where folding isn't needed. Further,
the symbol-testing predicate APIs in Evaluate/tools.h now all resolve any
associations of their symbols and work transparently on use-, host-, and
construct-association symbols; the tools used to resolve those associations have
been defined and documented more precisely, and their clients adjusted as needed.
Differential Revision: https://reviews.llvm.org/D94561
2021-01-13 07:36:45 +08:00
|
|
|
? actualLastSymbol->detailsIf<ObjectEntityDetails>()
|
2019-10-09 06:21:09 +08:00
|
|
|
: nullptr};
|
2019-10-10 07:30:34 +08:00
|
|
|
int actualRank{evaluate::GetRank(actualType.shape())};
|
2021-01-22 06:50:57 +08:00
|
|
|
bool actualIsPointer{evaluate::IsObjectPointer(actual, context)};
|
2021-01-31 02:14:07 +08:00
|
|
|
bool dummyIsAssumedRank{dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedRank)};
|
2019-10-09 06:21:09 +08:00
|
|
|
if (dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedShape)) {
|
|
|
|
|
// 15.5.2.4(16)
|
2019-10-11 07:06:05 +08:00
|
|
|
if (actualRank == 0) {
|
2019-10-09 06:21:09 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Scalar actual argument may not be associated with assumed-shape %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2019-11-23 05:20:58 +08:00
|
|
|
if (actualIsAssumedSize && actualLastSymbol) {
|
|
|
|
|
evaluate::SayWithDeclaration(messages, *actualLastSymbol,
|
2019-11-02 04:08:16 +08:00
|
|
|
"Assumed-size array may not be associated with assumed-shape %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2019-10-23 00:31:33 +08:00
|
|
|
} else if (actualRank == 0 && dummy.type.Rank() > 0) {
|
2019-10-09 06:21:09 +08:00
|
|
|
// Actual is scalar, dummy is an array. 15.5.2.4(14), 15.5.2.11
|
|
|
|
|
if (actualIsCoindexed) {
|
|
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Coindexed scalar actual argument must be associated with a scalar %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
2022-03-11 16:22:47 +08:00
|
|
|
bool actualIsArrayElement{IsArrayElement(actual)};
|
|
|
|
|
bool actualIsCKindCharacter{
|
|
|
|
|
actualType.type().category() == TypeCategory::Character &&
|
|
|
|
|
actualType.type().kind() == 1};
|
|
|
|
|
if (!actualIsCKindCharacter) {
|
|
|
|
|
if (!actualIsArrayElement &&
|
|
|
|
|
!(dummy.type.type().IsAssumedType() && dummyIsAssumedSize) &&
|
|
|
|
|
!dummyIsAssumedRank) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Whole scalar actual argument may not be associated with a %s array"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (actualIsPolymorphic) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Polymorphic scalar may not be associated with a %s array"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (actualIsArrayElement && actualLastSymbol &&
|
|
|
|
|
IsPointer(*actualLastSymbol)) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Element of pointer array may not be associated with a %s array"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (actualLastSymbol && IsAssumedShape(*actualLastSymbol)) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Element of assumed-shape array may not be associated with a %s array"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
|
|
|
|
}
|
2019-10-18 03:28:25 +08:00
|
|
|
if (actualLastObject && actualLastObject->IsCoarray() &&
|
2020-10-20 18:39:26 +08:00
|
|
|
IsAllocatable(*actualLastSymbol) && dummy.intent == common::Intent::Out &&
|
|
|
|
|
!(intrinsic &&
|
|
|
|
|
evaluate::AcceptsIntentOutAllocatableCoarray(
|
|
|
|
|
intrinsic->name))) { // C846
|
2019-10-18 03:28:25 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"ALLOCATABLE coarray '%s' may not be associated with INTENT(OUT) %s"_err_en_US,
|
|
|
|
|
actualLastSymbol->name(), dummyName);
|
|
|
|
|
}
|
2019-10-11 07:06:05 +08:00
|
|
|
|
2019-10-25 07:08:06 +08:00
|
|
|
// Definability
|
2019-10-11 04:09:35 +08:00
|
|
|
const char *reason{nullptr};
|
|
|
|
|
if (dummy.intent == common::Intent::Out) {
|
|
|
|
|
reason = "INTENT(OUT)";
|
|
|
|
|
} else if (dummy.intent == common::Intent::InOut) {
|
|
|
|
|
reason = "INTENT(IN OUT)";
|
2019-10-11 07:06:05 +08:00
|
|
|
} else if (dummyIsAsynchronous) {
|
2019-10-11 04:09:35 +08:00
|
|
|
reason = "ASYNCHRONOUS";
|
2019-10-11 07:06:05 +08:00
|
|
|
} else if (dummyIsVolatile) {
|
2019-10-11 04:09:35 +08:00
|
|
|
reason = "VOLATILE";
|
|
|
|
|
}
|
2019-11-08 08:01:38 +08:00
|
|
|
if (reason && scope) {
|
2020-03-29 12:00:16 +08:00
|
|
|
bool vectorSubscriptIsOk{isElemental || dummyIsValue}; // 15.5.2.4(21)
|
2020-03-06 04:56:30 +08:00
|
|
|
if (auto why{WhyNotModifiable(
|
|
|
|
|
messages.at(), actual, *scope, vectorSubscriptIsOk)}) {
|
2019-10-11 04:09:35 +08:00
|
|
|
if (auto *msg{messages.Say(
|
2020-04-19 19:10:37 +08:00
|
|
|
"Actual argument associated with %s %s must be definable"_err_en_US, // C1158
|
2019-10-17 06:36:54 +08:00
|
|
|
reason, dummyName)}) {
|
2020-03-06 04:56:30 +08:00
|
|
|
msg->Attach(*why);
|
2019-10-11 04:09:35 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2019-10-11 07:06:05 +08:00
|
|
|
|
|
|
|
|
// Cases when temporaries might be needed but must not be permitted.
|
2021-11-27 05:26:50 +08:00
|
|
|
bool actualIsContiguous{IsSimplyContiguous(actual, context)};
|
|
|
|
|
bool dummyIsAssumedShape{dummy.type.attrs().test(
|
|
|
|
|
characteristics::TypeAndShape::Attr::AssumedShape)};
|
2019-10-25 07:08:06 +08:00
|
|
|
bool dummyIsPointer{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
|
2019-11-02 04:08:16 +08:00
|
|
|
bool dummyIsContiguous{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
|
2019-10-11 07:06:05 +08:00
|
|
|
if ((actualIsAsynchronous || actualIsVolatile) &&
|
|
|
|
|
(dummyIsAsynchronous || dummyIsVolatile) && !dummyIsValue) {
|
2020-03-29 12:00:16 +08:00
|
|
|
if (actualIsCoindexed) { // C1538
|
2019-10-11 07:06:05 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"Coindexed ASYNCHRONOUS or VOLATILE actual argument may not be associated with %s with ASYNCHRONOUS or VOLATILE attributes unless VALUE"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-11 07:06:05 +08:00
|
|
|
}
|
2019-11-02 04:08:16 +08:00
|
|
|
if (actualRank > 0 && !actualIsContiguous) {
|
2019-10-11 07:06:05 +08:00
|
|
|
if (dummyIsContiguous ||
|
|
|
|
|
!(dummyIsAssumedShape || dummyIsAssumedRank ||
|
2020-03-29 12:00:16 +08:00
|
|
|
(actualIsPointer && dummyIsPointer))) { // C1539 & C1540
|
2019-10-11 07:06:05 +08:00
|
|
|
messages.Say(
|
2019-10-17 02:53:03 +08:00
|
|
|
"ASYNCHRONOUS or VOLATILE actual argument that is not simply contiguous may not be associated with a contiguous %s"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-11 07:06:05 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2019-10-25 07:08:06 +08:00
|
|
|
|
2019-10-30 03:46:25 +08:00
|
|
|
// 15.5.2.6 -- dummy is ALLOCATABLE
|
2019-10-25 07:08:06 +08:00
|
|
|
bool dummyIsAllocatable{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Allocatable)};
|
2022-04-02 04:31:23 +08:00
|
|
|
bool actualIsAllocatable{evaluate::IsAllocatableDesignator(actual)};
|
2019-10-30 03:46:25 +08:00
|
|
|
if (dummyIsAllocatable) {
|
|
|
|
|
if (!actualIsAllocatable) {
|
2019-10-25 07:08:06 +08:00
|
|
|
messages.Say(
|
2019-10-30 03:46:25 +08:00
|
|
|
"ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (actualIsAllocatable && actualIsCoindexed &&
|
|
|
|
|
dummy.intent != common::Intent::In) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-10-25 07:08:06 +08:00
|
|
|
}
|
2019-10-30 03:46:25 +08:00
|
|
|
if (!actualIsCoindexed && actualLastSymbol &&
|
|
|
|
|
actualLastSymbol->Corank() != dummy.type.corank()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"ALLOCATABLE %s has corank %d but actual argument has corank %d"_err_en_US,
|
|
|
|
|
dummyName, dummy.type.corank(), actualLastSymbol->Corank());
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-11-02 04:08:16 +08:00
|
|
|
// 15.5.2.7 -- dummy is POINTER
|
|
|
|
|
if (dummyIsPointer) {
|
|
|
|
|
if (dummyIsContiguous && !actualIsContiguous) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with CONTIGUOUS POINTER %s must be simply contiguous"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (!actualIsPointer) {
|
|
|
|
|
if (dummy.intent == common::Intent::In) {
|
2020-01-07 01:16:18 +08:00
|
|
|
semantics::CheckPointerAssignment(
|
2019-12-12 07:06:24 +08:00
|
|
|
context, parser::CharBlock{}, dummyName, dummy, actual);
|
2019-11-02 04:08:16 +08:00
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-30 03:46:25 +08:00
|
|
|
// 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE
|
|
|
|
|
if ((actualIsPointer && dummyIsPointer) ||
|
|
|
|
|
(actualIsAllocatable && dummyIsAllocatable)) {
|
2019-10-25 07:08:06 +08:00
|
|
|
bool actualIsUnlimited{actualType.type().IsUnlimitedPolymorphic()};
|
|
|
|
|
bool dummyIsUnlimited{dummy.type.type().IsUnlimitedPolymorphic()};
|
2019-10-30 03:46:25 +08:00
|
|
|
if (actualIsUnlimited != dummyIsUnlimited) {
|
|
|
|
|
if (typesCompatible) {
|
2019-10-25 07:08:06 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so"_err_en_US);
|
2019-10-30 03:46:25 +08:00
|
|
|
}
|
|
|
|
|
} else if (dummyIsPolymorphic != actualIsPolymorphic) {
|
|
|
|
|
if (dummy.intent == common::Intent::In && typesCompatible) {
|
|
|
|
|
// extension: allow with warning, rule is only relevant for definables
|
|
|
|
|
messages.Say(
|
2022-03-08 05:57:37 +08:00
|
|
|
"If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_port_en_US);
|
2019-10-30 03:46:25 +08:00
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US);
|
|
|
|
|
}
|
|
|
|
|
} else if (!actualIsUnlimited && typesCompatible) {
|
2020-10-01 04:34:23 +08:00
|
|
|
if (!actualType.type().IsTkCompatibleWith(dummy.type.type())) {
|
2019-10-30 03:46:25 +08:00
|
|
|
if (dummy.intent == common::Intent::In) {
|
|
|
|
|
// extension: allow with warning, rule is only relevant for definables
|
2019-10-25 07:08:06 +08:00
|
|
|
messages.Say(
|
2022-03-08 05:57:37 +08:00
|
|
|
"POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_port_en_US);
|
2019-10-30 03:46:25 +08:00
|
|
|
} else {
|
2019-10-25 07:08:06 +08:00
|
|
|
messages.Say(
|
2020-10-01 04:34:23 +08:00
|
|
|
"POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind"_err_en_US);
|
2019-10-25 07:08:06 +08:00
|
|
|
}
|
|
|
|
|
}
|
2022-04-04 23:16:30 +08:00
|
|
|
// 15.5.2.5(4)
|
2019-12-17 06:28:23 +08:00
|
|
|
if (const auto *derived{
|
|
|
|
|
evaluate::GetDerivedTypeSpec(actualType.type())}) {
|
|
|
|
|
if (!DefersSameTypeParameters(
|
|
|
|
|
*derived, *evaluate::GetDerivedTypeSpec(dummy.type.type()))) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US);
|
|
|
|
|
}
|
2022-04-04 23:16:30 +08:00
|
|
|
} else if (dummy.type.type().HasDeferredTypeParameter() !=
|
|
|
|
|
actualType.type().HasDeferredTypeParameter()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE"_err_en_US);
|
2019-10-30 03:46:25 +08:00
|
|
|
}
|
2019-10-25 07:08:06 +08:00
|
|
|
}
|
|
|
|
|
}
|
2019-11-05 06:06:52 +08:00
|
|
|
|
|
|
|
|
// 15.5.2.8 -- coarray dummy arguments
|
|
|
|
|
if (dummy.type.corank() > 0) {
|
|
|
|
|
if (actualType.corank() == 0) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with coarray %s must be a coarray"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
if (dummyIsVolatile) {
|
|
|
|
|
if (!actualIsVolatile) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"non-VOLATILE coarray may not be associated with VOLATILE coarray %s"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
if (actualIsVolatile) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"VOLATILE coarray may not be associated with non-VOLATILE coarray %s"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (actualRank == dummy.type.Rank() && !actualIsContiguous) {
|
|
|
|
|
if (dummyIsContiguous) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with a CONTIGUOUS coarray %s must be simply contiguous"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
} else if (!dummyIsAssumedShape && !dummyIsAssumedRank) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with coarray %s (not assumed shape or rank) must be simply contiguous"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2021-09-17 23:19:10 +08:00
|
|
|
|
|
|
|
|
// NULL(MOLD=) checking for non-intrinsic procedures
|
|
|
|
|
bool dummyIsOptional{
|
|
|
|
|
dummy.attrs.test(characteristics::DummyDataObject::Attr::Optional)};
|
|
|
|
|
bool actualIsNull{evaluate::IsNullPointer(actual)};
|
|
|
|
|
if (!intrinsic && !dummyIsPointer && !dummyIsOptional && actualIsNull) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with %s may not be null pointer %s"_err_en_US,
|
|
|
|
|
dummyName, actual.AsFortran());
|
|
|
|
|
}
|
2019-10-09 06:21:09 +08:00
|
|
|
}
|
|
|
|
|
|
2019-11-08 08:01:38 +08:00
|
|
|
static void CheckProcedureArg(evaluate::ActualArgument &arg,
|
2021-09-15 03:44:57 +08:00
|
|
|
const characteristics::Procedure &proc,
|
|
|
|
|
const characteristics::DummyProcedure &dummy, const std::string &dummyName,
|
2019-11-08 08:01:38 +08:00
|
|
|
evaluate::FoldingContext &context) {
|
|
|
|
|
parser::ContextualMessages &messages{context.messages()};
|
2022-02-12 08:58:01 +08:00
|
|
|
auto restorer{
|
|
|
|
|
messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
|
2021-09-15 03:44:57 +08:00
|
|
|
const characteristics::Procedure &interface { dummy.procedure.value() };
|
2019-11-08 08:01:38 +08:00
|
|
|
if (const auto *expr{arg.UnwrapExpr()}) {
|
|
|
|
|
bool dummyIsPointer{
|
2021-09-15 03:44:57 +08:00
|
|
|
dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
|
2019-11-08 08:01:38 +08:00
|
|
|
const auto *argProcDesignator{
|
|
|
|
|
std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
|
|
|
|
|
const auto *argProcSymbol{
|
|
|
|
|
argProcDesignator ? argProcDesignator->GetSymbol() : nullptr};
|
|
|
|
|
if (auto argChars{characteristics::DummyArgument::FromActual(
|
|
|
|
|
"actual argument", *expr, context)}) {
|
2020-09-26 00:03:17 +08:00
|
|
|
if (!argChars->IsTypelessIntrinsicDummy()) {
|
|
|
|
|
if (auto *argProc{
|
|
|
|
|
std::get_if<characteristics::DummyProcedure>(&argChars->u)}) {
|
|
|
|
|
characteristics::Procedure &argInterface{argProc->procedure.value()};
|
|
|
|
|
argInterface.attrs.reset(
|
|
|
|
|
characteristics::Procedure::Attr::NullPointer);
|
|
|
|
|
if (!argProcSymbol || argProcSymbol->attrs().test(Attr::INTRINSIC)) {
|
|
|
|
|
// It's ok to pass ELEMENTAL unrestricted intrinsic functions.
|
2019-11-08 08:01:38 +08:00
|
|
|
argInterface.attrs.reset(
|
2020-09-26 00:03:17 +08:00
|
|
|
characteristics::Procedure::Attr::Elemental);
|
|
|
|
|
} else if (argInterface.attrs.test(
|
|
|
|
|
characteristics::Procedure::Attr::Elemental)) {
|
|
|
|
|
if (argProcSymbol) { // C1533
|
|
|
|
|
evaluate::SayWithDeclaration(messages, *argProcSymbol,
|
|
|
|
|
"Non-intrinsic ELEMENTAL procedure '%s' may not be passed as an actual argument"_err_en_US,
|
|
|
|
|
argProcSymbol->name());
|
|
|
|
|
return; // avoid piling on with checks below
|
|
|
|
|
} else {
|
|
|
|
|
argInterface.attrs.reset(
|
|
|
|
|
characteristics::Procedure::Attr::NullPointer);
|
|
|
|
|
}
|
2019-11-08 08:01:38 +08:00
|
|
|
}
|
2020-09-26 00:03:17 +08:00
|
|
|
if (interface.HasExplicitInterface()) {
|
2022-02-24 08:36:39 +08:00
|
|
|
if (!interface.IsCompatibleWith(argInterface)) {
|
2021-01-13 00:52:27 +08:00
|
|
|
// 15.5.2.9(1): Explicit interfaces must match
|
|
|
|
|
if (argInterface.HasExplicitInterface()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual procedure argument has interface incompatible with %s"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
return;
|
2021-09-15 03:44:57 +08:00
|
|
|
} else if (proc.IsPure()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
|
|
|
|
|
dummyName);
|
2021-01-13 00:52:27 +08:00
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual procedure argument has an implicit interface "
|
|
|
|
|
"which is not known to be compatible with %s which has an "
|
2022-03-08 05:57:37 +08:00
|
|
|
"explicit interface"_warn_en_US,
|
2021-01-13 00:52:27 +08:00
|
|
|
dummyName);
|
|
|
|
|
}
|
2020-09-26 00:03:17 +08:00
|
|
|
}
|
|
|
|
|
} else { // 15.5.2.9(2,3)
|
|
|
|
|
if (interface.IsSubroutine() && argInterface.IsFunction()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with procedure %s is a function but must be a subroutine"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
} else if (interface.IsFunction()) {
|
|
|
|
|
if (argInterface.IsFunction()) {
|
2022-02-24 08:36:39 +08:00
|
|
|
if (!interface.functionResult->IsCompatibleWith(
|
|
|
|
|
*argInterface.functionResult)) {
|
2020-09-26 00:03:17 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument function associated with procedure %s has incompatible result type"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
} else if (argInterface.IsSubroutine()) {
|
2019-11-08 08:01:38 +08:00
|
|
|
messages.Say(
|
2020-09-26 00:03:17 +08:00
|
|
|
"Actual argument associated with procedure %s is a subroutine but must be a function"_err_en_US,
|
2019-11-08 08:01:38 +08:00
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2020-09-26 00:03:17 +08:00
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with procedure %s is not a procedure"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-11-08 08:01:38 +08:00
|
|
|
}
|
2021-03-13 05:51:33 +08:00
|
|
|
} else if (IsNullPointer(*expr)) {
|
|
|
|
|
if (!dummyIsPointer) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with procedure %s is a null pointer"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2019-11-08 08:01:38 +08:00
|
|
|
messages.Say(
|
2021-03-13 05:51:33 +08:00
|
|
|
"Actual argument associated with procedure %s is typeless"_err_en_US,
|
2019-11-08 08:01:38 +08:00
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
2021-03-13 05:51:33 +08:00
|
|
|
if (interface.HasExplicitInterface() && dummyIsPointer &&
|
2021-09-15 03:44:57 +08:00
|
|
|
dummy.intent != common::Intent::In) {
|
2021-03-13 05:51:33 +08:00
|
|
|
const Symbol *last{GetLastSymbol(*expr)};
|
|
|
|
|
if (!(last && IsProcedurePointer(*last))) {
|
2019-11-08 08:01:38 +08:00
|
|
|
// 15.5.2.9(5) -- dummy procedure POINTER
|
2022-02-24 08:36:39 +08:00
|
|
|
// Interface compatibility has already been checked above
|
2021-03-13 05:51:33 +08:00
|
|
|
messages.Say(
|
|
|
|
|
"Actual argument associated with procedure pointer %s must be a POINTER unless INTENT(IN)"_err_en_US,
|
|
|
|
|
dummyName);
|
2019-11-08 08:01:38 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Assumed-type argument may not be forwarded as procedure %s"_err_en_US,
|
|
|
|
|
dummyName);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2022-01-12 02:38:26 +08:00
|
|
|
// Allow BOZ literal actual arguments when they can be converted to a known
|
|
|
|
|
// dummy argument type
|
|
|
|
|
static void ConvertBOZLiteralArg(
|
|
|
|
|
evaluate::ActualArgument &arg, const evaluate::DynamicType &type) {
|
|
|
|
|
if (auto *expr{arg.UnwrapExpr()}) {
|
|
|
|
|
if (IsBOZLiteral(*expr)) {
|
|
|
|
|
if (auto converted{evaluate::ConvertToType(type, SomeExpr{*expr})}) {
|
|
|
|
|
arg = std::move(*converted);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-17 06:36:54 +08:00
|
|
|
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
|
2019-10-10 07:30:34 +08:00
|
|
|
const characteristics::DummyArgument &dummy,
|
2019-10-11 07:06:05 +08:00
|
|
|
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
|
2021-10-20 02:34:57 +08:00
|
|
|
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
|
|
|
|
|
bool allowIntegerConversions) {
|
2019-10-09 06:21:09 +08:00
|
|
|
auto &messages{context.messages()};
|
2019-10-17 02:53:03 +08:00
|
|
|
std::string dummyName{"dummy argument"};
|
|
|
|
|
if (!dummy.name.empty()) {
|
|
|
|
|
dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
|
|
|
|
|
}
|
2022-02-12 08:58:01 +08:00
|
|
|
auto restorer{
|
|
|
|
|
messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
|
2022-03-28 18:46:47 +08:00
|
|
|
std::visit(
|
2019-10-17 00:39:37 +08:00
|
|
|
common::visitors{
|
|
|
|
|
[&](const characteristics::DummyDataObject &object) {
|
2022-01-12 02:38:26 +08:00
|
|
|
ConvertBOZLiteralArg(arg, object.type.type());
|
2019-10-17 06:36:54 +08:00
|
|
|
if (auto *expr{arg.UnwrapExpr()}) {
|
2019-10-17 00:39:37 +08:00
|
|
|
if (auto type{characteristics::TypeAndShape::Characterize(
|
|
|
|
|
*expr, context)}) {
|
2020-01-03 04:26:47 +08:00
|
|
|
arg.set_dummyIntent(object.intent);
|
2019-10-23 00:31:33 +08:00
|
|
|
bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
|
2019-10-25 07:38:09 +08:00
|
|
|
CheckExplicitDataArg(object, dummyName, *expr, *type,
|
2021-10-20 02:34:57 +08:00
|
|
|
isElemental, context, scope, intrinsic,
|
|
|
|
|
allowIntegerConversions);
|
2019-10-17 00:39:37 +08:00
|
|
|
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
|
2021-07-28 01:40:34 +08:00
|
|
|
IsBOZLiteral(*expr)) {
|
2019-10-17 00:39:37 +08:00
|
|
|
// ok
|
2020-09-26 00:03:17 +08:00
|
|
|
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
|
|
|
|
|
evaluate::IsNullPointer(*expr)) {
|
2021-01-22 06:50:57 +08:00
|
|
|
// ok, ASSOCIATED(NULL())
|
2021-09-17 23:19:10 +08:00
|
|
|
} else if ((object.attrs.test(characteristics::DummyDataObject::
|
|
|
|
|
Attr::Pointer) ||
|
|
|
|
|
object.attrs.test(characteristics::
|
|
|
|
|
DummyDataObject::Attr::Optional)) &&
|
2021-01-22 06:50:57 +08:00
|
|
|
evaluate::IsNullPointer(*expr)) {
|
|
|
|
|
// ok, FOO(NULL())
|
2019-10-17 00:39:37 +08:00
|
|
|
} else {
|
|
|
|
|
messages.Say(
|
2020-06-20 09:11:46 +08:00
|
|
|
"Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,
|
|
|
|
|
expr->AsFortran(), dummyName);
|
2019-10-17 00:39:37 +08:00
|
|
|
}
|
[flang] Semantic checks for C709, C710, and C711
C709 An assumed-type entity shall be a dummy data object that does not
have the ALLOCATABLE, CODIMENSION, INTENT (OUT), POINTER, or VALUE
attribute and is not an explicit-shape array.
C710 An assumed-type variable name shall not appear in a designator or
expression except as an actual argument corresponding to a dummy
argument that is assumed-type, or as the first argument to the intrinsic
function IS_CONTIGUOUS, LBOUND, PRESENT, RANK, SHAPE, SIZE, or UBOUND,
or the function C_LOC from the intrinsic module ISO_C_BINDING.
C711 An assumed-type actual argument that corresponds to an assumed-rank
dummy argument shall be assumed-shape or assumed-rank.
For C709 I added code to check-declarations.cpp. For this, I had to
distinguish between polymorphic types and assumed-type types to
eliminate multiple messages on the same line.
C710 was already checked, but I added a notation in the source.
For C711 I added code to check-call.cpp and the test call15.f90.
Original-commit: flang-compiler/f18@4a703f2b5a6484208a059dc0b456363c138a661d
Reviewed-on: https://github.com/flang-compiler/f18/pull/985
2020-02-15 07:53:11 +08:00
|
|
|
} else {
|
2019-12-10 05:52:12 +08:00
|
|
|
const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
|
[flang] Semantic checks for C709, C710, and C711
C709 An assumed-type entity shall be a dummy data object that does not
have the ALLOCATABLE, CODIMENSION, INTENT (OUT), POINTER, or VALUE
attribute and is not an explicit-shape array.
C710 An assumed-type variable name shall not appear in a designator or
expression except as an actual argument corresponding to a dummy
argument that is assumed-type, or as the first argument to the intrinsic
function IS_CONTIGUOUS, LBOUND, PRESENT, RANK, SHAPE, SIZE, or UBOUND,
or the function C_LOC from the intrinsic module ISO_C_BINDING.
C711 An assumed-type actual argument that corresponds to an assumed-rank
dummy argument shall be assumed-shape or assumed-rank.
For C709 I added code to check-declarations.cpp. For this, I had to
distinguish between polymorphic types and assumed-type types to
eliminate multiple messages on the same line.
C710 was already checked, but I added a notation in the source.
For C711 I added code to check-call.cpp and the test call15.f90.
Original-commit: flang-compiler/f18@4a703f2b5a6484208a059dc0b456363c138a661d
Reviewed-on: https://github.com/flang-compiler/f18/pull/985
2020-02-15 07:53:11 +08:00
|
|
|
if (!object.type.type().IsAssumedType()) {
|
|
|
|
|
messages.Say(
|
2020-02-14 06:41:56 +08:00
|
|
|
"Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
|
[flang] Semantic checks for C709, C710, and C711
C709 An assumed-type entity shall be a dummy data object that does not
have the ALLOCATABLE, CODIMENSION, INTENT (OUT), POINTER, or VALUE
attribute and is not an explicit-shape array.
C710 An assumed-type variable name shall not appear in a designator or
expression except as an actual argument corresponding to a dummy
argument that is assumed-type, or as the first argument to the intrinsic
function IS_CONTIGUOUS, LBOUND, PRESENT, RANK, SHAPE, SIZE, or UBOUND,
or the function C_LOC from the intrinsic module ISO_C_BINDING.
C711 An assumed-type actual argument that corresponds to an assumed-rank
dummy argument shall be assumed-shape or assumed-rank.
For C709 I added code to check-declarations.cpp. For this, I had to
distinguish between polymorphic types and assumed-type types to
eliminate multiple messages on the same line.
C710 was already checked, but I added a notation in the source.
For C711 I added code to check-call.cpp and the test call15.f90.
Original-commit: flang-compiler/f18@4a703f2b5a6484208a059dc0b456363c138a661d
Reviewed-on: https://github.com/flang-compiler/f18/pull/985
2020-02-15 07:53:11 +08:00
|
|
|
assumed.name(), dummyName);
|
2022-02-19 04:25:58 +08:00
|
|
|
} else if (object.type.attrs().test(evaluate::characteristics::
|
|
|
|
|
TypeAndShape::Attr::AssumedRank) &&
|
|
|
|
|
!IsAssumedShape(assumed) &&
|
|
|
|
|
!evaluate::IsAssumedRank(assumed)) {
|
|
|
|
|
messages.Say( // C711
|
|
|
|
|
"Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US,
|
|
|
|
|
assumed.name(), dummyName);
|
[flang] Semantic checks for C709, C710, and C711
C709 An assumed-type entity shall be a dummy data object that does not
have the ALLOCATABLE, CODIMENSION, INTENT (OUT), POINTER, or VALUE
attribute and is not an explicit-shape array.
C710 An assumed-type variable name shall not appear in a designator or
expression except as an actual argument corresponding to a dummy
argument that is assumed-type, or as the first argument to the intrinsic
function IS_CONTIGUOUS, LBOUND, PRESENT, RANK, SHAPE, SIZE, or UBOUND,
or the function C_LOC from the intrinsic module ISO_C_BINDING.
C711 An assumed-type actual argument that corresponds to an assumed-rank
dummy argument shall be assumed-shape or assumed-rank.
For C709 I added code to check-declarations.cpp. For this, I had to
distinguish between polymorphic types and assumed-type types to
eliminate multiple messages on the same line.
C710 was already checked, but I added a notation in the source.
For C711 I added code to check-call.cpp and the test call15.f90.
Original-commit: flang-compiler/f18@4a703f2b5a6484208a059dc0b456363c138a661d
Reviewed-on: https://github.com/flang-compiler/f18/pull/985
2020-02-15 07:53:11 +08:00
|
|
|
}
|
2019-10-17 00:39:37 +08:00
|
|
|
}
|
|
|
|
|
},
|
2021-09-15 03:44:57 +08:00
|
|
|
[&](const characteristics::DummyProcedure &dummy) {
|
|
|
|
|
CheckProcedureArg(arg, proc, dummy, dummyName, context);
|
2019-11-08 08:01:38 +08:00
|
|
|
},
|
|
|
|
|
[&](const characteristics::AlternateReturn &) {
|
2021-01-05 01:35:15 +08:00
|
|
|
// All semantic checking is done elsewhere
|
2019-10-17 00:39:37 +08:00
|
|
|
},
|
|
|
|
|
},
|
|
|
|
|
dummy.u);
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
|
2019-10-10 07:30:34 +08:00
|
|
|
static void RearrangeArguments(const characteristics::Procedure &proc,
|
|
|
|
|
evaluate::ActualArguments &actuals, parser::ContextualMessages &messages) {
|
2019-09-17 07:58:13 +08:00
|
|
|
CHECK(proc.HasExplicitInterface());
|
|
|
|
|
if (actuals.size() < proc.dummyArguments.size()) {
|
|
|
|
|
actuals.resize(proc.dummyArguments.size());
|
|
|
|
|
} else if (actuals.size() > proc.dummyArguments.size()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Too many actual arguments (%zd) passed to procedure that expects only %zd"_err_en_US,
|
|
|
|
|
actuals.size(), proc.dummyArguments.size());
|
|
|
|
|
}
|
2019-10-10 07:30:34 +08:00
|
|
|
std::map<std::string, evaluate::ActualArgument> kwArgs;
|
2019-09-17 07:58:13 +08:00
|
|
|
for (auto &x : actuals) {
|
2019-12-26 04:29:50 +08:00
|
|
|
if (x && x->keyword()) {
|
|
|
|
|
auto emplaced{
|
|
|
|
|
kwArgs.try_emplace(x->keyword()->ToString(), std::move(*x))};
|
|
|
|
|
if (!emplaced.second) {
|
|
|
|
|
messages.Say(*x->keyword(),
|
|
|
|
|
"Argument keyword '%s=' appears on more than one effective argument in this procedure reference"_err_en_US,
|
|
|
|
|
*x->keyword());
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
2019-12-26 04:29:50 +08:00
|
|
|
x.reset();
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (!kwArgs.empty()) {
|
|
|
|
|
int index{0};
|
|
|
|
|
for (const auto &dummy : proc.dummyArguments) {
|
|
|
|
|
if (!dummy.name.empty()) {
|
|
|
|
|
auto iter{kwArgs.find(dummy.name)};
|
|
|
|
|
if (iter != kwArgs.end()) {
|
2019-10-10 07:30:34 +08:00
|
|
|
evaluate::ActualArgument &x{iter->second};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (actuals[index]) {
|
2019-12-06 02:24:18 +08:00
|
|
|
messages.Say(*x.keyword(),
|
2019-09-17 07:58:13 +08:00
|
|
|
"Keyword argument '%s=' has already been specified positionally (#%d) in this procedure reference"_err_en_US,
|
2019-12-06 02:24:18 +08:00
|
|
|
*x.keyword(), index + 1);
|
2019-09-17 07:58:13 +08:00
|
|
|
} else {
|
|
|
|
|
actuals[index] = std::move(x);
|
|
|
|
|
}
|
|
|
|
|
kwArgs.erase(iter);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
++index;
|
|
|
|
|
}
|
|
|
|
|
for (auto &bad : kwArgs) {
|
2019-10-10 07:30:34 +08:00
|
|
|
evaluate::ActualArgument &x{bad.second};
|
2019-12-06 02:24:18 +08:00
|
|
|
messages.Say(*x.keyword(),
|
2019-09-17 07:58:13 +08:00
|
|
|
"Argument keyword '%s=' is not recognized for this procedure reference"_err_en_US,
|
2019-12-06 02:24:18 +08:00
|
|
|
*x.keyword());
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
}
|
2019-10-10 07:08:13 +08:00
|
|
|
}
|
|
|
|
|
|
2021-09-10 04:09:48 +08:00
|
|
|
// The actual argument arrays to an ELEMENTAL procedure must conform.
|
|
|
|
|
static bool CheckElementalConformance(parser::ContextualMessages &messages,
|
|
|
|
|
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
|
|
|
|
|
evaluate::FoldingContext &context) {
|
|
|
|
|
std::optional<evaluate::Shape> shape;
|
|
|
|
|
std::string shapeName;
|
|
|
|
|
int index{0};
|
|
|
|
|
for (const auto &arg : actuals) {
|
|
|
|
|
const auto &dummy{proc.dummyArguments.at(index++)};
|
|
|
|
|
if (arg) {
|
|
|
|
|
if (const auto *expr{arg->UnwrapExpr()}) {
|
|
|
|
|
if (auto argShape{evaluate::GetShape(context, *expr)}) {
|
|
|
|
|
if (GetRank(*argShape) > 0) {
|
|
|
|
|
std::string argName{"actual argument ("s + expr->AsFortran() +
|
|
|
|
|
") corresponding to dummy argument #" + std::to_string(index) +
|
|
|
|
|
" ('" + dummy.name + "')"};
|
|
|
|
|
if (shape) {
|
|
|
|
|
auto tristate{evaluate::CheckConformance(messages, *shape,
|
|
|
|
|
*argShape, evaluate::CheckConformanceFlags::None,
|
|
|
|
|
shapeName.c_str(), argName.c_str())};
|
|
|
|
|
if (tristate && !*tristate) {
|
|
|
|
|
return false;
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
shape = std::move(argShape);
|
|
|
|
|
shapeName = argName;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return true;
|
|
|
|
|
}
|
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
static parser::Messages CheckExplicitInterface(
|
|
|
|
|
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
|
2020-10-20 18:39:26 +08:00
|
|
|
const evaluate::FoldingContext &context, const Scope *scope,
|
2021-10-20 02:34:57 +08:00
|
|
|
const evaluate::SpecificIntrinsic *intrinsic,
|
|
|
|
|
bool allowIntegerConversions) {
|
2019-10-12 06:41:11 +08:00
|
|
|
parser::Messages buffer;
|
|
|
|
|
parser::ContextualMessages messages{context.messages().at(), &buffer};
|
|
|
|
|
RearrangeArguments(proc, actuals, messages);
|
|
|
|
|
if (buffer.empty()) {
|
|
|
|
|
int index{0};
|
2019-12-06 02:24:18 +08:00
|
|
|
evaluate::FoldingContext localContext{context, messages};
|
2019-10-12 06:41:11 +08:00
|
|
|
for (auto &actual : actuals) {
|
|
|
|
|
const auto &dummy{proc.dummyArguments.at(index++)};
|
2019-11-10 01:29:31 +08:00
|
|
|
if (actual) {
|
2021-10-20 02:34:57 +08:00
|
|
|
CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
|
|
|
|
|
intrinsic, allowIntegerConversions);
|
2019-10-12 06:41:11 +08:00
|
|
|
} else if (!dummy.IsOptional()) {
|
|
|
|
|
if (dummy.name.empty()) {
|
|
|
|
|
messages.Say(
|
|
|
|
|
"Dummy argument #%d is not OPTIONAL and is not associated with "
|
|
|
|
|
"an actual argument in this procedure reference"_err_en_US,
|
|
|
|
|
index);
|
|
|
|
|
} else {
|
2019-10-17 02:53:03 +08:00
|
|
|
messages.Say("Dummy argument '%s=' (#%d) is not OPTIONAL and is not "
|
|
|
|
|
"associated with an actual argument in this procedure "
|
|
|
|
|
"reference"_err_en_US,
|
2019-10-12 06:41:11 +08:00
|
|
|
dummy.name, index);
|
|
|
|
|
}
|
2019-10-10 07:08:13 +08:00
|
|
|
}
|
|
|
|
|
}
|
2021-09-10 04:09:48 +08:00
|
|
|
if (proc.IsElemental() && !buffer.AnyFatalError()) {
|
|
|
|
|
CheckElementalConformance(messages, proc, actuals, localContext);
|
|
|
|
|
}
|
2019-10-10 07:08:13 +08:00
|
|
|
}
|
2019-10-12 06:41:11 +08:00
|
|
|
return buffer;
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
|
2019-10-23 00:31:33 +08:00
|
|
|
parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
|
|
|
|
|
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
|
2020-10-20 18:39:26 +08:00
|
|
|
const Scope &scope, const evaluate::SpecificIntrinsic *intrinsic) {
|
2021-10-20 02:34:57 +08:00
|
|
|
return CheckExplicitInterface(
|
|
|
|
|
proc, actuals, context, &scope, intrinsic, true);
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
|
2021-10-20 02:34:57 +08:00
|
|
|
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
|
|
|
|
|
bool allowIntegerConversions) {
|
|
|
|
|
return !CheckExplicitInterface(
|
|
|
|
|
proc, actuals, context, nullptr, nullptr, allowIntegerConversions)
|
2021-09-08 03:17:31 +08:00
|
|
|
.AnyFatalError();
|
2019-10-23 00:31:33 +08:00
|
|
|
}
|
|
|
|
|
|
2019-09-17 07:58:13 +08:00
|
|
|
void CheckArguments(const characteristics::Procedure &proc,
|
2019-10-10 07:30:34 +08:00
|
|
|
evaluate::ActualArguments &actuals, evaluate::FoldingContext &context,
|
2020-10-20 18:39:26 +08:00
|
|
|
const Scope &scope, bool treatingExternalAsImplicit,
|
|
|
|
|
const evaluate::SpecificIntrinsic *intrinsic) {
|
2019-10-11 04:09:35 +08:00
|
|
|
bool explicitInterface{proc.HasExplicitInterface()};
|
2022-01-12 02:38:26 +08:00
|
|
|
parser::ContextualMessages &messages{context.messages()};
|
|
|
|
|
if (!explicitInterface || treatingExternalAsImplicit) {
|
|
|
|
|
parser::Messages buffer;
|
|
|
|
|
{
|
|
|
|
|
auto restorer{messages.SetMessages(buffer)};
|
|
|
|
|
for (auto &actual : actuals) {
|
|
|
|
|
if (actual) {
|
|
|
|
|
CheckImplicitInterfaceArg(*actual, messages);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (!buffer.empty()) {
|
|
|
|
|
if (auto *msgs{messages.messages()}) {
|
|
|
|
|
msgs->Annex(std::move(buffer));
|
|
|
|
|
}
|
|
|
|
|
return; // don't pile on
|
|
|
|
|
}
|
|
|
|
|
}
|
2019-10-12 06:41:11 +08:00
|
|
|
if (explicitInterface) {
|
2020-10-20 18:39:26 +08:00
|
|
|
auto buffer{
|
|
|
|
|
CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
|
2019-10-17 00:39:37 +08:00
|
|
|
if (treatingExternalAsImplicit && !buffer.empty()) {
|
2022-01-12 02:38:26 +08:00
|
|
|
if (auto *msg{messages.Say(
|
2022-03-08 05:57:37 +08:00
|
|
|
"If the procedure's interface were explicit, this reference would be in error:"_warn_en_US)}) {
|
2022-04-02 03:46:04 +08:00
|
|
|
buffer.AttachTo(*msg, parser::Severity::Because);
|
2019-10-17 00:39:37 +08:00
|
|
|
}
|
|
|
|
|
}
|
2022-01-12 02:38:26 +08:00
|
|
|
if (auto *msgs{messages.messages()}) {
|
|
|
|
|
msgs->Annex(std::move(buffer));
|
2019-09-17 07:58:13 +08:00
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2020-03-29 12:00:16 +08:00
|
|
|
} // namespace Fortran::semantics
|