[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()) {
+            context_.Say(
+                "All consequent-args in a conditional argument must be the same derived type; have %s and %s"_err_en_US,
+                refType->AsFortran(), thisType->AsFortran());
+            return false;
+          }
+          for (const auto &[pName, pValue] : resSpec.parameters()) {
+            if (pValue.isKind()) {
+              auto it{thisSpec.parameters().find(pName)};
+              if (it == thisSpec.parameters().end() || pValue != it->second) {
+                context_.Say(
+                    "All consequent-args in a conditional argument must have the same kind type parameters; have %s and %s"_err_en_US,
+                    refType->AsFortran(), thisType->AsFortran());
+                return false;
+              }
----------------
jeanPerier wrote:

Could this be consolidate with how C1004 is enforced for conditional expressions [here](https://github.com/llvm/llvm-project/blob/8557b5714bca181906118a86d8152598f525fcc7/flang/lib/Semantics/expression.cpp#L4025)?

I think the usages of AreSameDerivedType may reject derived type with different length parameters, but in any case the C1004 and C1538 requirements are the same and should use the same logic as much as possible.

I am OK to use your version that seems more precise.

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