[flang-commits] [flang] 70f1b4b - [flang] Implemented 2 Semantic checks for DATA statement and fixed a few bugs
Anchu Rajendran via flang-commits
flang-commits at lists.llvm.org
Tue Jun 2 22:04:02 PDT 2020
Author: Anchu Rajendran
Date: 2020-06-03T10:33:26+05:30
New Revision: 70f1b4b4122088c1bd7324b519bc449dbfeaf298
URL: https://github.com/llvm/llvm-project/commit/70f1b4b4122088c1bd7324b519bc449dbfeaf298
DIFF: https://github.com/llvm/llvm-project/commit/70f1b4b4122088c1bd7324b519bc449dbfeaf298.diff
LOG: [flang] Implemented 2 Semantic checks for DATA statement and fixed a few bugs
Summary
- Implemented C876, C877
- Fixed IsConstantExpr to check C879
- Fixed bugs in few test cases - data01.f90, block-data01.f90,
pre-fir-tree02.f90
- Modified implementation of C8106 to identify all automatic objects
and modified equivalence01.f90 to reflect the changes
Differential Revision: https://reviews.llvm.org/D78424
Added:
flang/test/Semantics/data04.f90
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Semantics/check-data.cpp
flang/lib/Semantics/resolve-names-utils.cpp
flang/lib/Semantics/tools.cpp
flang/test/Lower/pre-fir-tree02.f90
flang/test/Semantics/block-data01.f90
flang/test/Semantics/data01.f90
flang/test/Semantics/data03.f90
flang/test/Semantics/equivalence01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 1132fc0bfaf4..e8b5335f7ea2 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -146,6 +146,8 @@ bool IsFinalizable(const Symbol &);
bool IsFinalizable(const DerivedTypeSpec &);
bool HasImpureFinal(const DerivedTypeSpec &);
bool IsCoarray(const Symbol &);
+bool IsInBlankCommon(const Symbol &);
+bool IsAutomaticObject(const Symbol &);
inline bool IsAssumedSizeArray(const Symbol &symbol) {
const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
return details && details->IsAssumedSize();
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 5cd1fcb431d7..a252a964e9e5 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -59,7 +59,9 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
}
return true;
}
-
+ bool operator()(const Component &component) const {
+ return (*this)(component.base());
+ }
// Forbid integer division by zero in constants.
template <int KIND>
bool operator()(
diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 522c15aa9548..4b2d2fc734f7 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -56,22 +56,69 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
}
bool operator()(const evaluate::Component &component) {
hasComponent_ = true;
- return (*this)(component.base());
+ const Symbol &lastSymbol{component.GetLastSymbol()};
+ if (isPointerAllowed_) {
+ if (IsPointer(lastSymbol) && hasSubscript_) { // C877
+ context_.Say(source_,
+ "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
+ lastSymbol.name().ToString());
+ return false;
+ }
+ RestrictPointer();
+ } else {
+ if (IsPointer(lastSymbol)) { // C877
+ context_.Say(source_,
+ "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
+ lastSymbol.name().ToString());
+ return false;
+ }
+ }
+ if (!isFirstSymbolChecked_) {
+ isFirstSymbolChecked_ = true;
+ if (!CheckFirstSymbol(component.GetFirstSymbol())) {
+ return false;
+ }
+ }
+ return (*this)(component.base()) && (*this)(lastSymbol);
}
- bool operator()(const evaluate::Subscript &subs) {
+ bool operator()(const evaluate::ArrayRef &arrayRef) {
hasSubscript_ = true;
+ return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
+ }
+ bool operator()(const evaluate::Substring &substring) {
+ hasSubscript_ = true;
+ return (*this)(substring.parent()) && (*this)(substring.lower()) &&
+ (*this)(substring.upper());
+ }
+ bool operator()(const evaluate::CoarrayRef &) { // C874
+ hasSubscript_ = true;
+ context_.Say(
+ source_, "Data object must not be a coindexed variable"_err_en_US);
+ return false;
+ }
+ bool operator()(const evaluate::Symbol &symbol) {
+ if (!isFirstSymbolChecked_) {
+ return CheckFirstSymbol(symbol) && CheckAnySymbol(symbol);
+ } else {
+ return CheckAnySymbol(symbol);
+ }
+ }
+ bool operator()(const evaluate::Subscript &subs) {
+ DataVarChecker subscriptChecker{context_, source_};
+ subscriptChecker.RestrictPointer();
return std::visit(
- common::visitors{
- [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
- return CheckSubscriptExpr(expr);
- },
- [&](const evaluate::Triplet &triplet) {
- return CheckSubscriptExpr(triplet.lower()) &&
- CheckSubscriptExpr(triplet.upper()) &&
- CheckSubscriptExpr(triplet.stride());
- },
- },
- subs.u);
+ common::visitors{
+ [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
+ return CheckSubscriptExpr(expr);
+ },
+ [&](const evaluate::Triplet &triplet) {
+ return CheckSubscriptExpr(triplet.lower()) &&
+ CheckSubscriptExpr(triplet.upper()) &&
+ CheckSubscriptExpr(triplet.stride());
+ },
+ },
+ subs.u) &&
+ subscriptChecker(subs.u);
}
template <typename T>
bool operator()(const evaluate::FunctionRef<T> &) const { // C875
@@ -79,11 +126,7 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
"Data object variable must not be a function reference"_err_en_US);
return false;
}
- bool operator()(const evaluate::CoarrayRef &) const { // C874
- context_.Say(
- source_, "Data object must not be a coindexed variable"_err_en_US);
- return false;
- }
+ void RestrictPointer() { isPointerAllowed_ = false; }
private:
bool CheckSubscriptExpr(
@@ -104,21 +147,71 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
return true;
}
}
+ bool CheckFirstSymbol(const Symbol &symbol);
+ bool CheckAnySymbol(const Symbol &symbol);
SemanticsContext &context_;
parser::CharBlock source_;
bool hasComponent_{false};
bool hasSubscript_{false};
+ bool isPointerAllowed_{true};
+ bool isFirstSymbolChecked_{false};
};
-// TODO: C876, C877, C879
+bool DataVarChecker::CheckFirstSymbol(const Symbol &symbol) { // C876
+ const Scope &scope{context_.FindScope(source_)};
+ if (IsDummy(symbol)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be a dummy argument"_err_en_US,
+ symbol.name().ToString());
+ } else if (IsFunction(symbol)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be a function name"_err_en_US,
+ symbol.name().ToString());
+ } else if (symbol.IsFuncResult()) {
+ context_.Say(source_,
+ "Data object part '%s' must not be a function result"_err_en_US,
+ symbol.name().ToString());
+ } else if (IsHostAssociated(symbol, scope)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be accessed by host association"_err_en_US,
+ symbol.name().ToString());
+ } else if (IsUseAssociated(symbol, scope)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be accessed by use association"_err_en_US,
+ symbol.name().ToString());
+ } else if (IsInBlankCommon(symbol)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be in blank COMMON"_err_en_US,
+ symbol.name().ToString());
+ } else {
+ return true;
+ }
+ return false;
+}
+
+bool DataVarChecker::CheckAnySymbol(const Symbol &symbol) { // C876
+ if (IsAutomaticObject(symbol)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be an automatic object"_err_en_US,
+ symbol.name().ToString());
+ } else if (IsAllocatable(symbol)) {
+ context_.Say(source_,
+ "Data object part '%s' must not be an allocatable object"_err_en_US,
+ symbol.name().ToString());
+ } else {
+ return true;
+ }
+ return false;
+}
+
void DataChecker::Leave(const parser::DataIDoObject &object) {
if (const auto *designator{
std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
&object.u)}) {
if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
auto source{designator->thing.value().source};
- if (evaluate::IsConstantExpr(*expr)) { // C878
+ if (evaluate::IsConstantExpr(*expr)) { // C878,C879
exprAnalyzer_.Say(
source, "Data implied do object must be a variable"_err_en_US);
} else {
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index c63ed5c60b30..5564570e263c 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -595,16 +595,9 @@ bool EquivalenceSets::CheckObject(const parser::Name &name) {
msg = "Nonsequence derived type object '%s'"
" is not allowed in an equivalence set"_err_en_US;
}
- } else if (symbol.IsObjectArray()) {
- for (const ShapeSpec &spec : symbol.get<ObjectEntityDetails>().shape()) {
- auto &lbound{spec.lbound().GetExplicit()};
- auto &ubound{spec.ubound().GetExplicit()};
- if ((lbound && !evaluate::ToInt64(*lbound)) ||
- (ubound && !evaluate::ToInt64(*ubound))) {
- msg = "Automatic array '%s'"
- " is not allowed in an equivalence set"_err_en_US;
- }
- }
+ } else if (IsAutomaticObject(symbol)) {
+ msg = "Automatic object '%s'"
+ " is not allowed in an equivalence set"_err_en_US;
}
}
if (!msg.text().empty()) {
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 707b88de1f2d..9aaa138305f8 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -581,6 +581,35 @@ bool HasImpureFinal(const DerivedTypeSpec &derived) {
bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; }
+bool IsAutomaticObject(const Symbol &symbol) {
+ if (IsDummy(symbol) || IsPointer(symbol) || IsAllocatable(symbol)) {
+ return false;
+ }
+ if (const DeclTypeSpec * type{symbol.GetType()}) {
+ if (type->category() == DeclTypeSpec::Character) {
+ ParamValue length{type->characterTypeSpec().length()};
+ if (length.isExplicit()) {
+ if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
+ if (!ToInt64(lengthExpr)) {
+ return true;
+ }
+ }
+ }
+ }
+ }
+ if (symbol.IsObjectArray()) {
+ for (const ShapeSpec &spec : symbol.get<ObjectEntityDetails>().shape()) {
+ auto &lbound{spec.lbound().GetExplicit()};
+ auto &ubound{spec.ubound().GetExplicit()};
+ if ((lbound && !evaluate::ToInt64(*lbound)) ||
+ (ubound && !evaluate::ToInt64(*ubound))) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
bool IsAssumedLengthCharacter(const Symbol &symbol) {
if (const DeclTypeSpec * type{symbol.GetType()}) {
return type->category() == DeclTypeSpec::Character &&
@@ -590,6 +619,20 @@ bool IsAssumedLengthCharacter(const Symbol &symbol) {
}
}
+bool IsInBlankCommon(const Symbol &symbol) {
+ if (FindCommonBlockContaining(symbol)) {
+ if (const auto *details{
+ symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ if (details->commonBlock()) {
+ if (details->commonBlock()->name().empty()) {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+
// C722 and C723: For a function to be assumed length, it must be external and
// of CHARACTER type
bool IsExternal(const Symbol &symbol) {
diff --git a/flang/test/Lower/pre-fir-tree02.f90 b/flang/test/Lower/pre-fir-tree02.f90
index 0fc219ff9a88..2d50a9394985 100644
--- a/flang/test/Lower/pre-fir-tree02.f90
+++ b/flang/test/Lower/pre-fir-tree02.f90
@@ -326,7 +326,7 @@ subroutine sub3()
end subroutine
! CHECK: Subroutine sub4
-subroutine sub4(i, j)
+subroutine sub4()
integer :: i
print*, "test"
! CHECK: DataStmt
diff --git a/flang/test/Semantics/block-data01.f90 b/flang/test/Semantics/block-data01.f90
index ba1bf5df233e..853506cf3eb9 100644
--- a/flang/test/Semantics/block-data01.f90
+++ b/flang/test/Semantics/block-data01.f90
@@ -11,9 +11,6 @@ block data foo
procedure(sin), pointer :: p => cos
!ERROR: 'p' is already declared as a procedure
common /block/ pi, p
- real :: inBlankCommon
- data inBlankCommon / 1.0 /
- common inBlankCommon
!ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
integer :: inDataButNotCommon
data inDataButNotCommon /1/
diff --git a/flang/test/Semantics/data01.f90 b/flang/test/Semantics/data01.f90
index 0632013a36b5..65664517645f 100644
--- a/flang/test/Semantics/data01.f90
+++ b/flang/test/Semantics/data01.f90
@@ -1,20 +1,16 @@
! RUN: %S/test_errors.sh %s %t %f18
!Test for checking data constraints, C882-C887
-module m1
+subroutine CheckRepeat
type person
integer :: age
character(len=25) :: name
end type
integer, parameter::digits(5) = ( /-11,-22,-33,44,55/ )
- integer ::notConstDigits(5) = ( /-11,-22,-33,44,55/ )
+ integer ::notConstDigits(5)
real, parameter::numbers(5) = ( /-11.11,-22.22,-33.33,44.44,55.55/ )
integer, parameter :: repeat = -1
integer :: myAge = 2
type(person) myName
-end
-
-subroutine CheckRepeat
- use m1
!C882
!ERROR: Missing initialization for parameter 'uninitialized'
integer, parameter :: uninitialized
@@ -39,7 +35,12 @@ subroutine CheckRepeat
end
subroutine CheckValue
- use m1
+ type person
+ integer :: age
+ character(len=25) :: name
+ end type
+ integer :: myAge = 2
+ type(person) myName
!OK: constant structure constructor
data myname / person(1, 'Abcd Ijkl') /
!C883
diff --git a/flang/test/Semantics/data03.f90 b/flang/test/Semantics/data03.f90
index 62a55cff7d07..fdab401d9b9b 100644
--- a/flang/test/Semantics/data03.f90
+++ b/flang/test/Semantics/data03.f90
@@ -62,6 +62,12 @@ subroutine CheckObject
!C880
!ERROR: Data implied do structure component must be subscripted
DATA(nums % one, i = 1, 5) / 5 * 1 /
+ !C879
+ !ERROR: Data implied do object must be a variable
+ DATA(newNums % numbers(i), i = 1, 5) / 5 * 1 /
+ !C879
+ !ERROR: Data implied do object must be a variable
+ DATA(newNumsArray(i) % one, i = 1, 5) / 5 * 1 /
!C880
!OK: Correct use
DATA(largeArray(j) % nums % one, j = 1, 10) / 10 * 1 /
diff --git a/flang/test/Semantics/data04.f90 b/flang/test/Semantics/data04.f90
new file mode 100644
index 000000000000..98030ff52749
--- /dev/null
+++ b/flang/test/Semantics/data04.f90
@@ -0,0 +1,155 @@
+! RUN: %S/test_errors.sh %s %t %f18
+!Testing data constraints : C876, C877
+module m
+ integer :: first
+ contains
+ subroutine h
+ integer a,b
+ !C876
+ !ERROR: Data object part 'first' must not be accessed by host association
+ DATA first /1/
+ end subroutine
+
+ function g(i)
+ integer ::i
+ g = i *1024
+ end
+
+ function f(i)
+ integer ::i
+ integer ::result
+ integer, allocatable :: a
+ integer :: b(i)
+ character(len=i), pointer:: charPtr
+ character(len=i), allocatable:: charAlloc
+ !C876
+ !ERROR: Data object part 'i' must not be a dummy argument
+ DATA i /1/
+ !C876
+ !ERROR: Data object part 'f' must not be a function result
+ DATA f /1/
+ !C876
+ !ERROR: Data object part 'g' must not be a function name
+ DATA g /1/
+ !C876
+ !ERROR: Data object part 'a' must not be an allocatable object
+ DATA a /1/
+ !C876
+ !ERROR: Data object part 'b' must not be an automatic object
+ DATA b(0) /1/
+ !C876
+ !Ok: As charPtr is a pointer, it is not an automatic object
+ DATA charPtr / NULL() /
+ !C876
+ !ERROR: Data object part 'charalloc' must not be an allocatable object
+ DATA charAlloc / 'abc' /
+ f = i *1024
+ end
+
+ subroutine CheckObject(i)
+ type specialNumbers
+ integer one
+ integer numbers(5)
+ type(specialNumbers), pointer :: headOfTheList
+ integer, pointer, dimension(:) :: ptoarray
+ character, pointer, dimension(:) :: ptochar
+ end type
+ type large
+ integer, allocatable :: allocVal
+ integer, allocatable :: elt(:)
+ integer val
+ type(specialNumbers) numsArray(5)
+ end type
+ type(large) largeNumber
+ type(large), allocatable :: allocatableLarge
+ type(large) :: largeNumberArray(i)
+ type(large) :: largeArray(5)
+ character :: name(i)
+ !C877
+ !OK: Correct use
+ DATA(largeNumber % numsArray(j) % headOfTheList, j = 1, 10) / 10 * NULL() /
+ !C877
+ !ERROR: Data object must not contain pointer 'headofthelist' as a non-rightmost part
+ DATA(largeNumber % numsArray(j) % headOfTheList % one, j = 1, 10) / 10 * NULL() /
+ !C877
+ !ERROR: Rightmost data object pointer 'ptoarray' must not be subscripted
+ DATA(largeNumber % numsArray(j) % ptoarray(1), j = 1, 10) / 10 * 1 /
+ !C877
+ !ERROR: Rightmost data object pointer 'ptochar' must not be subscripted
+ DATA largeNumber % numsArray(0) % ptochar(1:2) / 'ab' /
+ !C876
+ !ERROR: Data object part 'elt' must not be an allocatable object
+ DATA(largeNumber % elt(j) , j = 1, 10) / 10 * 1/
+ !C876
+ !ERROR: Data object part 'allocval' must not be an allocatable object
+ DATA(largeArray(j) % allocVal , j = 1, 10) / 10 * 1/
+ !C876
+ !ERROR: Data object part 'allocatablelarge' must not be an allocatable object
+ DATA allocatableLarge % val / 1 /
+ !C876
+ !ERROR: Data object part 'largenumberarray' must not be an automatic object
+ DATA(largeNumberArray(j) % val, j = 1, 10) / 10 * NULL() /
+ !C876
+ !ERROR: Data object part 'name' must not be an automatic object
+ DATA name( : 2) / 'Ancd' /
+ end
+ end
+
+ block data foo
+ integer :: a,b
+ common /c/ a,b
+ !C876
+ !OK: Correct use
+ DATA a /1/
+ end block data
+
+ module m2
+ integer m2_i
+ type newType
+ integer number
+ end type
+ type(newType) m2_number1
+ contains
+
+ subroutine checkDerivedType(m2_number)
+ type(newType) m2_number
+ type(newType) m2_number3
+ !C876
+ !ERROR: Data object part 'm2_number' must not be a dummy argument
+ DATA m2_number%number /1/
+ !C876
+ !ERROR: Data object part 'm2_number1' must not be accessed by host association
+ DATA m2_number1%number /1/
+ !C876
+ !OK: m2_number3 is not associated through use association
+ DATA m2_number3%number /1/
+ end
+ end
+
+ program new
+ use m2
+ integer a
+ real b,c
+ type seqType
+ sequence
+ integer number
+ end type
+ type(SeqType) num
+ COMMON b,a,c,num
+ type(newType) m2_number2
+ !C876
+ !ERROR: Data object part 'b' must not be in blank COMMON
+ DATA b /1/
+ !C876
+ !ERROR: Data object part 'm2_i' must not be accessed by use association
+ DATA m2_i /1/
+ !C876
+ !ERROR: Data object part 'm2_number1' must not be accessed by use association
+ DATA m2_number1%number /1/
+ !C876
+ !OK: m2_number2 is not associated through use association
+ DATA m2_number2%number /1/
+ !C876
+ !ERROR: Data object part 'num' must not be in blank COMMON
+ DATA num%number /1/
+ end program
diff --git a/flang/test/Semantics/equivalence01.f90 b/flang/test/Semantics/equivalence01.f90
index 219eb17f27d4..de60e8c9b2a4 100644
--- a/flang/test/Semantics/equivalence01.f90
+++ b/flang/test/Semantics/equivalence01.f90
@@ -128,7 +128,7 @@ subroutine s10
subroutine s11(n)
integer :: n
real :: x(n), y
- !ERROR: Automatic array 'x' is not allowed in an equivalence set
+ !ERROR: Automatic object 'x' is not allowed in an equivalence set
equivalence(x(1), y)
end
More information about the flang-commits
mailing list