added basic support for kind parrameter in int, real and cmplx functions

5 files changed, 73 insertions, 28 deletions

diff --git a/include/flang/AST/IntrinsicFunctions.def b/include/flang/AST/IntrinsicFunctions.def
index bb23869079..3438aa6ae7 100644
--- a/include/flang/AST/IntrinsicFunctions.def
+++ b/include/flang/AST/IntrinsicFunctions.def
@@ -80,11 +80,11 @@
 // Conversion group
 //
 
-INTRINSIC_FUNCTION(INT, INT, NUM_ARGS_1, FUNALL)
+INTRINSIC_FUNCTION(INT, INT, NUM_ARGS_1_OR_2, FUNALL)
 INTRINSIC_FUNCTION(IFIX, INT, NUM_ARGS_1, FUNALL)
 INTRINSIC_FUNCTION(IDINT, INT, NUM_ARGS_1, FUNALL)
 
-INTRINSIC_FUNCTION(REAL, REAL, NUM_ARGS_1, FUNALL)
+INTRINSIC_FUNCTION(REAL, REAL, NUM_ARGS_1_OR_2, FUNALL)
 INTRINSIC_FUNCTION(FLOAT, REAL, NUM_ARGS_1, FUNALL)
 INTRINSIC_FUNCTION(SNGL, REAL, NUM_ARGS_1, FUNALL)
 INTRINSIC_FUNCTION(DBLE, REAL, NUM_ARGS_1, FUNALL)
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index 1412e8bc42..7ff3f38305 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -689,6 +689,8 @@ public:
   BuiltinType::TypeKind EvalAndCheckTypeKind(QualType T,
                                              const Expr *E);
 
+  QualType ApplyTypeKind(QualType T, const Expr *E);
+
   /// Returns evaluated length specification
   /// fot the character type.
   unsigned EvalAndCheckCharacterLength(const Expr *E);
@@ -843,7 +845,8 @@ public:
   bool CheckBuiltinTypeArgument(const Expr *E, bool AllowArrays = false);
 
   /// Returns false if the argument's type is integer.
-  bool CheckIntegerArgument(const Expr *E, bool AllowArrays = false);
+  bool CheckIntegerArgument(const Expr *E, bool AllowArrays = false,
+                            StringRef ArgName = StringRef());
 
   /// Returns false if the argument's type is real.
   bool CheckRealArgument(const Expr *E, bool AllowArrays = false);
diff --git a/lib/Sema/SemaChecking.cpp b/lib/Sema/SemaChecking.cpp
index bd1816f9cd..5ddb1ee2ad 100644
--- a/lib/Sema/SemaChecking.cpp
+++ b/lib/Sema/SemaChecking.cpp
@@ -75,6 +75,12 @@ BuiltinType::TypeKind Sema::EvalAndCheckTypeKind(QualType T,
   return BuiltinType::NoKind;
 }
 
