[flang] Fix spurious error in character sequence association

[klausler]

When an allocatable or pointer was being associated as a storage sequence with a dummy argument, the checks were using the actual storage size of the allocatable or pointer's descriptor, not the size of the storage that it references.

Fixes #123807.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

When an allocatable or pointer was being associated as a storage sequence with a dummy argument, the checks were using the actual storage size of the allocatable or pointer's descriptor, not the size of the storage that it references.

Fixes #123807.

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/check-call.cpp (+6-2)
• (modified) flang/test/Semantics/call38.f90 (+36)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ba68a0f898d469..178c1346de9c25 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -167,7 +167,9 @@ static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
                   context.foldingContext(), /*getLastComponent=*/true};
               if (auto actualOffset{folder.FoldDesignator(actual)}) {
                 std::int64_t actualChars{*actualLength};
-                if (static_cast<std::size_t>(actualOffset->offset()) >=
+                if (IsAllocatableOrPointer(actualOffset->symbol())) {
+                  // don't use actualOffset->symbol().size()!
+                } else if (static_cast<std::size_t>(actualOffset->offset()) >=
                         actualOffset->symbol().size() ||
                     !evaluate::IsContiguous(
                         actualOffset->symbol(), foldingContext)) {
@@ -634,7 +636,9 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
                 context.foldingContext(), /*getLastComponent=*/true};
             if (auto actualOffset{folder.FoldDesignator(actual)}) {
               std::optional<std::int64_t> actualElements;
-              if (static_cast<std::size_t>(actualOffset->offset()) >=
+              if (IsAllocatableOrPointer(actualOffset->symbol())) {
+                // don't use actualOffset->symbol().size()!
+              } else if (static_cast<std::size_t>(actualOffset->offset()) >=
                       actualOffset->symbol().size() ||
                   !evaluate::IsContiguous(
                       actualOffset->symbol(), foldingContext)) {
diff --git a/flang/test/Semantics/call38.f90 b/flang/test/Semantics/call38.f90
index 34aae6b8b18357..b1a35973e35fee 100644
--- a/flang/test/Semantics/call38.f90
+++ b/flang/test/Semantics/call38.f90
@@ -544,3 +544,39 @@ subroutine sub2(arg2)
       character(*) :: arg2(10)
     end subroutine sub2
 end subroutine
+
+subroutine bug123807
+  interface
+    subroutine test(s)
+      character(5), intent(inout) :: s(5)
+    end
+  end interface
+  character(30) :: s30a
+  character(30), allocatable :: s30b
+  character(6) :: s30c(5)
+  character(24) :: s24a
+  character(24), allocatable :: s24b
+  character(4) :: s24c(6)
+  allocate(s30b)
+  allocate(s24b)
+  call test(s30a)
+  call test(s30a(6:))
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s30a(7:))
+  call test(s30b)
+  call test(s30b(6:))
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s30b(7:))
+  call test(s30c)
+  call test(s30c(1)(6:))
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s30c(2))
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s30c(2)(1:))
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s24a)
+  !ERROR: Actual argument has fewer characters remaining in storage sequence (24) than dummy argument 's=' (25)
+  call test(s24b)
+  !ERROR: Actual argument array has fewer characters (24) than dummy argument 's=' array (25)
+  call test(s24c)
+end

[DanielCChen]

LGTM.
Thanks for the quick fix!