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

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

Some legacy compiler 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.

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


5 Files Affected:

- (modified) flang/docs/Extensions.md (+3) 
- (modified) flang/include/flang/Support/Fortran-features.h (+2-1) 
- (modified) flang/lib/Evaluate/intrinsics.cpp (+15) 
- (modified) flang/lib/Support/Fortran-features.cpp (+1) 
- (added) flang/test/Evaluate/bug2418.f90 (+36) 


``````````diff
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 cbcb3592f04c3..9686fc13dd1df 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -57,7 +57,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     ForwardRefExplicitTypeDummy, InaccessibleDeferredOverride,
     CudaWarpMatchFunction, DoConcurrentOffload, TransferBOZ, Coarray,
     PointerPassObject, MultipleIdenticalDATA,
-    DefaultStructConstructorNullPointer, AssumedRankIoItem)
+    DefaultStructConstructorNullPointer, AssumedRankIoItem,
+    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

``````````

</details>


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