@@ -31,7 +31,7 @@ class ShiftControl {
3131public:
3232 ShiftControl (const Descriptor &s, Terminator &t, int dim)
3333 : shift_{s}, terminator_{t}, shiftRank_{s.rank ()}, dim_{dim} {}
34- void Init (const Descriptor &source) {
34+ void Init (const Descriptor &source, const char *which ) {
3535 int rank{source.rank ()};
3636 RUNTIME_CHECK (terminator_, shiftRank_ == 0 || shiftRank_ == rank - 1 );
3737 auto catAndKind{shift_.type ().GetCategoryAndKind ()};
@@ -44,8 +44,12 @@ class ShiftControl {
4444 if (j + 1 != dim_) {
4545 const Dimension &shiftDim{shift_.GetDimension (k)};
4646 lb_[k++] = shiftDim.LowerBound ();
47- RUNTIME_CHECK (terminator_,
48- shiftDim.Extent () == source.GetDimension (j).Extent ());
47+ if (shiftDim.Extent () != source.GetDimension (j).Extent ()) {
48+ terminator_.Crash (" %s: on dimension %d, SHIFT= has extent %jd but "
49+ " SOURCE= has extent %jd" ,
50+ which, k, static_cast <std::intmax_t >(shiftDim.Extent ()),
51+ static_cast <std::intmax_t >(source.GetDimension (j).Extent ()));
52+ }
4953 }
5054 }
5155 } else {
@@ -137,9 +141,12 @@ void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
137141 Terminator terminator{sourceFile, line};
138142 int rank{source.rank ()};
139143 RUNTIME_CHECK (terminator, rank > 1 );
140- RUNTIME_CHECK (terminator, dim >= 1 && dim <= rank);
144+ if (dim < 1 || dim > rank) {
145+ terminator.Crash (
146+ " CSHIFT: DIM=%d must be >= 1 and <= SOURCE= rank %d" , dim, rank);
147+ }
141148 ShiftControl shiftControl{shift, terminator, dim};
142- shiftControl.Init (source);
149+ shiftControl.Init (source, " CSHIFT " );
143150 SubscriptValue extent[maxRank];
144151 source.GetShape (extent);
145152 AllocateResult (result, source, rank, extent, terminator, " CSHIFT" );
@@ -200,29 +207,39 @@ void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
200207 SubscriptValue extent[maxRank];
201208 int rank{source.GetShape (extent)};
202209 RUNTIME_CHECK (terminator, rank > 1 );
203- RUNTIME_CHECK (terminator, dim >= 1 && dim <= rank);
210+ if (dim < 1 || dim > rank) {
211+ terminator.Crash (
212+ " EOSHIFT: DIM=%d must be >= 1 and <= SOURCE= rank %d" , dim, rank);
213+ }
204214 std::size_t elementLen{
205215 AllocateResult (result, source, rank, extent, terminator, " EOSHIFT" )};
206216 int boundaryRank{-1 };
207217 if (boundary) {
208218 boundaryRank = boundary->rank ();
209219 RUNTIME_CHECK (terminator, boundaryRank == 0 || boundaryRank == rank - 1 );
210- RUNTIME_CHECK (terminator,
211- boundary->type () == source.type () &&
212- boundary->ElementBytes () == elementLen);
220+ RUNTIME_CHECK (terminator, boundary->type () == source.type ());
221+ if (boundary->ElementBytes () != elementLen) {
222+ terminator.Crash (" EOSHIFT: BOUNDARY= has element byte length %zd, but "
223+ " SOURCE= has length %zd" ,
224+ boundary->ElementBytes (), elementLen);
225+ }
213226 if (boundaryRank > 0 ) {
214227 int k{0 };
215228 for (int j{0 }; j < rank; ++j) {
216229 if (j != dim - 1 ) {
217- RUNTIME_CHECK (
218- terminator, boundary->GetDimension (k).Extent () == extent[j]);
230+ if (boundary->GetDimension (k).Extent () != extent[j]) {
231+ terminator.Crash (" EOSHIFT: BOUNDARY= has extent %jd on dimension "
232+ " %d but must conform with extent %jd of SOURCE=" ,
233+ static_cast <std::intmax_t >(boundary->GetDimension (k).Extent ()),
234+ k + 1 , static_cast <std::intmax_t >(extent[j]));
235+ }
219236 ++k;
220237 }
221238 }
222239 }
223240 }
224241 ShiftControl shiftControl{shift, terminator, dim};
225- shiftControl.Init (source);
242+ shiftControl.Init (source, " EOSHIFT " );
226243 SubscriptValue resultAt[maxRank];
227244 for (int j{0 }; j < rank; ++j) {
228245 resultAt[j] = 1 ;
@@ -273,9 +290,12 @@ void RTNAME(EoshiftVector)(Descriptor &result, const Descriptor &source,
273290 AllocateResult (result, source, 1 , &extent, terminator, " EOSHIFT" )};
274291 if (boundary) {
275292 RUNTIME_CHECK (terminator, boundary->rank () == 0 );
276- RUNTIME_CHECK (terminator,
277- boundary->type () == source.type () &&
278- boundary->ElementBytes () == elementLen);
293+ RUNTIME_CHECK (terminator, boundary->type () == source.type ());
294+ if (boundary->ElementBytes () != elementLen) {
295+ terminator.Crash (" EOSHIFT: BOUNDARY= has element byte length %zd but "
296+ " SOURCE= has length %zd" ,
297+ boundary->ElementBytes (), elementLen);
298+ }
279299 }
280300 if (!boundary) {
281301 DefaultInitialize (result, terminator);
@@ -318,11 +338,19 @@ void RTNAME(Pack)(Descriptor &result, const Descriptor &source,
318338 SubscriptValue extent{trues};
319339 if (vector) {
320340 RUNTIME_CHECK (terminator, vector->rank () == 1 );
321- RUNTIME_CHECK (terminator,
322- source.type () == vector->type () &&
323- source.ElementBytes () == vector->ElementBytes ());
341+ RUNTIME_CHECK (terminator, source.type () == vector->type ());
342+ if (source.ElementBytes () != vector->ElementBytes ()) {
343+ terminator.Crash (" PACK: SOURCE= has element byte length %zd, but VECTOR= "
344+ " has length %zd" ,
345+ source.ElementBytes (), vector->ElementBytes ());
346+ }
324347 extent = vector->GetDimension (0 ).Extent ();
325- RUNTIME_CHECK (terminator, extent >= trues);
348+ if (extent < trues) {
349+ terminator.Crash (" PACK: VECTOR= has extent %jd but there are %jd MASK= "
350+ " elements that are .TRUE." ,
351+ static_cast <std::intmax_t >(extent),
352+ static_cast <std::intmax_t >(trues));
353+ }
326354 }
327355 AllocateResult (result, source, 1 , &extent, terminator, " PACK" );
328356 SubscriptValue sourceAt[maxRank], resultAt{1 };
@@ -366,20 +394,24 @@ void RTNAME(Reshape)(Descriptor &result, const Descriptor &source,
366394 RUNTIME_CHECK (terminator, shape.rank () == 1 );
367395 RUNTIME_CHECK (terminator, shape.type ().IsInteger ());
368396 SubscriptValue resultRank{shape.GetDimension (0 ).Extent ()};
369- RUNTIME_CHECK (terminator,
370- resultRank >= 0 && resultRank <= static_cast <SubscriptValue>(maxRank));
397+ if (resultRank < 0 || resultRank > static_cast <SubscriptValue>(maxRank)) {
398+ terminator.Crash (
399+ " RESHAPE: SHAPE= vector length %jd implies a bad result rank" ,
400+ static_cast <std::intmax_t >(resultRank));
401+ }
371402
372403 // Extract and check the shape of the result; compute its element count.
373404 SubscriptValue resultExtent[maxRank];
374405 std::size_t shapeElementBytes{shape.ElementBytes ()};
375406 std::size_t resultElements{1 };
376407 SubscriptValue shapeSubscript{shape.GetDimension (0 ).LowerBound ()};
377- for (SubscriptValue j{0 }; j < resultRank; ++j, ++shapeSubscript) {
408+ for (int j{0 }; j < resultRank; ++j, ++shapeSubscript) {
378409 resultExtent[j] = GetInt64 (
379410 shape.Element <char >(&shapeSubscript), shapeElementBytes, terminator);
380- if (resultExtent[j] < 0 )
381- terminator.Crash (
382- " RESHAPE: bad value for SHAPE(%d)=%d" , j + 1 , resultExtent[j]);
411+ if (resultExtent[j] < 0 ) {
412+ terminator.Crash (" RESHAPE: bad value for SHAPE(%d)=%jd" , j + 1 ,
413+ static_cast <std::intmax_t >(resultExtent[j]));
414+ }
383415 resultElements *= resultExtent[j];
384416 }
385417
@@ -389,10 +421,16 @@ void RTNAME(Reshape)(Descriptor &result, const Descriptor &source,
389421 std::size_t sourceElements{source.Elements ()};
390422 std::size_t padElements{pad ? pad->Elements () : 0 };
391423 if (resultElements > sourceElements) {
392- if (padElements <= 0 )
393- terminator.Crash (" RESHAPE: not eough elements, need %d but only have %d" ,
424+ if (padElements <= 0 ) {
425+ terminator.Crash (
426+ " RESHAPE: not enough elements, need %zd but only have %zd" ,
394427 resultElements, sourceElements);
395- RUNTIME_CHECK (terminator, pad->ElementBytes () == elementBytes);
428+ }
429+ if (pad->ElementBytes () != elementBytes) {
430+ terminator.Crash (" RESHAPE: PAD= has element byte length %zd but SOURCE= "
431+ " has length %zd" ,
432+ pad->ElementBytes (), elementBytes);
433+ }
396434 }
397435
398436 // Extract and check the optional ORDER= argument, which must be a
@@ -401,18 +439,22 @@ void RTNAME(Reshape)(Descriptor &result, const Descriptor &source,
401439 if (order) {
402440 RUNTIME_CHECK (terminator, order->rank () == 1 );
403441 RUNTIME_CHECK (terminator, order->type ().IsInteger ());
404- if (order->GetDimension (0 ).Extent () != resultRank)
405- terminator.Crash (" RESHAPE: the extent of ORDER (%d ) must match the rank"
442+ if (order->GetDimension (0 ).Extent () != resultRank) {
443+ terminator.Crash (" RESHAPE: the extent of ORDER (%jd ) must match the rank"
406444 " of the SHAPE (%d)" ,
407- order->GetDimension (0 ).Extent (), resultRank);
445+ static_cast <std::intmax_t >(order->GetDimension (0 ).Extent ()),
446+ resultRank);
447+ }
408448 std::uint64_t values{0 };
409449 SubscriptValue orderSubscript{order->GetDimension (0 ).LowerBound ()};
410450 std::size_t orderElementBytes{order->ElementBytes ()};
411451 for (SubscriptValue j{0 }; j < resultRank; ++j, ++orderSubscript) {
412452 auto k{GetInt64 (order->Element <char >(&orderSubscript), orderElementBytes,
413453 terminator)};
414- if (k < 1 || k > resultRank || ((values >> k) & 1 ))
415- terminator.Crash (" RESHAPE: bad value for ORDER element (%d)" , k);
454+ if (k < 1 || k > resultRank || ((values >> k) & 1 )) {
455+ terminator.Crash (" RESHAPE: bad value for ORDER element (%jd)" ,
456+ static_cast <std::intmax_t >(k));
457+ }
416458 values |= std::uint64_t {1 } << k;
417459 dimOrder[j] = k - 1 ;
418460 }
@@ -516,8 +558,12 @@ void RTNAME(Unpack)(Descriptor &result, const Descriptor &vector,
516558 CheckConformability (mask, field, terminator, " UNPACK" , " MASK=" , " FIELD=" );
517559 std::size_t elementLen{
518560 AllocateResult (result, field, rank, extent, terminator, " UNPACK" )};
519- RUNTIME_CHECK (terminator,
520- vector.type () == field.type () && vector.ElementBytes () == elementLen);
561+ RUNTIME_CHECK (terminator, vector.type () == field.type ());
562+ if (vector.ElementBytes () != elementLen) {
563+ terminator.Crash (
564+ " UNPACK: VECTOR= has element byte length %zd but FIELD= has length %zd" ,
565+ vector.ElementBytes (), elementLen);
566+ }
521567 SubscriptValue resultAt[maxRank], maskAt[maxRank], fieldAt[maxRank],
522568 vectorAt{vector.GetDimension (0 ).LowerBound ()};
523569 for (int j{0 }; j < rank; ++j) {
0 commit comments