squiid/llvm
1
0
Fork 0
Code Issues Pull requests Activity

[flang] Implemented 2 Semantic checks for DATA statement and fixed a few bugs

Browse source 
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
This commit is contained in:
Anchu Rajendran 2020-06-03 10:26:10 +05:30
parent def72b9195
commit 70f1b4b412
11 changed files with 335 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
flang/include/flang/Semantics/tools.h
View file

@ -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();

4
flang/lib/Evaluate/check-expression.cpp
View file

@ -59,7 +59,9 @@ public:
}
return true;
}
bool operator()(const Component &component) const {
return (*this)(component.base());
}
// Forbid integer division by zero in constants.
template <int KIND>
bool operator()(

133
flang/lib/Semantics/check-data.cpp
View file

@ -56,22 +56,69 @@ public:
}
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::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) {
hasSubscript_ = true;
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 @@ public:
"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 @@ private:
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 {

13
flang/lib/Semantics/resolve-names-utils.cpp
View file

@ -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()) {

43
flang/lib/Semantics/tools.cpp
View file

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

2
flang/test/Lower/pre-fir-tree02.f90
View file

@ -326,7 +326,7 @@ subroutine sub3()
end subroutine
! CHECK: Subroutine sub4
subroutine sub4(i, j)
subroutine sub4()
integer :: i
print*, "test"
! CHECK: DataStmt

3
flang/test/Semantics/block-data01.f90
View file

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

15
flang/test/Semantics/data01.f90
View file

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

6
flang/test/Semantics/data03.f90
View file

@ -62,6 +62,12 @@ module m
!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 /

155
flang/test/Semantics/data04.f90 Normal file
View file

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

2
flang/test/Semantics/equivalence01.f90
View file

@ -128,7 +128,7 @@ end
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