diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -95,6 +95,7 @@ "not yet implemented" message. * Structure field access with `.field` * `BYTE` as synonym for `INTEGER(KIND=1)`; but not when spelled `TYPE(BYTE)`. +* When kind-param is used for REAL literals, allow a matching exponent letter * Quad precision REAL literals with `Q` * `X` prefix/suffix as synonym for `Z` on hexadecimal literals * `B`, `O`, `Z`, and `X` accepted as suffixes as well as prefixes diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -19,14 +19,14 @@ FixedFormContinuationWithColumn1Ampersand, LogicalAbbreviations, XOROperator, PunctuationInNames, OptionalFreeFormSpace, BOZExtensions, EmptyStatement, AlternativeNE, ExecutionPartNamelist, DECStructures, - DoubleComplex, Byte, StarKind, QuadPrecision, SlashInitialization, - TripletInArrayConstructor, MissingColons, SignedComplexLiteral, - OldStyleParameter, ComplexConstructor, PercentLOC, SignedPrimary, FileName, - Carriagecontrol, Convert, Dispose, IOListLeadingComma, - AbbreviatedEditDescriptor, ProgramParentheses, PercentRefAndVal, - OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF, Assign, - AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand, ClassicCComments, - AdditionalFormats, BigIntLiterals, RealDoControls, + DoubleComplex, Byte, StarKind, ExponentMatchingKindParam, QuadPrecision, + SlashInitialization, TripletInArrayConstructor, MissingColons, + SignedComplexLiteral, OldStyleParameter, ComplexConstructor, PercentLOC, + SignedPrimary, FileName, Carriagecontrol, Convert, Dispose, + IOListLeadingComma, AbbreviatedEditDescriptor, ProgramParentheses, + PercentRefAndVal, OmitFunctionDummies, CrayPointer, Hollerith, ArithmeticIF, + Assign, AssignedGOTO, Pause, OpenACC, OpenMP, CruftAfterAmpersand, + ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls, EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric, EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents, OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile, diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -569,12 +569,20 @@ if (letterKind) { defaultKind = *letterKind; } - // C716 requires 'E' as an exponent, but this is more useful + // C716 requires 'E' as an exponent. + // Extension: allow exponent-letter matching the kind-param. auto kind{AnalyzeKindParam(x.kind, defaultKind)}; - if (letterKind && kind != *letterKind && expoLetter != 'e') { - Say("Explicit kind parameter on real constant disagrees with " - "exponent letter '%c'"_port_en_US, - expoLetter); + if (letterKind && expoLetter != 'e') { + if (kind != *letterKind) { + Say("Explicit kind parameter on real constant disagrees with " + "exponent letter '%c'"_warn_en_US, + expoLetter); + } else if (x.kind && + context_.ShouldWarn( + common::LanguageFeature::ExponentMatchingKindParam)) { + Say("Explicit kind parameter together with non-'E' exponent letter " + "is not standard"_port_en_US); + } } auto result{common::SearchTypes( RealTypeVisitor{kind, x.real.source, GetFoldingContext()})}; diff --git a/flang/test/Semantics/kinds04.f90 b/flang/test/Semantics/kinds04_q10.f90 rename from flang/test/Semantics/kinds04.f90 rename to flang/test/Semantics/kinds04_q10.f90 --- a/flang/test/Semantics/kinds04.f90 +++ b/flang/test/Semantics/kinds04_q10.f90 @@ -1,24 +1,32 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 -! C716 If both kind-param and exponent-letter appear, exponent-letter -! shall be E. -! C717 The value of kind-param shall specify an approximation method that +! C716 If both kind-param and exponent-letter appear, exponent-letter +! shall be E. (As an extension we also allow an exponent-letter which matches +! the kind-param) +! C717 The value of kind-param shall specify an approximation method that ! exists on the processor. +! +! This test is for x86_64, where exponent-letter 'q' is for +! 10-byte extended precision +! REQUIRES: x86-registered-target subroutine s(var) real :: realvar1 = 4.0E6_4 real :: realvar2 = 4.0D6 real :: realvar3 = 4.0Q6 real :: realvar4 = 4.0D6_8 - real :: realvar5 = 4.0Q6_16 - real :: realvar6 = 4.0E6_8 - real :: realvar7 = 4.0E6_10 - real :: realvar8 = 4.0E6_16 + real :: realvar5 = 4.0Q6_10 + !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'q' + real :: realvar6 = 4.0Q6_16 + real :: realvar7 = 4.0E6_8 + real :: realvar8 = 4.0E6_10 + real :: realvar9 = 4.0E6_16 !ERROR: Unsupported REAL(KIND=32) - real :: realvar9 = 4.0E6_32 + real :: realvar10 = 4.0E6_32 double precision :: doublevar1 = 4.0E6_4 double precision :: doublevar2 = 4.0D6 double precision :: doublevar3 = 4.0Q6 double precision :: doublevar4 = 4.0D6_8 + !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'q' double precision :: doublevar5 = 4.0Q6_16 double precision :: doublevar6 = 4.0E6_8 double precision :: doublevar7 = 4.0E6_10 diff --git a/flang/test/Semantics/kinds04.f90 b/flang/test/Semantics/kinds04_q16.f90 rename from flang/test/Semantics/kinds04.f90 rename to flang/test/Semantics/kinds04_q16.f90 --- a/flang/test/Semantics/kinds04.f90 +++ b/flang/test/Semantics/kinds04_q16.f90 @@ -1,19 +1,26 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 -! C716 If both kind-param and exponent-letter appear, exponent-letter -! shall be E. -! C717 The value of kind-param shall specify an approximation method that +! C716 If both kind-param and exponent-letter appear, exponent-letter +! shall be E. (As an extension we also allow an exponent-letter which matches +! the kind-param) +! C717 The value of kind-param shall specify an approximation method that ! exists on the processor. +! +! This test is for non-x86_64, where exponent-letter 'q' is for +! 16-byte quadruple precision +! UNSUPPORTED: x86-registered-target subroutine s(var) real :: realvar1 = 4.0E6_4 real :: realvar2 = 4.0D6 real :: realvar3 = 4.0Q6 real :: realvar4 = 4.0D6_8 - real :: realvar5 = 4.0Q6_16 - real :: realvar6 = 4.0E6_8 - real :: realvar7 = 4.0E6_10 - real :: realvar8 = 4.0E6_16 + !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'q' + real :: realvar5 = 4.0Q6_10 + real :: realvar6 = 4.0Q6_16 + real :: realvar7 = 4.0E6_8 + real :: realvar8 = 4.0E6_10 + real :: realvar9 = 4.0E6_16 !ERROR: Unsupported REAL(KIND=32) - real :: realvar9 = 4.0E6_32 + real :: realvar10 = 4.0E6_32 double precision :: doublevar1 = 4.0E6_4 double precision :: doublevar2 = 4.0D6 diff --git a/flang/test/Semantics/kinds05.f90 b/flang/test/Semantics/kinds05.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/kinds05.f90 @@ -0,0 +1,18 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic +! Check that we get portability warnings for the extensions +! - exponent-letter 'Q' +! - matching but non-'E' exponent letter together with kind-param + +subroutine s + real :: realvar1 = 4.0 + real :: realvar2 = 4.0D6 + real :: realvar3 = 4.0_8 + real :: realvar4 = 4.0E6_4 + real :: realvar5 = 4.0E6_8 + !WARNING: nonstandard usage: Q exponent + real :: realvar6 = 4.0Q6 + !WARNING: Explicit kind parameter together with non-'E' exponent letter is not standard + real :: realvar7 = 4.0D6_8 + !WARNING: Explicit kind parameter on real constant disagrees with exponent letter 'd' + real :: realvar8 = 4.0D6_4 +end subroutine s