xref: /llvm-project/flang/lib/Evaluate/type.cpp (revision d84faa428ef05436ea8b5fdbbab9e9b9c0a12985)
1 //===-- lib/Evaluate/type.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/type.h"
10 #include "flang/Common/idioms.h"
11 #include "flang/Evaluate/expression.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/target.h"
14 #include "flang/Parser/characters.h"
15 #include "flang/Semantics/scope.h"
16 #include "flang/Semantics/symbol.h"
17 #include "flang/Semantics/tools.h"
18 #include "flang/Semantics/type.h"
19 #include <algorithm>
20 #include <optional>
21 #include <string>
22 
23 // IsDescriptor() predicate: true when a symbol is implemented
24 // at runtime with a descriptor.
25 namespace Fortran::semantics {
26 
27 static bool IsDescriptor(const DeclTypeSpec *type) {
28   if (type) {
29     if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
30       return dynamicType->RequiresDescriptor();
31     }
32   }
33   return false;
34 }
35 
36 static bool IsDescriptor(const ObjectEntityDetails &details) {
37   if (IsDescriptor(details.type())) {
38     return true;
39   }
40   for (const ShapeSpec &shapeSpec : details.shape()) {
41     const auto &lb{shapeSpec.lbound().GetExplicit()};
42     const auto &ub{shapeSpec.ubound().GetExplicit()};
43     if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) {
44       return true;
45     }
46   }
47   return false;
48 }
49 
50 static bool IsDescriptor(const ProcEntityDetails &details) {
51   // A procedure pointer or dummy procedure must be & is a descriptor if
52   // and only if it requires a static link.
53   // TODO: refine this placeholder
54   return details.HasExplicitInterface();
55 }
56 
57 bool IsDescriptor(const Symbol &symbol) {
58   return common::visit(
59       common::visitors{
60           [&](const ObjectEntityDetails &d) {
61             return IsAllocatableOrPointer(symbol) || IsDescriptor(d);
62           },
63           [&](const ProcEntityDetails &d) {
64             return (symbol.attrs().test(Attr::POINTER) ||
65                        symbol.attrs().test(Attr::EXTERNAL)) &&
66                 IsDescriptor(d);
67           },
68           [&](const EntityDetails &d) { return IsDescriptor(d.type()); },
69           [](const AssocEntityDetails &d) {
70             if (const auto &expr{d.expr()}) {
71               if (expr->Rank() > 0) {
72                 return true;
73               }
74               if (const auto dynamicType{expr->GetType()}) {
75                 if (dynamicType->RequiresDescriptor()) {
76                   return true;
77                 }
78               }
79             }
80             return false;
81           },
82           [](const SubprogramDetails &d) {
83             return d.isFunction() && IsDescriptor(d.result());
84           },
85           [](const UseDetails &d) { return IsDescriptor(d.symbol()); },
86           [](const HostAssocDetails &d) { return IsDescriptor(d.symbol()); },
87           [](const auto &) { return false; },
88       },
89       symbol.details());
90 }
91 } // namespace Fortran::semantics
92 
93 namespace Fortran::evaluate {
94 
95 DynamicType::DynamicType(int k, const semantics::ParamValue &pv)
96     : category_{TypeCategory::Character}, kind_{k} {
97   CHECK(IsValidKindOfIntrinsicType(category_, kind_));
98   if (auto n{ToInt64(pv.GetExplicit())}) {
99     knownLength_ = *n > 0 ? *n : 0;
100   } else {
101     charLengthParamValue_ = &pv;
102   }
103 }
104 
105 template <typename A> inline bool PointeeComparison(const A *x, const A *y) {
106   return x == y || (x && y && *x == *y);
107 }
108 
109 bool DynamicType::operator==(const DynamicType &that) const {
110   return category_ == that.category_ && kind_ == that.kind_ &&
111       PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
112       knownLength().has_value() == that.knownLength().has_value() &&
113       (!knownLength() || *knownLength() == *that.knownLength()) &&
114       PointeeComparison(derived_, that.derived_);
115 }
116 
117 std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
118   if (category_ == TypeCategory::Character) {
119     if (knownLength()) {
120       return AsExpr(Constant<SubscriptInteger>(*knownLength()));
121     } else if (charLengthParamValue_) {
122       if (auto length{charLengthParamValue_->GetExplicit()}) {
123         return ConvertToType<SubscriptInteger>(std::move(*length));
124       }
125     }
126   }
127   return std::nullopt;
128 }
129 
130 std::size_t DynamicType::GetAlignment(
131     const TargetCharacteristics &targetCharacteristics) const {
132   if (category_ == TypeCategory::Derived) {
133     if (derived_ && derived_->scope()) {
134       return derived_->scope()->alignment().value_or(1);
135     }
136   } else {
137     return targetCharacteristics.GetAlignment(category_, kind_);
138   }
139   return 1; // needs to be after switch to dodge a bogus gcc warning
140 }
141 
142 std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
143     FoldingContext &context, bool aligned,
144     std::optional<std::int64_t> charLength) const {
145   switch (category_) {
146   case TypeCategory::Integer:
147   case TypeCategory::Real:
148   case TypeCategory::Complex:
149   case TypeCategory::Logical:
150     return Expr<SubscriptInteger>{
151         context.targetCharacteristics().GetByteSize(category_, kind_)};
152   case TypeCategory::Character:
153     if (auto len{charLength ? Expr<SubscriptInteger>{Constant<SubscriptInteger>{
154                                   *charLength}}
155                             : GetCharLength()}) {
156       return Fold(context,
157           Expr<SubscriptInteger>{
158               context.targetCharacteristics().GetByteSize(category_, kind_)} *
159               std::move(*len));
160     }
161     break;
162   case TypeCategory::Derived:
163     if (!IsPolymorphic() && derived_ && derived_->scope()) {
164       auto size{derived_->scope()->size()};
165       auto align{aligned ? derived_->scope()->alignment().value_or(0) : 0};
166       auto alignedSize{align > 0 ? ((size + align - 1) / align) * align : size};
167       return Expr<SubscriptInteger>{
168           static_cast<ConstantSubscript>(alignedSize)};
169     }
170     break;
171   }
172   return std::nullopt;
173 }
174 
175 bool DynamicType::IsAssumedLengthCharacter() const {
176   return category_ == TypeCategory::Character && charLengthParamValue_ &&
177       charLengthParamValue_->isAssumed();
178 }
179 
180 bool DynamicType::IsNonConstantLengthCharacter() const {
181   if (category_ != TypeCategory::Character) {
182     return false;
183   } else if (knownLength()) {
184     return false;
185   } else if (!charLengthParamValue_) {
186     return true;
187   } else if (const auto &expr{charLengthParamValue_->GetExplicit()}) {
188     return !IsConstantExpr(*expr);
189   } else {
190     return true;
191   }
192 }
193 
194 bool DynamicType::IsTypelessIntrinsicArgument() const {
195   return category_ == TypeCategory::Integer && kind_ == TypelessKind;
196 }
197 
198 const semantics::DerivedTypeSpec *GetDerivedTypeSpec(
199     const std::optional<DynamicType> &type) {
200   return type ? GetDerivedTypeSpec(*type) : nullptr;
201 }
202 
203 const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &type) {
204   if (type.category() == TypeCategory::Derived &&
205       !type.IsUnlimitedPolymorphic()) {
206     return &type.GetDerivedTypeSpec();
207   } else {
208     return nullptr;
209   }
210 }
211 
212 static const semantics::Symbol *FindParentComponent(
213     const semantics::DerivedTypeSpec &derived) {
214   const semantics::Symbol &typeSymbol{derived.typeSymbol()};
215   const semantics::Scope *scope{derived.scope()};
216   if (!scope) {
217     scope = typeSymbol.scope();
218   }
219   if (scope) {
220     const auto &dtDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
221     // TODO: Combine with semantics::DerivedTypeDetails::GetParentComponent
222     if (auto extends{dtDetails.GetParentComponentName()}) {
223       if (auto iter{scope->find(*extends)}; iter != scope->cend()) {
224         if (const semantics::Symbol & symbol{*iter->second};
225             symbol.test(semantics::Symbol::Flag::ParentComp)) {
226           return &symbol;
227         }
228       }
229     }
230   }
231   return nullptr;
232 }
233 
234 const semantics::DerivedTypeSpec *GetParentTypeSpec(
235     const semantics::DerivedTypeSpec &derived) {
236   if (const semantics::Symbol * parent{FindParentComponent(derived)}) {
237     return &parent->get<semantics::ObjectEntityDetails>()
238                 .type()
239                 ->derivedTypeSpec();
240   } else {
241     return nullptr;
242   }
243 }
244 
245 // Compares two derived type representations to see whether they both
246 // represent the "same type" in the sense of section 7.5.2.4.
247 using SetOfDerivedTypePairs =
248     std::set<std::pair<const semantics::DerivedTypeSpec *,
249         const semantics::DerivedTypeSpec *>>;
250 
251 static bool AreSameComponent(const semantics::Symbol &x,
252     const semantics::Symbol &y,
253     SetOfDerivedTypePairs & /* inProgress - not yet used */) {
254   if (x.attrs() != y.attrs()) {
255     return false;
256   }
257   if (x.attrs().test(semantics::Attr::PRIVATE)) {
258     return false;
259   }
260   // TODO: compare types, parameters, bounds, &c.
261   return x.has<semantics::ObjectEntityDetails>() ==
262       y.has<semantics::ObjectEntityDetails>();
263 }
264 
265 static bool AreTypeParamCompatible(const semantics::DerivedTypeSpec &x,
266     const semantics::DerivedTypeSpec &y, bool ignoreLenParameters) {
267   const auto *xScope{x.typeSymbol().scope()};
268   const auto *yScope{y.typeSymbol().scope()};
269   for (const auto &[paramName, value] : x.parameters()) {
270     const auto *yValue{y.FindParameter(paramName)};
271     if (!yValue) {
272       return false;
273     }
274     const auto *xParm{xScope ? xScope->FindComponent(paramName) : nullptr};
275     const auto *yParm{yScope ? yScope->FindComponent(paramName) : nullptr};
276     if (xParm && yParm) {
277       const auto *xTPD{xParm->detailsIf<semantics::TypeParamDetails>()};
278       const auto *yTPD{yParm->detailsIf<semantics::TypeParamDetails>()};
279       if (xTPD && yTPD) {
280         if (xTPD->attr() != yTPD->attr()) {
281           return false;
282         }
283         if (!ignoreLenParameters ||
284             xTPD->attr() != common::TypeParamAttr::Len) {
285           auto xExpr{value.GetExplicit()};
286           auto yExpr{yValue->GetExplicit()};
287           if (xExpr && yExpr) {
288             auto xVal{ToInt64(*xExpr)};
289             auto yVal{ToInt64(*yExpr)};
290             if (xVal && yVal && *xVal != *yVal) {
291               return false;
292             }
293           }
294         }
295       }
296     }
297   }
298   for (const auto &[paramName, _] : y.parameters()) {
299     if (!x.FindParameter(paramName)) {
300       return false; // y has more parameters than x
301     }
302   }
303   return true;
304 }
305 
306 static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x,
307     const semantics::DerivedTypeSpec &y, bool ignoreTypeParameterValues,
308     bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress) {
309   if (&x == &y) {
310     return true;
311   }
312   if (!ignoreTypeParameterValues &&
313       !AreTypeParamCompatible(x, y, ignoreLenParameters)) {
314     return false;
315   }
316   const auto &xSymbol{x.typeSymbol()};
317   const auto &ySymbol{y.typeSymbol()};
318   if (xSymbol == ySymbol) {
319     return true;
320   }
321   if (xSymbol.name() != ySymbol.name()) {
322     return false;
323   }
324   auto thisQuery{std::make_pair(&x, &y)};
325   if (inProgress.find(thisQuery) != inProgress.end()) {
326     return true; // recursive use of types in components
327   }
328   inProgress.insert(thisQuery);
329   const auto &xDetails{xSymbol.get<semantics::DerivedTypeDetails>()};
330   const auto &yDetails{ySymbol.get<semantics::DerivedTypeDetails>()};
331   if (!(xDetails.sequence() && yDetails.sequence()) &&
332       !(xSymbol.attrs().test(semantics::Attr::BIND_C) &&
333           ySymbol.attrs().test(semantics::Attr::BIND_C))) {
334     // PGI does not enforce this requirement; all other Fortran
335     // processors do with a hard error when violations are caught.
336     return false;
337   }
338   // Compare the component lists in their orders of declaration.
339   auto xEnd{xDetails.componentNames().cend()};
340   auto yComponentName{yDetails.componentNames().cbegin()};
341   auto yEnd{yDetails.componentNames().cend()};
342   for (auto xComponentName{xDetails.componentNames().cbegin()};
343        xComponentName != xEnd; ++xComponentName, ++yComponentName) {
344     if (yComponentName == yEnd || *xComponentName != *yComponentName ||
345         !xSymbol.scope() || !ySymbol.scope()) {
346       return false;
347     }
348     const auto xLookup{xSymbol.scope()->find(*xComponentName)};
349     const auto yLookup{ySymbol.scope()->find(*yComponentName)};
350     if (xLookup == xSymbol.scope()->end() ||
351         yLookup == ySymbol.scope()->end() ||
352         !AreSameComponent(*xLookup->second, *yLookup->second, inProgress)) {
353       return false;
354     }
355   }
356   return yComponentName == yEnd;
357 }
358 
359 bool AreSameDerivedType(
360     const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) {
361   SetOfDerivedTypePairs inProgress;
362   return AreSameDerivedType(x, y, false, false, inProgress);
363 }
364 
365 static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x,
366     const semantics::DerivedTypeSpec *y, bool isPolymorphic,
367     bool ignoreTypeParameterValues, bool ignoreLenTypeParameters) {
368   if (!x || !y) {
369     return false;
370   } else {
371     SetOfDerivedTypePairs inProgress;
372     if (AreSameDerivedType(*x, *y, ignoreTypeParameterValues,
373             ignoreLenTypeParameters, inProgress)) {
374       return true;
375     } else {
376       return isPolymorphic &&
377           AreCompatibleDerivedTypes(x, GetParentTypeSpec(*y), true,
378               ignoreTypeParameterValues, ignoreLenTypeParameters);
379     }
380   }
381 }
382 
383 static bool AreCompatibleTypes(const DynamicType &x, const DynamicType &y,
384     bool ignoreTypeParameterValues, bool ignoreLengths) {
385   if (x.IsUnlimitedPolymorphic()) {
386     return true;
387   } else if (y.IsUnlimitedPolymorphic()) {
388     return false;
389   } else if (x.category() != y.category()) {
390     return false;
391   } else if (x.category() == TypeCategory::Character) {
392     const auto xLen{x.knownLength()};
393     const auto yLen{y.knownLength()};
394     return x.kind() == y.kind() &&
395         (ignoreLengths || !xLen || !yLen || *xLen == *yLen);
396   } else if (x.category() != TypeCategory::Derived) {
397     return x.kind() == y.kind();
398   } else {
399     const auto *xdt{GetDerivedTypeSpec(x)};
400     const auto *ydt{GetDerivedTypeSpec(y)};
401     return AreCompatibleDerivedTypes(
402         xdt, ydt, x.IsPolymorphic(), ignoreTypeParameterValues, false);
403   }
404 }
405 
406 // See 7.3.2.3 (5) & 15.5.2.4
407 bool DynamicType::IsTkCompatibleWith(const DynamicType &that) const {
408   return AreCompatibleTypes(*this, that, false, true);
409 }
410 
411 bool DynamicType::IsTkLenCompatibleWith(const DynamicType &that) const {
412   return AreCompatibleTypes(*this, that, false, false);
413 }
414 
415 // 16.9.165
416 std::optional<bool> DynamicType::SameTypeAs(const DynamicType &that) const {
417   bool x{AreCompatibleTypes(*this, that, true, true)};
418   bool y{AreCompatibleTypes(that, *this, true, true)};
419   if (!x && !y) {
420     return false;
421   } else if (x && y && !IsPolymorphic() && !that.IsPolymorphic()) {
422     return true;
423   } else {
424     return std::nullopt;
425   }
426 }
427 
428 // 16.9.76
429 std::optional<bool> DynamicType::ExtendsTypeOf(const DynamicType &that) const {
430   if (IsUnlimitedPolymorphic() || that.IsUnlimitedPolymorphic()) {
431     return std::nullopt; // unknown
432   }
433   const auto *thisDts{evaluate::GetDerivedTypeSpec(*this)};
434   const auto *thatDts{evaluate::GetDerivedTypeSpec(that)};
435   if (!thisDts || !thatDts) {
436     return std::nullopt;
437   } else if (!AreCompatibleDerivedTypes(thatDts, thisDts, true, true, true)) {
438     // Note that I check *thisDts, not its parent, so that EXTENDS_TYPE_OF()
439     // is .true. when they are the same type.  This is technically
440     // an implementation-defined case in the standard, but every other
441     // compiler works this way.
442     if (IsPolymorphic() &&
443         AreCompatibleDerivedTypes(thisDts, thatDts, true, true, true)) {
444       // 'that' is *this or an extension of *this, and so runtime *this
445       // could be an extension of 'that'
446       return std::nullopt;
447     } else {
448       return false;
449     }
450   } else if (that.IsPolymorphic()) {
451     return std::nullopt; // unknown
452   } else {
453     return true;
454   }
455 }
456 
457 std::optional<DynamicType> DynamicType::From(
458     const semantics::DeclTypeSpec &type) {
459   if (const auto *intrinsic{type.AsIntrinsic()}) {
460     if (auto kind{ToInt64(intrinsic->kind())}) {
461       TypeCategory category{intrinsic->category()};
462       if (IsValidKindOfIntrinsicType(category, *kind)) {
463         if (category == TypeCategory::Character) {
464           const auto &charType{type.characterTypeSpec()};
465           return DynamicType{static_cast<int>(*kind), charType.length()};
466         } else {
467           return DynamicType{category, static_cast<int>(*kind)};
468         }
469       }
470     }
471   } else if (const auto *derived{type.AsDerived()}) {
472     return DynamicType{
473         *derived, type.category() == semantics::DeclTypeSpec::ClassDerived};
474   } else if (type.category() == semantics::DeclTypeSpec::ClassStar) {
475     return DynamicType::UnlimitedPolymorphic();
476   } else if (type.category() == semantics::DeclTypeSpec::TypeStar) {
477     return DynamicType::AssumedType();
478   } else {
479     common::die("DynamicType::From(DeclTypeSpec): failed");
480   }
481   return std::nullopt;
482 }
483 
484 std::optional<DynamicType> DynamicType::From(const semantics::Symbol &symbol) {
485   return From(symbol.GetType()); // Symbol -> DeclTypeSpec -> DynamicType
486 }
487 
488 DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
489   switch (category_) {
490   case TypeCategory::Integer:
491     switch (that.category_) {
492     case TypeCategory::Integer:
493       return DynamicType{TypeCategory::Integer, std::max(kind_, that.kind_)};
494     case TypeCategory::Real:
495     case TypeCategory::Complex:
496       return that;
497     default:
498       CRASH_NO_CASE;
499     }
500     break;
501   case TypeCategory::Real:
502     switch (that.category_) {
503     case TypeCategory::Integer:
504       return *this;
505     case TypeCategory::Real:
506       return DynamicType{TypeCategory::Real, std::max(kind_, that.kind_)};
507     case TypeCategory::Complex:
508       return DynamicType{TypeCategory::Complex, std::max(kind_, that.kind_)};
509     default:
510       CRASH_NO_CASE;
511     }
512     break;
513   case TypeCategory::Complex:
514     switch (that.category_) {
515     case TypeCategory::Integer:
516       return *this;
517     case TypeCategory::Real:
518     case TypeCategory::Complex:
519       return DynamicType{TypeCategory::Complex, std::max(kind_, that.kind_)};
520     default:
521       CRASH_NO_CASE;
522     }
523     break;
524   case TypeCategory::Logical:
525     switch (that.category_) {
526     case TypeCategory::Logical:
527       return DynamicType{TypeCategory::Logical, std::max(kind_, that.kind_)};
528     default:
529       CRASH_NO_CASE;
530     }
531     break;
532   default:
533     CRASH_NO_CASE;
534   }
535   return *this;
536 }
537 
538 bool DynamicType::RequiresDescriptor() const {
539   return IsPolymorphic() || IsNonConstantLengthCharacter() ||
540       (derived_ && CountNonConstantLenParameters(*derived_) > 0);
541 }
542 
543 bool DynamicType::HasDeferredTypeParameter() const {
544   if (derived_) {
545     for (const auto &pair : derived_->parameters()) {
546       if (pair.second.isDeferred()) {
547         return true;
548       }
549     }
550   }
551   return charLengthParamValue_ && charLengthParamValue_->isDeferred();
552 }
553 
554 bool SomeKind<TypeCategory::Derived>::operator==(
555     const SomeKind<TypeCategory::Derived> &that) const {
556   return PointeeComparison(derivedTypeSpec_, that.derivedTypeSpec_);
557 }
558 
559 int SelectedCharKind(const std::string &s, int defaultKind) { // 16.9.168
560   auto lower{parser::ToLowerCaseLetters(s)};
561   auto n{lower.size()};
562   while (n > 0 && lower[0] == ' ') {
563     lower.erase(0, 1);
564     --n;
565   }
566   while (n > 0 && lower[n - 1] == ' ') {
567     lower.erase(--n, 1);
568   }
569   if (lower == "ascii") {
570     return 1;
571   } else if (lower == "ucs-2") {
572     return 2;
573   } else if (lower == "iso_10646" || lower == "ucs-4") {
574     return 4;
575   } else if (lower == "default") {
576     return defaultKind;
577   } else {
578     return -1;
579   }
580 }
581 
582 std::optional<DynamicType> ComparisonType(
583     const DynamicType &t1, const DynamicType &t2) {
584   switch (t1.category()) {
585   case TypeCategory::Integer:
586     switch (t2.category()) {
587     case TypeCategory::Integer:
588       return DynamicType{TypeCategory::Integer, std::max(t1.kind(), t2.kind())};
589     case TypeCategory::Real:
590     case TypeCategory::Complex:
591       return t2;
592     default:
593       return std::nullopt;
594     }
595   case TypeCategory::Real:
596     switch (t2.category()) {
597     case TypeCategory::Integer:
598       return t1;
599     case TypeCategory::Real:
600     case TypeCategory::Complex:
601       return DynamicType{t2.category(), std::max(t1.kind(), t2.kind())};
602     default:
603       return std::nullopt;
604     }
605   case TypeCategory::Complex:
606     switch (t2.category()) {
607     case TypeCategory::Integer:
608       return t1;
609     case TypeCategory::Real:
610     case TypeCategory::Complex:
611       return DynamicType{TypeCategory::Complex, std::max(t1.kind(), t2.kind())};
612     default:
613       return std::nullopt;
614     }
615   case TypeCategory::Character:
616     switch (t2.category()) {
617     case TypeCategory::Character:
618       return DynamicType{
619           TypeCategory::Character, std::max(t1.kind(), t2.kind())};
620     default:
621       return std::nullopt;
622     }
623   case TypeCategory::Logical:
624     switch (t2.category()) {
625     case TypeCategory::Logical:
626       return DynamicType{TypeCategory::Logical, LogicalResult::kind};
627     default:
628       return std::nullopt;
629     }
630   default:
631     return std::nullopt;
632   }
633 }
634 
635 bool IsInteroperableIntrinsicType(const DynamicType &type) {
636   switch (type.category()) {
637   case TypeCategory::Integer:
638     return true;
639   case TypeCategory::Real:
640   case TypeCategory::Complex:
641     return type.kind() >= 4; // no short or half floats
642   case TypeCategory::Logical:
643     return type.kind() == 1; // C_BOOL
644   case TypeCategory::Character:
645     return type.kind() == 1 /* C_CHAR */ && type.knownLength().value_or(0) == 1;
646   default:
647     // Derived types are tested in Semantics/check-declarations.cpp
648     return false;
649   }
650 }
651 
652 } // namespace Fortran::evaluate
653