[flang] Correct handling of null pointer initializers

Fortran defines "null-init" null pointer initializers as
being function references, syntactically, that have to resolve
to calls to the intrinsic function NULL() with no actual
arguments.

Differential revision: https://reviews.llvm.org/D91657

flang/docs/f2018-grammar.md

@@ -216,7 +216,7 @@ R803 entity-decl ->
        function-name [* char-length]
 R804 object-name -> name
 R805 initialization -> = constant-expr | => null-init | => initial-data-target
-R806 null-init -> function-reference
+R806 null-init -> function-reference     {constrained to be NULL()}
 R807 access-spec -> PUBLIC | PRIVATE
 R808 language-binding-spec ->
        BIND ( C [, NAME = scalar-default-char-constant-expr] )

flang/include/flang/Parser/parse-tree.h

@@ -974,9 +974,8 @@ struct ComponentAttrSpec {
       u;
 };
 
-// R806 null-init -> function-reference
-// TODO replace with semantic check on expression
-EMPTY_CLASS(NullInit);
+// R806 null-init -> function-reference   ... which must be NULL()
+WRAPPER_CLASS(NullInit, common::Indirection<Expr>);
 
 // R744 initial-data-target -> designator
 using InitialDataTarget = common::Indirection<Designator>;
@@ -1412,7 +1411,7 @@ using TypedExpr = common::ForwardOwningPointer<evaluate::GenericExprWrapper>;
 //        scalar-constant | scalar-constant-subobject |
 //        signed-int-literal-constant | signed-real-literal-constant |
 //        null-init | initial-data-target |
