[flang-commits] [flang] 30d9323 - [flang] Pointers returned from functions are not definable as pointers

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-02-13T15:59:02-08:00
New Revision: 30d932305567e7f3d9018db3fd25060ae5c16cd5

URL: https://github.com/llvm/llvm-project/commit/30d932305567e7f3d9018db3fd25060ae5c16cd5
DIFF: https://github.com/llvm/llvm-project/commit/30d932305567e7f3d9018db3fd25060ae5c16cd5.diff

LOG: [flang] Pointers returned from functions are not definable as pointers

A reference to a pointer-valued function is a "variable" in the argot of
the Fortran standard, and can be the left-hand side of an assignment
statement or passed as a definable actual argument -- but it is not a
definable pointer, and cannot be associated with a pointer dummy argument
that is not INTENT(IN).

Differential Revision: https://reviews.llvm.org/D143827

Added: 
    flang/test/Semantics/definable04.f90

Modified: 
    flang/lib/Semantics/definable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index 79d57d0b394f..aa9246fb223e 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -267,11 +267,10 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
           expr.AsFortran());
     }
     return WhyNotDefinable(at, scope, flags, *dataRef);
-  }
-  if (evaluate::IsVariable(expr)) {
-    return std::nullopt; // result of function returning a pointer - ok
-  }
-  if (flags.test(DefinabilityFlag::PointerDefinition)) {
+  } else if (evaluate::IsNullPointer(expr)) {
+    return parser::Message{
+        at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()};
+  } else if (flags.test(DefinabilityFlag::PointerDefinition)) {
     if (const auto *procDesignator{
             std::get_if<evaluate::ProcedureDesignator>(&expr.u)}) {
       // Defining a procedure pointer
@@ -288,13 +287,14 @@ std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
         }
       }
     }
-  }
-  if (evaluate::IsNullPointer(expr)) {
     return parser::Message{
-        at, "'%s' is a null pointer"_because_en_US, expr.AsFortran()};
+        at, "'%s' is not a definable pointer"_because_en_US, expr.AsFortran()};
+  } else if (!evaluate::IsVariable(expr)) {
+    return parser::Message{at,
+        "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
+  } else {
+    return std::nullopt;
   }
-  return parser::Message{
-      at, "'%s' is not a variable or pointer"_because_en_US, expr.AsFortran()};
 }
 
 } // namespace Fortran::semantics

diff  --git a/flang/test/Semantics/definable04.f90 b/flang/test/Semantics/definable04.f90
new file mode 100644
index 000000000000..f9a5e045de1f
--- /dev/null
+++ b/flang/test/Semantics/definable04.f90
@@ -0,0 +1,27 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+  integer, target :: n
+ contains
+  function ptr()
+    integer, pointer :: ptr
+    ptr => n
+  end
+  subroutine s1(p)
+    integer, pointer, intent(in) :: p
+  end
+  subroutine s2(p)
+    integer, pointer, intent(in out) :: p
+  end
+end
+
+program test
+  use m
+  integer, pointer :: p
+  p => ptr() ! ok
+  ptr() = 1 ! ok
+  call s1(ptr()) ! ok
+  call s1(null()) ! ok
+  !ERROR: Actual argument associated with INTENT(IN OUT) dummy argument 'p=' is not definable
+  !BECAUSE: 'ptr()' is not a definable pointer
+  call s2(ptr())
+end