added support for arrays in some intrinsic conversion functions; fixed CMPLX intrinsic

8 files changed, 168 insertions, 108 deletions

diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index 1d6c40929d..bb38d5e88f 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -518,9 +518,14 @@ public:
                                       SourceLocation MaxLoc,
                                       ExprResult RealPart, ExprResult ImPart);
 
+  /// GetUnaryReturnType - Returns the type T with the
+  /// requires qualifiers and array type from the given expression.
+  QualType GetUnaryReturnType(const Expr *E, QualType T);
+
   ExprResult ActOnUnaryExpr(ASTContext &C, SourceLocation Loc,
                             UnaryExpr::Operator Op, ExprResult E);
 
+
   ExprResult ActOnBinaryExpr(ASTContext &C, SourceLocation Loc,
                              BinaryExpr::Operator Op,
                              ExprResult LHS,ExprResult RHS);
@@ -761,7 +766,7 @@ public:
 
   /// Checks that all of the expressions have the same type
   /// class and kind.
-  void CheckExpressionListSameTypeKind(ArrayRef<Expr*> Expressions);
+  void CheckExpressionListSameTypeKind(ArrayRef<Expr*> Expressions, bool AllowArrays = false);
 
   /// Returns true if the argument count doesn't match to the function
   /// count
@@ -816,44 +821,51 @@ public:
                                 ArrayRef<Expr*> Args,
                                 QualType &ReturnType);
 
+  /// Reports an incompatible argument error and returns true.
+  bool DiagnoseIncompatiblePassing(const Expr *E, QualType T,
+                                   bool AllowArrays,
+                                   StringRef ArgName = StringRef());
+  bool DiagnoseIncompatiblePassing(const Expr *E, StringRef T,
+                                   bool AllowArrays,
+                                   StringRef ArgName = StringRef());
 
   /// Returns false if the argument's type is integer.
-  bool CheckIntegerArgument(const Expr *E);
+  bool CheckIntegerArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is real.
-  bool CheckRealArgument(const Expr *E);
+  bool CheckRealArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is complex.
-  bool CheckComplexArgument(const Expr *E);
+  bool CheckComplexArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is real but isn't double precision.
-  bool CheckStrictlyRealArgument(const Expr *E);
+  bool CheckStrictlyRealArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is real array.
   bool CheckStrictlyRealArrayArgument(const Expr *E, StringRef ArgName);
 
   /// Returns false if the argument's type is real and is double precision.
-  bool CheckDoublePrecisionRealArgument(const Expr *E);
+  bool CheckDoublePrecisionRealArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is complex and is double complex.
-  bool CheckDoubleComplexArgument(const Expr *E);
+  bool CheckDoubleComplexArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is character.
   bool CheckCharacterArgument(const Expr *E);
 
   /// Returns false if the argument has an integer or a real type.
-  bool CheckIntegerOrRealArgument(const Expr *E);
+  bool CheckIntegerOrRealArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument has an integer or a real array type.
   bool CheckIntegerOrRealArrayArgument(const Expr *E, StringRef ArgName);
 
   /// Returns false if the argument has an integer or a real or
   /// a complex argument.
-  bool CheckIntegerOrRealOrComplexArgument(const Expr *E);
+  bool CheckIntegerOrRealOrComplexArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument has a real or
   /// a complex argument.
-  bool CheckRealOrComplexArgument(const Expr *E);
+  bool CheckRealOrComplexArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns true if the given expression is a logical array.
   bool IsLogicalArray(const Expr *E);
