[flang-commits] [flang] [flang] Add semantics support for Fortran 2023 conditional arguments (F2023 R1526-R1528) (PR #195345)

[via flang-commits]

================
@@ -4835,6 +4950,126 @@ void ArgumentAnalyzer::Analyze(
   }
 }
 
+// C1538: Each consequent-arg shall have the same declared type and kind
+// C1539: Each consequent-arg shall have the same rank or be assumed-rank
+bool ArgumentAnalyzer::CheckConsequentTypesAndRanks(
+    const ActualArgument::ConditionalArg &condArg) {
+  const Expr<SomeType> *refExpr{condArg.FirstNonNilConsequent()};
+  if (!refExpr) {
+    return true; // all .NIL.; caller checks separately
+  }
+  auto refType{refExpr->GetType()};
+  if (!refType) {
+    return true; // typeless; should have been caught earlier
+  }
+  int refRank{-1};
+  bool allSameRank{true};
+  bool hasAssumedRank{false};
+  bool hasNonAssumedRank{false};
+
+  // Check a single consequent against the reference type and rank
+  auto checkOne{[&](const ActualArgument::ConditionalArg::Consequent &cons)
+                    -> bool {
+    if (!cons) {
+      return true; // .NIL. is ok
+    }
+    auto thisType{cons->value().GetType()};
+    if (thisType) {
+      if (refType->category() != thisType->category() ||
+          (refType->category() != TypeCategory::Derived &&
+              refType->kind() != thisType->kind())) {
+        context_.Say(
+            "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+            refType->AsFortran(), thisType->AsFortran());
+        return false;
+      }
+      if (refType->category() == TypeCategory::Derived) {
+        // C1538: same declared type required.  Unlimited polymorphic
+        // (CLASS(*)) and assumed type (TYPE(*)) have no declared type,
+        // so mixing them with other types is invalid.
+        if (refType->IsUnlimitedPolymorphic() !=
+            thisType->IsUnlimitedPolymorphic()) {
+          context_.Say(
+              "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+              refType->AsFortran(), thisType->AsFortran());
+          return false;
+        }
+        if (refType->IsAssumedType() != thisType->IsAssumedType()) {
+          context_.Say(
+              "All consequent-args in a conditional argument must have the same type and kind; have %s and %s"_err_en_US,
+              refType->AsFortran(), thisType->AsFortran());
+          return false;
+        }
+        if (!refType->IsUnlimitedPolymorphic() && !refType->IsAssumedType()) {
+          const auto &resSpec{refType->GetDerivedTypeSpec()};
+          const auto &thisSpec{thisType->GetDerivedTypeSpec()};
+          if (&resSpec.typeSymbol() != &thisSpec.typeSymbol()) {
----------------
jeanPerier wrote:

It may be safer to use `GetUltimate()` here. Also, this will reject sequence types that are the same (according to 7.5.2.4). The only case where I see this being possible is if you have something like, which is odd, but nevertheless correct I think:

```
module m
contains
function f1()
  type :: point
    sequence
    integer :: x, y, z
  end type
  type(point) :: f1
end function
function f2()
  type :: point
    sequence
    integer :: x, y, z
  end type
  type(point) :: f1
end function

subroutine test(cdt)
 logical :: cdt
 call foo((cdt? f1() : f2()))
end subroutine
end module
```

You may want to expose a version of `AreSameDerivedType` that ignores length parameters and not kind parameters.

https://github.com/llvm/llvm-project/pull/195345