[flang] Fix intrinsic interface for DIMAG/DCONJG

[peixin]

Summary

The intrinsics DREAL, DIMAG, and DCONJG are from Fortran 77 extensions.
For DREAL, the type of argument is extended to any complex. For DIMAG
and DCONJG, the type of argument for them should be complex(8). For DIMAG,
the result type should be real(8). For DCONJG, the result type should be
complex(8). Fix the intrinsic interface for them and add test cases for
the semantic checks and the lowering.

[peixin]

gfortran 11.2:
https://gcc.gnu.org/onlinedocs/gcc-11.2.0/gfortran/DREAL.html#DREAL
https://gcc.gnu.org/onlinedocs/gcc-11.2.0/gfortran/AIMAG.html#AIMAG
https://gcc.gnu.org/onlinedocs/gcc-11.2.0/gfortran/CONJG.html#CONJG

ifort:
https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/c-to-d/dreal.html#dreal
https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/a-to-b/aimag.html#aimag
https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/c-to-d/conjg.html#conjg

[peixin]

1. Update the summary: Fortran 77 -> Fortran 77 extensions.
2. Remove the isRestrictedSpecific for DIMAG and DCONJG.

The semantic errors are tested for gfortran 11.2/ifort 2021.5.0/ifx 2022.0.0 in https://gcc.godbolt.org/z/dT1dchYjY. The patch makes it to be consistent with gfortran/ifort/ifx.

[jeanPerier]

Given dconjg and dimag are unrestricted specific intrinsic procedures, your change makes sense to me (we need an exact type for them, and we most likely had issues when lowering code that passed them as dummy procedure arguments).

However, given dreal is restricted, I do not know how useful it is to forbid it from accepting arguments of any complex type. In my opinion, the behavior of accepting this as an extension is pretty clear (as mentioned in the comment updated by this patch). Nvfortran actually accepts non complex(8) arguments. But I grant you it is the only compiler accepting that, so I am not strongly opposed being stricter here too. I would vote to keep dreal accepting non complex(8) so that we are consistent with the behavior of accepting this on all the specific conversion intrinsic procedures (dcmplx, dreal, float, idint, ifix, and sngl).

So please wait for a second opinion on dreal.

flang/test/Lower/intrinsics-1.f90

4 ↗

(On Diff #421772)

Intrinsics lowering tests are in https://github.com/llvm/llvm-project/tree/main/flang/test/Lower/Intrinsics/[intrinsic-name].f90, please use that pattern for these new tests.

[peixin]

I would vote to keep dreal accepting non complex(8) so that we are consistent with the behavior of accepting this on all the specific conversion intrinsic procedures (dcmplx, dreal, float, idint, ifix, and sngl).

For dcmplx, gfortran and ifort accepts any integer, real or complex. It seems each intrinsic should be checked case-by-case.
https://gcc.gnu.org/onlinedocs/gcc-11.2.0/gfortran/DCMPLX.html#DCMPLX
https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/c-to-d/dcmplx.html

For dreal, accepting complex(4) is totally fine and should have no risk. For complex(16), one warning may should be reported.

I will wait for others' comments.

[peixin]

Move flang/test/Lower/intrinsics-1.f90 to flang/test/Lower/Intrinsics/[intrinsic-name].f90.

[klausler]

The restricted specific intrinsic could actually be loosened to accept any numeric argument and would still work. I don't see why it should be made more particular. Usage accepted by other compilers should work in f18 unless there's a good reason otherwise.

[peixin]

Thanks @jeanPerier and @klausler for the opinions. Remove the DREAL fix and change the title and summary.

Although I think one warning should be emitted for the argument complex(16), I am not working on this for now. Current LLVM Flang doesn't emit warnings for a variety of cases other compilers support such as passing the actual argument of character(10) to the dummy argument of character(2). I will give high priority for severe problems, especially severe errors in workloads.

[jeanPerier]

Thanks for the fix

flang/lib/Evaluate/intrinsics.cpp

static const std::pair<const char *, const char *> genericAlias[]{
     {"xor", "ieor"},
     {"__builtin_ieee_selected_real_kind", "selected_real_kind"},
 };
 
 // The following table contains the intrinsic functions listed in
 // Tables 16.2 and 16.3 in Fortran 2018.  The "unrestricted" functions
 // in Table 16.2 can be used as actual arguments, PROCEDURE() interfaces,
 // and procedure pointer targets.
-// Note that the restricted conversion functions dcmplx, dreal, float, idint,
-// ifix, and sngl are extended to accept any argument kind because this is a
-// common Fortran compilers behavior, and as far as we can tell, is safe and
-// useful.
+// Note that the restricted conversion functions dcmplx, float, idint, ifix, and
+// sngl are extended to accept any argument kind because this is a common
+// Fortran compilers behavior, and as far as we can tell, is safe and useful.
 struct SpecificIntrinsicInterface : public IntrinsicInterface {
   const char *generic{nullptr};
   bool isRestrictedSpecific{false};
   // Exact actual/dummy type matching is required by default for specific
   // intrinsics. If useGenericAndForceResultType is set, then the probing will
   // also attempt to use the related generic intrinsic and to convert the result
   // to the specific intrinsic result type if needed. This also prevents
   // using the generic name so that folding can insert the conversion on the
static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
          DoublePrecision},
         "atan2"},
     {{"dcmplx", {{"x", AnyComplex}}, DoublePrecisionComplex}, "cmplx", true},
     {{"dcmplx",
          {{"x", AnyIntOrReal, Rank::elementalOrBOZ},
              {"y", AnyIntOrReal, Rank::elementalOrBOZ, Optionality::optional}},
          DoublePrecisionComplex},
         "cmplx", true},
