[flang-commits] [flang] 5349f99 - [flang] Correct handling of null pointer initializers
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Nov 18 13:57:37 PST 2020
Author: peter klausler
Date: 2020-11-18T13:57:25-08:00
New Revision: 5349f99114cfcf597220cbc9b9253f178a43fabd
URL: https://github.com/llvm/llvm-project/commit/5349f99114cfcf597220cbc9b9253f178a43fabd
DIFF: https://github.com/llvm/llvm-project/commit/5349f99114cfcf597220cbc9b9253f178a43fabd.diff
LOG: [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
Added:
flang/test/Semantics/null-init.f90
Modified:
flang/docs/f2018-grammar.md
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Semantics/expression.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Parser/Fortran-parsers.cpp
flang/lib/Semantics/data-to-inits.cpp
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/modfile20.f90
flang/test/Semantics/symbol15.f90
Removed:
################################################################################
diff --git a/flang/docs/f2018-grammar.md b/flang/docs/f2018-grammar.md
index 70f9ebc7f764..89d2184adde8 100644
--- a/flang/docs/f2018-grammar.md
+++ b/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] )
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 91ba14f88edf..a64ca06f1b3b 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/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;
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index f49408e81446..e095928656a8 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -237,6 +237,7 @@ class ExpressionAnalyzer {
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 @@ class ExpressionAnalyzer {
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 &);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 57e20165a99c..a56d31db3dca 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -190,6 +190,9 @@ class IsInitialDataTargetHelper
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:
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 4bb45fced39e..d1e2edcdae87 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/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(
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index 64113c78d804..0cfc5c209a1e 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/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;
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 364847ca56d9..ecbcad34b7fd 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/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) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index e8791931715b..95a0b896d12b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -188,14 +188,12 @@ class BaseVisitor {
if (context().HasError(symbol)) {
return std::nullopt;
}
- auto maybeExpr{AnalyzeExpr(*context_, expr)};
- if (!maybeExpr) {
- return std::nullopt;
- }
- auto exprType{maybeExpr->GetType()};
- auto converted{evaluate::ConvertToType(symbol, std::move(*maybeExpr))};
- if (!converted) {
- if (exprType) {
+ if (auto maybeExpr{AnalyzeExpr(*context_, expr)}) {
+ if (auto converted{
+ evaluate::ConvertToType(symbol, std::move(*maybeExpr))}) {
+ return FoldExpr(std::move(*converted));
+ }
+ 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 @@ class BaseVisitor {
"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 {
diff --git a/flang/test/Semantics/modfile20.f90 b/flang/test/Semantics/modfile20.f90
index a2730b1454f9..1be724c7e17f 100644
--- a/flang/test/Semantics/modfile20.f90
+++ b/flang/test/Semantics/modfile20.f90
@@ -33,7 +33,7 @@ module m
! 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
diff --git a/flang/test/Semantics/null-init.f90 b/flang/test/Semantics/null-init.f90
new file mode 100644
index 000000000000..ede47bb61ec6
--- /dev/null
+++ b/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
diff --git a/flang/test/Semantics/symbol15.f90 b/flang/test/Semantics/symbol15.f90
index 079dceca3c90..ddd3772252dc 100644
--- a/flang/test/Semantics/symbol15.f90
+++ b/flang/test/Semantics/symbol15.f90
@@ -12,6 +12,7 @@ subroutine iface
!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 @@ subroutine iface
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 @@ subroutine iface
!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 @@ subroutine iface
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 @@ subroutine iface
!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 @@ subroutine iface
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
More information about the flang-commits
mailing list