diff --git a/lib/CodeGen/CGIntrinsic.cpp b/lib/CodeGen/CGIntrinsic.cpp
index 8ab6d5c690..ad24c9fa21 100644
--- a/lib/CodeGen/CGIntrinsic.cpp
+++ b/lib/CodeGen/CGIntrinsic.cpp
@@ -51,7 +51,7 @@ RValueTy CodeGenFunction::EmitIntrinsicCall(const IntrinsicCallExpr *E) {
         return EmitComplexToComplexConversion(EmitComplexExpr(Args[0]),
                                               E->getType());
       else {
-        if(Args.size() == 2) {
+        if(Args.size() >= 2) {
           auto ElementType = getContext().getComplexTypeElementType(E->getType());
           return ComplexValueTy(EmitScalarToScalarConversion(EmitScalarExpr(Args[0]), ElementType),
                                 EmitScalarToScalarConversion(EmitScalarExpr(Args[1]), ElementType));
diff --git a/lib/Sema/SemaChecking.cpp b/lib/Sema/SemaChecking.cpp
index b0bf381434..80cbf8a303 100644
--- a/lib/Sema/SemaChecking.cpp
+++ b/lib/Sema/SemaChecking.cpp
@@ -377,7 +377,7 @@ bool Sema::CheckDefaultBuiltinOrDoublePrecisionExpression(const Expr *E) {
   return false;
 }
 
-void Sema::CheckExpressionListSameTypeKind(ArrayRef<Expr*> Expressions) {
+void Sema::CheckExpressionListSameTypeKind(ArrayRef<Expr*> Expressions, bool AllowArrays) {
   assert(!Expressions.empty());
   auto T = Expressions.front()->getType();
   for(size_t I = 0; I < Expressions.size(); ++I) {
@@ -389,8 +389,14 @@ void Sema::CheckExpressionListSameTypeKind(ArrayRef<Expr*> Expressions) {
   }
 }
 
-static const BuiltinType *getBuiltinType(const Expr *E) {
-  return dyn_cast<BuiltinType>(E->getType().getTypePtr());
+static QualType ScalarizeType(const QualType &T, bool AllowArrays) {
+  if(AllowArrays)
+    return T.getSelfOrArrayElementType();
+  return T;
+}
+
+static const BuiltinType *getBuiltinType(const Expr *E, bool AllowArrays = false) {
+  return dyn_cast<BuiltinType>(ScalarizeType(E->getType(), AllowArrays).getTypePtr());
 }
 
 static const BuiltinType *getBuiltinType(QualType T) {
@@ -418,46 +424,58 @@ static bool IsTypeDoublePrecisionComplex(QualType T) {
            Ext && Ext->getKindSelector() == BuiltinType::Real8? true : false;
 }
 
-bool Sema::CheckIntegerArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isIntegerType()) {
+bool Sema::DiagnoseIncompatiblePassing(const Expr *E, QualType T,
+                                       bool AllowArrays,
+                                       StringRef ArgName) {
+  QualType ET = AllowArrays? E->getType().getSelfOrArrayElementType() :
+                             E->getType();
+  if(ArgName.empty())
     Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.IntegerTy
-      << E->getSourceRange();
-    return true;
-  }
-  return false;
+      << ET << T << E->getSourceRange();
+  else
+    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible_named_arg)
+      << ET << ArgName << T << E->getSourceRange();
+  return true;
 }
 
-bool Sema::CheckRealArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isRealType()) {
+bool Sema::DiagnoseIncompatiblePassing(const Expr *E, StringRef T,
+                                       bool AllowArrays,
+                                       StringRef ArgName) {
+  QualType ET = AllowArrays? E->getType().getSelfOrArrayElementType() :
+                             E->getType();
+  if(ArgName.empty())
     Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.RealTy
-      << E->getSourceRange();
-    return true;
-  }
+      << ET << T << E->getSourceRange();
+  else
+    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible_named_arg)
+      << ET << ArgName << T << E->getSourceRange();
+  return true;
+}
+
+bool Sema::CheckIntegerArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isIntegerType())
+    return DiagnoseIncompatiblePassing(E, Context.IntegerTy, AllowArrays);
   return false;
 }
 
-bool Sema::CheckComplexArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isComplexType()) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.ComplexTy
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckRealArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isRealType())
+    return DiagnoseIncompatiblePassing(E, Context.RealTy, AllowArrays);
   return false;
 }
 