+QualType Sema::ApplyTypeKind(QualType T, const Expr *E) {
+  auto Kind = EvalAndCheckTypeKind(T, E);
+  return Kind != BuiltinType::NoKind?
+           Context.getExtQualType(T.getTypePtr(), Qualifiers(), Kind) : T;
+}
+
 unsigned Sema::EvalAndCheckCharacterLength(const Expr *E) {
   auto Result = CheckIntGT0(E, EvalAndCheckIntExpr(E, 1));
   if(Result > int64_t(std::numeric_limits<unsigned>::max())) {
@@ -459,10 +465,10 @@ bool Sema::CheckBuiltinTypeArgument(const Expr *E, bool AllowArrays) {
   return false;
 }
 
-bool Sema::CheckIntegerArgument(const Expr *E, bool AllowArrays) {
+bool Sema::CheckIntegerArgument(const Expr *E, bool AllowArrays, StringRef ArgName) {
   auto Type = getBuiltinType(E, AllowArrays);
   if(!Type || !Type->isIntegerType())
-    return DiagnoseIncompatiblePassing(E, Context.IntegerTy, AllowArrays);
+    return DiagnoseIncompatiblePassing(E, Context.IntegerTy, AllowArrays, ArgName);
   return false;
 }
 
diff --git a/lib/Sema/SemaIntrinsic.cpp b/lib/Sema/SemaIntrinsic.cpp
index 427c95c64f..e6aa069e25 100644
--- a/lib/Sema/SemaIntrinsic.cpp
+++ b/lib/Sema/SemaIntrinsic.cpp
@@ -70,52 +70,77 @@ bool Sema::CheckIntrinsicCallArgumentCount(intrinsic::FunctionKind Function,
   return false;
 }
 
+static QualType ApplyKind(Sema &S, QualType T, const Expr *E) {
+
+}
+
 // FIXME: add support for kind parameter
 bool Sema::CheckIntrinsicConversionFunc(intrinsic::FunctionKind Function,
                                         ArrayRef<Expr*> Args,
                                         QualType &ReturnType) {
-  auto FirstArg = Args[0];
+  const Expr *Item = Args[0];
+  const Expr *Kind = nullptr;
+
+  if(Function == INT || Function == REAL) {
+    if(Args.size() >= 2)
+      Kind = Args[1];
+  } else if(Function == CMPLX) {
+    if(Args.size() >= 2) {
+      if(Item->getType().getSelfOrArrayElementType()->isComplexType())
+        Kind = Args[1];
+      else if(Args.size() == 3) {
+        Kind = Args[2];
+      }
+    }
+  }
+  if(Kind) {
+    if(CheckIntegerArgument(Kind, false, "kind"))
+      Kind = nullptr;
+  }
+
   switch(Function) {
   case INT: case IFIX: case IDINT:
-    if(Function == IFIX) CheckStrictlyRealArgument(FirstArg, true);
-    else if(Function == IDINT) CheckDoublePrecisionRealArgument(FirstArg, true);
-    else CheckIntegerOrRealOrComplexArgument(FirstArg, true);
-    ReturnType = GetUnaryReturnType(FirstArg, Context.IntegerTy);
+    if(Function == IFIX) CheckStrictlyRealArgument(Item, true);
+    else if(Function == IDINT) CheckDoublePrecisionRealArgument(Item, true);
+    else CheckIntegerOrRealOrComplexArgument(Item, true);
+    ReturnType = GetUnaryReturnType(Item, Kind? ApplyTypeKind(Context.IntegerTy, Kind) :
+                                                Context.IntegerTy);
     break;
 
   case REAL: case FLOAT: case SNGL:
-    if(Function == FLOAT) CheckIntegerArgument(FirstArg, true);
-    else if(Function == SNGL) CheckDoublePrecisionRealArgument(FirstArg, true);
-    else CheckIntegerOrRealOrComplexArgument(FirstArg, true);
-    ReturnType = GetUnaryReturnType(FirstArg, Context.RealTy);
+    if(Function == FLOAT) CheckIntegerArgument(Item , true);
+    else if(Function == SNGL) CheckDoublePrecisionRealArgument(Item , true);
+    else CheckIntegerOrRealOrComplexArgument(Item , true);
+
+    ReturnType = GetUnaryReturnType(Item, Kind? ApplyTypeKind(Context.RealTy, Kind) :
+                                                Context.RealTy);
     break;
 
   case DBLE:
-    CheckIntegerOrRealOrComplexArgument(FirstArg, true);
-    ReturnType = GetUnaryReturnType(FirstArg, Context.DoublePrecisionTy);
+    CheckIntegerOrRealOrComplexArgument(Item , true);
+    ReturnType = GetUnaryReturnType(Item , Context.DoublePrecisionTy);
     break;
 
   case CMPLX:
   case DCMPLX:
-    CheckIntegerOrRealOrComplexArgument(FirstArg, true);
+    CheckIntegerOrRealOrComplexArgument(Item , true);
     if(Args.size() > 1) {
-      if(FirstArg->getType().getSelfOrArrayElementType()->isComplexType()) {
-        // FIXME: error.
-      }
-      else CheckIntegerOrRealArgument(Args[1], true);
+      if(!Item->getType().getSelfOrArrayElementType()->isComplexType())
+        CheckIntegerOrRealArgument(Args[1], true);
     }
-    ReturnType = GetUnaryReturnType(FirstArg, Function == CMPLX? Context.ComplexTy :
-                                                                 Context.DoubleComplexTy);
+    ReturnType = GetUnaryReturnType(Item, Kind? ApplyTypeKind(Context.ComplexTy, Kind) :
+                                     (Function == CMPLX? Context.ComplexTy :
+                                                         Context.DoubleComplexTy));
     break;
 
-    // FIXME: array support
+    // FIXME: array and kind support
   case ICHAR:
-    CheckCharacterArgument(FirstArg);
+    CheckCharacterArgument(Item);
     ReturnType = Context.IntegerTy;
     break;
 
   case CHAR:
-    CheckIntegerArgument(FirstArg);
+    CheckIntegerArgument(Item);
     ReturnType = Context.CharacterTy;
     break;
   }
diff --git a/test/Sema/intrinsicFunctions.f95 b/test/Sema/intrinsicFunctions.f95
index 09a95e6d13..85c0a2961f 100644
--- a/test/Sema/intrinsicFunctions.f95
+++ b/test/Sema/intrinsicFunctions.f95
@@ -8,6 +8,10 @@ PROGRAM intrinfuntest
   CHARACTER (LEN=100) string
   LOGICAL logicalResult
 
+  integer (kind=8) i64
+  real (kind =8) r8
+  complex(kind = 8) c8
+
   INTRINSIC INT, IFIX, IDINT
   INTRINSIC REAL, FLOAT, sngl
   INTRINSIC DBLE, cmplx
@@ -36,8 +40,8 @@ PROGRAM intrinfuntest
   i = IDINT(4.25D1) ! CHECK: i = idint(42.5)
   r = INT(22) ! CHECK: r = real(int(22))
 
-  i = INT() ! expected-error {{too few arguments to intrinsic function call, expected 1, have 0}}
-  i = INT(1,2) ! expected-error {{too many arguments to intrinsic function call, expected 1, have 2}}
+  i = INT() ! expected-error {{too few arguments to intrinsic function call, expected 1 or 2, have 0}}
+  i = INT(1,2,3) ! expected-error {{too many arguments to intrinsic function call, expected 1 or 2, have 3}}
 
   i = IFIX(22) ! expected-error {{passing 'integer' to parameter of incompatible type 'real'}}
   i = idint(22) ! expected-error {{passing 'integer' to parameter of incompatible type 'double precision'}}
@@ -71,6 +75,13 @@ PROGRAM intrinfuntest
   string = CHAR(65)
   string = char('TRUTH') ! expected-error {{passing 'character' to parameter of incompatible type 'integer'}}
 
+  i64 = int(i,8)
+  r8 = real(r,8)
+  c8 = complex(c,8)
+  i = int(i,1.0) ! expected-error {{passing 'real' to parameter 'kind' of incompatible type 'integer'}}
+  i = int(i,22) ! expected-error {{invalid kind selector '22' for type 'integer'}}
+  i = int(i,kind(i))
+
 !! misc and maths functions
 
   r = AINT(r) ! CHECK: r = aint(r)