mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-26 10:26:06 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Catch misuse of a procedure designator as an output item

Browse Source 
f18 was diagnosing the misuse of a procedure pointer as an output item,
but not the more general case of a procedure designator other than
a pointer.

Differential Revision: https://reviews.llvm.org/D143780
This commit is contained in:
Peter Klausler 2023-02-02 16:50:09 -08:00
parent 57751e60e3
commit aa128bb21e
3 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
flang/lib/Semantics/check-io.cpp
View File

@ -613,11 +613,9 @@ void IoChecker::Enter(const parser::OutputItem &item) {
if (evaluate::IsBOZLiteral(*expr)) {
context_.Say(parser::FindSourceLocation(*x), // C7109
"Output item must not be a BOZ literal constant"_err_en_US);
}
const Symbol *last{GetLastSymbol(*expr)};
if (last && IsProcedurePointer(*last)) {
} else if (IsProcedure(*expr)) {
context_.Say(parser::FindSourceLocation(*x),
"Output item must not be a procedure pointer"_err_en_US); // C1233
"Output item must not be a procedure"_err_en_US); // C1233
}
CheckForBadIoType(*expr,
flags_.test(Flag::FmtOrNml)

8
flang/lib/Semantics/expression.cpp
View File

@ -566,10 +566,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))};
if (!dataRef) {
dataRef = ExtractDataRef(std::move(result), /*intoSubstring=*/true);
if (!dataRef) {
dataRef = ExtractDataRef(std::move(result),
/*intoSubstring=*/false, /*intoComplexPart=*/true);
}
}
if (!dataRef) {
dataRef = ExtractDataRef(std::move(result),
/*intoSubstring=*/false, /*intoComplexPart=*/true);
}
if (dataRef && !CheckDataRef(*dataRef)) {
result.reset();

10
flang/test/Semantics/io04.f90
View File

@ -12,6 +12,8 @@
integer, pointer :: a(:)
integer, parameter :: const_id = 66666
procedure(), pointer :: procptr
external external
intrinsic acos
namelist /nnn/ nn1, nn2
@ -134,8 +136,12 @@
write(*, '(X)')
!ERROR: Output item must not be a procedure pointer
print*, n1, procptr, n2
!ERROR: Output item must not be a procedure
print*, procptr
!ERROR: Output item must not be a procedure
print*, acos
!ERROR: Output item must not be a procedure
print*, external
1 format (A)
9 continue