[flang-commits] [flang] [Flang] Extra check for character length in pointer allocation (PR #95145)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Carlos Seo (ceseo)

<details>
<summary>Changes</summary>

Check if the charater length parameter is the same as in the declaration when the pointer being allocated has non-constant length.

Fixes #<!-- -->78939

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


1 Files Affected:

- (modified) flang/lib/Semantics/check-allocate.cpp (+11-8) 


``````````diff
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index b4c5660670579..4473434582ef8 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -419,13 +419,16 @@ static bool HaveCompatibleTypeParameters(
 }
 
 static bool HaveCompatibleLengths(
-    const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
+    const DeclTypeSpec &type1, const DeclTypeSpec &type2, const Symbol &symbol) {
   if (type1.category() == DeclTypeSpec::Character &&
       type2.category() == DeclTypeSpec::Character) {
     auto v1{
         evaluate::ToInt64(type1.characterTypeSpec().length().GetExplicit())};
     auto v2{
         evaluate::ToInt64(type2.characterTypeSpec().length().GetExplicit())};
+    if (!type1.characterTypeSpec().length().isDeferred() && IsPointer(symbol)
+        && !v1 && v2)
+      return false;
     return !v1 || !v2 || *v1 == *v2;
   } else {
     return true;
@@ -495,23 +498,23 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
           "Allocatable object in ALLOCATE must be type compatible with type-spec"_err_en_US);
       return false;
     }
+    if (!HaveSameAssumedTypeParameters(*type_, *allocateInfo_.typeSpec)) {
+      // C935
+      context.Say(name_.source,
+          "Type parameters in type-spec must be assumed if and only if they are assumed for allocatable object in ALLOCATE"_err_en_US);
+      return false;
+    }
     if (!HaveCompatibleTypeParameters(*type_, *allocateInfo_.typeSpec)) {
       context.Say(name_.source,
           // C936
           "Type parameters of allocatable object in ALLOCATE must be the same as the corresponding ones in type-spec"_err_en_US);
       return false;
     }
-    if (!HaveCompatibleLengths(*type_, *allocateInfo_.typeSpec)) { // C934
+    if (!HaveCompatibleLengths(*type_, *allocateInfo_.typeSpec, *ultimate_)) { // C934
       context.Say(name_.source,
           "Character length of allocatable object in ALLOCATE must be the same as the type-spec"_err_en_US);
       return false;
     }
-    if (!HaveSameAssumedTypeParameters(*type_, *allocateInfo_.typeSpec)) {
-      // C935
-      context.Say(name_.source,
-          "Type parameters in type-spec must be assumed if and only if they are assumed for allocatable object in ALLOCATE"_err_en_US);
-      return false;
-    }
   } else if (allocateInfo_.gotSource || allocateInfo_.gotMold) {
     if (!IsTypeCompatible(*type_, allocateInfo_.sourceExprType.value())) {
       // first part of C945

``````````

</details>


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