added checks for type and dimension compability in maths intrinsic functions

7 files changed, 67 insertions, 22 deletions

diff --git a/include/flang/Basic/DiagnosticSemaKinds.td b/include/flang/Basic/DiagnosticSemaKinds.td
index 2ded6c4136..e066a37c39 100644
--- a/include/flang/Basic/DiagnosticSemaKinds.td
+++ b/include/flang/Basic/DiagnosticSemaKinds.td
@@ -51,6 +51,8 @@ def err_typecheck_passing_incompatible_named_args : Error<
   "passing %0 to parameter '%1' of incompatible type %2 (or parameter '%3' of type %4)">;
 def note_typecheck_passing_argument_to_param_here : Note<
   "passing argument to parameter %0 here">;
+def err_typecheck_arg_conflict_type : Error<
+  "conflicting types in arguments '%0' and '%1' (%2 and %3)">;
 def note_typecheck_initializing_member_here : Note<
   "initializing member %0 declared here">;
 
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index 7ff3f38305..4d664cc52a 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -841,6 +841,10 @@ public:
                                    bool AllowArrays,
                                    StringRef ArgName = StringRef());
 
+  bool CheckArgumentsTypeCompability(const Expr *E1, const Expr *E2,
+                                     StringRef ArgName1, StringRef ArgName2,
+                                     bool AllowArrays = false);
+
   /// Returns false if the argument's type is built in.
   bool CheckBuiltinTypeArgument(const Expr *E, bool AllowArrays = false);
 
diff --git a/lib/CodeGen/CGArray.cpp b/lib/CodeGen/CGArray.cpp
index ed842c4c7e..30974e2d63 100644
--- a/lib/CodeGen/CGArray.cpp
+++ b/lib/CodeGen/CGArray.cpp
@@ -578,18 +578,18 @@ RValueTy ArrayOperationEmitter::VisitIntrinsicCallExpr(const IntrinsicCallExpr *
     auto FirstVal = Emit(Args[0]);
 
     if(Func == INT || Func == REAL)
-      return CGF.EmitImplicitConversion(FirstVal, E->getType());
+      return CGF.EmitImplicitConversion(FirstVal, E->getType().getSelfOrArrayElementType());
     else if(Func == CMPLX) {
       if(FirstVal.isComplex())
         return CGF.EmitComplexToComplexConversion(FirstVal.asComplex(),
-                                                  E->getType());
+                                                  E->getType().getSelfOrArrayElementType());
       if(Args.size() >= 2) {
-        auto ElementType = CGF.getContext().getComplexTypeElementType(E->getType());
+        auto ElementType = CGF.getContext().getComplexTypeElementType(E->getType().getSelfOrArrayElementType());
         return ComplexValueTy(CGF.EmitScalarToScalarConversion(FirstVal.asScalar(), ElementType),
                               CGF.EmitScalarToScalarConversion(Emit(Args[1]).asScalar(), ElementType));
       }
       else return CGF.EmitScalarToComplexConversion(FirstVal.asScalar(),
-                                                    E->getType());
+                                                    E->getType().getSelfOrArrayElementType());
     }
     break;
   }
diff --git a/lib/Sema/SemaChecking.cpp b/lib/Sema/SemaChecking.cpp
index 5ddb1ee2ad..48441595f1 100644
--- a/lib/Sema/SemaChecking.cpp
+++ b/lib/Sema/SemaChecking.cpp
@@ -458,6 +458,27 @@ bool Sema::DiagnoseIncompatiblePassing(const Expr *E, StringRef T,
   return true;
 }
 
