void IoChecker::Enter(const parser::IoUnit &spec) {
if (const parser::Variable * var{std::get_if<parser::Variable>(&spec.u)}) {
- if (stmt_ == IoStmtKind::Write) {
- CheckForDefinableVariable(*var, "Internal file");
+ // Only now after generic resolution can it be known whether a function
+ // call appearing as UNIT=f() is an integer scalar external unit number
+ // or a character pointer for internal I/O.
+ const auto *expr{GetExpr(context_, *var)};
+ std::optional<evaluate::DynamicType> dyType;
+ if (expr) {
+ dyType = expr->GetType();
}
- if (const auto *expr{GetExpr(context_, *var)}) {
+ if (dyType && dyType->category() == TypeCategory::Integer) {
+ if (expr->Rank() != 0) {
+ context_.Say(parser::FindSourceLocation(*var),
+ "I/O unit number must be scalar"_err_en_US);
+ }
+ // In the case of an integer unit number variable, rewrite the parse
+ // tree as if the unit had been parsed as a FileUnitNumber in order
+ // to ease lowering.
+ auto &mutableSpec{const_cast<parser::IoUnit &>(spec)};
+ auto &mutableVar{std::get<parser::Variable>(mutableSpec.u)};
+ auto source{mutableVar.GetSource()};
+ auto typedExpr{std::move(mutableVar.typedExpr)};
+ auto newExpr{common::visit(
+ [](auto &&indirection) {
+ return parser::Expr{std::move(indirection)};
+ },
+ std::move(mutableVar.u))};
+ newExpr.source = source;
+ newExpr.typedExpr = std::move(typedExpr);
+ mutableSpec.u = parser::FileUnitNumber{
+ parser::ScalarIntExpr{parser::IntExpr{std::move(newExpr)}}};
+ } else if (!dyType || dyType->category() != TypeCategory::Character) {
+ SetSpecifier(IoSpecKind::Unit);
+ context_.Say(parser::FindSourceLocation(*var),
+ "I/O unit must be a character variable or a scalar integer expression"_err_en_US);
+ } else { // CHARACTER variable (internal I/O)
+ if (stmt_ == IoStmtKind::Write) {
+ CheckForDefinableVariable(*var, "Internal file");
+ }
if (HasVectorSubscript(*expr)) {
context_.Say(parser::FindSourceLocation(*var), // C1201
"Internal file must not have a vector subscript"_err_en_US);
}
+ SetSpecifier(IoSpecKind::Unit);
+ flags_.set(Flag::InternalUnit);
}
- SetSpecifier(IoSpecKind::Unit);
- flags_.set(Flag::InternalUnit);
} else if (std::get_if<parser::Star>(&spec.u)) {
SetSpecifier(IoSpecKind::Unit);
flags_.set(Flag::StarUnit);
void Post(parser::Name &);
void Post(parser::SpecificationPart &);
bool Pre(parser::ExecutionPart &);
- void Post(parser::IoUnit &);
void Post(parser::ReadStmt &);
void Post(parser::WriteStmt &);
return true;
}
-// Convert a syntactically ambiguous io-unit internal-file-variable to a
-// file-unit-number.
-void RewriteMutator::Post(parser::IoUnit &x) {
- if (auto *var{std::get_if<parser::Variable>(&x.u)}) {
- const parser::Name &last{parser::GetLastName(*var)};
- DeclTypeSpec *type{last.symbol ? last.symbol->GetType() : nullptr};
- if (!type || type->category() != DeclTypeSpec::Character) {
- // If the Variable is not known to be character (any kind), transform
- // the I/O unit in situ to a FileUnitNumber so that automatic expression
- // constraint checking will be applied.
- auto source{var->GetSource()};
- auto expr{common::visit(
- [](auto &&indirection) {
- return parser::Expr{std::move(indirection)};
- },
- std::move(var->u))};
- expr.source = source;
- x.u = parser::FileUnitNumber{
- parser::ScalarIntExpr{parser::IntExpr{std::move(expr)}}};
- }
- }
-}
-
// When a namelist group name appears (without NML=) in a READ or WRITE
// statement in such a way that it can be misparsed as a format expression,
// rewrite the I/O statement's parse tree node as if the namelist group
!ERROR: If UNIT=* appears, REC must not appear
write(*, rec=13) 'Ok'
- !ERROR: Must have INTEGER type, but is REAL(4)
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
write(unit, *) 'Ok'
!ERROR: If ADVANCE appears, UNIT=internal-file must not appear
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for UNIT=function()
+module m1
+ integer, target :: itarget
+ character(20), target :: ctarget
+ logical, target :: ltarget
+ interface gf
+ module procedure :: intf, pintf, pchf, logf, plogf
+ end interface
+ contains
+ integer function intf(n)
+ integer(1), intent(in) :: n
+ intf = n
+ end function
+ function pintf(n)
+ integer(2), intent(in) :: n
+ integer, pointer :: pintf
+ pintf => itarget
+ pintf = n
+ end function
+ function pchf(n)
+ integer(4), intent(in) :: n
+ character(:), pointer :: pchf
+ pchf => ctarget
+ end function
+ logical function logf(n)
+ integer(8), intent(in) :: n
+ logf = .true.
+ end function
+ function plogf(n)
+ integer(16), intent(in) :: n
+ logical, pointer :: plf
+ plf => ltarget
+ end function
+ subroutine test
+ write(intf(6_1),"('hi')")
+ write(pintf(6_2),"('hi')")
+ write(pchf(123_4),"('hi')")
+ write(gf(6_1),"('hi')")
+ write(gf(6_2),"('hi')")
+ write(gf(666_4),"('hi')")
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
+ write(logf(666_8),"('hi')")
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
+ write(plogf(666_16),"('hi')")
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
+ write(gf(666_8),"('hi')")
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
+ write(gf(666_16),"('hi')")
+ !ERROR: I/O unit must be a character variable or a scalar integer expression
+ write(null(),"('hi')")
+ end subroutine
+end module