#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"
// gets re-folded.
template <typename T> Expr<T> MakeInvalidIntrinsic(FunctionRef<T> &&funcRef) {
SpecificIntrinsic invalid{std::get<SpecificIntrinsic>(funcRef.proc().u)};
- invalid.name = "(invalid intrinsic function call)";
+ invalid.name = IntrinsicProcTable::InvalidName;
return Expr<T>{FunctionRef<T>{ProcedureDesignator{std::move(invalid)},
- ActualArguments{ActualArgument{AsGenericExpr(std::move(funcRef))}}}};
+ ActualArguments{std::move(funcRef.arguments())}}};
}
template <typename T> Expr<T> Folder<T>::Reshape(FunctionRef<T> &&funcRef) {
std::optional<std::vector<int>> order{GetIntegerVector<int>(args[3])};
if (!source || !shape || (args[2] && !pad) || (args[3] && !order)) {
return Expr<T>{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())};
}
std::vector<int> *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<T> result{!source->empty()
+ Constant<T> result{!source->empty() || !pad
? source->Reshape(std::move(shape.value()))
: pad->Reshape(std::move(shape.value()))};
ConstantSubscripts subscripts{result.lbounds()};
--- /dev/null
+! 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