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

[Carlos Seo via flang-commits]

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

>From 6cdff605667fec2c33eebeb3c57588704386e5e3 Mon Sep 17 00:00:00 2001
From: Carlos Eduardo Seo <carlos.seo at linaro.org>
Date: Wed, 5 Jun 2024 18:58:46 -0300
Subject: [PATCH] [Flang] Extra check for character length in pointer
 allocation

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

Fixes #78939
---
 flang/lib/Semantics/check-allocate.cpp | 23 ++++++++++++++---------
 1 file changed, 14 insertions(+), 9 deletions(-)

diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index b4c5660670579..d3154a29e02c5 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -418,14 +418,18 @@ static bool HaveCompatibleTypeParameters(
   }
 }
 
-static bool HaveCompatibleLengths(
-    const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
+static bool HaveCompatibleLengths(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 +499,24 @@ 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)) {
+      // F'2023 C939
+      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