[flang] Fix COMPLEX/REAL `/` and `**` operand promotion

The real operand was always converted to the complex operand type.
The highest precison should be used instead. This fix converts the
real to a complex of the same kind before applying the promotion
rules for complex operands.
Reference to Fortran 2018 standard 10.9.1.3 that rules this added
in comments.

Original-commit: flang-compiler/f18@0d6b9c33aa
Reviewed-on: https://github.com/flang-compiler/f18/pull/858
This commit is contained in:
Jean Perier 2019-12-06 01:18:20 -08:00
parent f8ae66dd11
commit ce1bd44198
2 changed files with 30 additions and 4 deletions

View File

@ -184,6 +184,20 @@ Expr<SomeReal> GetComplexPart(const Expr<SomeComplex> &z, bool isImaginary) {
z.u);
}
// Convert REAL to COMPLEX of the same kind. Preserving the real operand kind
// and then applying complex operand promotion rules allows the result to have
// the highest precision of REAL and COMPLEX operands as required by Fortran
// 2018 10.9.1.3.
Expr<SomeComplex> PromoteRealToComplex(Expr<SomeReal> &&someX) {
return std::visit(
[](auto &&x) {
using RT = ResultType<decltype(x)>;
return AsCategoryExpr(ComplexConstructor<RT::kind>{
std::move(x), AsExpr(Constant<RT>{Scalar<RT>{}})});
},
std::move(someX.u));
}
// Handle mixed COMPLEX+REAL (or INTEGER) operations in a better way
// than just converting the second operand to COMPLEX and performing the
// corresponding COMPLEX+COMPLEX operation.
@ -230,8 +244,13 @@ std::optional<Expr<SomeType>> MixedComplexLeft(
std::move(zx.u)));
} else if (defaultRealKind != 666) { // dodge unused parameter warning
// (a,b) ** x -> (a,b) ** (x,0)
if constexpr (RCAT == TypeCategory::Integer) {
Expr<SomeComplex> zy{ConvertTo(zx, std::move(iry))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
} else {
Expr<SomeComplex> zy{PromoteRealToComplex(std::move(iry))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
}
}
return NoExpr();
}
@ -264,8 +283,13 @@ std::optional<Expr<SomeType>> MixedComplexRight(
}
} else if (defaultRealKind != 666) { // dodge unused parameter warning
// x / (a,b) -> (x,0) / (a,b)
Expr<SomeComplex> zx{ConvertTo(zy, std::move(irx))};
if constexpr (LCAT == TypeCategory::Integer) {
Expr<SomeComplex> zx{ConvertTo(zx, std::move(irx))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
} else {
Expr<SomeComplex> zx{PromoteRealToComplex(std::move(irx))};
return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
}
}
return NoExpr();
}

View File

@ -99,6 +99,8 @@ module m
logical, parameter :: test_pow2 = (1**100).EQ.(1)
logical, parameter :: test_pow3 = (2**4).EQ.(16)
logical, parameter :: test_pow4 = (7**5).EQ.(16807)
logical, parameter :: test_pow5 = kind(real(1., kind=8)**cmplx(1., kind=4)).EQ.(8)
logical, parameter :: test_pow6 = kind(cmplx(1., kind=4)**real(1., kind=8)).EQ.(8)
! test MIN and MAX
real, parameter :: x1 = -35., x2= -35.05, x3=0., x4=35.05, x5=35.