FLANG
format.h
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
29namespace Fortran::common {
30
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.
41ENUM_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
49template <typename CHAR = char> class FormatValidator {
50public:
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
62private:
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
155template <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
166template <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
176template <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.
187template <typename CHAR> void FormatValidator<CHAR>::Advance(TokenKind tk) {
188 cursor_ = laCursor_;
189 token_.set_kind(tk);
190}
191
192template <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
453template <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.
463template <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
483template <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.
500template <typename CHAR>
501bool 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.
519template <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
546template <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
558template <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_
Definition: bit-population-count.h:20
Definition: format.h:31