[flang-commits] [flang] [flang] Better handling of ALLOCATED(pointer) error (PR #186622)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/186622

>From c3d470118999ca447bf2df024b0f303a90a4ce6a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sat, 14 Mar 2026 13:24:26 -0700
Subject: [PATCH] [flang] Better handling of ALLOCATED(pointer) error

Some legacy compilers accept a reference to the intrinsic function ALLOCATED
with a pointer argument.  (Pointers should be checked with ASSOCIATED
instead, of course.)  Emit a good warning, but also interpret the
call to ALLOCATED with a pointer argument as if it had been correctly
spelled.  Test that this only applies to the intrinsic ALLOCATED,
not a user-defined function.
---
 flang/docs/Extensions.md                      |  3 ++
 .../include/flang/Support/Fortran-features.h  |  2 +-
 flang/lib/Evaluate/intrinsics.cpp             | 15 ++++++++
 flang/lib/Support/Fortran-features.cpp        |  1 +
 flang/test/Evaluate/bug2418.f90               | 36 +++++++++++++++++++
 5 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Evaluate/bug2418.f90

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index a997980ca18e7..17d01d81d329b 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -496,6 +496,9 @@ program p
   namelist /g/ k
 end program
 ```
+* When the argument to intrinsic `ALLOCATED(p)` is actually a pointer
+  rather than an allocatable, it is interpreted as `ASSOCIATED(p)` with a
+  stern warning.
 
 ### Extensions supported when enabled by options
 
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index aa2c4cdc6d10b..ce35e06091bfd 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -58,7 +58,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     CudaWarpMatchFunction, DoConcurrentOffload, TransferBOZ, Coarray,
     PointerPassObject, MultipleIdenticalDATA,
     DefaultStructConstructorNullPointer, AssumedRankIoItem,
-    MultipleProgramUnitsOnSameLine)
+    MultipleProgramUnitsOnSameLine, AllocatedForAssociated)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 2ae1c478489c4..5659c5ae7f2d6 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3802,6 +3802,21 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
       return HandleC_Devloc(arguments, context);
     } else if (call.name == "null") {
       return HandleNull(arguments, context);
+    } else if (call.name == "allocated") {
+      if (context.languageFeatures().IsEnabled(
+              common::LanguageFeature::AllocatedForAssociated) &&
+          arguments.size() == 1 && arguments[0].has_value()) {
+        auto &arg{*arguments[0]};
+        if (const Expr<SomeType> *expr{arg.UnwrapExpr()};
+            expr && IsObjectPointer(*expr)) {
+          context.Warn(common::LanguageFeature::AllocatedForAssociated,
+              arg.sourceLocation(),
+              "Argument of ALLOCATED() should be an allocatable, but is instead an object pointer"_warn_en_US);
+          // Treat ALLOCATED(ptr) as ASSOCIATED(ptr)
+          CallCharacteristics newCall{"associated"};
+          return Probe(newCall, arguments, context);
+        }
+      }
     }
   }
 
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 83d1affba5ed2..79fa807af06a6 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -104,6 +104,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnLanguage_.set(LanguageFeature::ListDirectedSize);
   warnLanguage_.set(LanguageFeature::IgnoreIrrelevantAttributes);
   warnLanguage_.set(LanguageFeature::TransferBOZ);
+  warnLanguage_.set(LanguageFeature::AllocatedForAssociated);
   warnUsage_.set(UsageWarning::ShortArrayActual);
   warnUsage_.set(UsageWarning::FoldingException);
   warnUsage_.set(UsageWarning::FoldingAvoidsRuntimeCrash);
diff --git a/flang/test/Evaluate/bug2418.f90 b/flang/test/Evaluate/bug2418.f90
new file mode 100644
index 0000000000000..ae5960ac4f79f
--- /dev/null
+++ b/flang/test/Evaluate/bug2418.f90
@@ -0,0 +1,36 @@
+!RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+
+!CHECK-NOT: error:
+
+program main
+  integer, pointer :: p1(:) => NULL()
+  !CHECK: warning: Argument of ALLOCATED() should be an allocatable, but is instead an object pointer [-Wallocated-for-associated]
+  !CHECK:  PRINT *, associated(p1)
+  print *, allocated(p1)
+end
+
+subroutine s1
+  interface
+    logical function allocated(p)
+      class(*), pointer, intent(in) :: p(..)
+    end
+  end interface
+  real, pointer :: p2(:) => NULL()
+  !CHECK-NOT: error:
+  !CHECK-NOT: warning:
+  !CHECK: PRINT *, allocated(p2)
+  print *, allocated(p2)
+end
+
+subroutine s2
+  interface allocated
+    logical function specificallocated(p)
+      class(*), pointer, intent(in) :: p(..)
+    end
+  end interface
+  real, pointer :: p3(:) => NULL()
+  !CHECK-NOT: error:
+  !CHECK-NOT: warning:
+  !CHECK: PRINT *, specificallocated(p3)
+  print *, allocated(p3)
+end