-//        constant-structure-constructor    <- added "constant-"
+//        structure-constructor
 struct DataStmtConstant {
   UNION_CLASS_BOILERPLATE(DataStmtConstant);
   CharBlock source;

flang/include/flang/Semantics/expression.h

@@ -237,6 +237,7 @@ public:
   MaybeExpr Analyze(const parser::SignedComplexLiteralConstant &);
   MaybeExpr Analyze(const parser::StructureConstructor &);
   MaybeExpr Analyze(const parser::InitialDataTarget &);
+  MaybeExpr Analyze(const parser::NullInit &);
 
   void Analyze(const parser::CallStmt &);
   const Assignment *Analyze(const parser::AssignmentStmt &);
@@ -255,7 +256,6 @@ private:
   MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
   MaybeExpr Analyze(const parser::BOZLiteralConstant &);
   MaybeExpr Analyze(const parser::NamedConstant &);
-  MaybeExpr Analyze(const parser::NullInit &);
   MaybeExpr Analyze(const parser::DataStmtConstant &);
   MaybeExpr Analyze(const parser::Substring &);
   MaybeExpr Analyze(const parser::ArrayElement &);

flang/lib/Evaluate/check-expression.cpp

@@ -190,6 +190,9 @@ public:
   template <typename T> bool operator()(const Parentheses<T> &x) const {
     return (*this)(x.left());
   }
+  template <typename T> bool operator()(const FunctionRef<T> &x) const {
+    return false;
+  }
   bool operator()(const Relational<SomeType> &) const { return false; }
 
 private:

flang/lib/Parser/Fortran-parsers.cpp

@@ -644,9 +644,8 @@ constexpr auto objectName{name};
 TYPE_PARSER(construct<EntityDecl>(objectName, maybe(arraySpec),
     maybe(coarraySpec), maybe("*" >> charLength), maybe(initialization)))
 
-// R806 null-init -> function-reference
-// TODO: confirm in semantics that NULL still intrinsic in this scope
-TYPE_PARSER(construct<NullInit>("NULL ( )"_tok) / !"("_tok)
+// R806 null-init -> function-reference   ... which must resolve to NULL()
+TYPE_PARSER(lookAhead(name / "( )") >> construct<NullInit>(expr))
 
 // R807 access-spec -> PUBLIC | PRIVATE
 TYPE_PARSER(construct<AccessSpec>("PUBLIC" >> pure(AccessSpec::Kind::Public)) ||
@@ -827,7 +826,11 @@ TYPE_PARSER(construct<DataStmtRepeat>(intLiteralConstant) ||
 // R845 data-stmt-constant ->
 //        scalar-constant | scalar-constant-subobject |
 //        signed-int-literal-constant | signed-real-literal-constant |
-//        null-init | initial-data-target | structure-constructor
+//        null-init | initial-data-target |
+//        constant-structure-constructor
+// null-init and a structure-constructor without parameters or components
+// are syntactically ambiguous in DATA, so "x()" is misparsed into a
+// null-init then fixed up later in expression semantics.
 // TODO: Some structure constructors can be misrecognized as array
 // references into constant subobjects.
 TYPE_PARSER(sourced(first(

flang/lib/Semantics/data-to-inits.cpp

@@ -252,6 +252,7 @@ bool DataInitializationCompiler::InitElement(
   bool isPointer{lastSymbol && IsPointer(*lastSymbol)};
   bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)};
   evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()};
+  auto restorer{context.messages().SetLocation(values_.LocateSource())};
 
   const auto DescribeElement{[&]() {
     if (auto badDesignator{
@@ -302,39 +303,37 @@ bool DataInitializationCompiler::InitElement(
     } else if (evaluate::IsNullPointer(*expr)) {
       // nothing to do; rely on zero initialization
       return true;
-    } else if (evaluate::IsProcedure(*expr)) {
-      if (isProcPointer) {
+    } else if (isProcPointer) {
+      if (evaluate::IsProcedure(*expr)) {
         if (CheckPointerAssignment(context, designator, *expr)) {
           GetImage().AddPointer(offsetSymbol.offset(), *expr);
           return true;
         }
       } else {
-        exprAnalyzer_.Say(values_.LocateSource(),
-            "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
+        exprAnalyzer_.Say(
+            "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
             expr->AsFortran(), DescribeElement());
       }
-    } else if (isProcPointer) {
-      exprAnalyzer_.Say(values_.LocateSource(),
-          "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US,
+    } else if (evaluate::IsProcedure(*expr)) {
+      exprAnalyzer_.Say(
+          "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US,
           expr->AsFortran(), DescribeElement());
     } else if (CheckInitialTarget(context, designator, *expr)) {
       GetImage().AddPointer(offsetSymbol.offset(), *expr);
       return true;
     }
   } else if (evaluate::IsNullPointer(*expr)) {
-    exprAnalyzer_.Say(values_.LocateSource(),
-        "Initializer for '%s' must not be a pointer"_err_en_US,
+    exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US,
         DescribeElement());
   } else if (evaluate::IsProcedure(*expr)) {
-    exprAnalyzer_.Say(values_.LocateSource(),
-        "Initializer for '%s' must not be a procedure"_err_en_US,
+    exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US,
         DescribeElement());
   } else if (auto designatorType{designator.GetType()}) {
     if (auto converted{ConvertElement(*expr, *designatorType)}) {
       // value non-pointer initialization
       if (std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u) &&
           designatorType->category() != TypeCategory::Integer) { // 8.6.7(11)
-        exprAnalyzer_.Say(values_.LocateSource(),
+        exprAnalyzer_.Say(
             "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US,
             DescribeElement(), designatorType->AsFortran());
       } else if (converted->second) {
@@ -348,7 +347,7 @@ bool DataInitializationCompiler::InitElement(
       case evaluate::InitialImage::Ok:
         return true;
       case evaluate::InitialImage::NotAConstant:
-        exprAnalyzer_.Say(values_.LocateSource(),
+        exprAnalyzer_.Say(
             "DATA statement value '%s' for '%s' is not a constant"_err_en_US,
             folded.AsFortran(), DescribeElement());
         break;

flang/lib/Semantics/expression.cpp

@@ -709,8 +709,16 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
   return std::nullopt;
 }
 
-MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &x) {
-  return Expr<SomeType>{NullPointer{}};
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &n) {
+  if (MaybeExpr value{Analyze(n.v)}) {
+    // Subtle: when the NullInit is a DataStmtConstant, it might
+    // be a misparse of a structure constructor without parameters
+    // or components (e.g., T()).  Checking the result to ensure
+    // that a "=>" data entity initializer actually resolved to
+    // a null pointer has to be done by the caller.
+    return Fold(std::move(*value));
+  }
+  return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) {

flang/lib/Semantics/resolve-names.cpp

@@ -188,14 +188,12 @@ public:
     if (context().HasError(symbol)) {
       return std::nullopt;
     }
-    auto maybeExpr{AnalyzeExpr(*context_, expr)};
-    if (!maybeExpr) {
-      return std::nullopt;
+    if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
+      if (auto converted{
+              evaluate::ConvertToType(symbol, std::move(*maybeExpr))}) {
+        return FoldExpr(std::move(*converted));
       }
-    auto exprType{maybeExpr->GetType()};
-    auto converted{evaluate::ConvertToType(symbol, std::move(*maybeExpr))};
-    if (!converted) {
-      if (exprType) {
+      if (auto exprType{maybeExpr->GetType()}) {
         Say(source,
             "Initialization expression could not be converted to declared type of '%s' from %s"_err_en_US,
             symbol.name(), exprType->AsFortran());
@@ -204,9 +202,8 @@ public:
             "Initialization expression could not be converted to declared type of '%s'"_err_en_US,
             symbol.name());
       }
-      return std::nullopt;
     }
-    return FoldExpr(std::move(*converted));
+    return std::nullopt;
   }
 
   template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
@@ -3345,6 +3342,10 @@ bool DeclarationVisitor::Pre(const parser::ExternalStmt &x) {
     if (!ConvertToProcEntity(*symbol)) {
       SayWithDecl(
           name, *symbol, "EXTERNAL attribute not allowed on '%s'"_err_en_US);
+    } else if (symbol->attrs().test(Attr::INTRINSIC)) { // C840
+      Say(symbol->name(),
+          "Symbol '%s' cannot have both INTRINSIC and EXTERNAL attributes"_err_en_US,
+          symbol->name());
     }
   }
   return false;
@@ -5730,18 +5731,27 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
     // derived types may still need more attention.
     return;
   }
-  if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
+  if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
     // TODO: check C762 - all bounds and type parameters of component
     // are colons or constant expressions if component is initialized
-    bool isNullPointer{false};
     std::visit(
         common::visitors{
             [&](const parser::ConstantExpr &expr) {
               NonPointerInitialization(name, expr, inComponentDecl);
             },
-            [&](const parser::NullInit &) {
-              isNullPointer = true;
-              details->set_init(SomeExpr{evaluate::NullPointer{}});
+            [&](const parser::NullInit &null) {
+              Walk(null);
+              if (auto nullInit{EvaluateExpr(null)}) {
+                if (!evaluate::IsNullPointer(*nullInit)) {
+                  Say(name,
+                      "Pointer initializer must be intrinsic NULL()"_err_en_US); // C813
+                } else if (IsPointer(ultimate)) {
+                  object->set_init(std::move(*nullInit));
+                } else {
+                  Say(name,
+                      "Non-pointer component '%s' initialized with null pointer"_err_en_US);
+                }
+              }
             },
             [&](const parser::InitialDataTarget &) {
               DIE("InitialDataTarget can't appear here");
@@ -5757,15 +5767,6 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
             },
         },
         init.u);
-    if (isNullPointer) {
-      if (!IsPointer(ultimate)) {
-        Say(name,
-            "Non-pointer component '%s' initialized with null pointer"_err_en_US);
-      }
-    } else if (IsPointer(ultimate)) {
-      Say(name,
-          "Object pointer component '%s' initialized with non-pointer expression"_err_en_US);
-    }
   }
 }
 
@@ -5885,8 +5886,6 @@ void ResolveNamesVisitor::HandleProcedureName(
     }
     ConvertToProcEntity(*symbol);
     SetProcFlag(name, *symbol, flag);
-  } else if (symbol->has<UnknownDetails>()) {
-    DIE("unexpected UnknownDetails");
   } else if (CheckUseError(name)) {
     // error was reported
   } else {

flang/test/Semantics/modfile20.f90

@@ -33,7 +33,7 @@ end
 !    integer(4)::a=123_4
 !    type(t),pointer::b=>NULL()
 !  end type
+!  intrinsic::null
 !  type(t),parameter::x=t(a=456_4,b=NULL())
 !  type(t),parameter::y=t(a=789_4,b=NULL())
-!  intrinsic::null
 !end

flang/test/Semantics/null-init.f90

@@ -0,0 +1,75 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Tests valid and invalid NULL initializers
+
+module m1
+  implicit none
+  !ERROR: No explicit type declared for 'null'
+  private :: null
+end module
+
+module m2
+  implicit none
+  private :: null
+  integer, pointer :: p => null()
+end module
+
+module m3
+  private :: null
+  integer, pointer :: p => null()
+end module
+
+module m4
+  intrinsic :: null
+  integer, pointer :: p => null()
+end module
+
+module m5
+  external :: null
+  !ERROR: Pointer initializer must be intrinsic NULL()
+  integer, pointer :: p => null()
+end module
+
+module m6
+  !ERROR: Symbol 'null' cannot have both INTRINSIC and EXTERNAL attributes
+  integer, pointer :: p => null()
+  external :: null
+end module
+
+module m7
+  interface
+    function null() result(p)
+      integer, pointer :: p
+    end function
+  end interface
+  !ERROR: Pointer initializer must be intrinsic NULL()
+  integer, pointer :: p => null()
+end module
+
+module m8
+  integer, pointer :: p => null()
+  interface
+    !ERROR: 'null' is already declared in this scoping unit
+    function null() result(p)
+      integer, pointer :: p
+    end function
+  end interface
+end module
+
+module m9a
+  intrinsic :: null
+ contains
+  function foo()
+    integer, pointer :: foo
+    foo => null()
+  end function
+end module
+module m9b
+  use m9a, renamed => null, null => foo
+  integer, pointer :: p => renamed()
+  !ERROR: Pointer initializer must be intrinsic NULL()
+  integer, pointer :: q => null()
+  integer, pointer :: d1, d2
+  data d1/renamed()/
+  !ERROR: An initial data target must be a designator with constant subscripts
+  data d2/null()/
+end module

flang/test/Semantics/symbol15.f90

@@ -12,6 +12,7 @@ module m
  !DEF: /m/op1 POINTER, PUBLIC ObjectEntity REAL(4)
  real, pointer :: op1
  !DEF: /m/op2 POINTER, PUBLIC ObjectEntity REAL(4)
+ !DEF: /m/null INTRINSIC, PUBLIC (Function) ProcEntity
  real, pointer :: op2 => null()
  !DEF: /m/op3 POINTER, PUBLIC ObjectEntity REAL(4)
  !DEF: /m/x PUBLIC, TARGET ObjectEntity REAL(4)
@@ -24,6 +25,7 @@ module m
  procedure(iface), pointer :: pp1
  !REF: /m/iface
  !DEF: /m/pp2 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
+ !REF: /m/null
  procedure(iface), pointer :: pp2 => null()
  !REF: /m/iface
  !DEF: /m/pp3 EXTERNAL, POINTER, PUBLIC (Subroutine) ProcEntity
@@ -46,6 +48,7 @@ module m
   !DEF: /m/t1/opc1 POINTER ObjectEntity REAL(4)
   real, pointer :: opc1
   !DEF: /m/t1/opc2 POINTER ObjectEntity REAL(4)
+  !REF: /m/null
   real, pointer :: opc2 => null()
   !DEF: /m/t1/opc3 POINTER ObjectEntity REAL(4)
   !REF: /m/x
@@ -58,6 +61,7 @@ module m
   procedure(iface), nopass, pointer :: ppc1
   !REF: /m/iface
   !DEF: /m/t1/ppc2 NOPASS, POINTER (Subroutine) ProcEntity
+  !REF: /m/null
   procedure(iface), nopass, pointer :: ppc2 => null()
   !REF: /m/iface
   !DEF: /m/t1/ppc3 NOPASS, POINTER (Subroutine) ProcEntity
@@ -94,6 +98,7 @@ module m
   !DEF: /m/pdt1/opc1 POINTER ObjectEntity REAL(4)
   real, pointer :: opc1
   !DEF: /m/pdt1/opc2 POINTER ObjectEntity REAL(4)
+  !REF: /m/null
   real, pointer :: opc2 => null()
   !DEF: /m/pdt1/opc3 POINTER ObjectEntity REAL(4)
   !REF: /m/x
@@ -107,6 +112,7 @@ module m
   procedure(iface), nopass, pointer :: ppc1
   !REF: /m/iface
   !DEF: /m/pdt1/ppc2 NOPASS, POINTER (Subroutine) ProcEntity
+  !REF: /m/null
   procedure(iface), nopass, pointer :: ppc2 => null()
   !REF: /m/iface
   !DEF: /m/pdt1/ppc3 NOPASS, POINTER (Subroutine) ProcEntity