[flang-commits] [flang] b0fab14 - [flang] Fix spurious error in character sequence association (#124204)

[via flang-commits]

Author: Peter Klausler
Date: 2025-01-27T08:58:20-08:00
New Revision: b0fab14e9ca24a9160581ea26c19661c6f3a053f

URL: https://github.com/llvm/llvm-project/commit/b0fab14e9ca24a9160581ea26c19661c6f3a053f
DIFF: https://github.com/llvm/llvm-project/commit/b0fab14e9ca24a9160581ea26c19661c6f3a053f.diff

LOG: [flang] Fix spurious error in character sequence association (#124204)

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 https://github.com/llvm/llvm-project/issues/123807.

Added: 
    

Modified: 
    flang/lib/Semantics/check-call.cpp
    flang/test/Semantics/call38.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 79caf50d8597ec..e925e1c1c653e3 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -163,7 +163,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)) {
@@ -630,7 +632,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