-    {{"dconjg", {{"z", AnyComplex}}, DoublePrecisionComplex}, "conjg"},
+    {{"dconjg", {{"z", DoublePrecisionComplex}}, DoublePrecisionComplex},
+        "conjg"},
     {{"dcos", {{"x", DoublePrecision}}, DoublePrecision}, "cos"},
     {{"dcosh", {{"x", DoublePrecision}}, DoublePrecision}, "cosh"},
     {{"ddim", {{"x", DoublePrecision}, {"y", DoublePrecision}},
          DoublePrecision},
         "dim"},
     {{"dexp", {{"x", DoublePrecision}}, DoublePrecision}, "exp"},
     {{"dfloat", {{"a", AnyInt}}, DoublePrecision}, "real", true},
     {{"dim", {{"x", DefaultReal}, {"y", DefaultReal}}, DefaultReal}},
-    {{"dimag", {{"z", AnyComplex}}, DoublePrecision}, "aimag"},
+    {{"dimag", {{"z", DoublePrecisionComplex}}, DoublePrecision}, "aimag"},
     {{"dint", {{"a", DoublePrecision}}, DoublePrecision}, "aint"},
     {{"dlog", {{"x", DoublePrecision}}, DoublePrecision}, "log"},
     {{"dlog10", {{"x", DoublePrecision}}, DoublePrecision}, "log10"},
     {{"dmax1",
          {{"a1", DoublePrecision}, {"a2", DoublePrecision},
              {"a3", DoublePrecision, Rank::elemental, Optionality::repeats}},
          DoublePrecision},
         "max", true, true},
     {{"dmin1",
          {{"a1", DoublePrecision}, {"a2", DoublePrecision},
              {"a3", DoublePrecision, Rank::elemental, Optionality::repeats}},
          DoublePrecision},
         "min", true, true},
     {{"dmod", {{"a", DoublePrecision}, {"p", DoublePrecision}},
          DoublePrecision},
         "mod"},
     {{"dnint", {{"a", DoublePrecision}}, DoublePrecision}, "anint"},
     {{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision}},
-    {{"dreal", {{"a", AnyComplex}}, DoublePrecision}, "real", true},
+    {{"dreal", {{"a", DoublePrecisionComplex}}, DoublePrecision}, "real", true},
     {{"dsign", {{"a", DoublePrecision}, {"b", DoublePrecision}},
          DoublePrecision},
         "sign"},
     {{"dsin", {{"x", DoublePrecision}}, DoublePrecision}, "sin"},
     {{"dsinh", {{"x", DoublePrecision}}, DoublePrecision}, "sinh"},
     {{"dsqrt", {{"x", DoublePrecision}}, DoublePrecision}, "sqrt"},
     {{"dtan", {{"x", DoublePrecision}}, DoublePrecision}, "tan"},
     {{"dtanh", {{"x", DoublePrecision}}, DoublePrecision}, "tanh"},

flang/test/Lower/Intrinsics/dconjg.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+subroutine test_dconjg(r, c)
+  complex(8), intent(out) :: r
+  complex(8), intent(in) :: c
+
+! CHECK-LABEL: func @_QPtest_dconjg(
+! CHECK-SAME: %[[ARG_0:.*]]: !fir.ref<!fir.complex<8>> {fir.bindc_name = "r"},
+! CHECK-SAME: %[[ARG_1:.*]]: !fir.ref<!fir.complex<8>> {fir.bindc_name = "c"}) {
+! CHECK:   %[[VAL_0:.*]] = fir.load %[[ARG_1]] : !fir.ref<!fir.complex<8>>
+! CHECK:   %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (!fir.complex<8>) -> f64
+! CHECK:   %[[VAL_2:.*]] = arith.negf %[[VAL_1]] : f64
+! CHECK:   %[[VAL_3:.*]] = fir.insert_value %[[VAL_0]], %[[VAL_2]], [1 : index] : (!fir.complex<8>, f64) -> !fir.complex<8>
+! CHECK:   fir.store %[[VAL_3]] to %[[ARG_0]] : !fir.ref<!fir.complex<8>>
+! CHECK:   return
+! CHECK: }
+
+  r = dconjg(c)
+end

