1 //===-- include/flang/Common/format.h ---------------------------*- C++ -*-===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #ifndef FORTRAN_COMMON_FORMAT_H_ 10 #define FORTRAN_COMMON_FORMAT_H_ 11 12 #include "enum-set.h" 13 #include "flang/Common/Fortran-consts.h" 14 #include <cstring> 15 16 // Define a FormatValidator class template to validate a format expression 17 // of a given CHAR type. To enable use in runtime library code as well as 18 // compiler code, the implementation does its own parsing without recourse 19 // to compiler parser machinery, and avoids features that require C++ runtime 20 // library support. A format expression is a pointer to a fixed size 21 // character string, with an explicit length. Class function Check analyzes 22 // the expression for syntax and semantic errors and warnings. When an error 23 // or warning is found, a caller-supplied reporter function is called, which 24 // may request early termination of validation analysis when some threshold 25 // number of errors have been reported. If the context is a READ, WRITE, 26 // or PRINT statement, rather than a FORMAT statement, statement-specific 27 // checks are also done. 28 29 namespace Fortran::common { 30 31 struct FormatMessage { 32 const char *text; // message text; may have one %s argument 33 const char *arg; // optional %s argument value 34 int offset; // offset to message marker 35 int length; // length of message marker 36 bool isError; // vs. warning 37 }; 38 39 // This declaration is logically private to class FormatValidator. 40 // It is placed here to work around a clang compilation problem. 41 ENUM_CLASS(TokenKind, None, A, B, BN, BZ, D, DC, DP, DT, E, EN, ES, EX, F, G, I, 42 L, O, P, RC, RD, RN, RP, RU, RZ, S, SP, SS, T, TL, TR, X, Z, Colon, Slash, 43 Backslash, // nonstandard: inhibit newline on output 44 Dollar, // nonstandard: inhibit newline on output on terminals 45 Star, LParen, RParen, Comma, Point, Sign, 46 UnsignedInteger, // value in integerValue_ 47 String) // char-literal-constant or Hollerith constant 48 49 template <typename CHAR = char> class FormatValidator { 50 public: 51 using Reporter = std::function<bool(const FormatMessage &)>; 52 FormatValidator(const CHAR *format, size_t length, Reporter reporter, 53 IoStmtKind stmt = IoStmtKind::None) 54 : format_{format}, end_{format + length}, reporter_{reporter}, 55 stmt_{stmt}, cursor_{format - 1} { 56 CHECK(format); 57 } 58 59 bool Check(); 60 int maxNesting() const { return maxNesting_; } 61 62 private: 63 common::EnumSet<TokenKind, TokenKind_enumSize> itemsWithLeadingInts_{ 64 TokenKind::A, TokenKind::B, TokenKind::D, TokenKind::DT, TokenKind::E, 65 TokenKind::EN, TokenKind::ES, TokenKind::EX, TokenKind::F, TokenKind::G, 66 TokenKind::I, TokenKind::L, TokenKind::O, TokenKind::P, TokenKind::X, 67 TokenKind::Z, TokenKind::Slash, TokenKind::LParen}; 68 69 struct Token { 70 Token &set_kind(TokenKind kind) { 71 kind_ = kind; 72 return *this; 73 } 74 Token &set_offset(int offset) { 75 offset_ = offset; 76 return *this; 77 } 78 Token &set_length(int length) { 79 length_ = length; 80 return *this; 81 } 82 83 TokenKind kind() const { return kind_; } 84 int offset() const { return offset_; } 85 int length() const { return length_; } 86 87 bool IsSet() { return kind_ != TokenKind::None; } 88 89 private: 90 TokenKind kind_{TokenKind::None}; 91 int offset_{0}; 92 int length_{1}; 93 }; 94 95 void ReportWarning(const char *text) { ReportWarning(text, token_); } 96 void ReportWarning( 97 const char *text, Token &token, const char *arg = nullptr) { 98 FormatMessage msg{ 99 text, arg ? arg : argString_, token.offset(), token.length(), false}; 100 reporterExit_ |= reporter_(msg); 101 } 102 103 void ReportError(const char *text) { ReportError(text, token_); } 104 void ReportError(const char *text, Token &token, const char *arg = nullptr) { 105 if (suppressMessageCascade_) { 106 return; 107 } 108 formatHasErrors_ = true; 109 suppressMessageCascade_ = true; 110 FormatMessage msg{ 111 text, arg ? arg : argString_, token.offset(), token.length(), true}; 112 reporterExit_ |= reporter_(msg); 113 } 114 115 void SetLength() { SetLength(token_); } 116 void SetLength(Token &token) { 117 token.set_length(cursor_ - format_ - token.offset() + (cursor_ < end_)); 118 } 119 120 CHAR NextChar(); 121 CHAR LookAheadChar(); 122 void Advance(TokenKind); 123 void NextToken(); 124 125 void check_r(bool allowed = true); 126 bool check_w(); 127 void check_m(); 128 bool check_d(bool checkScaleFactor = false); 129 void check_k(); 130 void check_e(); 131 132 const CHAR *const format_; // format text 133 const CHAR *const end_; // one-past-last of format_ text 134 Reporter reporter_; 135 IoStmtKind stmt_; 136 137 const CHAR *cursor_{}; // current location in format_ 138 const CHAR *laCursor_{}; // lookahead cursor 139 Token previousToken_{}; 140 Token token_{}; // current token 141 Token knrToken_{}; // k, n, or r UnsignedInteger token 142 Token scaleFactorToken_{}; // most recent scale factor token P 143 int64_t integerValue_{-1}; // value of UnsignedInteger token 144 int64_t knrValue_{-1}; // -1 ==> not present 145 int64_t scaleFactorValue_{}; // signed k in kP 146 int64_t wValue_{-1}; 147 char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name 148 bool formatHasErrors_{false}; 149 bool unterminatedFormatError_{false}; 150 bool suppressMessageCascade_{false}; 151 bool reporterExit_{false}; 152 int maxNesting_{0}; // max level of nested parentheses 153 }; 154 155 template <typename CHAR> static inline bool IsWhite(CHAR c) { 156 // White space. ' ' is standard. Other characters are extensions. 157 // Extension candidates: 158 // '\t' (horizontal tab) 159 // '\n' (new line) 160 // '\v' (vertical tab) 161 // '\f' (form feed) 162 // '\r' (carriage ret) 163 return c == ' ' || c == '\t' || c == '\v'; 164 } 165 166 template <typename CHAR> CHAR FormatValidator<CHAR>::NextChar() { 167 for (++cursor_; cursor_ < end_; ++cursor_) { 168 if (!IsWhite(*cursor_)) { 169 return toupper(*cursor_); 170 } 171 } 172 cursor_ = end_; // don't allow cursor_ > end_ 173 return ' '; 174 } 175 176 template <typename CHAR> CHAR FormatValidator<CHAR>::LookAheadChar() { 177 for (laCursor_ = cursor_ + 1; laCursor_ < end_; ++laCursor_) { 178 if (!IsWhite(*laCursor_)) { 179 return toupper(*laCursor_); 180 } 181 } 182 laCursor_ = end_; // don't allow laCursor_ > end_ 183 return ' '; 184 } 185 186 // After a call to LookAheadChar, set token kind and advance cursor to laCursor. 187 template <typename CHAR> void FormatValidator<CHAR>::Advance(TokenKind tk) { 188 cursor_ = laCursor_; 189 token_.set_kind(tk); 190 } 191 192 template <typename CHAR> void FormatValidator<CHAR>::NextToken() { 193 // At entry, cursor_ points before the start of the next token. 194 // At exit, cursor_ points to last CHAR of token_. 195 196 previousToken_ = token_; 197 CHAR c{NextChar()}; 198 token_.set_kind(TokenKind::None); 199 token_.set_offset(cursor_ - format_); 200 token_.set_length(1); 201 if (c == '_' && integerValue_ >= 0) { // C1305, C1309, C1310, C1312, C1313 202 ReportError("Kind parameter '_' character in format expression"); 203 } 204 integerValue_ = -1; 205 206 switch (c) { 207 case '0': 208 case '1': 209 case '2': 210 case '3': 211 case '4': 212 case '5': 213 case '6': 214 case '7': 215 case '8': 216 case '9': { 217 int64_t lastValue; 218 const CHAR *lastCursor; 219 integerValue_ = 0; 220 bool overflow{false}; 221 do { 222 lastValue = integerValue_; 223 lastCursor = cursor_; 224 integerValue_ = 10 * integerValue_ + c - '0'; 225 if (lastValue > integerValue_) { 226 overflow = true; 227 } 228 c = NextChar(); 229 } while (c >= '0' && c <= '9'); 230 cursor_ = lastCursor; 231 token_.set_kind(TokenKind::UnsignedInteger); 232 if (overflow) { 233 SetLength(); 234 ReportError("Integer overflow in format expression"); 235 break; 236 } 237 if (LookAheadChar() != 'H') { 238 break; 239 } 240 // Hollerith constant 241 if (laCursor_ + integerValue_ < end_) { 242 token_.set_kind(TokenKind::String); 243 cursor_ = laCursor_ + integerValue_; 244 } else { 245 token_.set_kind(TokenKind::None); 246 cursor_ = end_; 247 } 248 SetLength(); 249 if (stmt_ == IoStmtKind::Read) { // 13.3.2p6 250 ReportError("'H' edit descriptor in READ format expression"); 251 } else if (token_.kind() == TokenKind::None) { 252 ReportError("Unterminated 'H' edit descriptor"); 253 } else { 254 ReportWarning("Legacy 'H' edit descriptor"); 255 } 256 break; 257 } 258 case 'A': 259 token_.set_kind(TokenKind::A); 260 break; 261 case 'B': 262 switch (LookAheadChar()) { 263 case 'N': 264 Advance(TokenKind::BN); 265 break; 266 case 'Z': 267 Advance(TokenKind::BZ); 268 break; 269 default: 270 token_.set_kind(TokenKind::B); 271 break; 272 } 273 break; 274 case 'D': 275 switch (LookAheadChar()) { 276 case 'C': 277 Advance(TokenKind::DC); 278 break; 279 case 'P': 280 Advance(TokenKind::DP); 281 break; 282 case 'T': 283 Advance(TokenKind::DT); 284 break; 285 default: 286 token_.set_kind(TokenKind::D); 287 break; 288 } 289 break; 290 case 'E': 291 switch (LookAheadChar()) { 292 case 'N': 293 Advance(TokenKind::EN); 294 break; 295 case 'S': 296 Advance(TokenKind::ES); 297 break; 298 case 'X': 299 Advance(TokenKind::EX); 300 break; 301 default: 302 token_.set_kind(TokenKind::E); 303 break; 304 } 305 break; 306 case 'F': 307 token_.set_kind(TokenKind::F); 308 break; 309 case 'G': 310 token_.set_kind(TokenKind::G); 311 break; 312 case 'I': 313 token_.set_kind(TokenKind::I); 314 break; 315 case 'L': 316 token_.set_kind(TokenKind::L); 317 break; 318 case 'O': 319 token_.set_kind(TokenKind::O); 320 break; 321 case 'P': 322 token_.set_kind(TokenKind::P); 323 break; 324 case 'R': 325 switch (LookAheadChar()) { 326 case 'C': 327 Advance(TokenKind::RC); 328 break; 329 case 'D': 330 Advance(TokenKind::RD); 331 break; 332 case 'N': 333 Advance(TokenKind::RN); 334 break; 335 case 'P': 336 Advance(TokenKind::RP); 337 break; 338 case 'U': 339 Advance(TokenKind::RU); 340 break; 341 case 'Z': 342 Advance(TokenKind::RZ); 343 break; 344 default: 345 token_.set_kind(TokenKind::None); 346 break; 347 } 348 break; 349 case 'S': 350 switch (LookAheadChar()) { 351 case 'P': 352 Advance(TokenKind::SP); 353 break; 354 case 'S': 355 Advance(TokenKind::SS); 356 break; 357 default: 358 token_.set_kind(TokenKind::S); 359 break; 360 } 361 break; 362 case 'T': 363 switch (LookAheadChar()) { 364 case 'L': 365 Advance(TokenKind::TL); 366 break; 367 case 'R': 368 Advance(TokenKind::TR); 369 break; 370 default: 371 token_.set_kind(TokenKind::T); 372 break; 373 } 374 break; 375 case 'X': 376 token_.set_kind(TokenKind::X); 377 break; 378 case 'Z': 379 token_.set_kind(TokenKind::Z); 380 break; 381 case '-': 382 case '+': 383 token_.set_kind(TokenKind::Sign); 384 break; 385 case '/': 386 token_.set_kind(TokenKind::Slash); 387 break; 388 case '(': 389 token_.set_kind(TokenKind::LParen); 390 break; 391 case ')': 392 token_.set_kind(TokenKind::RParen); 393 break; 394 case '.': 395 token_.set_kind(TokenKind::Point); 396 break; 397 case ':': 398 token_.set_kind(TokenKind::Colon); 399 break; 400 case '\\': 401 token_.set_kind(TokenKind::Backslash); 402 break; 403 case '$': 404 token_.set_kind(TokenKind::Dollar); 405 break; 406 case '*': 407 token_.set_kind(LookAheadChar() == '(' ? TokenKind::Star : TokenKind::None); 408 break; 409 case ',': { 410 token_.set_kind(TokenKind::Comma); 411 CHAR laChar = LookAheadChar(); 412 if (laChar == ',') { 413 Advance(TokenKind::Comma); 414 token_.set_offset(cursor_ - format_); 415 ReportError("Unexpected ',' in format expression"); 416 } else if (laChar == ')') { 417 ReportError("Unexpected ',' before ')' in format expression"); 418 } 419 break; 420 } 421 case '\'': 422 case '"': 423 for (++cursor_; cursor_ < end_; ++cursor_) { 424 if (*cursor_ == c) { 425 if (auto nc{cursor_ + 1}; nc < end_ && *nc != c) { 426 token_.set_kind(TokenKind::String); 427 break; 428 } 429 ++cursor_; 430 } 431 } 432 SetLength(); 433 if (stmt_ == IoStmtKind::Read && 434 previousToken_.kind() != TokenKind::DT) { // 13.3.2p6 435 ReportError("String edit descriptor in READ format expression"); 436 } else if (token_.kind() != TokenKind::String) { 437 ReportError("Unterminated string"); 438 } 439 break; 440 default: 441 if (cursor_ >= end_ && !unterminatedFormatError_) { 442 suppressMessageCascade_ = false; 443 ReportError("Unterminated format expression"); 444 unterminatedFormatError_ = true; 445 } 446 token_.set_kind(TokenKind::None); 447 break; 448 } 449 450 SetLength(); 451 } 452 453 template <typename CHAR> void FormatValidator<CHAR>::check_r(bool allowed) { 454 if (!allowed && knrValue_ >= 0) { 455 ReportError("Repeat specifier before '%s' edit descriptor", knrToken_); 456 } else if (knrValue_ == 0) { 457 ReportError("'%s' edit descriptor repeat specifier must be positive", 458 knrToken_); // C1304 459 } 460 } 461 462 // Return the predicate "w value is present" to control further processing. 463 template <typename CHAR> bool FormatValidator<CHAR>::check_w() { 464 if (token_.kind() == TokenKind::UnsignedInteger) { 465 wValue_ = integerValue_; 466 if (wValue_ == 0) { 467 if (*argString_ == 'A' || stmt_ == IoStmtKind::Read) { 468 // C1306, 13.7.2.1p6 469 ReportError("'%s' edit descriptor 'w' value must be positive"); 470 } else if (*argString_ == 'L') { 471 ReportWarning("'%s' edit descriptor 'w' value should be positive"); 472 } 473 } 474 NextToken(); 475 return true; 476 } 477 if (*argString_ != 'A' && *argString_ != 'L') { 478 ReportWarning("Expected '%s' edit descriptor 'w' value"); // C1306 479 } 480 return false; 481 } 482 483 template <typename CHAR> void FormatValidator<CHAR>::check_m() { 484 if (token_.kind() != TokenKind::Point) { 485 return; 486 } 487 NextToken(); 488 if (token_.kind() != TokenKind::UnsignedInteger) { 489 ReportError("Expected '%s' edit descriptor 'm' value after '.'"); 490 return; 491 } 492 if ((stmt_ == IoStmtKind::Print || stmt_ == IoStmtKind::Write) && 493 wValue_ > 0 && integerValue_ > wValue_) { // 13.7.2.2p5, 13.7.2.4p6 494 ReportError("'%s' edit descriptor 'm' value is greater than 'w' value"); 495 } 496 NextToken(); 497 } 498 499 // Return the predicate "d value is present" to control further processing. 500 template <typename CHAR> 501 bool FormatValidator<CHAR>::check_d(bool checkScaleFactor) { 502 if (token_.kind() != TokenKind::Point) { 503 ReportError("Expected '%s' edit descriptor '.d' value"); 504 return false; 505 } 506 NextToken(); 507 if (token_.kind() != TokenKind::UnsignedInteger) { 508 ReportError("Expected '%s' edit descriptor 'd' value after '.'"); 509 return false; 510 } 511 if (checkScaleFactor) { 512 check_k(); 513 } 514 NextToken(); 515 return true; 516 } 517 518 // Check the value of scale factor k against a field width d. 519 template <typename CHAR> void FormatValidator<CHAR>::check_k() { 520 // Limit the check to D and E edit descriptors in output statements that 521 // explicitly set the scale factor. 522 if (stmt_ != IoStmtKind::Print && stmt_ != IoStmtKind::Write) { 523 return; 524 } 525 if (!scaleFactorToken_.IsSet()) { 526 return; 527 } 528 // 13.7.2.3.3p5 - The values of d and k must satisfy: 529 // −d < k <= 0; or 530 // 0 < k < d+2 531 const int64_t d{integerValue_}; 532 const int64_t k{scaleFactorValue_}; 533 // Exception: d = k = 0 is nonstandard, but has a reasonable interpretation. 534 if (d == 0 && k == 0) { 535 return; 536 } 537 if (k <= 0 && !(-d < k)) { 538 ReportError("Negative scale factor k (from kP) and width d in a '%s' " 539 "edit descriptor must satisfy '-d < k'"); 540 } else if (k > 0 && !(k < d + 2)) { 541 ReportError("Positive scale factor k (from kP) and width d in a '%s' " 542 "edit descriptor must satisfy 'k < d+2'"); 543 } 544 } 545 546 template <typename CHAR> void FormatValidator<CHAR>::check_e() { 547 if (token_.kind() != TokenKind::E) { 548 return; 549 } 550 NextToken(); 551 if (token_.kind() != TokenKind::UnsignedInteger) { 552 ReportError("Expected '%s' edit descriptor 'e' value after 'E'"); 553 return; 554 } 555 NextToken(); 556 } 557 558 template <typename CHAR> bool FormatValidator<CHAR>::Check() { 559 if (!*format_) { 560 ReportError("Empty format expression"); 561 return formatHasErrors_; 562 } 563 NextToken(); 564 if (token_.kind() != TokenKind::LParen) { 565 ReportError("Format expression must have an initial '('"); 566 return formatHasErrors_; 567 } 568 NextToken(); 569 570 int nestLevel{0}; // Outer level ()s are at level 0. 571 Token starToken{}; // unlimited format token 572 bool hasDataEditDesc{false}; 573 574 // Subject to error recovery exceptions, a loop iteration processes one 575 // edit descriptor or does list management. The loop terminates when 576 // - a level-0 right paren is processed (format may be valid) 577 // - the end of an incomplete format is reached 578 // - the error reporter requests termination (error threshold reached) 579 while (!reporterExit_) { 580 Token signToken{}; 581 knrValue_ = -1; // -1 ==> not present 582 wValue_ = -1; 583 bool commaRequired{true}; 584 585 if (token_.kind() == TokenKind::Sign) { 586 signToken = token_; 587 NextToken(); 588 } 589 if (token_.kind() == TokenKind::UnsignedInteger) { 590 knrToken_ = token_; 591 knrValue_ = integerValue_; 592 NextToken(); 593 } 594 if (signToken.IsSet() && (knrValue_ < 0 || token_.kind() != TokenKind::P)) { 595 argString_[0] = format_[signToken.offset()]; 596 argString_[1] = 0; 597 ReportError("Unexpected '%s' in format expression", signToken); 598 } 599 // Default message argument. 600 // Alphabetic edit descriptor names are one or two characters in length. 601 argString_[0] = toupper(format_[token_.offset()]); 602 argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0; 603 // Process one format edit descriptor or do format list management. 604 switch (token_.kind()) { 605 case TokenKind::A: 606 // R1307 data-edit-desc -> A [w] 607 hasDataEditDesc = true; 608 check_r(); 609 NextToken(); 610 check_w(); 611 break; 612 case TokenKind::B: 613 case TokenKind::I: 614 case TokenKind::O: 615 case TokenKind::Z: 616 // R1307 data-edit-desc -> B w [. m] | I w [. m] | O w [. m] | Z w [. m] 617 hasDataEditDesc = true; 618 check_r(); 619 NextToken(); 620 if (check_w()) { 621 check_m(); 622 } 623 break; 624 case TokenKind::D: 625 case TokenKind::F: { 626 // R1307 data-edit-desc -> D w . d | F w . d 627 bool isD{token_.kind() == TokenKind::D}; 628 hasDataEditDesc = true; 629 check_r(); 630 NextToken(); 631 if (check_w()) { 632 check_d(/*checkScaleFactor=*/isD); 633 } 634 break; 635 } 636 case TokenKind::E: 637 case TokenKind::EN: 638 case TokenKind::ES: 639 case TokenKind::EX: { 640 // R1307 data-edit-desc -> 641 // E w . d [E e] | EN w . d [E e] | ES w . d [E e] | EX w . d [E e] 642 bool isE{token_.kind() == TokenKind::E}; 643 hasDataEditDesc = true; 644 check_r(); 645 NextToken(); 646 if (check_w() && check_d(/*checkScaleFactor=*/isE)) { 647 check_e(); 648 } 649 break; 650 } 651 case TokenKind::G: 652 // R1307 data-edit-desc -> G w [. d [E e]] 653 hasDataEditDesc = true; 654 check_r(); 655 NextToken(); 656 if (check_w()) { 657 if (wValue_ > 0) { 658 if (check_d()) { // C1307 659 check_e(); 660 } 661 } else if (token_.kind() == TokenKind::Point && check_d() && 662 token_.kind() == TokenKind::E) { // C1308 663 ReportError("A 'G0' edit descriptor must not have an 'e' value"); 664 NextToken(); 665 if (token_.kind() == TokenKind::UnsignedInteger) { 666 NextToken(); 667 } 668 } 669 } 670 break; 671 case TokenKind::L: 672 // R1307 data-edit-desc -> L w 673 hasDataEditDesc = true; 674 check_r(); 675 NextToken(); 676 check_w(); 677 break; 678 case TokenKind::DT: 679 // R1307 data-edit-desc -> DT [char-literal-constant] [( v-list )] 680 hasDataEditDesc = true; 681 check_r(); 682 NextToken(); 683 if (token_.kind() == TokenKind::String) { 684 NextToken(); 685 } 686 if (token_.kind() == TokenKind::LParen) { 687 do { 688 NextToken(); 689 if (token_.kind() == TokenKind::Sign) { 690 NextToken(); 691 } 692 if (token_.kind() != TokenKind::UnsignedInteger) { 693 ReportError( 694 "Expected integer constant in 'DT' edit descriptor v-list"); 695 break; 696 } 697 NextToken(); 698 } while (token_.kind() == TokenKind::Comma); 699 if (token_.kind() != TokenKind::RParen) { 700 ReportError("Expected ',' or ')' in 'DT' edit descriptor v-list"); 701 while (cursor_ < end_ && token_.kind() != TokenKind::RParen) { 702 NextToken(); 703 } 704 } 705 NextToken(); 706 } 707 break; 708 case TokenKind::String: 709 // R1304 data-edit-desc -> char-string-edit-desc 710 if (knrValue_ >= 0) { 711 ReportError("Repeat specifier before character string edit descriptor", 712 knrToken_); 713 } 714 NextToken(); 715 break; 716 case TokenKind::BN: 717 case TokenKind::BZ: 718 case TokenKind::DC: 719 case TokenKind::DP: 720 case TokenKind::RC: 721 case TokenKind::RD: 722 case TokenKind::RN: 723 case TokenKind::RP: 724 case TokenKind::RU: 725 case TokenKind::RZ: 726 case TokenKind::S: 727 case TokenKind::SP: 728 case TokenKind::SS: 729 // R1317 sign-edit-desc -> SS | SP | S 730 // R1318 blank-interp-edit-desc -> BN | BZ 731 // R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP 732 // R1320 decimal-edit-desc -> DC | DP 733 check_r(false); 734 NextToken(); 735 break; 736 case TokenKind::P: { 737 // R1313 control-edit-desc -> k P 738 if (knrValue_ < 0) { 739 ReportError("'P' edit descriptor must have a scale factor"); 740 } else { 741 scaleFactorToken_ = knrToken_; 742 if (signToken.IsSet() && format_[signToken.offset()] == '-') { 743 scaleFactorValue_ = -knrValue_; 744 } else { 745 scaleFactorValue_ = knrValue_; 746 } 747 } 748 // Diagnosing C1302 may require multiple token lookahead. 749 // Save current cursor position to enable backup. 750 const CHAR *saveCursor{cursor_}; 751 NextToken(); 752 if (token_.kind() == TokenKind::UnsignedInteger) { 753 NextToken(); 754 } 755 switch (token_.kind()) { 756 case TokenKind::D: 757 case TokenKind::E: 758 case TokenKind::EN: 759 case TokenKind::ES: 760 case TokenKind::EX: 761 case TokenKind::F: 762 case TokenKind::G: 763 commaRequired = false; 764 break; 765 default:; 766 } 767 cursor_ = saveCursor; 768 NextToken(); 769 break; 770 } 771 case TokenKind::T: 772 case TokenKind::TL: 773 case TokenKind::TR: 774 // R1315 position-edit-desc -> T n | TL n | TR n 775 check_r(false); 776 NextToken(); 777 if (integerValue_ <= 0) { // C1311 778 ReportError("'%s' edit descriptor must have a positive position value"); 779 } 780 NextToken(); 781 break; 782 case TokenKind::X: 783 // R1315 position-edit-desc -> n X 784 if (knrValue_ == 0) { // C1311 785 ReportError("'X' edit descriptor must have a positive position value", 786 knrToken_); 787 } else if (knrValue_ < 0) { 788 ReportWarning( 789 "'X' edit descriptor must have a positive position value"); 790 } 791 NextToken(); 792 break; 793 case TokenKind::Colon: 794 // R1313 control-edit-desc -> : 795 check_r(false); 796 commaRequired = false; 797 NextToken(); 798 break; 799 case TokenKind::Slash: 800 // R1313 control-edit-desc -> [r] / 801 commaRequired = false; 802 NextToken(); 803 break; 804 case TokenKind::Backslash: 805 check_r(false); 806 ReportWarning("Non-standard '\\' edit descriptor"); 807 NextToken(); 808 break; 809 case TokenKind::Dollar: 810 check_r(false); 811 ReportWarning("Non-standard '$' edit descriptor"); 812 NextToken(); 813 break; 814 case TokenKind::Star: 815 // NextToken assigns a token kind of Star only if * is followed by (. 816 // So the next token is guaranteed to be LParen. 817 if (nestLevel > 0) { 818 ReportError("Nested unlimited format item list"); 819 } 820 starToken = token_; 821 if (knrValue_ >= 0) { 822 ReportError( 823 "Repeat specifier before unlimited format item list", knrToken_); 824 } 825 hasDataEditDesc = false; 826 NextToken(); 827 [[fallthrough]]; 828 case TokenKind::LParen: 829 if (knrValue_ == 0) { 830 ReportError("List repeat specifier must be positive", knrToken_); 831 } 832 if (++nestLevel > maxNesting_) { 833 maxNesting_ = nestLevel; 834 } 835 break; 836 case TokenKind::RParen: 837 if (knrValue_ >= 0) { 838 ReportError("Unexpected integer constant", knrToken_); 839 } 840 do { 841 if (nestLevel == 0) { 842 // Any characters after level-0 ) are ignored. 843 return formatHasErrors_; // normal exit (may have messages) 844 } 845 if (nestLevel == 1 && starToken.IsSet() && !hasDataEditDesc) { 846 SetLength(starToken); 847 ReportError( // C1303 848 "Unlimited format item list must contain a data edit descriptor", 849 starToken); 850 } 851 --nestLevel; 852 NextToken(); 853 } while (token_.kind() == TokenKind::RParen); 854 if (nestLevel == 0 && starToken.IsSet()) { 855 ReportError("Character in format after unlimited format item list"); 856 } 857 break; 858 case TokenKind::Comma: 859 if (knrValue_ >= 0) { 860 ReportError("Unexpected integer constant", knrToken_); 861 } 862 if (suppressMessageCascade_ || reporterExit_) { 863 break; 864 } 865 [[fallthrough]]; 866 default: 867 ReportError("Unexpected '%s' in format expression"); 868 NextToken(); 869 } 870 871 // Process comma separator and exit an incomplete format. 872 switch (token_.kind()) { 873 case TokenKind::Colon: // Comma not required; token not yet processed. 874 case TokenKind::Slash: // Comma not required; token not yet processed. 875 case TokenKind::RParen: // Comma not allowed; token not yet processed. 876 suppressMessageCascade_ = false; 877 break; 878 case TokenKind::LParen: // Comma not allowed; token already processed. 879 case TokenKind::Comma: // Normal comma case; move past token. 880 suppressMessageCascade_ = false; 881 NextToken(); 882 break; 883 case TokenKind::Sign: // Error; main switch has a better message. 884 case TokenKind::None: // Error; token not yet processed. 885 if (cursor_ >= end_) { 886 return formatHasErrors_; // incomplete format error exit 887 } 888 break; 889 default: 890 // Possible first token of the next format item; token not yet processed. 891 if (commaRequired) { 892 const char *s{"Expected ',' or ')' in format expression"}; // C1302 893 if (previousToken_.kind() == TokenKind::UnsignedInteger && 894 previousToken_.length() > 1 && 895 itemsWithLeadingInts_.test(token_.kind())) { 896 // F10.32F10.3 is ambiguous, F10.3F10.3 is not 897 ReportError(s); 898 } else { 899 ReportWarning(s); 900 } 901 } 902 } 903 } 904 905 return formatHasErrors_; // error reporter (message threshold) exit 906 } 907 908 } // namespace Fortran::common 909 #endif // FORTRAN_COMMON_FORMAT_H_ 910