1 //===-- lib/Evaluate/characteristics.cpp ----------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8
9 #include "flang/Evaluate/characteristics.h"
10 #include "flang/Common/indirection.h"
11 #include "flang/Evaluate/check-expression.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/intrinsics.h"
14 #include "flang/Evaluate/tools.h"
15 #include "flang/Evaluate/type.h"
16 #include "flang/Parser/message.h"
17 #include "flang/Semantics/scope.h"
18 #include "flang/Semantics/symbol.h"
19 #include "llvm/Support/raw_ostream.h"
20 #include <initializer_list>
21
22 using namespace Fortran::parser::literals;
23
24 namespace Fortran::evaluate::characteristics {
25
26 // Copy attributes from a symbol to dst based on the mapping in pairs.
27 template <typename A, typename B>
CopyAttrs(const semantics::Symbol & src,A & dst,const std::initializer_list<std::pair<semantics::Attr,B>> & pairs)28 static void CopyAttrs(const semantics::Symbol &src, A &dst,
29 const std::initializer_list<std::pair<semantics::Attr, B>> &pairs) {
30 for (const auto &pair : pairs) {
31 if (src.attrs().test(pair.first)) {
32 dst.attrs.set(pair.second);
33 }
34 }
35 }
36
37 // Shapes of function results and dummy arguments have to have
38 // the same rank, the same deferred dimensions, and the same
39 // values for explicit dimensions when constant.
ShapesAreCompatible(const Shape & x,const Shape & y)40 bool ShapesAreCompatible(const Shape &x, const Shape &y) {
41 if (x.size() != y.size()) {
42 return false;
43 }
44 auto yIter{y.begin()};
45 for (const auto &xDim : x) {
46 const auto &yDim{*yIter++};
47 if (xDim) {
48 if (!yDim || ToInt64(*xDim) != ToInt64(*yDim)) {
49 return false;
50 }
51 } else if (yDim) {
52 return false;
53 }
54 }
55 return true;
56 }
57
operator ==(const TypeAndShape & that) const58 bool TypeAndShape::operator==(const TypeAndShape &that) const {
59 return type_ == that.type_ && ShapesAreCompatible(shape_, that.shape_) &&
60 attrs_ == that.attrs_ && corank_ == that.corank_;
61 }
62
Rewrite(FoldingContext & context)63 TypeAndShape &TypeAndShape::Rewrite(FoldingContext &context) {
64 LEN_ = Fold(context, std::move(LEN_));
65 shape_ = Fold(context, std::move(shape_));
66 return *this;
67 }
68
Characterize(const semantics::Symbol & symbol,FoldingContext & context)69 std::optional<TypeAndShape> TypeAndShape::Characterize(
70 const semantics::Symbol &symbol, FoldingContext &context) {
71 const auto &ultimate{symbol.GetUltimate()};
72 return std::visit(
73 common::visitors{
74 [&](const semantics::ProcEntityDetails &proc) {
75 const semantics::ProcInterface &interface{proc.interface()};
76 if (interface.type()) {
77 return Characterize(*interface.type(), context);
78 } else if (interface.symbol()) {
79 return Characterize(*interface.symbol(), context);
80 } else {
81 return std::optional<TypeAndShape>{};
82 }
83 },
84 [&](const semantics::AssocEntityDetails &assoc) {
85 return Characterize(assoc, context);
86 },
87 [&](const semantics::ProcBindingDetails &binding) {
88 return Characterize(binding.symbol(), context);
89 },
90 [&](const auto &x) -> std::optional<TypeAndShape> {
91 using Ty = std::decay_t<decltype(x)>;
92 if constexpr (std::is_same_v<Ty, semantics::EntityDetails> ||
93 std::is_same_v<Ty, semantics::ObjectEntityDetails> ||
94 std::is_same_v<Ty, semantics::TypeParamDetails>) {
95 if (const semantics::DeclTypeSpec * type{ultimate.GetType()}) {
96 if (auto dyType{DynamicType::From(*type)}) {
97 TypeAndShape result{
98 std::move(*dyType), GetShape(context, ultimate)};
99 result.AcquireAttrs(ultimate);
100 result.AcquireLEN(ultimate);
101 return std::move(result.Rewrite(context));
102 }
103 }
104 }
105 return std::nullopt;
106 },
107 },
108 // GetUltimate() used here, not ResolveAssociations(), because
109 // we need the type/rank of an associate entity from TYPE IS,
110 // CLASS IS, or RANK statement.
111 ultimate.details());
112 }
113
Characterize(const semantics::AssocEntityDetails & assoc,FoldingContext & context)114 std::optional<TypeAndShape> TypeAndShape::Characterize(
115 const semantics::AssocEntityDetails &assoc, FoldingContext &context) {
116 std::optional<TypeAndShape> result;
117 if (auto type{DynamicType::From(assoc.type())}) {
118 if (auto rank{assoc.rank()}) {
119 if (*rank >= 0 && *rank <= common::maxRank) {
120 result = TypeAndShape{std::move(*type), Shape(*rank)};
121 }
122 } else if (auto shape{GetShape(context, assoc.expr())}) {
123 result = TypeAndShape{std::move(*type), std::move(*shape)};
124 }
125 if (result && type->category() == TypeCategory::Character) {
126 if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc.expr())}) {
127 if (auto len{chExpr->LEN()}) {
128 result->set_LEN(std::move(*len));
129 }
130 }
131 }
132 }
133 return Fold(context, std::move(result));
134 }
135
Characterize(const semantics::DeclTypeSpec & spec,FoldingContext & context)136 std::optional<TypeAndShape> TypeAndShape::Characterize(
137 const semantics::DeclTypeSpec &spec, FoldingContext &context) {
138 if (auto type{DynamicType::From(spec)}) {
139 return Fold(context, TypeAndShape{std::move(*type)});
140 } else {
141 return std::nullopt;
142 }
143 }
144
Characterize(const ActualArgument & arg,FoldingContext & context)145 std::optional<TypeAndShape> TypeAndShape::Characterize(
146 const ActualArgument &arg, FoldingContext &context) {
147 return Characterize(arg.UnwrapExpr(), context);
148 }
149
IsCompatibleWith(parser::ContextualMessages & messages,const TypeAndShape & that,const char * thisIs,const char * thatIs,bool isElemental,enum CheckConformanceFlags::Flags flags) const150 bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
151 const TypeAndShape &that, const char *thisIs, const char *thatIs,
152 bool isElemental, enum CheckConformanceFlags::Flags flags) const {
153 if (!type_.IsTkCompatibleWith(that.type_)) {
154 messages.Say(
155 "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US,
156 thatIs, that.AsFortran(), thisIs, AsFortran());
157 return false;
158 }
159 return isElemental ||
160 CheckConformance(messages, shape_, that.shape_, flags, thisIs, thatIs)
161 .value_or(true /*fail only when nonconformance is known now*/);
162 }
163
MeasureElementSizeInBytes(FoldingContext & foldingContext,bool align) const164 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
165 FoldingContext &foldingContext, bool align) const {
166 if (LEN_) {
167 CHECK(type_.category() == TypeCategory::Character);
168 return Fold(foldingContext,
169 Expr<SubscriptInteger>{type_.kind()} * Expr<SubscriptInteger>{*LEN_});
170 }
171 if (auto elementBytes{type_.MeasureSizeInBytes(foldingContext, align)}) {
172 return Fold(foldingContext, std::move(*elementBytes));
173 }
174 return std::nullopt;
175 }
176
MeasureSizeInBytes(FoldingContext & foldingContext) const177 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
178 FoldingContext &foldingContext) const {
179 if (auto elements{GetSize(Shape{shape_})}) {
180 // Sizes of arrays (even with single elements) are multiples of
181 // their alignments.
182 if (auto elementBytes{
183 MeasureElementSizeInBytes(foldingContext, GetRank(shape_) > 0)}) {
184 return Fold(
185 foldingContext, std::move(*elements) * std::move(*elementBytes));
186 }
187 }
188 return std::nullopt;
189 }
190
AcquireAttrs(const semantics::Symbol & symbol)191 void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
192 if (const auto *object{
193 symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
194 corank_ = object->coshape().Rank();
195 if (object->IsAssumedRank()) {
196 attrs_.set(Attr::AssumedRank);
197 }
198 if (object->IsAssumedShape()) {
199 attrs_.set(Attr::AssumedShape);
200 }
201 if (object->IsAssumedSize()) {
202 attrs_.set(Attr::AssumedSize);
203 }
204 if (object->IsDeferredShape()) {
205 attrs_.set(Attr::DeferredShape);
206 }
207 if (object->IsCoarray()) {
208 attrs_.set(Attr::Coarray);
209 }
210 }
211 }
212
AcquireLEN()213 void TypeAndShape::AcquireLEN() {
214 if (auto len{type_.GetCharLength()}) {
215 LEN_ = std::move(len);
216 }
217 }
218
AcquireLEN(const semantics::Symbol & symbol)219 void TypeAndShape::AcquireLEN(const semantics::Symbol &symbol) {
220 if (type_.category() == TypeCategory::Character) {
221 if (auto len{DataRef{symbol}.LEN()}) {
222 LEN_ = std::move(*len);
223 }
224 }
225 }
226
AsFortran() const227 std::string TypeAndShape::AsFortran() const {
228 return type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
229 }
230
Dump(llvm::raw_ostream & o) const231 llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
232 o << type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
233 attrs_.Dump(o, EnumToString);
234 if (!shape_.empty()) {
235 o << " dimension";
236 char sep{'('};
237 for (const auto &expr : shape_) {
238 o << sep;
239 sep = ',';
240 if (expr) {
241 expr->AsFortran(o);
242 } else {
243 o << ':';
244 }
245 }
246 o << ')';
247 }
248 return o;
249 }
250
operator ==(const DummyDataObject & that) const251 bool DummyDataObject::operator==(const DummyDataObject &that) const {
252 return type == that.type && attrs == that.attrs && intent == that.intent &&
253 coshape == that.coshape;
254 }
255
GetIntent(const semantics::Attrs & attrs)256 static common::Intent GetIntent(const semantics::Attrs &attrs) {
257 if (attrs.test(semantics::Attr::INTENT_IN)) {
258 return common::Intent::In;
259 } else if (attrs.test(semantics::Attr::INTENT_OUT)) {
260 return common::Intent::Out;
261 } else if (attrs.test(semantics::Attr::INTENT_INOUT)) {
262 return common::Intent::InOut;
263 } else {
264 return common::Intent::Default;
265 }
266 }
267
Characterize(const semantics::Symbol & symbol,FoldingContext & context)268 std::optional<DummyDataObject> DummyDataObject::Characterize(
269 const semantics::Symbol &symbol, FoldingContext &context) {
270 if (symbol.has<semantics::ObjectEntityDetails>() ||
271 symbol.has<semantics::EntityDetails>()) {
272 if (auto type{TypeAndShape::Characterize(symbol, context)}) {
273 std::optional<DummyDataObject> result{std::move(*type)};
274 using semantics::Attr;
275 CopyAttrs<DummyDataObject, DummyDataObject::Attr>(symbol, *result,
276 {
277 {Attr::OPTIONAL, DummyDataObject::Attr::Optional},
278 {Attr::ALLOCATABLE, DummyDataObject::Attr::Allocatable},
279 {Attr::ASYNCHRONOUS, DummyDataObject::Attr::Asynchronous},
280 {Attr::CONTIGUOUS, DummyDataObject::Attr::Contiguous},
281 {Attr::VALUE, DummyDataObject::Attr::Value},
282 {Attr::VOLATILE, DummyDataObject::Attr::Volatile},
283 {Attr::POINTER, DummyDataObject::Attr::Pointer},
284 {Attr::TARGET, DummyDataObject::Attr::Target},
285 });
286 result->intent = GetIntent(symbol.attrs());
287 return result;
288 }
289 }
290 return std::nullopt;
291 }
292
CanBePassedViaImplicitInterface() const293 bool DummyDataObject::CanBePassedViaImplicitInterface() const {
294 if ((attrs &
295 Attrs{Attr::Allocatable, Attr::Asynchronous, Attr::Optional,
296 Attr::Pointer, Attr::Target, Attr::Value, Attr::Volatile})
297 .any()) {
298 return false; // 15.4.2.2(3)(a)
299 } else if ((type.attrs() &
300 TypeAndShape::Attrs{TypeAndShape::Attr::AssumedShape,
301 TypeAndShape::Attr::AssumedRank,
302 TypeAndShape::Attr::Coarray})
303 .any()) {
304 return false; // 15.4.2.2(3)(b-d)
305 } else if (type.type().IsPolymorphic()) {
306 return false; // 15.4.2.2(3)(f)
307 } else if (const auto *derived{GetDerivedTypeSpec(type.type())}) {
308 return derived->parameters().empty(); // 15.4.2.2(3)(e)
309 } else {
310 return true;
311 }
312 }
313
Dump(llvm::raw_ostream & o) const314 llvm::raw_ostream &DummyDataObject::Dump(llvm::raw_ostream &o) const {
315 attrs.Dump(o, EnumToString);
316 if (intent != common::Intent::Default) {
317 o << "INTENT(" << common::EnumToString(intent) << ')';
318 }
319 type.Dump(o);
320 if (!coshape.empty()) {
321 char sep{'['};
322 for (const auto &expr : coshape) {
323 expr.AsFortran(o << sep);
324 sep = ',';
325 }
326 }
327 return o;
328 }
329
DummyProcedure(Procedure && p)330 DummyProcedure::DummyProcedure(Procedure &&p)
331 : procedure{new Procedure{std::move(p)}} {}
332
operator ==(const DummyProcedure & that) const333 bool DummyProcedure::operator==(const DummyProcedure &that) const {
334 return attrs == that.attrs && intent == that.intent &&
335 procedure.value() == that.procedure.value();
336 }
337
GetSeenProcs(const semantics::UnorderedSymbolSet & seenProcs)338 static std::string GetSeenProcs(
339 const semantics::UnorderedSymbolSet &seenProcs) {
340 // Sort the symbols so that they appear in the same order on all platforms
341 auto ordered{semantics::OrderBySourcePosition(seenProcs)};
342 std::string result;
343 llvm::interleave(
344 ordered,
345 [&](const SymbolRef p) { result += '\'' + p->name().ToString() + '\''; },
346 [&]() { result += ", "; });
347 return result;
348 }
349
350 // These functions with arguments of type UnorderedSymbolSet are used with
351 // mutually recursive calls when characterizing a Procedure, a DummyArgument,
352 // or a DummyProcedure to detect circularly defined procedures as required by
353 // 15.4.3.6, paragraph 2.
354 static std::optional<DummyArgument> CharacterizeDummyArgument(
355 const semantics::Symbol &symbol, FoldingContext &context,
356 semantics::UnorderedSymbolSet &seenProcs);
357
CharacterizeProcedure(const semantics::Symbol & original,FoldingContext & context,semantics::UnorderedSymbolSet & seenProcs)358 static std::optional<Procedure> CharacterizeProcedure(
359 const semantics::Symbol &original, FoldingContext &context,
360 semantics::UnorderedSymbolSet &seenProcs) {
361 Procedure result;
362 const auto &symbol{ResolveAssociations(original)};
363 if (seenProcs.find(symbol) != seenProcs.end()) {
364 std::string procsList{GetSeenProcs(seenProcs)};
365 context.messages().Say(symbol.name(),
366 "Procedure '%s' is recursively defined. Procedures in the cycle:"
367 " %s"_err_en_US,
368 symbol.name(), procsList);
369 return std::nullopt;
370 }
371 seenProcs.insert(symbol);
372 CopyAttrs<Procedure, Procedure::Attr>(symbol, result,
373 {
374 {semantics::Attr::PURE, Procedure::Attr::Pure},
375 {semantics::Attr::ELEMENTAL, Procedure::Attr::Elemental},
376 {semantics::Attr::BIND_C, Procedure::Attr::BindC},
377 });
378 if (result.attrs.test(Procedure::Attr::Elemental) &&
379 !symbol.attrs().test(semantics::Attr::IMPURE)) {
380 result.attrs.set(Procedure::Attr::Pure); // explicitly flag pure procedures
381 }
382 return std::visit(
383 common::visitors{
384 [&](const semantics::SubprogramDetails &subp)
385 -> std::optional<Procedure> {
386 if (subp.isFunction()) {
387 if (auto fr{
388 FunctionResult::Characterize(subp.result(), context)}) {
389 result.functionResult = std::move(fr);
390 } else {
391 return std::nullopt;
392 }
393 } else {
394 result.attrs.set(Procedure::Attr::Subroutine);
395 }
396 for (const semantics::Symbol *arg : subp.dummyArgs()) {
397 if (!arg) {
398 if (subp.isFunction()) {
399 return std::nullopt;
400 } else {
401 result.dummyArguments.emplace_back(AlternateReturn{});
402 }
403 } else if (auto argCharacteristics{CharacterizeDummyArgument(
404 *arg, context, seenProcs)}) {
405 result.dummyArguments.emplace_back(
406 std::move(argCharacteristics.value()));
407 } else {
408 return std::nullopt;
409 }
410 }
411 return result;
412 },
413 [&](const semantics::ProcEntityDetails &proc)
414 -> std::optional<Procedure> {
415 if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
416 // Fails when the intrinsic is not a specific intrinsic function
417 // from F'2018 table 16.2. In order to handle forward references,
418 // attempts to use impermissible intrinsic procedures as the
419 // interfaces of procedure pointers are caught and flagged in
420 // declaration checking in Semantics.
421 return context.intrinsics().IsSpecificIntrinsicFunction(
422 symbol.name().ToString());
423 }
424 const semantics::ProcInterface &interface{proc.interface()};
425 if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
426 return CharacterizeProcedure(
427 *interfaceSymbol, context, seenProcs);
428 } else {
429 result.attrs.set(Procedure::Attr::ImplicitInterface);
430 const semantics::DeclTypeSpec *type{interface.type()};
431 if (symbol.test(semantics::Symbol::Flag::Subroutine)) {
432 // ignore any implicit typing
433 result.attrs.set(Procedure::Attr::Subroutine);
434 } else if (type) {
435 if (auto resultType{DynamicType::From(*type)}) {
436 result.functionResult = FunctionResult{*resultType};
437 } else {
438 return std::nullopt;
439 }
440 } else if (symbol.test(semantics::Symbol::Flag::Function)) {
441 return std::nullopt;
442 }
443 // The PASS name, if any, is not a characteristic.
444 return result;
445 }
446 },
447 [&](const semantics::ProcBindingDetails &binding) {
448 if (auto result{CharacterizeProcedure(
449 binding.symbol(), context, seenProcs)}) {
450 if (!symbol.attrs().test(semantics::Attr::NOPASS)) {
451 auto passName{binding.passName()};
452 for (auto &dummy : result->dummyArguments) {
453 if (!passName || dummy.name.c_str() == *passName) {
454 dummy.pass = true;
455 return result;
456 }
457 }
458 DIE("PASS argument missing");
459 }
460 return result;
461 } else {
462 return std::optional<Procedure>{};
463 }
464 },
465 [&](const semantics::UseDetails &use) {
466 return CharacterizeProcedure(use.symbol(), context, seenProcs);
467 },
468 [&](const semantics::HostAssocDetails &assoc) {
469 return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
470 },
471 [&](const semantics::EntityDetails &) {
472 context.messages().Say(
473 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
474 symbol.name());
475 return std::optional<Procedure>{};
476 },
477 [&](const semantics::SubprogramNameDetails &) {
478 context.messages().Say(
479 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,
480 symbol.name());
481 return std::optional<Procedure>{};
482 },
483 [&](const auto &) {
484 context.messages().Say(
485 "'%s' is not a procedure"_err_en_US, symbol.name());
486 return std::optional<Procedure>{};
487 },
488 },
489 symbol.details());
490 }
491
CharacterizeDummyProcedure(const semantics::Symbol & symbol,FoldingContext & context,semantics::UnorderedSymbolSet & seenProcs)492 static std::optional<DummyProcedure> CharacterizeDummyProcedure(
493 const semantics::Symbol &symbol, FoldingContext &context,
494 semantics::UnorderedSymbolSet &seenProcs) {
495 if (auto procedure{CharacterizeProcedure(symbol, context, seenProcs)}) {
496 // Dummy procedures may not be elemental. Elemental dummy procedure
497 // interfaces are errors when the interface is not intrinsic, and that
498 // error is caught elsewhere. Elemental intrinsic interfaces are
499 // made non-elemental.
500 procedure->attrs.reset(Procedure::Attr::Elemental);
501 DummyProcedure result{std::move(procedure.value())};
502 CopyAttrs<DummyProcedure, DummyProcedure::Attr>(symbol, result,
503 {
504 {semantics::Attr::OPTIONAL, DummyProcedure::Attr::Optional},
505 {semantics::Attr::POINTER, DummyProcedure::Attr::Pointer},
506 });
507 result.intent = GetIntent(symbol.attrs());
508 return result;
509 } else {
510 return std::nullopt;
511 }
512 }
513
Dump(llvm::raw_ostream & o) const514 llvm::raw_ostream &DummyProcedure::Dump(llvm::raw_ostream &o) const {
515 attrs.Dump(o, EnumToString);
516 if (intent != common::Intent::Default) {
517 o << "INTENT(" << common::EnumToString(intent) << ')';
518 }
519 procedure.value().Dump(o);
520 return o;
521 }
522
Dump(llvm::raw_ostream & o) const523 llvm::raw_ostream &AlternateReturn::Dump(llvm::raw_ostream &o) const {
524 return o << '*';
525 }
526
~DummyArgument()527 DummyArgument::~DummyArgument() {}
528
operator ==(const DummyArgument & that) const529 bool DummyArgument::operator==(const DummyArgument &that) const {
530 return u == that.u; // name and passed-object usage are not characteristics
531 }
532
CharacterizeDummyArgument(const semantics::Symbol & symbol,FoldingContext & context,semantics::UnorderedSymbolSet & seenProcs)533 static std::optional<DummyArgument> CharacterizeDummyArgument(
534 const semantics::Symbol &symbol, FoldingContext &context,
535 semantics::UnorderedSymbolSet &seenProcs) {
536 auto name{symbol.name().ToString()};
537 if (symbol.has<semantics::ObjectEntityDetails>() ||
538 symbol.has<semantics::EntityDetails>()) {
539 if (auto obj{DummyDataObject::Characterize(symbol, context)}) {
540 return DummyArgument{std::move(name), std::move(obj.value())};
541 }
542 } else if (auto proc{
543 CharacterizeDummyProcedure(symbol, context, seenProcs)}) {
544 return DummyArgument{std::move(name), std::move(proc.value())};
545 }
546 return std::nullopt;
547 }
548
FromActual(std::string && name,const Expr<SomeType> & expr,FoldingContext & context)549 std::optional<DummyArgument> DummyArgument::FromActual(
550 std::string &&name, const Expr<SomeType> &expr, FoldingContext &context) {
551 return std::visit(
552 common::visitors{
553 [&](const BOZLiteralConstant &) {
554 return std::make_optional<DummyArgument>(std::move(name),
555 DummyDataObject{
556 TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
557 },
558 [&](const NullPointer &) {
559 return std::make_optional<DummyArgument>(std::move(name),
560 DummyDataObject{
561 TypeAndShape{DynamicType::TypelessIntrinsicArgument()}});
562 },
563 [&](const ProcedureDesignator &designator) {
564 if (auto proc{Procedure::Characterize(designator, context)}) {
565 return std::make_optional<DummyArgument>(
566 std::move(name), DummyProcedure{std::move(*proc)});
567 } else {
568 return std::optional<DummyArgument>{};
569 }
570 },
571 [&](const ProcedureRef &call) {
572 if (auto proc{Procedure::Characterize(call, context)}) {
573 return std::make_optional<DummyArgument>(
574 std::move(name), DummyProcedure{std::move(*proc)});
575 } else {
576 return std::optional<DummyArgument>{};
577 }
578 },
579 [&](const auto &) {
580 if (auto type{TypeAndShape::Characterize(expr, context)}) {
581 return std::make_optional<DummyArgument>(
582 std::move(name), DummyDataObject{std::move(*type)});
583 } else {
584 return std::optional<DummyArgument>{};
585 }
586 },
587 },
588 expr.u);
589 }
590
IsOptional() const591 bool DummyArgument::IsOptional() const {
592 return std::visit(
593 common::visitors{
594 [](const DummyDataObject &data) {
595 return data.attrs.test(DummyDataObject::Attr::Optional);
596 },
597 [](const DummyProcedure &proc) {
598 return proc.attrs.test(DummyProcedure::Attr::Optional);
599 },
600 [](const AlternateReturn &) { return false; },
601 },
602 u);
603 }
604
SetOptional(bool value)605 void DummyArgument::SetOptional(bool value) {
606 std::visit(common::visitors{
607 [value](DummyDataObject &data) {
608 data.attrs.set(DummyDataObject::Attr::Optional, value);
609 },
610 [value](DummyProcedure &proc) {
611 proc.attrs.set(DummyProcedure::Attr::Optional, value);
612 },
613 [](AlternateReturn &) { DIE("cannot set optional"); },
614 },
615 u);
616 }
617
SetIntent(common::Intent intent)618 void DummyArgument::SetIntent(common::Intent intent) {
619 std::visit(common::visitors{
620 [intent](DummyDataObject &data) { data.intent = intent; },
621 [intent](DummyProcedure &proc) { proc.intent = intent; },
622 [](AlternateReturn &) { DIE("cannot set intent"); },
623 },
624 u);
625 }
626
GetIntent() const627 common::Intent DummyArgument::GetIntent() const {
628 return std::visit(common::visitors{
629 [](const DummyDataObject &data) { return data.intent; },
630 [](const DummyProcedure &proc) { return proc.intent; },
631 [](const AlternateReturn &) -> common::Intent {
632 DIE("Alternate returns have no intent");
633 },
634 },
635 u);
636 }
637
CanBePassedViaImplicitInterface() const638 bool DummyArgument::CanBePassedViaImplicitInterface() const {
639 if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
640 return object->CanBePassedViaImplicitInterface();
641 } else {
642 return true;
643 }
644 }
645
IsTypelessIntrinsicDummy() const646 bool DummyArgument::IsTypelessIntrinsicDummy() const {
647 const auto *argObj{std::get_if<characteristics::DummyDataObject>(&u)};
648 return argObj && argObj->type.type().IsTypelessIntrinsicArgument();
649 }
650
Dump(llvm::raw_ostream & o) const651 llvm::raw_ostream &DummyArgument::Dump(llvm::raw_ostream &o) const {
652 if (!name.empty()) {
653 o << name << '=';
654 }
655 if (pass) {
656 o << " PASS";
657 }
658 std::visit([&](const auto &x) { x.Dump(o); }, u);
659 return o;
660 }
661
FunctionResult(DynamicType t)662 FunctionResult::FunctionResult(DynamicType t) : u{TypeAndShape{t}} {}
FunctionResult(TypeAndShape && t)663 FunctionResult::FunctionResult(TypeAndShape &&t) : u{std::move(t)} {}
FunctionResult(Procedure && p)664 FunctionResult::FunctionResult(Procedure &&p) : u{std::move(p)} {}
~FunctionResult()665 FunctionResult::~FunctionResult() {}
666
operator ==(const FunctionResult & that) const667 bool FunctionResult::operator==(const FunctionResult &that) const {
668 return attrs == that.attrs && u == that.u;
669 }
670
Characterize(const Symbol & symbol,FoldingContext & context)671 std::optional<FunctionResult> FunctionResult::Characterize(
672 const Symbol &symbol, FoldingContext &context) {
673 if (symbol.has<semantics::ObjectEntityDetails>()) {
674 if (auto type{TypeAndShape::Characterize(symbol, context)}) {
675 FunctionResult result{std::move(*type)};
676 CopyAttrs<FunctionResult, FunctionResult::Attr>(symbol, result,
677 {
678 {semantics::Attr::ALLOCATABLE, FunctionResult::Attr::Allocatable},
679 {semantics::Attr::CONTIGUOUS, FunctionResult::Attr::Contiguous},
680 {semantics::Attr::POINTER, FunctionResult::Attr::Pointer},
681 });
682 return result;
683 }
684 } else if (auto maybeProc{Procedure::Characterize(symbol, context)}) {
685 FunctionResult result{std::move(*maybeProc)};
686 result.attrs.set(FunctionResult::Attr::Pointer);
687 return result;
688 }
689 return std::nullopt;
690 }
691
IsAssumedLengthCharacter() const692 bool FunctionResult::IsAssumedLengthCharacter() const {
693 if (const auto *ts{std::get_if<TypeAndShape>(&u)}) {
694 return ts->type().IsAssumedLengthCharacter();
695 } else {
696 return false;
697 }
698 }
699
CanBeReturnedViaImplicitInterface() const700 bool FunctionResult::CanBeReturnedViaImplicitInterface() const {
701 if (attrs.test(Attr::Pointer) || attrs.test(Attr::Allocatable)) {
702 return false; // 15.4.2.2(4)(b)
703 } else if (const auto *typeAndShape{GetTypeAndShape()}) {
704 if (typeAndShape->Rank() > 0) {
705 return false; // 15.4.2.2(4)(a)
706 } else {
707 const DynamicType &type{typeAndShape->type()};
708 switch (type.category()) {
709 case TypeCategory::Character:
710 if (type.knownLength()) {
711 return true;
712 } else if (const auto *param{type.charLengthParamValue()}) {
713 if (const auto &expr{param->GetExplicit()}) {
714 return IsConstantExpr(*expr); // 15.4.2.2(4)(c)
715 } else if (param->isAssumed()) {
716 return true;
717 }
718 }
719 return false;
720 case TypeCategory::Derived:
721 if (!type.IsPolymorphic()) {
722 const auto &spec{type.GetDerivedTypeSpec()};
723 for (const auto &pair : spec.parameters()) {
724 if (const auto &expr{pair.second.GetExplicit()}) {
725 if (!IsConstantExpr(*expr)) {
726 return false; // 15.4.2.2(4)(c)
727 }
728 }
729 }
730 return true;
731 }
732 return false;
733 default:
734 return true;
735 }
736 }
737 } else {
738 return false; // 15.4.2.2(4)(b) - procedure pointer
739 }
740 }
741
Dump(llvm::raw_ostream & o) const742 llvm::raw_ostream &FunctionResult::Dump(llvm::raw_ostream &o) const {
743 attrs.Dump(o, EnumToString);
744 std::visit(common::visitors{
745 [&](const TypeAndShape &ts) { ts.Dump(o); },
746 [&](const CopyableIndirection<Procedure> &p) {
747 p.value().Dump(o << " procedure(") << ')';
748 },
749 },
750 u);
751 return o;
752 }
753
Procedure(FunctionResult && fr,DummyArguments && args,Attrs a)754 Procedure::Procedure(FunctionResult &&fr, DummyArguments &&args, Attrs a)
755 : functionResult{std::move(fr)}, dummyArguments{std::move(args)}, attrs{a} {
756 }
Procedure(DummyArguments && args,Attrs a)757 Procedure::Procedure(DummyArguments &&args, Attrs a)
758 : dummyArguments{std::move(args)}, attrs{a} {}
~Procedure()759 Procedure::~Procedure() {}
760
operator ==(const Procedure & that) const761 bool Procedure::operator==(const Procedure &that) const {
762 return attrs == that.attrs && functionResult == that.functionResult &&
763 dummyArguments == that.dummyArguments;
764 }
765
FindPassIndex(std::optional<parser::CharBlock> name) const766 int Procedure::FindPassIndex(std::optional<parser::CharBlock> name) const {
767 int argCount{static_cast<int>(dummyArguments.size())};
768 int index{0};
769 if (name) {
770 while (index < argCount && *name != dummyArguments[index].name.c_str()) {
771 ++index;
772 }
773 }
774 CHECK(index < argCount);
775 return index;
776 }
777
CanOverride(const Procedure & that,std::optional<int> passIndex) const778 bool Procedure::CanOverride(
779 const Procedure &that, std::optional<int> passIndex) const {
780 // A pure procedure may override an impure one (7.5.7.3(2))
781 if ((that.attrs.test(Attr::Pure) && !attrs.test(Attr::Pure)) ||
782 that.attrs.test(Attr::Elemental) != attrs.test(Attr::Elemental) ||
783 functionResult != that.functionResult) {
784 return false;
785 }
786 int argCount{static_cast<int>(dummyArguments.size())};
787 if (argCount != static_cast<int>(that.dummyArguments.size())) {
788 return false;
789 }
790 for (int j{0}; j < argCount; ++j) {
791 if ((!passIndex || j != *passIndex) &&
792 dummyArguments[j] != that.dummyArguments[j]) {
793 return false;
794 }
795 }
796 return true;
797 }
798
Characterize(const semantics::Symbol & original,FoldingContext & context)799 std::optional<Procedure> Procedure::Characterize(
800 const semantics::Symbol &original, FoldingContext &context) {
801 semantics::UnorderedSymbolSet seenProcs;
802 return CharacterizeProcedure(original, context, seenProcs);
803 }
804
Characterize(const ProcedureDesignator & proc,FoldingContext & context)805 std::optional<Procedure> Procedure::Characterize(
806 const ProcedureDesignator &proc, FoldingContext &context) {
807 if (const auto *symbol{proc.GetSymbol()}) {
808 if (auto result{characteristics::Procedure::Characterize(
809 ResolveAssociations(*symbol), context)}) {
810 return result;
811 }
812 } else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
813 return intrinsic->characteristics.value();
814 }
815 return std::nullopt;
816 }
817
Characterize(const ProcedureRef & ref,FoldingContext & context)818 std::optional<Procedure> Procedure::Characterize(
819 const ProcedureRef &ref, FoldingContext &context) {
820 if (auto callee{Characterize(ref.proc(), context)}) {
821 if (callee->functionResult) {
822 if (const Procedure *
823 proc{callee->functionResult->IsProcedurePointer()}) {
824 return {*proc};
825 }
826 }
827 }
828 return std::nullopt;
829 }
830
CanBeCalledViaImplicitInterface() const831 bool Procedure::CanBeCalledViaImplicitInterface() const {
832 if (attrs.test(Attr::Elemental) || attrs.test(Attr::BindC)) {
833 return false; // 15.4.2.2(5,6)
834 } else if (IsFunction() &&
835 !functionResult->CanBeReturnedViaImplicitInterface()) {
836 return false;
837 } else {
838 for (const DummyArgument &arg : dummyArguments) {
839 if (!arg.CanBePassedViaImplicitInterface()) {
840 return false;
841 }
842 }
843 return true;
844 }
845 }
846
Dump(llvm::raw_ostream & o) const847 llvm::raw_ostream &Procedure::Dump(llvm::raw_ostream &o) const {
848 attrs.Dump(o, EnumToString);
849 if (functionResult) {
850 functionResult->Dump(o << "TYPE(") << ") FUNCTION";
851 } else {
852 o << "SUBROUTINE";
853 }
854 char sep{'('};
855 for (const auto &dummy : dummyArguments) {
856 dummy.Dump(o << sep);
857 sep = ',';
858 }
859 return o << (sep == '(' ? "()" : ")");
860 }
861
862 // Utility class to determine if Procedures, etc. are distinguishable
863 class DistinguishUtils {
864 public:
865 // Are these procedures distinguishable for a generic name?
866 static bool Distinguishable(const Procedure &, const Procedure &);
867 // Are these procedures distinguishable for a generic operator or assignment?
868 static bool DistinguishableOpOrAssign(const Procedure &, const Procedure &);
869
870 private:
871 struct CountDummyProcedures {
CountDummyProceduresFortran::evaluate::characteristics::DistinguishUtils::CountDummyProcedures872 CountDummyProcedures(const DummyArguments &args) {
873 for (const DummyArgument &arg : args) {
874 if (std::holds_alternative<DummyProcedure>(arg.u)) {
875 total += 1;
876 notOptional += !arg.IsOptional();
877 }
878 }
879 }
880 int total{0};
881 int notOptional{0};
882 };
883
884 static bool Rule3Distinguishable(const Procedure &, const Procedure &);
885 static const DummyArgument *Rule1DistinguishingArg(
886 const DummyArguments &, const DummyArguments &);
887 static int FindFirstToDistinguishByPosition(
888 const DummyArguments &, const DummyArguments &);
889 static int FindLastToDistinguishByName(
890 const DummyArguments &, const DummyArguments &);
891 static int CountCompatibleWith(const DummyArgument &, const DummyArguments &);
892 static int CountNotDistinguishableFrom(
893 const DummyArgument &, const DummyArguments &);
894 static bool Distinguishable(const DummyArgument &, const DummyArgument &);
895 static bool Distinguishable(const DummyDataObject &, const DummyDataObject &);
896 static bool Distinguishable(const DummyProcedure &, const DummyProcedure &);
897 static bool Distinguishable(const FunctionResult &, const FunctionResult &);
898 static bool Distinguishable(const TypeAndShape &, const TypeAndShape &);
899 static bool IsTkrCompatible(const DummyArgument &, const DummyArgument &);
900 static bool IsTkrCompatible(const TypeAndShape &, const TypeAndShape &);
901 static const DummyArgument *GetAtEffectivePosition(
902 const DummyArguments &, int);
903 static const DummyArgument *GetPassArg(const Procedure &);
904 };
905
906 // Simpler distinguishability rules for operators and assignment
DistinguishableOpOrAssign(const Procedure & proc1,const Procedure & proc2)907 bool DistinguishUtils::DistinguishableOpOrAssign(
908 const Procedure &proc1, const Procedure &proc2) {
909 auto &args1{proc1.dummyArguments};
910 auto &args2{proc2.dummyArguments};
911 if (args1.size() != args2.size()) {
912 return true; // C1511: distinguishable based on number of arguments
913 }
914 for (std::size_t i{0}; i < args1.size(); ++i) {
915 if (Distinguishable(args1[i], args2[i])) {
916 return true; // C1511, C1512: distinguishable based on this arg
917 }
918 }
919 return false;
920 }
921
Distinguishable(const Procedure & proc1,const Procedure & proc2)922 bool DistinguishUtils::Distinguishable(
923 const Procedure &proc1, const Procedure &proc2) {
924 auto &args1{proc1.dummyArguments};
925 auto &args2{proc2.dummyArguments};
926 auto count1{CountDummyProcedures(args1)};
927 auto count2{CountDummyProcedures(args2)};
928 if (count1.notOptional > count2.total || count2.notOptional > count1.total) {
929 return true; // distinguishable based on C1514 rule 2
930 }
931 if (Rule3Distinguishable(proc1, proc2)) {
932 return true; // distinguishable based on C1514 rule 3
933 }
934 if (Rule1DistinguishingArg(args1, args2)) {
935 return true; // distinguishable based on C1514 rule 1
936 }
937 int pos1{FindFirstToDistinguishByPosition(args1, args2)};
938 int name1{FindLastToDistinguishByName(args1, args2)};
939 if (pos1 >= 0 && pos1 <= name1) {
940 return true; // distinguishable based on C1514 rule 4
941 }
942 int pos2{FindFirstToDistinguishByPosition(args2, args1)};
943 int name2{FindLastToDistinguishByName(args2, args1)};
944 if (pos2 >= 0 && pos2 <= name2) {
945 return true; // distinguishable based on C1514 rule 4
946 }
947 return false;
948 }
949
950 // C1514 rule 3: Procedures are distinguishable if both have a passed-object
951 // dummy argument and those are distinguishable.
Rule3Distinguishable(const Procedure & proc1,const Procedure & proc2)952 bool DistinguishUtils::Rule3Distinguishable(
953 const Procedure &proc1, const Procedure &proc2) {
954 const DummyArgument *pass1{GetPassArg(proc1)};
955 const DummyArgument *pass2{GetPassArg(proc2)};
956 return pass1 && pass2 && Distinguishable(*pass1, *pass2);
957 }
958
959 // Find a non-passed-object dummy data object in one of the argument lists
960 // that satisfies C1514 rule 1. I.e. x such that:
961 // - m is the number of dummy data objects in one that are nonoptional,
962 // are not passed-object, that x is TKR compatible with
963 // - n is the number of non-passed-object dummy data objects, in the other
964 // that are not distinguishable from x
965 // - m is greater than n
Rule1DistinguishingArg(const DummyArguments & args1,const DummyArguments & args2)966 const DummyArgument *DistinguishUtils::Rule1DistinguishingArg(
967 const DummyArguments &args1, const DummyArguments &args2) {
968 auto size1{args1.size()};
969 auto size2{args2.size()};
970 for (std::size_t i{0}; i < size1 + size2; ++i) {
971 const DummyArgument &x{i < size1 ? args1[i] : args2[i - size1]};
972 if (!x.pass && std::holds_alternative<DummyDataObject>(x.u)) {
973 if (CountCompatibleWith(x, args1) >
974 CountNotDistinguishableFrom(x, args2) ||
975 CountCompatibleWith(x, args2) >
976 CountNotDistinguishableFrom(x, args1)) {
977 return &x;
978 }
979 }
980 }
981 return nullptr;
982 }
983
984 // Find the index of the first nonoptional non-passed-object dummy argument
985 // in args1 at an effective position such that either:
986 // - args2 has no dummy argument at that effective position
987 // - the dummy argument at that position is distinguishable from it
FindFirstToDistinguishByPosition(const DummyArguments & args1,const DummyArguments & args2)988 int DistinguishUtils::FindFirstToDistinguishByPosition(
989 const DummyArguments &args1, const DummyArguments &args2) {
990 int effective{0}; // position of arg1 in list, ignoring passed arg
991 for (std::size_t i{0}; i < args1.size(); ++i) {
992 const DummyArgument &arg1{args1.at(i)};
993 if (!arg1.pass && !arg1.IsOptional()) {
994 const DummyArgument *arg2{GetAtEffectivePosition(args2, effective)};
995 if (!arg2 || Distinguishable(arg1, *arg2)) {
996 return i;
997 }
998 }
999 effective += !arg1.pass;
1000 }
1001 return -1;
1002 }
1003
1004 // Find the index of the last nonoptional non-passed-object dummy argument
1005 // in args1 whose name is such that either:
1006 // - args2 has no dummy argument with that name
1007 // - the dummy argument with that name is distinguishable from it
FindLastToDistinguishByName(const DummyArguments & args1,const DummyArguments & args2)1008 int DistinguishUtils::FindLastToDistinguishByName(
1009 const DummyArguments &args1, const DummyArguments &args2) {
1010 std::map<std::string, const DummyArgument *> nameToArg;
1011 for (const auto &arg2 : args2) {
1012 nameToArg.emplace(arg2.name, &arg2);
1013 }
1014 for (int i = args1.size() - 1; i >= 0; --i) {
1015 const DummyArgument &arg1{args1.at(i)};
1016 if (!arg1.pass && !arg1.IsOptional()) {
1017 auto it{nameToArg.find(arg1.name)};
1018 if (it == nameToArg.end() || Distinguishable(arg1, *it->second)) {
1019 return i;
1020 }
1021 }
1022 }
1023 return -1;
1024 }
1025
1026 // Count the dummy data objects in args that are nonoptional, are not
1027 // passed-object, and that x is TKR compatible with
CountCompatibleWith(const DummyArgument & x,const DummyArguments & args)1028 int DistinguishUtils::CountCompatibleWith(
1029 const DummyArgument &x, const DummyArguments &args) {
1030 return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
1031 return !y.pass && !y.IsOptional() && IsTkrCompatible(x, y);
1032 });
1033 }
1034
1035 // Return the number of dummy data objects in args that are not
1036 // distinguishable from x and not passed-object.
CountNotDistinguishableFrom(const DummyArgument & x,const DummyArguments & args)1037 int DistinguishUtils::CountNotDistinguishableFrom(
1038 const DummyArgument &x, const DummyArguments &args) {
1039 return std::count_if(args.begin(), args.end(), [&](const DummyArgument &y) {
1040 return !y.pass && std::holds_alternative<DummyDataObject>(y.u) &&
1041 !Distinguishable(y, x);
1042 });
1043 }
1044
Distinguishable(const DummyArgument & x,const DummyArgument & y)1045 bool DistinguishUtils::Distinguishable(
1046 const DummyArgument &x, const DummyArgument &y) {
1047 if (x.u.index() != y.u.index()) {
1048 return true; // different kind: data/proc/alt-return
1049 }
1050 return std::visit(
1051 common::visitors{
1052 [&](const DummyDataObject &z) {
1053 return Distinguishable(z, std::get<DummyDataObject>(y.u));
1054 },
1055 [&](const DummyProcedure &z) {
1056 return Distinguishable(z, std::get<DummyProcedure>(y.u));
1057 },
1058 [&](const AlternateReturn &) { return false; },
1059 },
1060 x.u);
1061 }
1062
Distinguishable(const DummyDataObject & x,const DummyDataObject & y)1063 bool DistinguishUtils::Distinguishable(
1064 const DummyDataObject &x, const DummyDataObject &y) {
1065 using Attr = DummyDataObject::Attr;
1066 if (Distinguishable(x.type, y.type)) {
1067 return true;
1068 } else if (x.attrs.test(Attr::Allocatable) && y.attrs.test(Attr::Pointer) &&
1069 y.intent != common::Intent::In) {
1070 return true;
1071 } else if (y.attrs.test(Attr::Allocatable) && x.attrs.test(Attr::Pointer) &&
1072 x.intent != common::Intent::In) {
1073 return true;
1074 } else {
1075 return false;
1076 }
1077 }
1078
Distinguishable(const DummyProcedure & x,const DummyProcedure & y)1079 bool DistinguishUtils::Distinguishable(
1080 const DummyProcedure &x, const DummyProcedure &y) {
1081 const Procedure &xProc{x.procedure.value()};
1082 const Procedure &yProc{y.procedure.value()};
1083 if (Distinguishable(xProc, yProc)) {
1084 return true;
1085 } else {
1086 const std::optional<FunctionResult> &xResult{xProc.functionResult};
1087 const std::optional<FunctionResult> &yResult{yProc.functionResult};
1088 return xResult ? !yResult || Distinguishable(*xResult, *yResult)
1089 : yResult.has_value();
1090 }
1091 }
1092
Distinguishable(const FunctionResult & x,const FunctionResult & y)1093 bool DistinguishUtils::Distinguishable(
1094 const FunctionResult &x, const FunctionResult &y) {
1095 if (x.u.index() != y.u.index()) {
1096 return true; // one is data object, one is procedure
1097 }
1098 return std::visit(
1099 common::visitors{
1100 [&](const TypeAndShape &z) {
1101 return Distinguishable(z, std::get<TypeAndShape>(y.u));
1102 },
1103 [&](const CopyableIndirection<Procedure> &z) {
1104 return Distinguishable(z.value(),
1105 std::get<CopyableIndirection<Procedure>>(y.u).value());
1106 },
1107 },
1108 x.u);
1109 }
1110
Distinguishable(const TypeAndShape & x,const TypeAndShape & y)1111 bool DistinguishUtils::Distinguishable(
1112 const TypeAndShape &x, const TypeAndShape &y) {
1113 return !IsTkrCompatible(x, y) && !IsTkrCompatible(y, x);
1114 }
1115
1116 // Compatibility based on type, kind, and rank
IsTkrCompatible(const DummyArgument & x,const DummyArgument & y)1117 bool DistinguishUtils::IsTkrCompatible(
1118 const DummyArgument &x, const DummyArgument &y) {
1119 const auto *obj1{std::get_if<DummyDataObject>(&x.u)};
1120 const auto *obj2{std::get_if<DummyDataObject>(&y.u)};
1121 return obj1 && obj2 && IsTkrCompatible(obj1->type, obj2->type);
1122 }
IsTkrCompatible(const TypeAndShape & x,const TypeAndShape & y)1123 bool DistinguishUtils::IsTkrCompatible(
1124 const TypeAndShape &x, const TypeAndShape &y) {
1125 return x.type().IsTkCompatibleWith(y.type()) &&
1126 (x.attrs().test(TypeAndShape::Attr::AssumedRank) ||
1127 y.attrs().test(TypeAndShape::Attr::AssumedRank) ||
1128 x.Rank() == y.Rank());
1129 }
1130
1131 // Return the argument at the given index, ignoring the passed arg
GetAtEffectivePosition(const DummyArguments & args,int index)1132 const DummyArgument *DistinguishUtils::GetAtEffectivePosition(
1133 const DummyArguments &args, int index) {
1134 for (const DummyArgument &arg : args) {
1135 if (!arg.pass) {
1136 if (index == 0) {
1137 return &arg;
1138 }
1139 --index;
1140 }
1141 }
1142 return nullptr;
1143 }
1144
1145 // Return the passed-object dummy argument of this procedure, if any
GetPassArg(const Procedure & proc)1146 const DummyArgument *DistinguishUtils::GetPassArg(const Procedure &proc) {
1147 for (const auto &arg : proc.dummyArguments) {
1148 if (arg.pass) {
1149 return &arg;
1150 }
1151 }
1152 return nullptr;
1153 }
1154
Distinguishable(const Procedure & x,const Procedure & y)1155 bool Distinguishable(const Procedure &x, const Procedure &y) {
1156 return DistinguishUtils::Distinguishable(x, y);
1157 }
1158
DistinguishableOpOrAssign(const Procedure & x,const Procedure & y)1159 bool DistinguishableOpOrAssign(const Procedure &x, const Procedure &y) {
1160 return DistinguishUtils::DistinguishableOpOrAssign(x, y);
1161 }
1162
1163 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyArgument)
1164 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
1165 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(FunctionResult)
1166 DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Procedure)
1167 } // namespace Fortran::evaluate::characteristics
1168
1169 template class Fortran::common::Indirection<
1170 Fortran::evaluate::characteristics::Procedure, true>;
1171