diff --git a/flang/runtime/transformational.cpp b/flang/runtime/transformational.cpp --- a/flang/runtime/transformational.cpp +++ b/flang/runtime/transformational.cpp @@ -377,7 +377,9 @@ for (SubscriptValue j{0}; j < resultRank; ++j, ++shapeSubscript) { resultExtent[j] = GetInt64( shape.Element(&shapeSubscript), shapeElementBytes, terminator); - RUNTIME_CHECK(terminator, resultExtent[j] >= 0); + if (resultExtent[j] < 0) + terminator.Crash( + "RESHAPE: bad value for SHAPE(%d)=%d", j + 1, resultExtent[j]); resultElements *= resultExtent[j]; } @@ -387,7 +389,9 @@ std::size_t sourceElements{source.Elements()}; std::size_t padElements{pad ? pad->Elements() : 0}; if (resultElements > sourceElements) { - RUNTIME_CHECK(terminator, padElements > 0); + if (padElements <= 0) + terminator.Crash("RESHAPE: not eough elements, need %d but only have %d", + resultElements, sourceElements); RUNTIME_CHECK(terminator, pad->ElementBytes() == elementBytes); } @@ -397,15 +401,18 @@ if (order) { RUNTIME_CHECK(terminator, order->rank() == 1); RUNTIME_CHECK(terminator, order->type().IsInteger()); - RUNTIME_CHECK(terminator, order->GetDimension(0).Extent() == resultRank); + if (order->GetDimension(0).Extent() != resultRank) + terminator.Crash("RESHAPE: the extent of ORDER (%d) must match the rank" + " of the SHAPE (%d)", + order->GetDimension(0).Extent(), resultRank); std::uint64_t values{0}; SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()}; std::size_t orderElementBytes{order->ElementBytes()}; for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) { auto k{GetInt64(order->Element(&orderSubscript), orderElementBytes, terminator)}; - RUNTIME_CHECK( - terminator, k >= 1 && k <= resultRank && !((values >> k) & 1)); + if (k < 1 || k > resultRank || ((values >> k) & 1)) + terminator.Crash("RESHAPE: bad value for ORDER element (%d)", k); values |= std::uint64_t{1} << k; dimOrder[j] = k - 1; } diff --git a/flang/test/Semantics/reshape.f90 b/flang/test/Semantics/reshape.f90 --- a/flang/test/Semantics/reshape.f90 +++ b/flang/test/Semantics/reshape.f90 @@ -35,6 +35,8 @@ 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]) + integer, parameter, dimension(2,2) :: bad_order = reshape([1, 2, 3, 4], [2,2]) + real :: array20(2,3) ! Implicit reshape of array of components type :: dType integer :: field(2) @@ -47,4 +49,6 @@ [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])) + !ERROR: 'order=' argument has unacceptable rank 2 + array20 = RESHAPE([(n, n = 1, 4)], [2, 3], order = bad_order) end program reshaper