flang/test/Lower/Intrinsics/dimag.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+subroutine test_dimag(r, c)
+  real(8), intent(out) :: r
+  complex(8), intent(in) :: c
+
+! CHECK-LABEL: func @_QPtest_dimag(
+! CHECK-SAME: %[[ARG_0:.*]]: !fir.ref<f64> {fir.bindc_name = "r"},
+! CHECK-SAME: %[[ARG_1:.*]]: !fir.ref<!fir.complex<8>> {fir.bindc_name = "c"}) {
+! CHECK:   %[[VAL_0:.*]] = fir.load %[[ARG_1]] : !fir.ref<!fir.complex<8>>
+! CHECK:   %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (!fir.complex<8>) -> f64
+! CHECK:   fir.store %[[VAL_1]] to %[[ARG_0]] : !fir.ref<f64>
+! CHECK:   return
+! CHECK: }
+
+  r = dimag(c)
+end

flang/test/Lower/Intrinsics/dreal.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+subroutine test_dreal(r, c)
+  real(8), intent(out) :: r
+  complex(8), intent(in) :: c
+
+! CHECK-LABEL: func @_QPtest_dreal(
+! CHECK-SAME: %[[ARG_0:.*]]: !fir.ref<f64> {fir.bindc_name = "r"},
+! CHECK-SAME: %[[ARG_1:.*]]: !fir.ref<!fir.complex<8>> {fir.bindc_name = "c"}) {
+! CHECK:   %[[VAL_0:.*]] = fir.load %[[ARG_1]] : !fir.ref<!fir.complex<8>>
+! CHECK:   %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (!fir.complex<8>) -> f64
+! CHECK:   fir.store %[[VAL_1]] to %[[ARG_0]] : !fir.ref<f64>
+! CHECK:   return
+! CHECK: }
+
+  r = dreal(c)
+end

flang/test/Semantics/intrinsics01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors for DREAL, DIMAG, DCONJG intrinsics
+
+subroutine s()
+  real :: a
+  complex(4) :: c4 ! test scalar
+  complex(8) :: c8
+  complex(16) :: c16(2) ! test array
+
+  !ERROR: Actual argument for 'a=' has bad type 'REAL(4)'
+  print *, dreal(a)
+
+  !ERROR: Actual argument for 'a=' has bad type or kind 'COMPLEX(4)'
+  print *, dreal(c4)
+
+  print *, dreal(c8)
+
+  !ERROR: Actual argument for 'a=' has bad type or kind 'COMPLEX(16)'
+  print *, dreal(c16)
+
+  !ERROR: Actual argument for 'z=' has bad type 'REAL(4)'
+  print *, dimag(a)
+
+  !ERROR: Actual argument for 'z=' has bad type or kind 'COMPLEX(4)'
+  print *, dimag(c4)
+
+  print *, dimag(c8)
+
+  !ERROR: Actual argument for 'z=' has bad type or kind 'COMPLEX(16)'
+  print *, dimag(c16)
+
+  !ERROR: Actual argument for 'z=' has bad type 'REAL(4)'
+  print *, dconjg(a)
+
+  !ERROR: Actual argument for 'z=' has bad type or kind 'COMPLEX(4)'
+  print *, dconjg(c4)
+
+  print *, dconjg(c8)
+
+  !ERROR: Actual argument for 'z=' has bad type or kind 'COMPLEX(16)'
+  print *, dconjg(c16)
+
+end subroutine

flang/unittests/Evaluate/intrinsics.cpp

void TestIntrinsics() {
 
   TestCall{defaults, table, "conjg"}
       .Push(Const(Scalar<Complex4>{}))
       .DoCall(Complex4::GetType());
   TestCall{defaults, table, "conjg"}
       .Push(Const(Scalar<Complex8>{}))
       .DoCall(Complex8::GetType());
   TestCall{defaults, table, "dconjg"}
-      .Push(Const(Scalar<Complex4>{}))
-      .DoCall(Complex8::GetType());
-  TestCall{defaults, table, "dconjg"}
       .Push(Const(Scalar<Complex8>{}))
       .DoCall(Complex8::GetType());
 
   TestCall{defaults, table, "float"}.Push(Const(Scalar<Real4>{})).DoCall();
   TestCall{defaults, table, "float"}
       .Push(Const(Scalar<Int4>{}))
       .DoCall(Real4::GetType());
   TestCall{defaults, table, "idint"}.Push(Const(Scalar<Int4>{})).DoCall();