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

[flang] Fix some bugs exposed by testing new checks 

Original-commit: flang-compiler/f18@9cc70dcad6
Reviewed-on: https://github.com/flang-compiler/f18/pull/782
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-10-16 09:39:37 -07:00
parent 4c37c06597
commit 3a4091b5e3
3 changed files with 57 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
flang/lib/evaluate/fold.cc
View File

@ -412,7 +412,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
if (int rank{array->Rank()}; rank > 0) {
std::optional<int> dim;
if (args[1].has_value()) {
if (funcRef.Rank() == 0) {
// Optional DIM= argument is present: result is scalar.
if (auto dim64{GetInt64Arg(args[1])}) {
if (*dim64 < 1 || *dim64 > rank) {
@ -467,7 +467,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
if (int rank{array->Rank()}; rank > 0) {
std::optional<int> dim;
if (args[1].has_value()) {
if (funcRef.Rank() == 0) {
// Optional DIM= argument is present: result is scalar.
if (auto dim64{GetInt64Arg(args[1])}) {
if (*dim64 < 1 || *dim64 > rank) {

15
flang/lib/evaluate/shape.cc
View File

@ -477,10 +477,21 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
} else if (intrinsic->name == "reshape") {
if (call.arguments().size() >= 2 && call.arguments().at(1).has_value()) {
// SHAPE(RESHAPE(array,shape)) -> shape
const auto *shapeExpr{call.arguments().at(1).value().UnwrapExpr()};
auto shape{std::get<Expr<SomeInteger>>(DEREF(shapeExpr).u)};
if (const auto *shapeExpr{
call.arguments().at(1).value().UnwrapExpr()}) {
auto shape{std::get<Expr<SomeInteger>>(shapeExpr->u)};
return AsShape(context_, ConvertToType<ExtentType>(std::move(shape)));
}
}
} else if (intrinsic->name == "transpose") {
if (call.arguments().size() >= 1) {
if (auto shape{(*this)(call.arguments().at(0))}) {
if (shape->size() == 2) {
std::swap((*shape)[0], (*shape)[1]);
return shape;
}
}
}
} else if (intrinsic->characteristics.value().attrs.test(characteristics::
Procedure::Attr::NullPointer)) { // NULL(MOLD=)
return (*this)(call.arguments());

46
flang/lib/semantics/check-call.cc
View File

@ -307,14 +307,17 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
const Scope &scope) {
auto &messages{context.messages()};
if (const auto *object{
std::get_if<characteristics::DummyDataObject>(&dummy.u)}) {
std::visit(
common::visitors{
[&](const characteristics::DummyDataObject &object) {
if (const auto *expr{arg.UnwrapExpr()}) {
if (auto type{
characteristics::TypeAndShape::Characterize(*expr, context)}) {
CheckExplicitDataArg(*object, *expr, *type, proc, context, scope);
} else if (object->type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(expr->u)) {
if (auto type{characteristics::TypeAndShape::Characterize(
*expr, context)}) {
CheckExplicitDataArg(
object, *expr, *type, proc, context, scope);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
std::holds_alternative<evaluate::BOZLiteralConstant>(
expr->u)) {
// ok
} else {
messages.Say(
@ -322,7 +325,7 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
}
} else if (const Symbol * assumed{arg.GetAssumedTypeDummy()}) {
// An assumed-type dummy is being forwarded.
if (!object->type.type().IsAssumedType()) {
if (!object.type.type().IsAssumedType()) {
messages.Say(
"Assumed-type TYPE(*) '%s' may be associated only with an assumed-TYPE(*) dummy argument"_err_en_US,
assumed->name());
@ -331,10 +334,13 @@ static void CheckExplicitInterfaceArg(const evaluate::ActualArgument &arg,
messages.Say(
"Actual argument is not an expression or variable"_err_en_US);
}
} else {
},
[](const auto &) {
// TODO check actual procedure compatibility
// TODO check alternate return
}
},
},
dummy.u);
}
static void RearrangeArguments(const characteristics::Procedure &proc,
@ -427,26 +433,20 @@ void CheckArguments(const characteristics::Procedure &proc,
bool explicitInterface{proc.HasExplicitInterface()};
if (explicitInterface) {
auto buffer{CheckExplicitInterface(proc, actuals, context, scope)};
if (treatingExternalAsImplicit && !buffer.empty()) {
if (auto *msg{context.messages().Say(
"Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
buffer.AttachTo(*msg);
}
}
if (auto *msgs{context.messages().messages()}) {
msgs->Merge(std::move(buffer));
}
}
if (!explicitInterface || treatingExternalAsImplicit) {
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
for (auto &actual : actuals) {
if (actual.has_value()) {
CheckImplicitInterfaceArg(*actual, messages);
}
}
if (!buffer.empty()) {
if (treatingExternalAsImplicit) {
if (auto *msg{context.messages().Say(
"Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
buffer.AttachTo(*msg);
}
} else if (auto *msgs{context.messages().messages()}) {
msgs->Merge(std::move(buffer));
CheckImplicitInterfaceArg(*actual, context.messages());
}
}
}