[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 0f2b4c71367e65783911583c7e28000b11f0abf8 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 | 37 +++++++++++++++-----------
 flang/test/Semantics/allocate14.f90    | 24 +++++++++++++++++
 2 files changed, 45 insertions(+), 16 deletions(-)
 create mode 100644 flang/test/Semantics/allocate14.f90

diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index b4c5660670579..f4eac416bb8fe 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -418,15 +418,19 @@ static bool HaveCompatibleTypeParameters(
   }
 }
 
-static bool HaveCompatibleLengths(
-    const DeclTypeSpec &type1, const DeclTypeSpec &type2) {
-  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())};
-    return !v1 || !v2 || *v1 == *v2;
+static bool HaveCompatibleLengths(const DeclTypeSpec &type,
+    const DeclTypeSpec &typeSpec, const Symbol &symbol) {
+  if (type.category() == DeclTypeSpec::Character &&
+      typeSpec.category() == DeclTypeSpec::Character) {
+    auto typeLength{
+        evaluate::ToInt64(type.characterTypeSpec().length().GetExplicit())};
+    auto typeSpecLength{
+        evaluate::ToInt64(typeSpec.characterTypeSpec().length().GetExplicit())};
+    if (!type.characterTypeSpec().length().isDeferred() && IsPointer(symbol) &&
+        !typeLength && typeSpecLength) {
+      return false;
+    }
+    return !typeLength || !typeSpecLength || *typeLength == *typeSpecLength;
   } 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
diff --git a/flang/test/Semantics/allocate14.f90 b/flang/test/Semantics/allocate14.f90
new file mode 100644
index 0000000000000..27cb3440909b0
--- /dev/null
+++ b/flang/test/Semantics/allocate14.f90
@@ -0,0 +1,24 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors in ALLOCATE statements
+
+! C934
+! If type-spec appears, it shall specify a type with which each
+! allocate-object is type compatible.
+! Issue #78939: allocatable object has a non-defined character length.
+! This should also be an error when the length is defined by a parameter
+! in a module.
+
+module m1
+  integer::nn=1
+  integer,parameter::np=1
+end module m1
+
+program main
+  use m1
+  character(nn),pointer::cns
+  character(np),pointer::c1s
+  !ERROR: Character length of allocatable object in ALLOCATE must be the same as the type-spec
+  allocate(character(2)::cns)
+  !ERROR: Character length of allocatable object in ALLOCATE must be the same as the type-spec
+  allocate(character(2)::c1s)
+end program main