maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] These changes are for issue 458, to perform semantic checks on DO variable 

and initial, final, and step expressions.  As a new extension, we want to allow
REAL and DOUBLE PRECISION values for them by default.

Here's a summary of the changes:
 - There already existed infrastructure for semantic checking of DO loops that
   was partially specific to DO CONCURRENT loops.  Because I re-used some of
   this infrastructure, I renamed some files and classes from "concurrent" to
   "stmt".
 - I added some functions to distinguish among the different kinds of DO
   statements.
 - I added the functions to check-do-stmt.cc to produce the necessary warnins
   and errors.  Note that there are no tests for the warnings since the
   necessary testing infrastructure does not yet exist.
 - I changed test-errors.sh so that additional compilation options can be
   specified in the test source.
 - I added two new tests to test for the various kinds of values that can be
   used for the DO variables and control expressions.  The two tests are
   identical except for the use of different compilation options.
   dosemantics03.f90 specifies the options "-Mstandard -Werror" to produce
   error messages for the use of REAL and DOUBLE PRECISION DO variables and
   controls.  dosemantics04.f90 uses the default options and only produces
   error messages for contructs that are erroneous by default.

Original-commit: flang-compiler/f18@f484660c75
Reviewed-on: https://github.com/flang-compiler/f18/pull/478
Tree-same-pre-rewrite: false
This commit is contained in:
Peter Steinfeld 2019-06-04 15:14:34 -07:00
parent cd4491bb68
commit 93a59505a5
11 changed files with 646 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/documentation/Extensions.md
View File

@ -62,7 +62,7 @@ Extensions, deletions, and legacy features supported by default
files are easier to write and use.
* $ and \ edit descriptors are supported in FORMAT to suppress newline
output on user prompts.
* REAL variable and bounds in DO loops
* REAL and DOUBLE PRECISION variable and bounds in DO loops
* Integer literals without explicit kind specifiers that are out of range
for the default kind of INTEGER are assumed to have the least larger kind
that can hold them, if one exists.

21
flang/lib/parser/parse-tree.cc
View File

@ -80,9 +80,26 @@ Expr::Expr(Designator &&x)
Expr::Expr(FunctionReference &&x)
: u{common::Indirection<FunctionReference>::Make(std::move(x))} {}
const std::optional<LoopControl> &DoConstruct::GetLoopControl() const {
NonLabelDoStmt const &doStmt{
std::get<Statement<NonLabelDoStmt>>(t).statement};
std::optional<LoopControl> const &control{
std::get<std::optional<LoopControl>>(doStmt.t)};
return control;
}
bool DoConstruct::IsDoNormal() const {
std::optional<LoopControl> const &control{GetLoopControl()};
return control && std::holds_alternative<LoopControl::Bounds>(control->u);
}
bool DoConstruct::IsDoWhile() const {
std::optional<LoopControl> const &control{GetLoopControl()};
return control && std::holds_alternative<ScalarLogicalExpr>(control->u);
}
bool DoConstruct::IsDoConcurrent() const {
auto &doStmt{std::get<Statement<NonLabelDoStmt>>(t).statement};
auto &control{std::get<std::optional<LoopControl>>(doStmt.t)};
std::optional<LoopControl> const &control{GetLoopControl()};
return control && std::holds_alternative<LoopControl::Concurrent>(control->u);
}

3
flang/lib/parser/parse-tree.h
View File

@ -2217,6 +2217,9 @@ WRAPPER_CLASS(EndDoStmt, std::optional<Name>);
// CONTINUE; multiple "label DO" loops ending on the same label
struct DoConstruct {
TUPLE_CLASS_BOILERPLATE(DoConstruct);
const std::optional<LoopControl> &GetLoopControl() const;
bool IsDoNormal() const;
bool IsDoWhile() const;
bool IsDoConcurrent() const;
std::tuple<Statement<NonLabelDoStmt>, Block, Statement<EndDoStmt>> t;
};

2
flang/lib/semantics/CMakeLists.txt
View File

