xref: /llvm-project/flang/include/flang/Common/format.h (revision eb77f442b342a1bb234254e05759933bad9dfab1)
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