-bool Sema::CheckStrictlyRealArgument(const Expr *E) {
-  if(!IsTypeSinglePrecisionReal(E->getType())) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.RealTy
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckComplexArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isComplexType())
+    return DiagnoseIncompatiblePassing(E, Context.ComplexTy, AllowArrays);
+  return false;
+}
+
+bool Sema::CheckStrictlyRealArgument(const Expr *E, bool AllowArrays) {
+  if(!IsTypeSinglePrecisionReal(ScalarizeType(E->getType(), AllowArrays)))
+    return DiagnoseIncompatiblePassing(E, Context.RealTy, AllowArrays);
   return false;
 }
 
@@ -467,51 +485,32 @@ bool Sema::CheckStrictlyRealArrayArgument(const Expr *E, StringRef ArgName) {
     if(IsTypeSinglePrecisionReal(T->getElementType()))
       return false;
   }
-
-  Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible_named_arg)
-    << E->getType() << ArgName << "'real array'"
-    << E->getSourceRange();
-  return true;
+  return DiagnoseIncompatiblePassing(E, "'real array'", false, ArgName);
 }
 
-bool Sema::CheckDoublePrecisionRealArgument(const Expr *E) {
-  if(!IsTypeDoublePrecisionReal(E->getType())) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.DoublePrecisionTy
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckDoublePrecisionRealArgument(const Expr *E, bool AllowArrays) {
+  if(!IsTypeDoublePrecisionReal(ScalarizeType(E->getType(), AllowArrays)))
+    return DiagnoseIncompatiblePassing(E, Context.DoublePrecisionTy, AllowArrays);
   return false;
 }
 
-bool Sema::CheckDoubleComplexArgument(const Expr *E) {
-  if(!IsTypeDoublePrecisionComplex(E->getType())) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.DoubleComplexTy
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckDoubleComplexArgument(const Expr *E, bool AllowArrays) {
+  if(!IsTypeDoublePrecisionComplex(ScalarizeType(E->getType(), AllowArrays)))
+    return DiagnoseIncompatiblePassing(E, Context.DoubleComplexTy, AllowArrays);
   return false;
 }
 
 bool Sema::CheckCharacterArgument(const Expr *E) {
   auto Type = getBuiltinType(E);
-  if(!Type || !Type->isCharacterType()) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << Context.CharacterTy
-      << E->getSourceRange();
-  }
+  if(!Type || !Type->isCharacterType())
+    return DiagnoseIncompatiblePassing(E, Context.CharacterTy, false);
   return false;
 }
 
-bool Sema::CheckIntegerOrRealArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isIntegerOrRealType()) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << "'integer' or 'real'"
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckIntegerOrRealArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isIntegerOrRealType())
+    return DiagnoseIncompatiblePassing(E, "'integer' or 'real'", AllowArrays);
   return false;
 }
 
@@ -529,25 +528,17 @@ bool Sema::CheckIntegerOrRealArrayArgument(const Expr *E, StringRef ArgName) {
   return true;
 }
 
-bool Sema::CheckIntegerOrRealOrComplexArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isIntegerOrRealOrComplexType()) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << "'integer' or 'real' or 'complex'"
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckIntegerOrRealOrComplexArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isIntegerOrRealOrComplexType())
+    return DiagnoseIncompatiblePassing(E, "'integer' or 'real' or 'complex'", AllowArrays);
   return false;
 }
 
