From 2cf52504bb076d24c23f161e92340828052b69f7 Mon Sep 17 00:00:00 2001 From: Peter Steinfeld Date: Wed, 29 Jul 2020 14:46:36 -0700 Subject: [PATCH] [flang] Fixes for RESHAPE() I fixed an assert caused by passing an empty array as the source= argument to RESHAPE(). In the process, I noticed that there were no tests for RESHAPE(), so I wrote a test that covers all the description in 16.9.163. In the process, I made the error messages more consistent and descriptive. I also changed the test to see if a reference to an intrinsic function was a constant to say that it is a constant if it's a refererence to an invalid intrinsic. This avoids emitting multiple messages for the same erroneous source. Differential Revision: https://reviews.llvm.org/D84904 --- flang/include/flang/Evaluate/constant.h | 2 +- flang/include/flang/Evaluate/intrinsics.h | 5 ++++ flang/lib/Evaluate/check-expression.cpp | 5 +++- flang/lib/Evaluate/constant.cpp | 6 ++-- flang/lib/Evaluate/fold-implementation.h | 23 +++++++++----- flang/lib/Evaluate/intrinsics.cpp | 6 +++- flang/test/Semantics/reshape.f90 | 50 +++++++++++++++++++++++++++++++ 7 files changed, 83 insertions(+), 14 deletions(-) create mode 100644 flang/test/Semantics/reshape.f90 diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h index 1617bdd..a25916f 100644 --- a/flang/include/flang/Evaluate/constant.h +++ b/flang/include/flang/Evaluate/constant.h @@ -54,7 +54,7 @@ std::size_t TotalElementCount(const ConstantSubscripts &); std::optional> ValidateDimensionOrder( int rank, const std::vector &order); -bool IsValidShape(const ConstantSubscripts &); +bool HasNegativeExtent(const ConstantSubscripts &); class ConstantBounds { public: diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h index 50212a1..09f5691 100644 --- a/flang/include/flang/Evaluate/intrinsics.h +++ b/flang/include/flang/Evaluate/intrinsics.h @@ -92,6 +92,11 @@ public: std::optional IsSpecificIntrinsicFunction( const std::string &) const; + // Illegal name for an intrinsic used to avoid cascading error messages when + // constant folding. + static const inline std::string InvalidName{ + "(invalid intrinsic function call)"}; + llvm::raw_ostream &Dump(llvm::raw_ostream &) const; private: diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 9ac1a12..a7cc094 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -43,7 +43,10 @@ public: } template bool operator()(const FunctionRef &call) const { if (const auto *intrinsic{std::get_if(&call.proc().u)}) { - return intrinsic->name == "kind"; + // kind is always a constant, and we avoid cascading errors by calling + // invalid calls to intrinsics constant + return intrinsic->name == "kind" || + intrinsic->name == IntrinsicProcTable::InvalidName; // TODO: other inquiry intrinsics } else { return false; diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp index e749763..5b73979 100644 --- a/flang/lib/Evaluate/constant.cpp +++ b/flang/lib/Evaluate/constant.cpp @@ -93,13 +93,13 @@ std::optional> ValidateDimensionOrder( } } -bool IsValidShape(const ConstantSubscripts &shape) { +bool HasNegativeExtent(const ConstantSubscripts &shape) { for (ConstantSubscript extent : shape) { if (extent < 0) { - return false; + return true; } } - return shape.size() <= common::maxRank; + return false; } template diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h index 85e3561..ebe826f 100644 --- a/flang/lib/Evaluate/fold-implementation.h +++ b/flang/lib/Evaluate/fold-implementation.h @@ -22,6 +22,7 @@ #include "flang/Evaluate/expression.h" #include "flang/Evaluate/fold.h" #include "flang/Evaluate/formatting.h" +#include "flang/Evaluate/intrinsics.h" #include "flang/Evaluate/shape.h" #include "flang/Evaluate/tools.h" #include "flang/Evaluate/traverse.h" @@ -600,9 +601,9 @@ std::optional> GetIntegerVector(const B &x) { // gets re-folded. template Expr MakeInvalidIntrinsic(FunctionRef &&funcRef) { SpecificIntrinsic invalid{std::get(funcRef.proc().u)}; - invalid.name = "(invalid intrinsic function call)"; + invalid.name = IntrinsicProcTable::InvalidName; return Expr{FunctionRef{ProcedureDesignator{std::move(invalid)}, - ActualArguments{ActualArgument{AsGenericExpr(std::move(funcRef))}}}}; + ActualArguments{std::move(funcRef.arguments())}}}; } template Expr Folder::Reshape(FunctionRef &&funcRef) { @@ -615,8 +616,13 @@ template Expr Folder::Reshape(FunctionRef &&funcRef) { std::optional> order{GetIntegerVector(args[3])}; if (!source || !shape || (args[2] && !pad) || (args[3] && !order)) { return Expr{std::move(funcRef)}; // Non-constant arguments - } else if (!IsValidShape(shape.value())) { - context_.messages().Say("Invalid SHAPE in RESHAPE"_en_US); + } else if (shape.value().size() > common::maxRank) { + context_.messages().Say( + "Size of 'shape=' argument must not be greater than %d"_err_en_US, + common::maxRank); + } else if (HasNegativeExtent(shape.value())) { + context_.messages().Say( + "'shape=' argument must not have a negative extent"_err_en_US); } else { int rank{GetRank(shape.value())}; std::size_t resultElements{TotalElementCount(shape.value())}; @@ -626,12 +632,13 @@ template Expr Folder::Reshape(FunctionRef &&funcRef) { } std::vector *dimOrderPtr{dimOrder ? &dimOrder.value() : nullptr}; if (order && !dimOrder) { - context_.messages().Say("Invalid ORDER in RESHAPE"_en_US); + context_.messages().Say("Invalid 'order=' argument in RESHAPE"_err_en_US); } else if (resultElements > source->size() && (!pad || pad->empty())) { - context_.messages().Say("Too few SOURCE elements in RESHAPE and PAD" - "is not present or has null size"_en_US); + context_.messages().Say( + "Too few elements in 'source=' argument and 'pad=' " + "argument is not present or has null size"_err_en_US); } else { - Constant result{!source->empty() + Constant result{!source->empty() || !pad ? source->Reshape(std::move(shape.value())) : pad->Reshape(std::move(shape.value()))}; ConstantSubscripts subscripts{result.lbounds()}; diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 0ad5c19..35a69e4 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -1258,7 +1258,11 @@ std::optional IntrinsicInterface::Match( break; case Rank::shape: CHECK(!shapeArgSize); - if (rank == 1) { + if (rank != 1) { + messages.Say( + "'shape=' argument must be an array of rank 1"_err_en_US); + return std::nullopt; + } else { if (auto shape{GetShape(context, *arg)}) { if (auto constShape{AsConstantShape(context, *shape)}) { shapeArgSize = constShape->At(ConstantSubscripts{1}).ToInt64(); diff --git a/flang/test/Semantics/reshape.f90 b/flang/test/Semantics/reshape.f90 new file mode 100644 index 0000000..7749df6 --- /dev/null +++ b/flang/test/Semantics/reshape.f90 @@ -0,0 +1,50 @@ +! RUN: %S/test_errors.sh %s %t %f18 + +!Tests for RESHAPE +program reshaper + ! RESHAPE with arguments SOURCE and SHAPE + integer, parameter :: array1(2,3) = RESHAPE([(n, n=1,6)], [2,3]) + ! RESHAPE with arguments SOURCE, SHAPE, and PAD + integer :: array2(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99]) + ! RESHAPE with arguments SOURCE, SHAPE, PAD, and ORDER + integer :: array3(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99], [2, 1]) + !ERROR: Too few elements in 'source=' argument and 'pad=' argument is not present or has null size + integer :: array4(2,3) = RESHAPE([(n, n=1,5)], [2,3]) + !ERROR: Actual argument for 'shape=' has bad type 'REAL(4)' + integer :: array5(2,3) = RESHAPE([(n, n=1,6)], [2.2,3.3]) + !ERROR: 'shape=' argument must be an array of rank 1 + integer :: array6(2,3) = RESHAPE([(n, n=1,6)], RESHAPE([(n, n=1,6)], [2,3])) + !ERROR: 'shape=' argument must be an array of rank 1 + integer :: array7(2,3) = RESHAPE([(n, n=1,4)], 343) + !ERROR: Actual argument for 'pad=' has bad type or kind 'INTEGER(8)' + integer :: array8(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99_8]) + !ERROR: Actual argument for 'pad=' has bad type or kind 'REAL(4)' + real :: array9(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99.9]) + !ERROR: Invalid 'order=' argument in RESHAPE + real :: array10(2,3) = RESHAPE([(n,n=1,4)],[2,3],[99],[2,3]) + !ERROR: Actual argument for 'order=' has bad type 'REAL(4)' + real :: array11(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99], [2.2,3.3]) + !ERROR: Invalid 'order=' argument in RESHAPE + real :: array12(2,3) = RESHAPE([(n, n=1,4)], [2,3], [99], [1]) + !ERROR: Invalid 'order=' argument in RESHAPE + real :: array13(2,3) = RESHAPE([(n, n = 1, 4)], [2, 3], [99], [1, 1]) + + ! Examples that have caused problems + integer :: array14(0,0,0) = RESHAPE([(n,n=1,0)],[0,0,0]) + integer, parameter :: array15(1) = RESHAPE([(n,n=1,2)],[1]) + integer, parameter :: array16(1) = RESHAPE([(n,n=1,8)],[1], [0], array15) + integer, parameter, dimension(3,4) :: array17 = 3 + integer, parameter, dimension(3,4) :: array18 = RESHAPE(array17, [3,4]) + ! Implicit reshape of array of components + type :: dType + integer :: field(2) + end type dType + type(dType), parameter :: array19(*) = [dType::dType(field=[1,2])] + logical, parameter :: lVar = all(array19(:)%field(1) == [2]) + + !ERROR: Size of 'shape=' argument must not be greater than 15 + CALL ext_sub(RESHAPE([(n, n=1,20)], & + [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1])) + !ERROR: 'shape=' argument must not have a negative extent + CALL ext_sub(RESHAPE([(n, n=1,20)], [1, -5, 3])) +end program reshaper -- 2.7.4