+bool Sema::CheckArgumentsTypeCompability(const Expr *E1, const Expr *E2,
+                                         StringRef ArgName1, StringRef ArgName2,
+                                         bool AllowArrays) {
+  // assume builtin type
+  auto Type1 = getBuiltinType(E1, AllowArrays);
+  auto Type2 = getBuiltinType(E2, AllowArrays);
+  auto T1 = AllowArrays? E1->getType().getSelfOrArrayElementType() : E1->getType();
+  auto T2 = AllowArrays? E2->getType().getSelfOrArrayElementType() : E2->getType();
+  auto Ext1 = T1.getExtQualsPtrOrNull();
+  auto Ext2 = T2.getExtQualsPtrOrNull();
+  if(!Type2 || Type1->getTypeSpec() != Type2->getTypeSpec() ||
+     Context.getArithmeticOrLogicalTypeKind(Ext1,T1) != Context.getArithmeticOrLogicalTypeKind(Ext2, T2)) {
+    Diags.Report(E2->getLocation(), diag::err_typecheck_arg_conflict_type)
+     << ArgName1 << ArgName2
+     << T1 << T2
+     << E1->getSourceRange() << E2->getSourceRange();
+    return true;
+  }
+  return false;
+}
+
 bool Sema::CheckBuiltinTypeArgument(const Expr *E, bool AllowArrays) {
   auto Type = getBuiltinType(E, AllowArrays);
   if(!Type)
diff --git a/lib/Sema/SemaIntrinsic.cpp b/lib/Sema/SemaIntrinsic.cpp
index e6aa069e25..71245decb4 100644
--- a/lib/Sema/SemaIntrinsic.cpp
+++ b/lib/Sema/SemaIntrinsic.cpp
@@ -125,8 +125,10 @@ bool Sema::CheckIntrinsicConversionFunc(intrinsic::FunctionKind Function,
   case DCMPLX:
     CheckIntegerOrRealOrComplexArgument(Item , true);
     if(Args.size() > 1) {
-      if(!Item->getType().getSelfOrArrayElementType()->isComplexType())
+      if(!Item->getType().getSelfOrArrayElementType()->isComplexType()) {
         CheckIntegerOrRealArgument(Args[1], true);
+        CheckArrayArgumentsDimensionCompability(Item, Args[1], "x", "y");
+      }
     }
     ReturnType = GetUnaryReturnType(Item, Kind? ApplyTypeKind(Context.ComplexTy, Kind) :
                                      (Function == CMPLX? Context.ComplexTy :
@@ -238,37 +240,32 @@ bool Sema::CheckIntrinsicMathsFunc(intrinsic::FunctionKind Function,
     if(GenericFunction != Function) {
       switch(Function) {
       case ISIGN: case IDIM:
-        CheckIntegerArgument(FirstArg);
-        CheckIntegerArgument(SecondArg);
+        CheckIntegerArgument(FirstArg, true);
         break;
       case AMOD:
-        CheckRealArgument(FirstArg);
-        CheckRealArgument(SecondArg);
+        CheckRealArgument(FirstArg, true);
         break;
       case DMOD: case DSIGN: case DDIM:
       case DATAN2:
-        CheckDoublePrecisionRealArgument(FirstArg);
-        CheckDoublePrecisionRealArgument(SecondArg);
+        CheckDoublePrecisionRealArgument(FirstArg, true);
         break;
       }
     }
     else {
-      if(GenericFunction == ATAN2) {
-        CheckRealArgument(FirstArg);
-        CheckRealArgument(SecondArg);
-      } else {
-        CheckIntegerOrRealArgument(FirstArg);
-        CheckIntegerOrRealArgument(SecondArg);
-      }
+      if(GenericFunction == ATAN2)
+        CheckRealArgument(FirstArg, true);
+     else
+        CheckIntegerOrRealArgument(FirstArg, true);
     }
-    CheckExpressionListSameTypeKind(Args);
-    ReturnType = FirstArg->getType();
+    CheckArgumentsTypeCompability(FirstArg, SecondArg, "x", "y", true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "x", "y");
+    ReturnType = FirstArg->getType(); // FIXME: Binary type
     break;
 
   case DPROD:
     CheckStrictlyRealArgument(FirstArg, true);
     CheckStrictlyRealArgument(SecondArg, true);
-    // FIXME: compability
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "x", "y");
     ReturnType = GetBinaryReturnType(FirstArg, SecondArg, Context.DoublePrecisionTy);
     break;
 
diff --git a/test/Sema/intrinsicArrayOperations.f95 b/test/Sema/intrinsicArrayOperations.f95
index 8d347f80f2..02bd1d7774 100644
--- a/test/Sema/intrinsicArrayOperations.f95
+++ b/test/Sema/intrinsicArrayOperations.f95
@@ -2,8 +2,9 @@
 ! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
 program intrinfuntest
   integer i_mat(4,4), i_arr(5)
+  integer(8) i64
   real r_mat(4,4), r_arr(10)
-  complex c_mat(4,4)
+  complex c_mat(4,4), c_arr(5)
   character char_mat(4,4)
   logical l_mat(4,4)
 
@@ -39,14 +40,30 @@ program intrinfuntest
   r_arr = real( (/ i_arr, 6,7,8,9,10 /) )
   r_mat = int(c_mat) ! CHECK: r_mat = real(int(c_mat))
   r_mat = real(i_arr) ! expected-error {{conflicting shapes in an array expression (2 dimensions and 1 dimension)}}
+  c_mat = cmplx(i_mat, i_arr) ! expected-error {{conflicting shapes in arguments 'x' and 'y' (2 dimensions and 1 dimension)}}
+  c_arr = cmplx(i_arr, r_arr) ! expected-error {{conflicting size for dimension 1 in arguments 'x' and 'y' (5 and 10)}}
 
 !! misc and maths functions
 
+  i_mat = mod(i_mat,i_mat)
+  i_mat = mod(i_mat,7)
+  i_mat = mod(i_mat,i64) ! expected-error {{conflicting types in arguments 'x' and 'y' ('integer' and 'integer (Kind=8)')}}
+  r_mat = atan2(r_mat,2.0)
+  r_mat = atan2(r_mat,c_mat) ! expected-error {{conflicting types in arguments 'x' and 'y' ('real' and 'complex')}}
+  r_arr = atan2(2.0, r_mat)
+  r_mat = sign(r_mat, r_mat)
+  i_mat = dim(4, i_mat)
+  i_mat = dim(i_mat, int(12,8)) ! expected-error {{conflicting types in arguments 'x' and 'y' ('integer' and 'integer (Kind=8)')}}
+
   r_mat = aimag(c_mat)
   i_arr = aimag(c_mat) ! expected-error {{conflicting shapes in an array expression (1 dimension and 2 dimensions)}}
   c_mat = conjg(c_mat)
+  r_arr = dprod(r_arr,r_arr)
+  r_arr = dprod(r_arr,r_mat) ! expected-error {{conflicting shapes in arguments 'x' and 'y' (1 dimension and 2 dimensions)}}
+
   i_mat = abs(i_mat) + sqrt(r_mat)
   r_mat = sin(r_mat) * cos(r_mat) + tan(r_mat)
   c_mat = exp(c_mat) + sin(c_mat)
   r_mat = log(r_mat) * log10(r_arr) ! expected-error {{conflicting shapes in an array expression (2 dimensions and 1 dimension)}}
+
 end
diff --git a/test/Sema/intrinsicFunctions.f95 b/test/Sema/intrinsicFunctions.f95
index 85c0a2961f..f2bdf8e732 100644
--- a/test/Sema/intrinsicFunctions.f95
+++ b/test/Sema/intrinsicFunctions.f95
@@ -114,6 +114,9 @@ PROGRAM intrinfuntest
   r = max(1.0, r)  ! CHECK: r = max(1, r)
   i = min(i, 11)
 
+  i = mod(i64, 4) ! expected-error {{conflicting types in arguments 'x' and 'y' ('integer (Kind=8)' and 'integer')}}
+  i = sign(i64, i) ! expected-error {{conflicting types in arguments 'x' and 'y' ('integer (Kind=8)' and 'integer')}}
+
   i = LEN(string) ! CHECK: i = len(string)
   i = len_trim(string) ! CHECK: i = len_trim(string)
   i = LEN(22) ! expected-error {{passing 'integer' to parameter of incompatible type 'character'}}
@@ -154,6 +157,7 @@ PROGRAM intrinfuntest
 
   r = ATAN2(r, 1.0) ! CHECK: r = atan2(r, 1)
   d = ATAN2(d, 1D0) ! CHECK: d = atan2(d, 1)
+  r = atan2(r, i) ! expected-error {{conflicting types in arguments 'x' and 'y' ('real' and 'integer')}}
 
 !! lexical comparison functions