@@ -265,102 +265,42 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
265
265
}
266
266
}
267
267
268
- // Some subscript semantic checks must be deferred until all of the
269
- // subscripts are in hand.
270
- MaybeExpr ExpressionAnalyzer::CompleteSubscripts (ArrayRef &&ref) {
271
- const Symbol &symbol{ref.GetLastSymbol ().GetUltimate ()};
272
- int symbolRank{symbol.Rank ()};
273
- int subscripts{static_cast <int >(ref.size ())};
274
- if (subscripts == 0 ) {
275
- return std::nullopt; // error recovery
276
- } else if (subscripts != symbolRank) {
277
- if (symbolRank != 0 ) {
278
- Say (" Reference to rank-%d object '%s' has %d subscripts" _err_en_US,
279
- symbolRank, symbol.name (), subscripts);
280
- }
281
- return std::nullopt;
282
- } else if (symbol.has <semantics::ObjectEntityDetails>() ||
283
- symbol.has <semantics::AssocEntityDetails>()) {
284
- // C928 & C1002
285
- if (Triplet *last{std::get_if<Triplet>(&ref.subscript ().back ().u )}) {
286
- if (!last->upper () && IsAssumedSizeArray (symbol)) {
287
- Say (" Assumed-size array '%s' must have explicit final "
288
- " subscript upper bound value" _err_en_US,
289
- symbol.name ());
290
- return std::nullopt;
291
- }
292
- }
293
- } else {
294
- // Shouldn't get here from Analyze(ArrayElement) without a valid base,
295
- // which, if not an object, must be a construct entity from
296
- // SELECT TYPE/RANK or ASSOCIATE.
297
- CHECK (symbol.has <semantics::AssocEntityDetails>());
298
- }
299
- if (!semantics::IsNamedConstant (symbol) && !inDataStmtObject_) {
300
- // Subscripts of named constants are checked in folding.
301
- // Subscripts of DATA statement objects are checked in data statement
302
- // conversion to initializers.
303
- CheckSubscripts (ref);
304
- }
305
- return Designate (DataRef{std::move (ref)});
306
- }
307
-
308
- // Applies subscripts to a data reference.
309
- MaybeExpr ExpressionAnalyzer::ApplySubscripts (
310
- DataRef &&dataRef, std::vector<Subscript> &&subscripts) {
311
- if (subscripts.empty ()) {
312
- return std::nullopt; // error recovery
313
- }
314
- return common::visit (
315
- common::visitors{
316
- [&](SymbolRef &&symbol) {
317
- return CompleteSubscripts (ArrayRef{symbol, std::move (subscripts)});
318
- },
319
- [&](Component &&c) {
320
- return CompleteSubscripts (
321
- ArrayRef{std::move (c), std::move (subscripts)});
322
- },
323
- [&](auto &&) -> MaybeExpr {
324
- DIE (" bad base for ArrayRef" );
325
- return std::nullopt;
326
- },
327
- },
328
- std::move (dataRef.u ));
329
- }
330
-
331
- void ExpressionAnalyzer::CheckSubscripts (ArrayRef &ref) {
332
- // Fold subscript expressions and check for an empty triplet.
333
- const Symbol &arraySymbol{ref.base ().GetLastSymbol ()};
334
- Shape lb{GetLBOUNDs (foldingContext_, NamedEntity{arraySymbol})};
335
- CHECK (lb.size () >= ref.subscript ().size ());
336
- Shape ub{GetUBOUNDs (foldingContext_, NamedEntity{arraySymbol})};
337
- CHECK (ub.size () >= ref.subscript ().size ());
268
+ // Returns false if any dimension could be empty (e.g. A(1:0)) or has an error
269
+ static bool FoldSubscripts (semantics::SemanticsContext &context,
270
+ const Symbol &arraySymbol, std::vector<Subscript> &subscripts, Shape &lb,
271
+ Shape &ub) {
272
+ FoldingContext &foldingContext{context.foldingContext ()};
273
+ lb = GetLBOUNDs (foldingContext, NamedEntity{arraySymbol});
274
+ CHECK (lb.size () >= subscripts.size ());
275
+ ub = GetUBOUNDs (foldingContext, NamedEntity{arraySymbol});
276
+ CHECK (ub.size () >= subscripts.size ());
338
277
bool anyPossiblyEmptyDim{false };
339
278
int dim{0 };
340
- for (Subscript &ss : ref. subscript () ) {
279
+ for (Subscript &ss : subscripts ) {
341
280
if (Triplet * triplet{std::get_if<Triplet>(&ss.u )}) {
342
- auto expr{Fold (triplet->stride ())};
281
+ auto expr{Fold (foldingContext, triplet->stride ())};
343
282
auto stride{ToInt64 (expr)};
344
283
triplet->set_stride (std::move (expr));
345
284
std::optional<ConstantSubscript> lower, upper;
346
285
if (auto expr{triplet->lower ()}) {
347
- *expr = Fold (std::move (*expr));
286
+ *expr = Fold (foldingContext, std::move (*expr));
348
287
lower = ToInt64 (*expr);
349
288
triplet->set_lower (std::move (*expr));
350
289
} else {
351
290
lower = ToInt64 (lb[dim]);
352
291
}
353
292
if (auto expr{triplet->upper ()}) {
354
- *expr = Fold (std::move (*expr));
293
+ *expr = Fold (foldingContext, std::move (*expr));
355
294
upper = ToInt64 (*expr);
356
295
triplet->set_upper (std::move (*expr));
357
296
} else {
358
297
upper = ToInt64 (ub[dim]);
359
298
}
360
299
if (stride) {
361
300
if (*stride == 0 ) {
362
- Say (" Stride of triplet must not be zero" _err_en_US);
363
- return ;
301
+ foldingContext.messages ().Say (
302
+ " Stride of triplet must not be zero" _err_en_US);
303
+ return false ; // error
364
304
}
365
305
if (lower && upper) {
366
306
if (*stride > 0 ) {
@@ -380,21 +320,53 @@ void ExpressionAnalyzer::CheckSubscripts(ArrayRef &ref) {
380
320
}
381
321
} else { // not triplet
382
322
auto &expr{std::get<IndirectSubscriptIntegerExpr>(ss.u ).value ()};
383
- expr = Fold (std::move (expr));
323
+ expr = Fold (foldingContext, std::move (expr));
384
324
anyPossiblyEmptyDim |= expr.Rank () > 0 ; // vector subscript
385
325
}
386
326
++dim;
387
327
}
388
- if (anyPossiblyEmptyDim) {
389
- return ;
328
+ return !anyPossiblyEmptyDim;
329
+ }
330
+
331
+ static void ValidateSubscriptValue (parser::ContextualMessages &messages,
332
+ const Symbol &symbol, ConstantSubscript val,
333
+ std::optional<ConstantSubscript> lb, std::optional<ConstantSubscript> ub,
334
+ int dim, const char *co = " " ) {
335
+ std::optional<parser::MessageFixedText> msg;
336
+ std::optional<ConstantSubscript> bound;
337
+ if (lb && val < *lb) {
338
+ msg =
339
+ " %ssubscript %jd is less than lower %sbound %jd for %sdimension %d of array" _err_en_US;
340
+ bound = *lb;
341
+ } else if (ub && val > *ub) {
342
+ msg =
343
+ " %ssubscript %jd is greater than upper %sbound %jd for %sdimension %d of array" _err_en_US;
344
+ bound = *ub;
345
+ if (dim + 1 == symbol.Rank () && IsDummy (symbol) && *bound == 1 ) {
346
+ // Old-school overindexing of a dummy array isn't fatal when
347
+ // it's on the last dimension and the extent is 1.
348
+ msg->set_severity (parser::Severity::Warning);
349
+ }
350
+ }
351
+ if (msg) {
352
+ AttachDeclaration (
353
+ messages.Say (std::move (*msg), co, static_cast <std::intmax_t >(val), co,
354
+ static_cast <std::intmax_t >(bound.value ()), co, dim + 1 ),
355
+ symbol);
390
356
}
391
- dim = 0 ;
392
- for (Subscript &ss : ref.subscript ()) {
357
+ }
358
+
359
+ static void ValidateSubscripts (semantics::SemanticsContext &context,
360
+ const Symbol &arraySymbol, const std::vector<Subscript> &subscripts,
361
+ const Shape &lb, const Shape &ub) {
362
+ int dim{0 };
363
+ for (const Subscript &ss : subscripts) {
393
364
auto dimLB{ToInt64 (lb[dim])};
394
365
auto dimUB{ToInt64 (ub[dim])};
395
366
if (dimUB && dimLB && *dimUB < *dimLB) {
396
367
AttachDeclaration (
397
- Warn (common::UsageWarning::SubscriptedEmptyArray,
368
+ context.Warn (common::UsageWarning::SubscriptedEmptyArray,
369
+ context.foldingContext ().messages ().at (),
398
370
" Empty array dimension %d should not be subscripted as an element or non-empty array section" _err_en_US,
399
371
dim + 1 ),
400
372
arraySymbol);
@@ -429,35 +401,105 @@ void ExpressionAnalyzer::CheckSubscripts(ArrayRef &ref) {
429
401
}
430
402
for (int j{0 }; j < vals; ++j) {
431
403
if (val[j]) {
432
- std::optional<parser::MessageFixedText> msg;
433
- std::optional<ConstantSubscript> bound;
434
- if (dimLB && *val[j] < *dimLB) {
435
- msg =
436
- " Subscript %jd is less than lower bound %jd for dimension %d of array" _err_en_US;
437
- bound = *dimLB;
438
- } else if (dimUB && *val[j] > *dimUB) {
439
- msg =
440
- " Subscript %jd is greater than upper bound %jd for dimension %d of array" _err_en_US;
441
- bound = *dimUB;
442
- if (dim + 1 == arraySymbol.Rank () && IsDummy (arraySymbol) &&
443
- *bound == 1 ) {
444
- // Old-school overindexing of a dummy array isn't fatal when
445
- // it's on the last dimension and the extent is 1.
446
- msg->set_severity (parser::Severity::Warning);
447
- }
448
- }
449
- if (msg) {
450
- AttachDeclaration (
451
- Say (std::move (*msg), static_cast <std::intmax_t >(*val[j]),
452
- static_cast <std::intmax_t >(bound.value ()), dim + 1 ),
453
- arraySymbol);
454
- }
404
+ ValidateSubscriptValue (context.foldingContext ().messages (), arraySymbol,
405
+ *val[j], dimLB, dimUB, dim);
455
406
}
456
407
}
457
408
++dim;
458
409
}
459
410
}
460
411
412
+ static void CheckSubscripts (
413
+ semantics::SemanticsContext &context, ArrayRef &ref) {
414
+ const Symbol &arraySymbol{ref.base ().GetLastSymbol ()};
415
+ Shape lb, ub;
416
+ if (FoldSubscripts (context, arraySymbol, ref.subscript (), lb, ub)) {
417
+ ValidateSubscripts (context, arraySymbol, ref.subscript (), lb, ub);
418
+ }
419
+ }
420
+
421
+ static void CheckSubscripts (
422
+ semantics::SemanticsContext &context, CoarrayRef &ref) {
423
+ const Symbol &coarraySymbol{ref.GetBase ().GetLastSymbol ()};
424
+ Shape lb, ub;
425
+ if (FoldSubscripts (context, coarraySymbol, ref.subscript (), lb, ub)) {
426
+ ValidateSubscripts (context, coarraySymbol, ref.subscript (), lb, ub);
427
+ }
428
+ FoldingContext &foldingContext{context.foldingContext ()};
429
+ int dim{0 };
430
+ for (auto &expr : ref.cosubscript ()) {
431
+ expr = Fold (foldingContext, std::move (expr));
432
+ if (auto val{ToInt64 (expr)}) {
433
+ ValidateSubscriptValue (foldingContext.messages (), coarraySymbol, *val,
434
+ ToInt64 (GetLCOBOUND (coarraySymbol, dim)),
435
+ ToInt64 (GetUCOBOUND (coarraySymbol, dim)), dim, " co" );
436
+ }
437
+ ++dim;
438
+ }
439
+ }
440
+
441
+ // Some subscript semantic checks must be deferred until all of the
442
+ // subscripts are in hand.
443
+ MaybeExpr ExpressionAnalyzer::CompleteSubscripts (ArrayRef &&ref) {
444
+ const Symbol &symbol{ref.GetLastSymbol ().GetUltimate ()};
445
+ int symbolRank{symbol.Rank ()};
446
+ int subscripts{static_cast <int >(ref.size ())};
447
+ if (subscripts == 0 ) {
448
+ return std::nullopt; // error recovery
449
+ } else if (subscripts != symbolRank) {
450
+ if (symbolRank != 0 ) {
451
+ Say (" Reference to rank-%d object '%s' has %d subscripts" _err_en_US,
452
+ symbolRank, symbol.name (), subscripts);
453
+ }
454
+ return std::nullopt;
455
+ } else if (symbol.has <semantics::ObjectEntityDetails>() ||
456
+ symbol.has <semantics::AssocEntityDetails>()) {
457
+ // C928 & C1002
458
+ if (Triplet * last{std::get_if<Triplet>(&ref.subscript ().back ().u )}) {
459
+ if (!last->upper () && IsAssumedSizeArray (symbol)) {
460
+ Say (" Assumed-size array '%s' must have explicit final subscript upper bound value" _err_en_US,
461
+ symbol.name ());
462
+ return std::nullopt;
463
+ }
464
+ }
465
+ } else {
466
+ // Shouldn't get here from Analyze(ArrayElement) without a valid base,
467
+ // which, if not an object, must be a construct entity from
468
+ // SELECT TYPE/RANK or ASSOCIATE.
469
+ CHECK (symbol.has <semantics::AssocEntityDetails>());
470
+ }
471
+ if (!semantics::IsNamedConstant (symbol) && !inDataStmtObject_) {
472
+ // Subscripts of named constants are checked in folding.
473
+ // Subscripts of DATA statement objects are checked in data statement
474
+ // conversion to initializers.
475
+ CheckSubscripts (context_, ref);
476
+ }
477
+ return Designate (DataRef{std::move (ref)});
478
+ }
479
+
480
+ // Applies subscripts to a data reference.
481
+ MaybeExpr ExpressionAnalyzer::ApplySubscripts (
482
+ DataRef &&dataRef, std::vector<Subscript> &&subscripts) {
483
+ if (subscripts.empty ()) {
484
+ return std::nullopt; // error recovery
485
+ }
486
+ return common::visit (common::visitors{
487
+ [&](SymbolRef &&symbol) {
488
+ return CompleteSubscripts (
489
+ ArrayRef{symbol, std::move (subscripts)});
490
+ },
491
+ [&](Component &&c) {
492
+ return CompleteSubscripts (
493
+ ArrayRef{std::move (c), std::move (subscripts)});
494
+ },
495
+ [&](auto &&) -> MaybeExpr {
496
+ DIE (" bad base for ArrayRef" );
497
+ return std::nullopt;
498
+ },
499
+ },
500
+ std::move (dataRef.u ));
501
+ }
502
+
461
503
// C919a - only one part-ref of a data-ref may have rank > 0
462
504
bool ExpressionAnalyzer::CheckRanks (const DataRef &dataRef) {
463
505
return common::visit (
@@ -1524,9 +1566,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
1524
1566
// Reverse the chain of symbols so that the base is first and coarray
1525
1567
// ultimate component is last.
1526
1568
if (cosubsOk) {
1527
- return Designate (
1528
- DataRef{CoarrayRef{SymbolVector{reversed.crbegin (), reversed.crend ()},
1529
- std::move (subscripts), std::move (cosubscripts)}});
1569
+ CoarrayRef coarrayRef{SymbolVector{reversed.crbegin (), reversed.crend ()},
1570
+ std::move (subscripts), std::move (cosubscripts)};
1571
+ CheckSubscripts (context_, coarrayRef);
1572
+ return Designate (DataRef{std::move (coarrayRef)});
1530
1573
}
1531
1574
}
1532
1575
return std::nullopt;
0 commit comments