[flang-commits] [flang] cadc07f - [flang] Legacy extension: non-character formats
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jan 14 14:17:13 PST 2022
Author: Peter Klausler
Date: 2022-01-14T14:17:05-08:00
New Revision: cadc07f01f49598560bb7f259d310d6b3c572a18
URL: https://github.com/llvm/llvm-project/commit/cadc07f01f49598560bb7f259d310d6b3c572a18
DIFF: https://github.com/llvm/llvm-project/commit/cadc07f01f49598560bb7f259d310d6b3c572a18.diff
LOG: [flang] Legacy extension: non-character formats
Very old (pre-'77 standard) codes would use arrays initialized
with Hollerith literals, typically in DATA, as modifiable
formats.
Differential Revision: https://reviews.llvm.org/D117344
Added:
Modified:
flang/docs/Extensions.md
flang/include/flang/Common/Fortran-features.h
flang/lib/Semantics/check-io.cpp
flang/test/Semantics/assign06.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6b639fa489b9..70c310151256 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -204,6 +204,11 @@ end
the component appears in a derived type with `SEQUENCE`.
(This case should probably be an exception to constraint C740 in
the standard.)
+* Format expressions that have type but are not character and not
+ integer scalars are accepted so long as they are simply contiguous.
+ This legacy extension supports pre-Fortran'77 usage in which
+ variables initialized in DATA statements with Hollerith literals
+ as modifiable formats.
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index c033de623fc0..7e64b2adfdf4 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -31,7 +31,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
- DistinguishableSpecifics, DefaultSave, PointerInSeqType)
+ DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
diff --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index fcca5f7b1291..7c2a4f77e17b 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -213,21 +213,41 @@ void IoChecker::Enter(const parser::Format &spec) {
return;
}
auto type{expr->GetType()};
- if (!type ||
- (type->category() != TypeCategory::Integer &&
- type->category() != TypeCategory::Character) ||
+ if (type && type->category() == TypeCategory::Integer &&
+ type->kind() ==
+ context_.defaultKinds().GetDefaultKind(type->category()) &&
+ expr->Rank() == 0) {
+ flags_.set(Flag::AssignFmt);
+ if (!IsVariable(*expr)) {
+ context_.Say(format.source,
+ "Assigned format label must be a scalar variable"_err_en_US);
+ }
+ return;
+ }
+ if (type && type->category() != TypeCategory::Character &&
+ (type->category() != TypeCategory::Integer ||
+ expr->Rank() > 0) &&
+ context_.IsEnabled(
+ common::LanguageFeature::NonCharacterFormat)) {
+ // Legacy extension: using non-character variables, typically
+ // DATA-initialized with Hollerith, as format expressions.
+ if (context_.ShouldWarn(
+ common::LanguageFeature::NonCharacterFormat)) {
+ context_.Say(format.source,
+ "Non-character format expression is not standard"_en_US);
+ }
+ } else if (!type ||
type->kind() !=
context_.defaultKinds().GetDefaultKind(type->category())) {
context_.Say(format.source,
- "Format expression must be default character or integer"_err_en_US);
+ "Format expression must be default character or default scalar integer"_err_en_US);
return;
}
- if (type->category() == TypeCategory::Integer) {
- flags_.set(Flag::AssignFmt);
- if (expr->Rank() != 0 || !IsVariable(*expr)) {
- context_.Say(format.source,
- "Assigned format label must be a scalar variable"_err_en_US);
- }
+ if (expr->Rank() > 0 &&
+ !IsSimplyContiguous(*expr, context_.foldingContext())) {
+ // The runtime APIs don't allow arbitrary descriptors for formats.
+ context_.Say(format.source,
+ "Format expression must be a simply contiguous array if not scalar"_err_en_US);
return;
}
flags_.set(Flag::CharFmt);
diff --git a/flang/test/Semantics/assign06.f90 b/flang/test/Semantics/assign06.f90
index 4e65a779f55b..c9e9d859add3 100644
--- a/flang/test/Semantics/assign06.f90
+++ b/flang/test/Semantics/assign06.f90
@@ -11,6 +11,8 @@ subroutine test(n)
integer(kind=1) :: badlab1
real :: badlab2
integer :: badlab3(1)
+ real, pointer :: badlab4(:) ! not contiguous
+ real, pointer, contiguous :: oklab4(:)
assign 1 to lab ! ok
assign 1 to implicitlab1 ! ok
!ERROR: 'badlab1' must be a default integer scalar variable
@@ -35,12 +37,16 @@ subroutine test(n)
assign 3 to lab ! ok
write(*,fmt=lab) ! ok
write(*,fmt=implicitlab3) ! ok
- !ERROR: Format expression must be default character or integer
+ !ERROR: Format expression must be default character or default scalar integer
write(*,fmt=badlab1)
- !ERROR: Format expression must be default character or integer
- write(*,fmt=badlab2)
- !ERROR: Format expression must be default character or integer
+ !ERROR: Format expression must be default character or default scalar integer
+ write(*,fmt=z'feedface')
+ !Legacy extension cases
write(*,fmt=badlab2)
+ write(*,fmt=badlab3)
+ !ERROR: Format expression must be a simply contiguous array if not scalar
+ write(*,fmt=badlab4)
+ write(*,fmt=badlab5) ! ok legacy extension
1 continue
3 format('yes')
end subroutine test
More information about the flang-commits
mailing list