[flang-commits] [flang] [flang] Emit warning when Hollerith actual passed to CLASS(*) (PR #84084)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

When a Hollerith actual argument is associated with an unlimited polymorphic dummy argument, it's treated as if it were CHARACTER.  Some other compilers treat it as if it had been BOZ, so emit a portability warning.

Resolves https://github.com/llvm/llvm-project/issues/83548.

---
Full diff: https://github.com/llvm/llvm-project/pull/84084.diff


4 Files Affected:

- (modified) flang/include/flang/Evaluate/constant.h (+3) 
- (modified) flang/lib/Semantics/check-call.cpp (+9-1) 
- (modified) flang/lib/Semantics/expression.cpp (+5-2) 
- (added) flang/test/Semantics/call41.f90 (+12) 


``````````diff
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index ee83d9fc04f3b9..71be7906d2fe2a 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -186,6 +186,8 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
 
   const Scalar<Result> &values() const { return values_; }
   ConstantSubscript LEN() const { return length_; }
+  bool wasHollerith() const { return wasHollerith_; }
+  void set_wasHollerith(bool yes = true) { wasHollerith_ = yes; }
 
   std::optional<Scalar<Result>> GetScalarValue() const {
     if (Rank() == 0) {
@@ -210,6 +212,7 @@ class Constant<Type<TypeCategory::Character, KIND>> : public ConstantBounds {
 private:
   Scalar<Result> values_; // one contiguous string
   ConstantSubscript length_;
+  bool wasHollerith_{false};
 };
 
 class StructureConstructor;
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 3adbd7cc41774d..d625f8c2f7fc11 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -332,7 +332,15 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   bool typesCompatible{typesCompatibleWithIgnoreTKR ||
       dummy.type.type().IsTkCompatibleWith(actualType.type())};
   int dummyRank{dummy.type.Rank()};
-  if (!typesCompatible && dummyRank == 0 && allowActualArgumentConversions) {
+  if (typesCompatible) {
+    if (const auto *constantChar{
+            evaluate::UnwrapConstantValue<evaluate::Ascii>(actual)};
+        constantChar && constantChar->wasHollerith() &&
+        dummy.type.type().IsUnlimitedPolymorphic()) {
+      messages.Say(
+          "passing Hollerith to unlimited polymorphic as if it were CHARACTER"_port_en_US);
+    }
+  } else if (dummyRank == 0 && allowActualArgumentConversions) {
     // Extension: pass Hollerith literal to scalar as if it had been BOZ
     if (auto converted{evaluate::HollerithToBOZ(
             foldingContext, actual, dummy.type.type())}) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 54bfe0f2e1563d..1015a9e6efcef8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -875,8 +875,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
 MaybeExpr ExpressionAnalyzer::Analyze(
     const parser::HollerithLiteralConstant &x) {
   int kind{GetDefaultKind(TypeCategory::Character)};
-  auto value{x.v};
-  return AnalyzeString(std::move(value), kind);
+  auto result{AnalyzeString(std::string{x.v}, kind)};
+  if (auto *constant{UnwrapConstantValue<Ascii>(result)}) {
+    constant->set_wasHollerith(true);
+  }
+  return result;
 }
 
 // .TRUE. and .FALSE. of various kinds
diff --git a/flang/test/Semantics/call41.f90 b/flang/test/Semantics/call41.f90
new file mode 100644
index 00000000000000..a4c7514d99ba5e
--- /dev/null
+++ b/flang/test/Semantics/call41.f90
@@ -0,0 +1,12 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+module m
+ contains
+  subroutine unlimited(x)
+    class(*), intent(in) :: x
+  end
+  subroutine test
+    !PORTABILITY: passing Hollerith to unlimited polymorphic as if it were CHARACTER
+    call unlimited(6HHERMAN)
+    call unlimited('abc') ! ok
+  end
+end

``````````

</details>


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