1 // Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
2 //
3 // Licensed under the Apache License, Version 2.0 (the "License");
4 // you may not use this file except in compliance with the License.
5 // You may obtain a copy of the License at
6 //
7 // http://www.apache.org/licenses/LICENSE-2.0
8 //
9 // Unless required by applicable law or agreed to in writing, software
10 // distributed under the License is distributed on an "AS IS" BASIS,
11 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 // See the License for the specific language governing permissions and
13 // limitations under the License.
14
15 #include "check-io.h"
16 #include "expression.h"
17 #include "tools.h"
18 #include "../common/format.h"
19 #include "../parser/tools.h"
20 #include <unordered_map>
21
22 namespace Fortran::semantics {
23
24 // TODO: C1234, C1235 -- defined I/O constraints
25
26 class FormatErrorReporter {
27 public:
FormatErrorReporter(SemanticsContext & context,const parser::CharBlock & formatCharBlock,int errorAllowance=3)28 FormatErrorReporter(SemanticsContext &context,
29 const parser::CharBlock &formatCharBlock, int errorAllowance = 3)
30 : context_{context}, formatCharBlock_{formatCharBlock},
31 errorAllowance_{errorAllowance} {}
32
33 bool Say(const common::FormatMessage &);
34
35 private:
36 SemanticsContext &context_;
37 const parser::CharBlock &formatCharBlock_;
38 int errorAllowance_; // initialized to maximum number of errors to report
39 };
40
Say(const common::FormatMessage & msg)41 bool FormatErrorReporter::Say(const common::FormatMessage &msg) {
42 if (!msg.isError && !context_.warnOnNonstandardUsage()) {
43 return false;
44 }
45 parser::MessageFormattedText text{
46 parser::MessageFixedText(msg.text, strlen(msg.text), msg.isError),
47 msg.arg};
48 if (formatCharBlock_.size()) {
49 // The input format is a folded expression. Error markers span the full
50 // original unfolded expression in formatCharBlock_.
51 context_.Say(formatCharBlock_, text);
52 } else {
53 // The input format is a source expression. Error markers have an offset
54 // and length relative to the beginning of formatCharBlock_.
55 parser::CharBlock messageCharBlock{
56 parser::CharBlock(formatCharBlock_.begin() + msg.offset, msg.length)};
57 context_.Say(messageCharBlock, text);
58 }
59 return msg.isError && --errorAllowance_ <= 0;
60 }
61
Enter(const parser::Statement<common::Indirection<parser::FormatStmt>> & stmt)62 void IoChecker::Enter(
63 const parser::Statement<common::Indirection<parser::FormatStmt>> &stmt) {
64 if (!stmt.label.has_value()) {
65 context_.Say("Format statement must be labeled"_err_en_US); // C1301
66 }
67 const char *formatStart{static_cast<const char *>(
68 std::memchr(stmt.source.begin(), '(', stmt.source.size()))};
69 parser::CharBlock reporterCharBlock{formatStart, static_cast<std::size_t>(0)};
70 FormatErrorReporter reporter{context_, reporterCharBlock};
71 auto reporterWrapper{[&](const auto &msg) { return reporter.Say(msg); }};
72 switch (context_.GetDefaultKind(TypeCategory::Character)) {
73 case 1: {
74 common::FormatValidator<char> validator{formatStart,
75 stmt.source.size() - (formatStart - stmt.source.begin()),
76 reporterWrapper};
77 validator.Check();
78 break;
79 }
80 case 2: { // TODO: Get this to work.
81 common::FormatValidator<char16_t> validator{
82 /*???*/ nullptr, /*???*/ 0, reporterWrapper};
83 validator.Check();
84 break;
85 }
86 case 4: { // TODO: Get this to work.
87 common::FormatValidator<char32_t> validator{
88 /*???*/ nullptr, /*???*/ 0, reporterWrapper};
89 validator.Check();
90 break;
91 }
92 default: CRASH_NO_CASE;
93 }
94 }
95
Enter(const parser::ConnectSpec & spec)96 void IoChecker::Enter(const parser::ConnectSpec &spec) {
97 // ConnectSpec context FileNameExpr
98 if (std::get_if<parser::FileNameExpr>(&spec.u)) {
99 SetSpecifier(IoSpecKind::File);
100 }
101 }
102
Enter(const parser::ConnectSpec::CharExpr & spec)103 void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
104 IoSpecKind specKind{};
105 using ParseKind = parser::ConnectSpec::CharExpr::Kind;
106 switch (std::get<ParseKind>(spec.t)) {
107 case ParseKind::Access: specKind = IoSpecKind::Access; break;
108 case ParseKind::Action: specKind = IoSpecKind::Action; break;
109 case ParseKind::Asynchronous: specKind = IoSpecKind::Asynchronous; break;
110 case ParseKind::Blank: specKind = IoSpecKind::Blank; break;
111 case ParseKind::Decimal: specKind = IoSpecKind::Decimal; break;
112 case ParseKind::Delim: specKind = IoSpecKind::Delim; break;
113 case ParseKind::Encoding: specKind = IoSpecKind::Encoding; break;
114 case ParseKind::Form: specKind = IoSpecKind::Form; break;
115 case ParseKind::Pad: specKind = IoSpecKind::Pad; break;
116 case ParseKind::Position: specKind = IoSpecKind::Position; break;
117 case ParseKind::Round: specKind = IoSpecKind::Round; break;
118 case ParseKind::Sign: specKind = IoSpecKind::Sign; break;
119 case ParseKind::Convert: specKind = IoSpecKind::Convert; break;
120 case ParseKind::Dispose: specKind = IoSpecKind::Dispose; break;
121 }
122 SetSpecifier(specKind);
123 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
124 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
125 std::string s{parser::ToUpperCaseLetters(*charConst)};
126 if (specKind == IoSpecKind::Access) {
127 flags_.set(Flag::KnownAccess);
128 flags_.set(Flag::AccessDirect, s == "DIRECT");
129 flags_.set(Flag::AccessStream, s == "STREAM");
130 }
131 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
132 }
133 }
134
Enter(const parser::ConnectSpec::Newunit &)135 void IoChecker::Enter(const parser::ConnectSpec::Newunit &) {
136 SetSpecifier(IoSpecKind::Newunit);
137 }
138
Enter(const parser::ConnectSpec::Recl & spec)139 void IoChecker::Enter(const parser::ConnectSpec::Recl &spec) {
140 SetSpecifier(IoSpecKind::Recl);
141 if (const std::optional<std::int64_t> recl{
142 GetConstExpr<std::int64_t>(spec)}) {
143 if (*recl <= 0) {
144 context_.Say(parser::FindSourceLocation(spec),
145 "RECL value (%jd) must be positive"_err_en_US,
146 std::move(static_cast<std::intmax_t>(*recl))); // 12.5.6.15
147 }
148 }
149 }
150
Enter(const parser::EndLabel &)151 void IoChecker::Enter(const parser::EndLabel &) {
152 SetSpecifier(IoSpecKind::End);
153 }
154
Enter(const parser::EorLabel &)155 void IoChecker::Enter(const parser::EorLabel &) {
156 SetSpecifier(IoSpecKind::Eor);
157 }
158
Enter(const parser::ErrLabel &)159 void IoChecker::Enter(const parser::ErrLabel &) {
160 SetSpecifier(IoSpecKind::Err);
161 }
162
Enter(const parser::FileUnitNumber &)163 void IoChecker::Enter(const parser::FileUnitNumber &) {
164 SetSpecifier(IoSpecKind::Unit);
165 flags_.set(Flag::NumberUnit);
166 }
167
Enter(const parser::Format & spec)168 void IoChecker::Enter(const parser::Format &spec) {
169 SetSpecifier(IoSpecKind::Fmt);
170 flags_.set(Flag::FmtOrNml);
171 std::visit(
172 common::visitors{
173 [&](const parser::Label &) { flags_.set(Flag::LabelFmt); },
174 [&](const parser::Star &) { flags_.set(Flag::StarFmt); },
175 [&](const parser::DefaultCharExpr &format) {
176 flags_.set(Flag::CharFmt);
177 const std::optional<std::string> constantFormat{
178 GetConstExpr<std::string>(format)};
179 if (!constantFormat) {
180 return;
181 }
182 // validate constant format -- 12.6.2.2
183 bool isFolded{constantFormat->size() !=
184 format.thing.value().source.size() - 2};
185 parser::CharBlock reporterCharBlock{isFolded
186 ? parser::CharBlock{format.thing.value().source}
187 : parser::CharBlock{format.thing.value().source.begin() + 1,
188 static_cast<std::size_t>(0)}};
189 FormatErrorReporter reporter{context_, reporterCharBlock};
190 auto reporterWrapper{
191 [&](const auto &msg) { return reporter.Say(msg); }};
192 switch (context_.GetDefaultKind(TypeCategory::Character)) {
193 case 1: {
194 common::FormatValidator<char> validator{constantFormat->c_str(),
195 constantFormat->length(), reporterWrapper, stmt_};
196 validator.Check();
197 break;
198 }
199 case 2: {
200 // TODO: Get this to work. (Maybe combine with earlier instance?)
201 common::FormatValidator<char16_t> validator{
202 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
203 validator.Check();
204 break;
205 }
206 case 4: {
207 // TODO: Get this to work. (Maybe combine with earlier instance?)
208 common::FormatValidator<char32_t> validator{
209 /*???*/ nullptr, /*???*/ 0, reporterWrapper, stmt_};
210 validator.Check();
211 break;
212 }
213 default: CRASH_NO_CASE;
214 }
215 },
216 },
217 spec.u);
218 }
219
Enter(const parser::IdExpr &)220 void IoChecker::Enter(const parser::IdExpr &) { SetSpecifier(IoSpecKind::Id); }
221
Enter(const parser::IdVariable & spec)222 void IoChecker::Enter(const parser::IdVariable &spec) {
223 SetSpecifier(IoSpecKind::Id);
224 auto expr{GetExpr(spec)};
225 if (expr == nullptr || !expr->GetType()) {
226 return;
227 }
228 int kind{expr->GetType()->kind()};
229 int defaultKind{context_.GetDefaultKind(TypeCategory::Integer)};
230 if (kind < defaultKind) {
231 context_.Say(
232 "ID kind (%d) is smaller than default INTEGER kind (%d)"_err_en_US,
233 std::move(kind), std::move(defaultKind)); // C1229
234 }
235 }
236
Enter(const parser::InputItem & spec)237 void IoChecker::Enter(const parser::InputItem &spec) {
238 flags_.set(Flag::DataList);
239 if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
240 const parser::Name &name{GetLastName(*var)};
241 if (auto *details{name.symbol->detailsIf<ObjectEntityDetails>()}) {
242 // TODO: Determine if this check is needed at all, and if so, replace
243 // the false subcondition with a check for a whole array. Otherwise,
244 // the check incorrectly flags array element and section references.
245 if (details->IsAssumedSize() && false) {
246 // This check may be superseded by C928 or C1002.
247 context_.Say(name.source,
248 "'%s' must not be a whole assumed size array"_err_en_US,
249 name.source); // C1231
250 }
251 }
252 }
253 }
254
Enter(const parser::InquireSpec & spec)255 void IoChecker::Enter(const parser::InquireSpec &spec) {
256 // InquireSpec context FileNameExpr
257 if (std::get_if<parser::FileNameExpr>(&spec.u)) {
258 SetSpecifier(IoSpecKind::File);
259 }
260 }
261
Enter(const parser::InquireSpec::CharVar & spec)262 void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
263 IoSpecKind specKind{};
264 using ParseKind = parser::InquireSpec::CharVar::Kind;
265 switch (std::get<ParseKind>(spec.t)) {
266 case ParseKind::Access: specKind = IoSpecKind::Access; break;
267 case ParseKind::Action: specKind = IoSpecKind::Action; break;
268 case ParseKind::Asynchronous: specKind = IoSpecKind::Asynchronous; break;
269 case ParseKind::Blank: specKind = IoSpecKind::Blank; break;
270 case ParseKind::Decimal: specKind = IoSpecKind::Decimal; break;
271 case ParseKind::Delim: specKind = IoSpecKind::Delim; break;
272 case ParseKind::Direct: specKind = IoSpecKind::Direct; break;
273 case ParseKind::Encoding: specKind = IoSpecKind::Encoding; break;
274 case ParseKind::Form: specKind = IoSpecKind::Form; break;
275 case ParseKind::Formatted: specKind = IoSpecKind::Formatted; break;
276 case ParseKind::Iomsg: specKind = IoSpecKind::Iomsg; break;
277 case ParseKind::Name: specKind = IoSpecKind::Name; break;
278 case ParseKind::Pad: specKind = IoSpecKind::Pad; break;
279 case ParseKind::Position: specKind = IoSpecKind::Position; break;
280 case ParseKind::Read: specKind = IoSpecKind::Read; break;
281 case ParseKind::Readwrite: specKind = IoSpecKind::Readwrite; break;
282 case ParseKind::Round: specKind = IoSpecKind::Round; break;
283 case ParseKind::Sequential: specKind = IoSpecKind::Sequential; break;
284 case ParseKind::Sign: specKind = IoSpecKind::Sign; break;
285 case ParseKind::Status: specKind = IoSpecKind::Status; break;
286 case ParseKind::Stream: specKind = IoSpecKind::Stream; break;
287 case ParseKind::Unformatted: specKind = IoSpecKind::Unformatted; break;
288 case ParseKind::Write: specKind = IoSpecKind::Write; break;
289 case ParseKind::Convert: specKind = IoSpecKind::Convert; break;
290 case ParseKind::Dispose: specKind = IoSpecKind::Dispose; break;
291 }
292 SetSpecifier(specKind);
293 }
294
Enter(const parser::InquireSpec::IntVar & spec)295 void IoChecker::Enter(const parser::InquireSpec::IntVar &spec) {
296 IoSpecKind specKind{};
297 using ParseKind = parser::InquireSpec::IntVar::Kind;
298 switch (std::get<parser::InquireSpec::IntVar::Kind>(spec.t)) {
299 case ParseKind::Iostat: specKind = IoSpecKind::Iostat; break;
300 case ParseKind::Nextrec: specKind = IoSpecKind::Nextrec; break;
301 case ParseKind::Number: specKind = IoSpecKind::Number; break;
302 case ParseKind::Pos: specKind = IoSpecKind::Pos; break;
303 case ParseKind::Recl: specKind = IoSpecKind::Recl; break;
304 case ParseKind::Size: specKind = IoSpecKind::Size; break;
305 }
306 SetSpecifier(specKind);
307 }
308
Enter(const parser::InquireSpec::LogVar & spec)309 void IoChecker::Enter(const parser::InquireSpec::LogVar &spec) {
310 IoSpecKind specKind{};
311 using ParseKind = parser::InquireSpec::LogVar::Kind;
312 switch (std::get<parser::InquireSpec::LogVar::Kind>(spec.t)) {
313 case ParseKind::Exist: specKind = IoSpecKind::Exist; break;
314 case ParseKind::Named: specKind = IoSpecKind::Named; break;
315 case ParseKind::Opened: specKind = IoSpecKind::Opened; break;
316 case ParseKind::Pending: specKind = IoSpecKind::Pending; break;
317 }
318 SetSpecifier(specKind);
319 }
320
Enter(const parser::IoControlSpec & spec)321 void IoChecker::Enter(const parser::IoControlSpec &spec) {
322 // IoControlSpec context Name
323 flags_.set(Flag::IoControlList);
324 if (std::holds_alternative<parser::Name>(spec.u)) {
325 SetSpecifier(IoSpecKind::Nml);
326 flags_.set(Flag::FmtOrNml);
327 }
328 }
329
Enter(const parser::IoControlSpec::Asynchronous & spec)330 void IoChecker::Enter(const parser::IoControlSpec::Asynchronous &spec) {
331 SetSpecifier(IoSpecKind::Asynchronous);
332 if (const std::optional<std::string> charConst{
333 GetConstExpr<std::string>(spec)}) {
334 flags_.set(
335 Flag::AsynchronousYes, parser::ToUpperCaseLetters(*charConst) == "YES");
336 CheckStringValue(IoSpecKind::Asynchronous, *charConst,
337 parser::FindSourceLocation(spec)); // C1223
338 }
339 }
340
Enter(const parser::IoControlSpec::CharExpr & spec)341 void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
342 IoSpecKind specKind{};
343 using ParseKind = parser::IoControlSpec::CharExpr::Kind;
344 switch (std::get<ParseKind>(spec.t)) {
345 case ParseKind::Advance: specKind = IoSpecKind::Advance; break;
346 case ParseKind::Blank: specKind = IoSpecKind::Blank; break;
347 case ParseKind::Decimal: specKind = IoSpecKind::Decimal; break;
348 case ParseKind::Delim: specKind = IoSpecKind::Delim; break;
349 case ParseKind::Pad: specKind = IoSpecKind::Pad; break;
350 case ParseKind::Round: specKind = IoSpecKind::Round; break;
351 case ParseKind::Sign: specKind = IoSpecKind::Sign; break;
352 }
353 SetSpecifier(specKind);
354 if (const std::optional<std::string> charConst{GetConstExpr<std::string>(
355 std::get<parser::ScalarDefaultCharExpr>(spec.t))}) {
356 if (specKind == IoSpecKind::Advance) {
357 flags_.set(
358 Flag::AdvanceYes, parser::ToUpperCaseLetters(*charConst) == "YES");
359 }
360 CheckStringValue(specKind, *charConst, parser::FindSourceLocation(spec));
361 }
362 }
363
Enter(const parser::IoControlSpec::Pos &)364 void IoChecker::Enter(const parser::IoControlSpec::Pos &) {
365 SetSpecifier(IoSpecKind::Pos);
366 }
367
Enter(const parser::IoControlSpec::Rec &)368 void IoChecker::Enter(const parser::IoControlSpec::Rec &) {
369 SetSpecifier(IoSpecKind::Rec);
370 }
371
Enter(const parser::IoControlSpec::Size &)372 void IoChecker::Enter(const parser::IoControlSpec::Size &) {
373 SetSpecifier(IoSpecKind::Size);
374 }
375
Enter(const parser::IoUnit & spec)376 void IoChecker::Enter(const parser::IoUnit &spec) {
377 if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
378 // TODO: C1201 - internal file variable must not be an array section ...
379 if (auto expr{GetExpr(*var)}) {
380 if (!ExprTypeKindIsDefault(*expr, context_)) {
381 // This may be too restrictive; other kinds may be valid.
382 context_.Say( // C1202
383 "Invalid character kind for an internal file variable"_err_en_US);
384 }
385 }
386 SetSpecifier(IoSpecKind::Unit);
387 flags_.set(Flag::InternalUnit);
388 } else if (std::get_if<parser::Star>(&spec.u)) {
389 SetSpecifier(IoSpecKind::Unit);
390 flags_.set(Flag::StarUnit);
391 }
392 }
393
Enter(const parser::MsgVariable &)394 void IoChecker::Enter(const parser::MsgVariable &) {
395 SetSpecifier(IoSpecKind::Iomsg);
396 }
397
Enter(const parser::OutputItem &)398 void IoChecker::Enter(const parser::OutputItem &) {
399 flags_.set(Flag::DataList);
400 // TODO: C1233 - output item must not be a procedure pointer
401 }
402
Enter(const parser::StatusExpr & spec)403 void IoChecker::Enter(const parser::StatusExpr &spec) {
404 SetSpecifier(IoSpecKind::Status);
405 if (const std::optional<std::string> charConst{
406 GetConstExpr<std::string>(spec)}) {
407 // Status values for Open and Close are different.
408 std::string s{parser::ToUpperCaseLetters(*charConst)};
409 if (stmt_ == IoStmtKind::Open) {
410 flags_.set(Flag::KnownStatus);
411 flags_.set(Flag::StatusNew, s == "NEW");
412 flags_.set(Flag::StatusReplace, s == "REPLACE");
413 flags_.set(Flag::StatusScratch, s == "SCRATCH");
414 // CheckStringValue compares for OPEN Status string values.
415 CheckStringValue(
416 IoSpecKind::Status, *charConst, parser::FindSourceLocation(spec));
417 return;
418 }
419 CHECK(stmt_ == IoStmtKind::Close);
420 if (s != "DELETE" && s != "KEEP") {
421 context_.Say(parser::FindSourceLocation(spec),
422 "Invalid STATUS value '%s'"_err_en_US, *charConst);
423 }
424 }
425 }
426
Enter(const parser::StatVariable &)427 void IoChecker::Enter(const parser::StatVariable &) {
428 SetSpecifier(IoSpecKind::Iostat);
429 }
430
Leave(const parser::BackspaceStmt &)431 void IoChecker::Leave(const parser::BackspaceStmt &) {
432 CheckForRequiredSpecifier(
433 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
434 stmt_ = IoStmtKind::None;
435 }
436
Leave(const parser::CloseStmt &)437 void IoChecker::Leave(const parser::CloseStmt &) {
438 CheckForRequiredSpecifier(
439 flags_.test(Flag::NumberUnit), "UNIT number"); // C1208
440 stmt_ = IoStmtKind::None;
441 }
442
Leave(const parser::EndfileStmt &)443 void IoChecker::Leave(const parser::EndfileStmt &) {
444 CheckForRequiredSpecifier(
445 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
446 stmt_ = IoStmtKind::None;
447 }
448
Leave(const parser::FlushStmt &)449 void IoChecker::Leave(const parser::FlushStmt &) {
450 CheckForRequiredSpecifier(
451 flags_.test(Flag::NumberUnit), "UNIT number"); // C1243
452 stmt_ = IoStmtKind::None;
453 }
454
Leave(const parser::InquireStmt & stmt)455 void IoChecker::Leave(const parser::InquireStmt &stmt) {
456 if (std::get_if<std::list<parser::InquireSpec>>(&stmt.u)) {
457 // Inquire by unit or by file (vs. by output list).
458 CheckForRequiredSpecifier(
459 flags_.test(Flag::NumberUnit) || specifierSet_.test(IoSpecKind::File),
460 "UNIT number or FILE"); // C1246
461 CheckForProhibitedSpecifier(IoSpecKind::File, IoSpecKind::Unit); // C1246
462 CheckForRequiredSpecifier(IoSpecKind::Id, IoSpecKind::Pending); // C1248
463 }
464 stmt_ = IoStmtKind::None;
465 }
466
Leave(const parser::OpenStmt &)467 void IoChecker::Leave(const parser::OpenStmt &) {
468 CheckForRequiredSpecifier(specifierSet_.test(IoSpecKind::Unit) ||
469 specifierSet_.test(IoSpecKind::Newunit),
470 "UNIT or NEWUNIT"); // C1204, C1205
471 CheckForProhibitedSpecifier(
472 IoSpecKind::Newunit, IoSpecKind::Unit); // C1204, C1205
473 CheckForRequiredSpecifier(flags_.test(Flag::StatusNew), "STATUS='NEW'",
474 IoSpecKind::File); // 12.5.6.10
475 CheckForRequiredSpecifier(flags_.test(Flag::StatusReplace),
476 "STATUS='REPLACE'", IoSpecKind::File); // 12.5.6.10
477 CheckForProhibitedSpecifier(flags_.test(Flag::StatusScratch),
478 "STATUS='SCRATCH'", IoSpecKind::File); // 12.5.6.10
479 if (flags_.test(Flag::KnownStatus)) {
480 CheckForRequiredSpecifier(IoSpecKind::Newunit,
481 specifierSet_.test(IoSpecKind::File) ||
482 flags_.test(Flag::StatusScratch),
483 "FILE or STATUS='SCRATCH'"); // 12.5.6.12
484 } else {
485 CheckForRequiredSpecifier(IoSpecKind::Newunit,
486 specifierSet_.test(IoSpecKind::File) ||
487 specifierSet_.test(IoSpecKind::Status),
488 "FILE or STATUS"); // 12.5.6.12
489 }
490 if (flags_.test(Flag::KnownAccess)) {
491 CheckForRequiredSpecifier(flags_.test(Flag::AccessDirect),
492 "ACCESS='DIRECT'", IoSpecKind::Recl); // 12.5.6.15
493 CheckForProhibitedSpecifier(flags_.test(Flag::AccessStream),
494 "STATUS='STREAM'", IoSpecKind::Recl); // 12.5.6.15
495 }
496 stmt_ = IoStmtKind::None;
497 }
498
Leave(const parser::PrintStmt &)499 void IoChecker::Leave(const parser::PrintStmt &) { stmt_ = IoStmtKind::None; }
500
Leave(const parser::ReadStmt &)501 void IoChecker::Leave(const parser::ReadStmt &) {
502 if (!flags_.test(Flag::IoControlList)) {
503 return;
504 }
505 LeaveReadWrite();
506 CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
507 CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
508 CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
509 CheckForRequiredSpecifier(IoSpecKind::Eor,
510 specifierSet_.test(IoSpecKind::Advance) && !flags_.test(Flag::AdvanceYes),
511 "ADVANCE with value 'NO'"); // C1222 + 12.6.2.1p2
512 CheckForRequiredSpecifier(IoSpecKind::Blank, flags_.test(Flag::FmtOrNml),
513 "FMT or NML"); // C1227
514 CheckForRequiredSpecifier(
515 IoSpecKind::Pad, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
516 stmt_ = IoStmtKind::None;
517 }
518
Leave(const parser::RewindStmt &)519 void IoChecker::Leave(const parser::RewindStmt &) {
520 CheckForRequiredSpecifier(
521 flags_.test(Flag::NumberUnit), "UNIT number"); // C1240
522 stmt_ = IoStmtKind::None;
523 }
524
Leave(const parser::WaitStmt &)525 void IoChecker::Leave(const parser::WaitStmt &) {
526 CheckForRequiredSpecifier(
527 flags_.test(Flag::NumberUnit), "UNIT number"); // C1237
528 stmt_ = IoStmtKind::None;
529 }
530
Leave(const parser::WriteStmt &)531 void IoChecker::Leave(const parser::WriteStmt &) {
532 LeaveReadWrite();
533 CheckForProhibitedSpecifier(IoSpecKind::Blank); // C1213
534 CheckForProhibitedSpecifier(IoSpecKind::End); // C1213
535 CheckForProhibitedSpecifier(IoSpecKind::Eor); // C1213
536 CheckForProhibitedSpecifier(IoSpecKind::Pad); // C1213
537 CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
538 CheckForRequiredSpecifier(
539 IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
540 CheckForRequiredSpecifier(IoSpecKind::Delim,
541 flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
542 "FMT=* or NML"); // C1228
543 stmt_ = IoStmtKind::None;
544 }
545
LeaveReadWrite() const546 void IoChecker::LeaveReadWrite() const {
547 CheckForRequiredSpecifier(IoSpecKind::Unit); // C1211
548 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Rec); // C1216
549 CheckForProhibitedSpecifier(IoSpecKind::Nml, IoSpecKind::Fmt); // C1216
550 CheckForProhibitedSpecifier(
551 IoSpecKind::Nml, flags_.test(Flag::DataList), "a data list"); // C1216
552 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
553 "UNIT=internal-file", IoSpecKind::Pos); // C1219
554 CheckForProhibitedSpecifier(flags_.test(Flag::InternalUnit),
555 "UNIT=internal-file", IoSpecKind::Rec); // C1219
556 CheckForProhibitedSpecifier(
557 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Pos); // C1219
558 CheckForProhibitedSpecifier(
559 flags_.test(Flag::StarUnit), "UNIT=*", IoSpecKind::Rec); // C1219
560 CheckForProhibitedSpecifier(
561 IoSpecKind::Rec, flags_.test(Flag::StarFmt), "FMT=*"); // C1220
562 CheckForRequiredSpecifier(IoSpecKind::Advance,
563 flags_.test(Flag::CharFmt) || flags_.test(Flag::LabelFmt),
564 "an explicit format"); // C1221
565 CheckForProhibitedSpecifier(IoSpecKind::Advance,
566 flags_.test(Flag::InternalUnit), "UNIT=internal-file"); // C1221
567 CheckForRequiredSpecifier(flags_.test(Flag::AsynchronousYes),
568 "ASYNCHRONOUS='YES'", flags_.test(Flag::NumberUnit),
569 "UNIT=number"); // C1224
570 CheckForRequiredSpecifier(IoSpecKind::Id, flags_.test(Flag::AsynchronousYes),
571 "ASYNCHRONOUS='YES'"); // C1225
572 CheckForProhibitedSpecifier(IoSpecKind::Pos, IoSpecKind::Rec); // C1226
573 CheckForRequiredSpecifier(IoSpecKind::Decimal, flags_.test(Flag::FmtOrNml),
574 "FMT or NML"); // C1227
575 CheckForRequiredSpecifier(IoSpecKind::Round, flags_.test(Flag::FmtOrNml),
576 "FMT or NML"); // C1227
577 }
578
SetSpecifier(IoSpecKind specKind)579 void IoChecker::SetSpecifier(IoSpecKind specKind) {
580 if (stmt_ == IoStmtKind::None) {
581 // FMT may appear on PRINT statements, which don't have any checks.
582 // [IO]MSG and [IO]STAT parse symbols are shared with non-I/O statements.
583 return;
584 }
585 // C1203, C1207, C1210, C1236, C1239, C1242, C1245
586 if (specifierSet_.test(specKind)) {
587 context_.Say("Duplicate %s specifier"_err_en_US,
588 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
589 }
590 specifierSet_.set(specKind);
591 }
592
CheckStringValue(IoSpecKind specKind,const std::string & value,const parser::CharBlock & source) const593 void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
594 const parser::CharBlock &source) const {
595 static std::unordered_map<IoSpecKind, const std::set<std::string>> specValues{
596 {IoSpecKind::Access, {"DIRECT", "SEQUENTIAL", "STREAM"}},
597 {IoSpecKind::Action, {"READ", "READWRITE", "WRITE"}},
598 {IoSpecKind::Advance, {"NO", "YES"}},
599 {IoSpecKind::Asynchronous, {"NO", "YES"}},
600 {IoSpecKind::Blank, {"NULL", "ZERO"}},
601 {IoSpecKind::Decimal, {"COMMA", "POINT"}},
602 {IoSpecKind::Delim, {"APOSTROPHE", "NONE", "QUOTE"}},
603 {IoSpecKind::Encoding, {"DEFAULT", "UTF-8"}},
604 {IoSpecKind::Form, {"FORMATTED", "UNFORMATTED"}},
605 {IoSpecKind::Pad, {"NO", "YES"}},
606 {IoSpecKind::Position, {"APPEND", "ASIS", "REWIND"}},
607 {IoSpecKind::Round,
608 {"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
609 {IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
610 {IoSpecKind::Status,
611 // Open values; Close values are {"DELETE", "KEEP"}.
612 {"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
613 {IoSpecKind::Convert, {"BIG_ENDIAN", "LITTLE_ENDIAN", "NATIVE"}},
614 {IoSpecKind::Dispose, {"DELETE", "KEEP"}},
615 };
616 if (!specValues.at(specKind).count(parser::ToUpperCaseLetters(value))) {
617 context_.Say(source, "Invalid %s value '%s'"_err_en_US,
618 parser::ToUpperCaseLetters(common::EnumToString(specKind)), value);
619 }
620 }
621
622 // CheckForRequiredSpecifier and CheckForProhibitedSpecifier functions
623 // need conditions to check, and string arguments to insert into a message.
624 // A IoSpecKind provides both an absence/presence condition and a string
625 // argument (its name). A (condition, string) pair provides an arbitrary
626 // condition and an arbitrary string.
627
CheckForRequiredSpecifier(IoSpecKind specKind) const628 void IoChecker::CheckForRequiredSpecifier(IoSpecKind specKind) const {
629 if (!specifierSet_.test(specKind)) {
630 context_.Say("%s statement must have a %s specifier"_err_en_US,
631 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
632 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
633 }
634 }
635
CheckForRequiredSpecifier(bool condition,const std::string & s) const636 void IoChecker::CheckForRequiredSpecifier(
637 bool condition, const std::string &s) const {
638 if (!condition) {
639 context_.Say("%s statement must have a %s specifier"_err_en_US,
640 parser::ToUpperCaseLetters(common::EnumToString(stmt_)), s);
641 }
642 }
643
CheckForRequiredSpecifier(IoSpecKind specKind1,IoSpecKind specKind2) const644 void IoChecker::CheckForRequiredSpecifier(
645 IoSpecKind specKind1, IoSpecKind specKind2) const {
646 if (specifierSet_.test(specKind1) && !specifierSet_.test(specKind2)) {
647 context_.Say("If %s appears, %s must also appear"_err_en_US,
648 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
649 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
650 }
651 }
652
CheckForRequiredSpecifier(IoSpecKind specKind,bool condition,const std::string & s) const653 void IoChecker::CheckForRequiredSpecifier(
654 IoSpecKind specKind, bool condition, const std::string &s) const {
655 if (specifierSet_.test(specKind) && !condition) {
656 context_.Say("If %s appears, %s must also appear"_err_en_US,
657 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
658 }
659 }
660
CheckForRequiredSpecifier(bool condition,const std::string & s,IoSpecKind specKind) const661 void IoChecker::CheckForRequiredSpecifier(
662 bool condition, const std::string &s, IoSpecKind specKind) const {
663 if (condition && !specifierSet_.test(specKind)) {
664 context_.Say("If %s appears, %s must also appear"_err_en_US, s,
665 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
666 }
667 }
668
CheckForRequiredSpecifier(bool condition1,const std::string & s1,bool condition2,const std::string & s2) const669 void IoChecker::CheckForRequiredSpecifier(bool condition1,
670 const std::string &s1, bool condition2, const std::string &s2) const {
671 if (condition1 && !condition2) {
672 context_.Say("If %s appears, %s must also appear"_err_en_US, s1, s2);
673 }
674 }
675
CheckForProhibitedSpecifier(IoSpecKind specKind) const676 void IoChecker::CheckForProhibitedSpecifier(IoSpecKind specKind) const {
677 if (specifierSet_.test(specKind)) {
678 context_.Say("%s statement must not have a %s specifier"_err_en_US,
679 parser::ToUpperCaseLetters(common::EnumToString(stmt_)),
680 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
681 }
682 }
683
CheckForProhibitedSpecifier(IoSpecKind specKind1,IoSpecKind specKind2) const684 void IoChecker::CheckForProhibitedSpecifier(
685 IoSpecKind specKind1, IoSpecKind specKind2) const {
686 if (specifierSet_.test(specKind1) && specifierSet_.test(specKind2)) {
687 context_.Say("If %s appears, %s must not appear"_err_en_US,
688 parser::ToUpperCaseLetters(common::EnumToString(specKind1)),
689 parser::ToUpperCaseLetters(common::EnumToString(specKind2)));
690 }
691 }
692
CheckForProhibitedSpecifier(IoSpecKind specKind,bool condition,const std::string & s) const693 void IoChecker::CheckForProhibitedSpecifier(
694 IoSpecKind specKind, bool condition, const std::string &s) const {
695 if (specifierSet_.test(specKind) && condition) {
696 context_.Say("If %s appears, %s must not appear"_err_en_US,
697 parser::ToUpperCaseLetters(common::EnumToString(specKind)), s);
698 }
699 }
700
CheckForProhibitedSpecifier(bool condition,const std::string & s,IoSpecKind specKind) const701 void IoChecker::CheckForProhibitedSpecifier(
702 bool condition, const std::string &s, IoSpecKind specKind) const {
703 if (condition && specifierSet_.test(specKind)) {
704 context_.Say("If %s appears, %s must not appear"_err_en_US, s,
705 parser::ToUpperCaseLetters(common::EnumToString(specKind)));
706 }
707 }
708
709 } // namespace Fortran::semantics
710