[flang] Correct handling of null pointer initializers

[klausler]

Summary

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.

[PeteSteinfeld]

Aside from the noted items, all builds, tests, and looks good.

flang/lib/Semantics/resolve-names.cpp

5737

Something weird is going on with this file. When I look at this file in my downloaded version, this line that begins with "if (auto" is at line 5733 rather than line 5737 as this display shows.

It looks to me like your version of the file doesn't contain the changes from D91560. Please be sure to integrate those changes before merging.

5744–5746

It would be good to have a test for this.

5758–5759

It would be good to have a test for this.

flang/docs/f2018-grammar.md

        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

       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>;

 //        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

   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 &);

   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

   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

 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)) ||

 // 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

   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{

     } 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) {

       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

   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

     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;

     // 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);
+              if (IsPointer(ultimate)) {
+                Say(name,
+                    "Object pointer component '%s' initialized with non-pointer expression"_err_en_US);
+              }
             },
-            [&](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");

             },
         },
         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);
-    }
   }
 }
 

     }
     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

 !    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

+! 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

  !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)

  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

   !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

   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

   !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

   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