-bool Sema::CheckRealOrComplexArgument(const Expr *E) {
-  auto Type = getBuiltinType(E);
-  if(!Type || !Type->isRealOrComplexType()) {
-    Diags.Report(E->getLocation(), diag::err_typecheck_passing_incompatible)
-      << E->getType() << "'real' or 'complex'"
-      << E->getSourceRange();
-    return true;
-  }
+bool Sema::CheckRealOrComplexArgument(const Expr *E, bool AllowArrays) {
+  auto Type = getBuiltinType(E, AllowArrays);
+  if(!Type || !Type->isRealOrComplexType())
+    return DiagnoseIncompatiblePassing(E, "'real' or 'complex'", AllowArrays);
   return false;
 }
 
diff --git a/lib/Sema/SemaExpr.cpp b/lib/Sema/SemaExpr.cpp
index e2e2021067..5cc73590c6 100644
--- a/lib/Sema/SemaExpr.cpp
+++ b/lib/Sema/SemaExpr.cpp
@@ -367,6 +367,13 @@ static TypecheckAction TypecheckUnaryExpr(UnaryExpr::Operator Op,
   return NoAction;
 }
 
+QualType Sema::GetUnaryReturnType(const Expr *E, QualType T) {
+  auto EType = E->getType();
+  if(auto ATy = EType->asArrayType())
+    return Context.getArrayType(T, ATy->getDimensions());
+  return T;
+}
+
 ExprResult Sema::ActOnUnaryExpr(ASTContext &C, SourceLocation Loc,
                                 UnaryExpr::Operator Op, ExprResult E) {
   unsigned Diagnostic = 0;
diff --git a/lib/Sema/SemaIntrinsic.cpp b/lib/Sema/SemaIntrinsic.cpp
index 7ab0ef7d96..626fe21124 100644
--- a/lib/Sema/SemaIntrinsic.cpp
+++ b/lib/Sema/SemaIntrinsic.cpp
@@ -77,35 +77,38 @@ bool Sema::CheckIntrinsicConversionFunc(intrinsic::FunctionKind Function,
   auto FirstArg = Args[0];
   switch(Function) {
   case INT: case IFIX: case IDINT:
-    if(Function == IFIX) CheckStrictlyRealArgument(FirstArg);
-    else if(Function == IDINT) CheckDoublePrecisionRealArgument(FirstArg);
-    else CheckIntegerOrRealOrComplexArgument(FirstArg);
-    ReturnType = Context.IntegerTy;
+    if(Function == IFIX) CheckStrictlyRealArgument(FirstArg, true);
+    else if(Function == IDINT) CheckDoublePrecisionRealArgument(FirstArg, true);
+    else CheckIntegerOrRealOrComplexArgument(FirstArg, true);
+    ReturnType = GetUnaryReturnType(FirstArg, Context.IntegerTy);
     break;
 
   case REAL: case FLOAT: case SNGL:
-    if(Function == FLOAT) CheckIntegerArgument(FirstArg);
-    else if(Function == SNGL) CheckDoublePrecisionRealArgument(FirstArg);
-    else CheckIntegerOrRealOrComplexArgument(FirstArg);
-    ReturnType = Context.RealTy;
+    if(Function == FLOAT) CheckIntegerArgument(FirstArg, true);
+    else if(Function == SNGL) CheckDoublePrecisionRealArgument(FirstArg, true);
+    else CheckIntegerOrRealOrComplexArgument(FirstArg, true);
+    ReturnType = GetUnaryReturnType(FirstArg, Context.RealTy);
     break;
 
   case DBLE:
-    CheckIntegerOrRealOrComplexArgument(FirstArg);
-    ReturnType = Context.DoublePrecisionTy;
+    CheckIntegerOrRealOrComplexArgument(FirstArg, true);
+    ReturnType = GetUnaryReturnType(FirstArg, Context.DoublePrecisionTy);
     break;
 
   case CMPLX:
   case DCMPLX:
-    CheckIntegerOrRealOrComplexArgument(FirstArg);
+    CheckIntegerOrRealOrComplexArgument(FirstArg, true);
     if(Args.size() > 1) {
-      if(!CheckIntegerOrRealOrComplexArgument(Args[1]))
-        CheckExpressionListSameTypeKind(Args);
+      if(FirstArg->getType().getSelfOrArrayElementType()->isComplexType()) {
+        // FIXME: error.
+      }
+      else CheckIntegerOrRealArgument(Args[1], true);
     }
-    ReturnType = Function == CMPLX? Context.ComplexTy :
-                                    Context.DoubleComplexTy;
+    ReturnType = GetUnaryReturnType(FirstArg, Function == CMPLX? Context.ComplexTy :
+                                                                 Context.DoubleComplexTy);
     break;
 
+    // FIXME: array support
   case ICHAR:
     CheckCharacterArgument(FirstArg);
     ReturnType = Context.IntegerTy;
diff --git a/test/CodeGen/intrinsicConversion.f95 b/test/CodeGen/intrinsicConversion.f95
index 969e5120d6..54f9710fcf 100644
--- a/test/CodeGen/intrinsicConversion.f95
+++ b/test/CodeGen/intrinsicConversion.f95
@@ -30,6 +30,8 @@ PROGRAM intrinsicconv
   c = cmplx(d) ! CHECK: fptrunc
   c = cmplx(r, r)
   c = cmplx(1.0, r)
+  c = cmplx(i, r)
+  c = cmplx( (1.0, 2.0 ) )
 
   i = ichar('A') ! CHECK: zext i8
   str = char(i)  ! CHECK: trunc i32
diff --git a/test/Sema/intrinsicArrayOperations.f95 b/test/Sema/intrinsicArrayOperations.f95
new file mode 100644
index 0000000000..d3e9576d6e
--- /dev/null
+++ b/test/Sema/intrinsicArrayOperations.f95
@@ -0,0 +1,42 @@
+! RUN: %flang -fsyntax-only -verify < %s
+! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
+program intrinfuntest
+  integer i_mat(4,4), i_arr(5)
+  real r_mat(4,4), r_arr(10)
+  complex c_mat(4,4)
+  character char_mat(4,4)
+  logical l_mat(4,4)
+
+  INTRINSIC INT, IFIX, IDINT
+  INTRINSIC REAL, FLOAT, sngl
+  INTRINSIC DBLE, cmplx
+  INTRINSIC char, ICHAR
+
+  INTRINSIC AINT, dint, anint, DNINT, nint, IDNINT
+  INTRINSIC abs, iabs, dabs, cabs
+  INTRINSIC mod, sign, dim, dprod, max, min
+  INTRINSIC len, len_trim, index
+  INTRINSIC aimag, conjg
+
+  intrinsic sqrt, dsqrt, csqrt, exp, dexp, cexp
+  intrinsic log, alog, dlog, clog, log10, alog10, dlog10
+  intrinsic sin, dsin, csin, cos, dcos, ccos, tan, dtan
+  intrinsic asin, dasin, acos, dacos, atan, datan, atan2, datan2
+  intrinsic sinh, dsinh, cosh, dcosh, tanh, dtanh
+
+  intrinsic lge, lgt, lle, llt
+
+!! conversion functions
+
+  i_mat = int(1)
+  i_mat = int(2.0)
+  r_mat = real(i_mat)
+  i_mat = int(r_mat)
+  c_mat = cmplx(r_mat)
+  i_mat = int(c_mat)
+  c_mat = cmplx(i_mat, i_mat)
+  i_arr = int( (/ 1.0, 2.0, 3.0, 4.0, 5.0 /) )
+  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)}}
+end
diff --git a/test/Sema/intrinsicFunctions.f95 b/test/Sema/intrinsicFunctions.f95
index e57d0150cf..09a95e6d13 100644
--- a/test/Sema/intrinsicFunctions.f95
+++ b/test/Sema/intrinsicFunctions.f95
@@ -58,9 +58,12 @@ PROGRAM intrinfuntest
   c = cmplx(2.0)
   c = CMPLX(33)
   c = CMPLX(1,2)
+  c = cmplx(1.0, i)
+  c = cmplx(1, c) ! expected-error {{passing 'complex' to parameter of incompatible type 'integer' or 'real'}}
+  c = cmplx( (1.0, 2.0 ) )
   c = CMPLX() ! expected-error {{too few arguments to intrinsic function call, expected 1 or 2, have 0}}
   c = CMPLX(1,2,3,4) ! expected-error {{too many arguments to intrinsic function call, expected 1 or 2, have 4}}
-  c = CMPLX(1.0, .false.) ! expected-error {{passing 'logical' to parameter of incompatible type 'integer' or 'real' or 'complex'}}
+  c = CMPLX(1.0, .false.) ! expected-error {{passing 'logical' to parameter of incompatible type 'integer' or 'real'}}
 
   i = ICHAR('HELLO')
   i = ichar(.false.) ! expected-error {{passing 'logical' to parameter of incompatible type 'character'}}