@ -20,7 +20,7 @@ add_library(FortranSemantics
check-arithmeticif.cc
check-coarray.cc
check-deallocate.cc
check-do-concurrent.cc
check-do-stmt.cc
check-if-stmt.cc
check-io.cc
check-nullify.cc

153
flang/lib/semantics/check-do-concurrent.cc → flang/lib/semantics/check-do-stmt.cc
View File

@ -12,13 +12,14 @@
// See the License for the specific language governing permissions and
// limitations under the License.
#include "check-do-concurrent.h"
#include "check-do-stmt.h"
#include "attr.h"
#include "scope.h"
#include "semantics.h"
#include "symbol.h"
#include "tools.h"
#include "type.h"
#include "../evaluate/expression.h"
#include "../evaluate/traversal.h"
#include "../parser/message.h"
#include "../parser/parse-tree-visitor.h"
@ -31,6 +32,7 @@ static bool isPure(const Attrs &attrs) {
return attrs.test(Attr::PURE) ||
(attrs.test(Attr::ELEMENTAL) && !attrs.test(Attr::IMPURE));
}
static bool isProcedure(const Symbol::Flags &flags) {
return flags.test(Symbol::Flag::Function) ||
flags.test(Symbol::Flag::Subroutine);
@ -51,57 +53,70 @@ public:
}
return true;
}
// C1167
bool Pre(const parser::WhereConstructStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::ForallConstructStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::ChangeTeamStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::CriticalStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::LabelDoStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::NonLabelDoStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::IfThenStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::SelectCaseStmt &s) {
addName(std::get<std::optional<parser::Name>>(s.t));
return true;
}
bool Pre(const parser::SelectRankStmt &s) {
addName(std::get<0>(s.t));
return true;
}
bool Pre(const parser::SelectTypeStmt &s) {
addName(std::get<0>(s.t));
return true;
}
// C1136
void Post(const parser::ReturnStmt &) {
messages_.Say(currentStatementSourcePosition_,
"RETURN not allowed in DO CONCURRENT"_err_en_US);
}
// C1137
void NoImageControl() {
messages_.Say(currentStatementSourcePosition_,
"image control statement not allowed in DO CONCURRENT"_err_en_US);
}
void Post(const parser::SyncAllStmt &) { NoImageControl(); }
void Post(const parser::SyncImagesStmt &) { NoImageControl(); }
void Post(const parser::SyncMemoryStmt &) { NoImageControl(); }
@ -122,6 +137,7 @@ public:
"ALLOCATE coarray not allowed in DO CONCURRENT"_err_en_US);
}
}
void Post(const parser::DeallocateStmt &) {
if (anyObjectIsCoarray()) {
messages_.Say(currentStatementSourcePosition_,
@ -134,6 +150,7 @@ public:
" in DO CONCURRENT"_err_en_US);
}
}
template<typename T> void Post(const parser::Statement<T> &) {
if (EndTDeallocatesCoarray()) {
messages_.Say(currentStatementSourcePosition_,
@ -141,6 +158,7 @@ public:
" in DO CONCURRENT"_err_en_US);
}
}
// C1141: cannot call ieee_get_flag, ieee_[gs]et_halting_mode
void Post(const parser::ProcedureDesignator &procedureDesignator) {
if (auto *name{std::get_if<parser::Name>(&procedureDesignator.u)}) {
@ -203,6 +221,7 @@ private:
}
return false;
}
void addName(const std::optional<parser::Name> &nm) {
if (nm.has_value()) {
names_.insert(nm.value().source);
@ -227,10 +246,12 @@ public:
currentStatementSourcePosition_ = statement.source;
return true;
}
bool Pre(const parser::DoConstruct &) {
++do_depth_;
return true;
}
template<typename T> void Post(const T &) {}
// C1138: branch from within a DO CONCURRENT shall not target outside loop
@ -241,22 +262,27 @@ public:
checkLabelUse(i);
}
}
void Post(const parser::ArithmeticIfStmt &arithmeticIfStmt) {
checkLabelUse(std::get<1>(arithmeticIfStmt.t));
checkLabelUse(std::get<2>(arithmeticIfStmt.t));
checkLabelUse(std::get<3>(arithmeticIfStmt.t));
}
void Post(const parser::AssignStmt &assignStmt) {
checkLabelUse(std::get<parser::Label>(assignStmt.t));
}
void Post(const parser::AssignedGotoStmt &assignedGotoStmt) {
for (auto &i : std::get<std::list<parser::Label>>(assignedGotoStmt.t)) {
checkLabelUse(i);
}
}
void Post(const parser::AltReturnSpec &altReturnSpec) {
checkLabelUse(altReturnSpec.v);
}
void Post(const parser::ErrLabel &errLabel) { checkLabelUse(errLabel.v); }
void Post(const parser::EndLabel &endLabel) { checkLabelUse(endLabel.v); }
void Post(const parser::EorLabel &eorLabel) { checkLabelUse(eorLabel.v); }
@ -276,6 +302,7 @@ public:
doConcurrentSourcePosition_, nm.value().source);
}
}
void checkLabelUse(const parser::Label &labelUsed) {
if (labels_.find(labelUsed) == labels_.end()) {
messages_.Say(currentStatementSourcePosition_,
@ -302,6 +329,7 @@ struct GatherSymbols {
};
enum GatherWhichVariables { All, NotShared, Local };
static CS GatherVariables(const std::list<parser::LocalitySpec> &localitySpecs,
GatherWhichVariables which) {
CS symbols;
@ -344,41 +372,108 @@ static CS GatherReferencesFromExpression(const parser::Expr &expression) {
}
}
// Find a canonical DO CONCURRENT and enforce semantics checks on its body
class DoConcurrentContext {
// Find a DO statement and enforce semantics checks on its body
class DoStmtContext {
public:
DoConcurrentContext(SemanticsContext &context)
: messages_{context.messages()} {}
DoStmtContext(SemanticsContext &context)
: context_{context}, messages_{context.messages()} {}
bool operator==(const DoConcurrentContext &x) const { return this == &x; }
bool operator==(const DoStmtContext &x) const { return this == &x; }
void Check(const parser::DoConstruct &doConstruct) {
if (doConstruct.IsDoConcurrent()) {
CheckDoConcurrent(doConstruct);
return;
}
if (doConstruct.IsDoNormal()) {
CheckDoNormal(doConstruct);
return;
}
// TODO: handle the other cases
}
private:
using Bounds = parser::LoopControl::Bounds;
const Bounds &GetBounds(const parser::DoConstruct &doConstruct) {
auto &doStmt{
std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};
auto &optionalLoopControl{
std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
if (optionalLoopControl) {
currentStatementSourcePosition_ = doStmt.source;
if (auto *concurrent{std::get_if<parser::LoopControl::Concurrent>(
&optionalLoopControl->u)}) {
DoConcurrentEnforcement doConcurrentEnforcement{messages_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);
DoConcurrentLabelEnforce doConcurrentLabelEnforce{messages_,
doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
currentStatementSourcePosition_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentLabelEnforce);
EnforceConcurrentLoopControl(*concurrent);
}
auto &loopControl{optionalLoopControl.value()};
return std::get<Bounds>(loopControl.u);
}
void CheckDoControl(parser::CharBlock sourceLocation, bool isReal) {
if ((isReal) && (!context_.warnOnNonstandardUsage())) {
// No messages for the default case
} else if (isReal && context_.warnOnNonstandardUsage() &&
(!context_.warningsAreErrors())) {
messages_.Say(sourceLocation,
"DO controls not of type INTEGER are a non-standard "
"extension"_en_US);
} else {
messages_.Say(sourceLocation, "DO controls should be INTEGER"_err_en_US);
}
}
private:
void CheckDoVariable(const parser::ScalarName &scalarName) {
const DeclTypeSpec *symType{scalarName.thing.symbol->GetType()};
if (symType->IsNumeric(TypeCategory::Integer)) {
return; // No warnings or errors for INTEGER
}
const parser::CharBlock &sourceLocation{scalarName.thing.source};
CheckDoControl(sourceLocation, symType->IsNumeric(TypeCategory::Real));
}
void CheckDoExpression(const parser::ScalarExpr &scalarExpression) {
const evaluate::Expr<evaluate::SomeType> *expr{GetExpr(scalarExpression)};
if (ExprHasTypeCategory(*expr, TypeCategory::Integer)) {
return; // No warnings or errors for INTEGER
}
const parser::CharBlock &sourceLocation{
scalarExpression.thing.value().source};
CheckDoControl(
sourceLocation, ExprHasTypeCategory(*expr, TypeCategory::Real));
}
void CheckDoNormal(const parser::DoConstruct &doConstruct) {
// Get the bounds, then check the variable, init, final, and step
const Bounds &bounds{GetBounds(doConstruct)};
CheckDoVariable(bounds.name);
CheckDoExpression(bounds.lower);
CheckDoExpression(bounds.upper);
if (bounds.step.has_value()) {
CheckDoExpression(bounds.step.value());
}
}
void CheckDoConcurrent(const parser::DoConstruct &doConstruct) {
auto &doStmt{
std::get<parser::Statement<parser::NonLabelDoStmt>>(doConstruct.t)};
auto &loopControl{
std::get<std::optional<parser::LoopControl>>(doStmt.statement.t)};
currentStatementSourcePosition_ = doStmt.source;
DoConcurrentEnforcement doConcurrentEnforcement{messages_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentEnforcement);
DoConcurrentLabelEnforce doConcurrentLabelEnforce{messages_,
doConcurrentEnforcement.labels(), doConcurrentEnforcement.names(),
currentStatementSourcePosition_};
parser::Walk(
std::get<parser::Block>(doConstruct.t), doConcurrentLabelEnforce);
auto &concurrent{std::get<parser::LoopControl::Concurrent>(loopControl->u)};
EnforceConcurrentLoopControl(concurrent);
}
bool InnermostEnclosingScope(const semantics::Symbol &symbol) const {
// TODO - implement
return true;
}
void CheckZeroOrOneDefaultNone(
const std::list<parser::LocalitySpec> &localitySpecs) const {
// C1127
@ -394,6 +489,7 @@ private:
}
}
}
void CheckScopingConstraints(const CS &symbols) const {
// C1124
for (auto *symbol : symbols) {
@ -453,6 +549,7 @@ private:
// C1130
// TODO - implement
}
// check constraints [C1121 .. C1130]
void EnforceConcurrentLoopControl(
const parser::LoopControl::Concurrent &concurrent) const {
@ -498,21 +595,15 @@ private:
CheckDefaultNoneImpliesExplicitLocality(localitySpecs);
}
SemanticsContext &context_;
parser::Messages &messages_;
parser::CharBlock currentStatementSourcePosition_;
};
DoConcurrentChecker::DoConcurrentChecker(SemanticsContext &context)
: context_{new DoConcurrentContext{context}} {}
DoConcurrentChecker::~DoConcurrentChecker() = default;
// DO loops must be canonicalized prior to calling
void DoConcurrentChecker::Leave(const parser::DoConstruct &x) {
context_.value().Check(x);
void DoStmtChecker::Leave(const parser::DoConstruct &x) {
DoStmtContext doContext{context_};
doContext.Check(x);
}
} // namespace Fortran::semantics
template class Fortran::common::Indirection<
Fortran::semantics::DoConcurrentContext>;

25
flang/lib/semantics/check-do-concurrent.h → flang/lib/semantics/check-do-stmt.h
View File

@ -12,30 +12,21 @@
// See the License for the specific language governing permissions and
// limitations under the License.
#ifndef FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
#define FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
#ifndef FORTRAN_SEMANTICS_CHECK_DO_STMT_H_
#define FORTRAN_SEMANTICS_CHECK_DO_STMT_H_
#include "semantics.h"
#include "../common/indirection.h"
namespace Fortran::parser {
struct DoConstruct;
}
namespace Fortran::semantics {
class DoConcurrentContext;
}
extern template class Fortran::common::Indirection<
Fortran::semantics::DoConcurrentContext>;
#include "../parser/parse-tree.h"
namespace Fortran::semantics {
class DoConcurrentChecker : public virtual BaseChecker {
class DoStmtChecker : public virtual BaseChecker {
public:
explicit DoConcurrentChecker(SemanticsContext &);
~DoConcurrentChecker();
explicit DoStmtChecker(SemanticsContext &context) : context_{context} {}
void Leave(const parser::DoConstruct &);
private:
common::Indirection<DoConcurrentContext> context_;
SemanticsContext &context_;
};
}
#endif // FORTRAN_SEMANTICS_CHECK_DO_CONCURRENT_H_
#endif // FORTRAN_SEMANTICS_CHECK_DO_STMT_H_

5
flang/lib/semantics/semantics.cc
View File

@ -19,7 +19,7 @@
#include "check-arithmeticif.h"
#include "check-coarray.h"
#include "check-deallocate.h"
#include "check-do-concurrent.h"
#include "check-do-stmt.h"
#include "check-if-stmt.h"
#include "check-io.h"
#include "check-nullify.h"
@ -34,7 +34,6 @@
#include "symbol.h"
#include "../common/default-kinds.h"
#include "../parser/parse-tree-visitor.h"
#include <ostream>
namespace Fortran::semantics {
@ -83,7 +82,7 @@ private:
using StatementSemanticsPass1 = ExprChecker;
using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
DeallocateChecker, DoConcurrentChecker, IfStmtChecker, IoChecker,
DeallocateChecker, DoStmtChecker, IfStmtChecker, IoChecker,
NullifyChecker, ReturnStmtChecker, StopChecker>;
static bool PerformStatementSemantics(

2
flang/test/semantics/CMakeLists.txt
View File

@ -124,6 +124,8 @@ set(ERROR_TESTS
allocate13.f90
dosemantics01.f90
dosemantics02.f90
dosemantics03.f90
dosemantics04.f90
expr-errors01.f90
null01.f90
)

250
flang/test/semantics/dosemantics03.f90 Normal file
View File

@ -0,0 +1,250 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
! Issue 458 -- semantic checks for a normal DO loop. The DO variable
! and the initial, final, and step expressions must be INTEGER if the
! options for standard conformance and turning warnings into errors
! are both in effect. This test turns on the options for standards
! conformance and turning warnings into errors. This produces error
! messages for the cases where REAL and DOUBLE PRECISION variables
! and expressions are used in the DO controls.
!
! This test is just like dosemantics04.f90 but with the options
! to produce error messages when using REAL and DOUBLE PRECISION DO
! loop controls.
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
!OPTIONS: -Mstandard -Werror
PROGRAM do_issue_458
IMPLICIT NONE
INTEGER :: ivar
REAL :: rvar
DOUBLE PRECISION :: dvar
LOGICAL :: lvar
COMPLEX :: cvar
CHARACTER :: chvar
INTEGER, DIMENSION(3) :: avar
TYPE derived
REAL :: first
INTEGER :: second
END TYPE derived
TYPE(derived) :: devar
INTEGER, POINTER :: pivar
REAL, POINTER :: prvar
DOUBLE PRECISION, POINTER :: pdvar
LOGICAL, POINTER :: plvar
! DO variables
! INTEGER DO variable
DO ivar = 1, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! REAL DO variable
!ERROR: DO controls should be INTEGER
DO rvar = 1, 10, 3
PRINT *, "rvar is: ", rvar
END DO
! DOUBLE PRECISISON DO variable
!ERROR: DO controls should be INTEGER
DO dvar = 1, 10, 3
PRINT *, "dvar is: ", dvar
END DO
! Pointer to INTEGER DO variable
ALLOCATE(pivar)
DO pivar = 1, 10, 3
PRINT *, "pivar is: ", pivar
END DO
! Pointer to REAL DO variable
ALLOCATE(prvar)
!ERROR: DO controls should be INTEGER
DO prvar = 1, 10, 3
PRINT *, "prvar is: ", prvar
END DO
! Pointer to DOUBLE PRECISION DO variable
ALLOCATE(pdvar)
!ERROR: DO controls should be INTEGER
DO pdvar = 1, 10, 3
PRINT *, "pdvar is: ", pdvar
END DO
! CHARACTER DO variable
!ERROR: DO controls should be INTEGER
DO chvar = 1, 10, 3
PRINT *, "chvar is: ", chvar
END DO
! LOGICAL DO variable
!ERROR: DO controls should be INTEGER
DO lvar = 1, 10, 3
PRINT *, "lvar is: ", lvar
END DO
! COMPLEX DO variable
!ERROR: DO controls should be INTEGER
DO cvar = 1, 10, 3
PRINT *, "cvar is: ", cvar
END DO
! Derived type DO variable
!ERROR: DO controls should be INTEGER
DO devar = 1, 10, 3
PRINT *, "devar is: ", devar
END DO
! Pointer to LOGICAL DO variable
ALLOCATE(plvar)
!ERROR: DO controls should be INTEGER
DO plvar = 1, 10, 3
PRINT *, "plvar is: ", plvar
END DO
! Initial expressions
! REAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = rvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION initial expression
!ERROR: DO controls should be INTEGER
DO ivar = dvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER initial expression
DO ivar = pivar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = prvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION initial expression
!ERROR: DO controls should be INTEGER
DO ivar = pdvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! LOGICAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = lvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX initial expression
!ERROR: DO controls should be INTEGER
DO ivar = cvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Derived type initial expression
!ERROR: DO controls should be INTEGER
DO ivar = devar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to LOGICAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = plvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Final expression
! REAL final expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, rvar, 3
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION final expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, dvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER final expression
DO ivar = 1, pivar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL final expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, prvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION final expression
!ERROR: DO controls should be INTEGER
DO ivar = pdvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX final expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, cvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Step expression
! REAL step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, rvar
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, dvar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER step expression
DO ivar = 1, 10, pivar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, prvar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, pdvar
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX Step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, cvar
PRINT *, "ivar is: ", ivar
END DO
! Array DO variable
!ERROR: Must be a scalar value, but is a rank-1 array
DO avar = 1, 10, 3
PRINT *, "plvar is: ", plvar
END DO
END PROGRAM do_issue_458

233
flang/test/semantics/dosemantics04.f90 Normal file
View File

@ -0,0 +1,233 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
! Issue 458 -- semantic checks for a normal DO loop. The DO variable
! and the initial, final, and step expressions must be INTEGER if the
! options for standard conformance and turning warnings into errors
! are both in effect. This test turns on the options for standards
! conformance and turning warnings into errors. This produces error
! messages for the cases where REAL and DOUBLE PRECISION variables
! and expressions are used in the DO controls.
!
! This test is just like dosemantics03.f90 but without the options
! to produce error messages when using REAL and DOUBLE PRECISION DO
! loop controls.
! RUN: ${F18} -funparse-with-symbols %s 2>&1 | ${FileCheck} %s
PROGRAM do_issue_458
IMPLICIT NONE
INTEGER :: ivar
REAL :: rvar
DOUBLE PRECISION :: dvar
LOGICAL :: lvar
COMPLEX :: cvar
CHARACTER :: chvar
INTEGER, DIMENSION(3) :: avar
TYPE derived
REAL :: first
INTEGER :: second
END TYPE derived
TYPE(derived) :: devar
INTEGER, POINTER :: pivar
REAL, POINTER :: prvar
DOUBLE PRECISION, POINTER :: pdvar
LOGICAL, POINTER :: plvar
! DO variables
! INTEGER DO variable
DO ivar = 1, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! REAL DO variable
DO rvar = 1, 10, 3
PRINT *, "rvar is: ", rvar
END DO
! DOUBLE PRECISISON DO variable
DO dvar = 1, 10, 3
PRINT *, "dvar is: ", dvar
END DO
! Pointer to INTEGER DO variable
ALLOCATE(pivar)
DO pivar = 1, 10, 3
PRINT *, "pivar is: ", pivar
END DO
! Pointer to REAL DO variable
ALLOCATE(prvar)
DO prvar = 1, 10, 3
PRINT *, "prvar is: ", prvar
END DO
! Pointer to DOUBLE PRECISION DO variable
ALLOCATE(pdvar)
DO pdvar = 1, 10, 3
PRINT *, "pdvar is: ", pdvar
END DO
! CHARACTER DO variable
!ERROR: DO controls should be INTEGER
DO chvar = 1, 10, 3
PRINT *, "chvar is: ", chvar
END DO
! LOGICAL DO variable
!ERROR: DO controls should be INTEGER
DO lvar = 1, 10, 3
PRINT *, "lvar is: ", lvar
END DO
! COMPLEX DO variable
!ERROR: DO controls should be INTEGER
DO cvar = 1, 10, 3
PRINT *, "cvar is: ", cvar
END DO
! Derived type DO variable
!ERROR: DO controls should be INTEGER
DO devar = 1, 10, 3
PRINT *, "devar is: ", devar
END DO
! Pointer to LOGICAL DO variable
ALLOCATE(plvar)
!ERROR: DO controls should be INTEGER
DO plvar = 1, 10, 3
PRINT *, "plvar is: ", plvar
END DO
! Initial expressions
! REAL initial expression
DO ivar = rvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION initial expression
DO ivar = dvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER initial expression
DO ivar = pivar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL initial expression
DO ivar = prvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION initial expression
DO ivar = pdvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! LOGICAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = lvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX initial expression
!ERROR: DO controls should be INTEGER
DO ivar = cvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Derived type initial expression
!ERROR: DO controls should be INTEGER
DO ivar = devar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to LOGICAL initial expression
!ERROR: DO controls should be INTEGER
DO ivar = plvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! Final expression
! REAL final expression
DO ivar = 1, rvar, 3
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION final expression
DO ivar = 1, dvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER final expression
DO ivar = 1, pivar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL final expression
DO ivar = 1, prvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION final expression
DO ivar = pdvar, 10, 3
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX final expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, cvar, 3
PRINT *, "ivar is: ", ivar
END DO
! Step expression
! REAL step expression
DO ivar = 1, 10, rvar
PRINT *, "ivar is: ", ivar
END DO
! DOUBLE PRECISION step expression
DO ivar = 1, 10, dvar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to INTEGER step expression
DO ivar = 1, 10, pivar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to REAL step expression
DO ivar = 1, 10, prvar
PRINT *, "ivar is: ", ivar
END DO
! Pointer to DOUBLE PRECISION step expression
DO ivar = 1, 10, pdvar
PRINT *, "ivar is: ", ivar
END DO
! COMPLEX Step expression
!ERROR: DO controls should be INTEGER
DO ivar = 1, 10, cvar
PRINT *, "ivar is: ", ivar
END DO
! Array DO variable
!ERROR: Must be a scalar value, but is a rank-1 array
DO avar = 1, 10, 3
PRINT *, "plvar is: ", plvar
END DO
END PROGRAM do_issue_458

6
flang/test/semantics/test_errors.sh
View File

@ -36,8 +36,12 @@ log=$temp/log
actual=$temp/actual
expect=$temp/expect
diffs=$temp/diffs
options=$temp/options
cmd="$CMD $src"
# See if there are additional options
awk '/^ *!OPTIONS: / {gsub (/^! OPTIONS: /, " " ); print}' $src > $options
cmd="$CMD `cat $options` $src"
( cd $temp; $cmd ) > $log 2>&1
if [[ $? -ge 128 ]]; then
cat $log