[flang] Fix intrinsic interface for DIMAG/DCONJG

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.

Reviewed By: Jean Perier

Differential Revision: https://reviews.llvm.org/D123459

flang/lib/Evaluate/intrinsics.cpp

@@ -955,7 +955,8 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
              {"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}},
@@ -964,7 +965,7 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"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"},

flang/test/Lower/Intrinsics/dconjg.f90

@@ -0,0 +1,19 @@
+! 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

@@ -0,0 +1,17 @@
+! 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

@@ -0,0 +1,17 @@
+! 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

@@ -0,0 +1,41 @@
+! 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)
+
+  print *, dreal(c4)
+
+  print *, dreal(c8)
+
+  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

@@ -237,9 +237,6 @@ void TestIntrinsics() {
   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());