tests and more convenient conversions (#15)

* add testthat * reformat basic tests * add example of table test * convert named lists to dicts #11 * dont add row.names by default. #13 * more consistent types and more tests
KxSystems · Jul 31, 2017 · 483a191 · 483a191
1 parent c6f8b6e
commit 483a191
Show file tree

Hide file tree

Showing 8 changed files with 265 additions and 144 deletions.
diff --git a/src/common.c b/src/common.c
@@ -116,12 +116,36 @@ void make_data_frame(SEXP data) {
 /* for datetime, timestamp */
 static void setdatetimeclass(SEXP sxp) {
   SEXP datetimeclass= PROTECT(allocVector(STRSXP, 2));
-  SET_STRING_ELT(datetimeclass, 0, mkChar("POSIXt"));
-  SET_STRING_ELT(datetimeclass, 1, mkChar("POSIXct"));
+  SET_STRING_ELT(datetimeclass, 0, mkChar("POSIXct"));
+  SET_STRING_ELT(datetimeclass, 1, mkChar("POSIXt"));
   setAttrib(sxp, R_ClassSymbol, datetimeclass);
   UNPROTECT(2);
 }
 
+
+static SEXP UnitsSymbol = NULL;
+
+
+/* for timespan, minute, second */
+SEXP setdifftimeclass(SEXP sxp, char* units) {
+  SEXP difftimeclass= PROTECT(allocVector(STRSXP, 1));
+  SET_STRING_ELT(difftimeclass, 0, mkChar("difftime"));
+  setAttrib(sxp, R_ClassSymbol, difftimeclass);
+  if (UnitsSymbol == NULL) UnitsSymbol = install("units");
+  setAttrib(sxp, UnitsSymbol, mkChar(units));
+  UNPROTECT(1);
+  return sxp;
+}
+
+/* for date,month */
+SEXP setdateclass(SEXP sxp) {
+  SEXP difftimeclass= PROTECT(allocVector(STRSXP, 1));
+  SET_STRING_ELT(difftimeclass, 0, mkChar("Date"));
+  setAttrib(sxp, R_ClassSymbol, difftimeclass);
+  UNPROTECT(1);
+  return sxp;
+}
+
 /*
  * We have functions that turn any K object into the appropriate R SEXP.
  */
@@ -420,7 +444,9 @@ static SEXP from_symbol_kobject(K x) {
   return result;
 }
 
-static SEXP from_month_kobject(K object) { return from_int_kobject(object); }
+static SEXP from_month_kobject(K object) { 
+  return from_int_kobject(object); 
+  }
 
 static SEXP from_date_kobject(K x) {
   SEXP result;
@@ -434,11 +460,8 @@ static SEXP from_date_kobject(K x) {
     for(i= 0; i < length; i++)
       INTEGER_POINTER(result)[i]= kI(x)[i] + 10957;
   }
-  dateclass= PROTECT(allocVector(STRSXP, 1));
-  SET_STRING_ELT(dateclass, 0, mkChar("Date"));
-  setAttrib(result, R_ClassSymbol, dateclass);
-  UNPROTECT(2);
-  return result;
+  UNPROTECT(1);
+  return setdateclass(result);
 }
 
 static SEXP from_datetime_kobject(K x) {
@@ -456,11 +479,17 @@ static SEXP from_datetime_kobject(K x) {
   return result;
 }
 
-static SEXP from_minute_kobject(K object) { return from_int_kobject(object); }
+static SEXP from_minute_kobject(K object) { 
+  return setdifftimeclass(from_int_kobject(object),"mins"); 
+  }
 
-static SEXP from_second_kobject(K object) { return from_int_kobject(object); }
+static SEXP from_second_kobject(K object) { 
+  return setdifftimeclass(from_int_kobject(object),"secs"); 
+  }
 
-static SEXP from_time_kobject(K object) { return from_int_kobject(object); }
+static SEXP from_time_kobject(K object) { 
+  return from_int_kobject(object); 
+  }
 
 static SEXP from_timespan_kobject(K x) {
   SEXP result;
@@ -474,7 +503,7 @@ static SEXP from_timespan_kobject(K x) {
       NUMERIC_POINTER(result)[i]= kJ(x)[i] / 1e9;
   }
   UNPROTECT(1);
-  return result;
+  return setdifftimeclass(result,"secs");
 }
 
 static SEXP from_timestamp_kobject(K x) {

diff --git a/src/sexp2k.c b/src/sexp2k.c
@@ -9,10 +9,9 @@ ZK from_any_robject(SEXP sxp);
  * convert R SEXP into K object.
  */
 ZK from_any_robject(SEXP);
-ZK error_broken_robject(SEXP);
 ZK from_null_robject(SEXP);
 ZK from_symbol_robject(SEXP);
-ZK from_pairlist_robject(SEXP);
+ZK dictpairlist(SEXP);
 ZK from_closure_robject(SEXP);
 ZK from_language_robject(SEXP);
 ZK from_char_robject(SEXP);
@@ -55,7 +54,7 @@ ZK from_any_robject(SEXP sxp) {
     return from_symbol_robject(sxp);
     break; /* symbols */
   case LISTSXP:
-    return from_pairlist_robject(sxp);
+    return dictpairlist(sxp);
     break; /* lists of dotted pairs */
   case CLOSXP:
     return from_closure_robject(sxp);
@@ -97,7 +96,7 @@ ZK from_any_robject(SEXP sxp) {
     return from_nyi_robject("dot", sxp);
     break; /* dot-dot-dot object */
   case ANYSXP:
-    return error_broken_robject(sxp);
+    return from_nyi_robject("any",sxp);
     break; /* make "any" args work */
   case VECSXP:
     return from_vector_robject(sxp);
@@ -112,20 +111,19 @@ ZK from_any_robject(SEXP sxp) {
     return from_nyi_robject("external", sxp);
     break; /* external pointer */
   case WEAKREFSXP:
-    return error_broken_robject(sxp);
+    return from_nyi_robject("weakref",sxp);
     break; /* weak reference */
   case RAWSXP:
     return from_raw_robject(sxp);
     break; /* raw bytes */
   case S4SXP:
     return from_nyi_robject("s4", sxp);
     break; /* S4 non-vector */
-
   case NEWSXP:
-    return error_broken_robject(sxp);
+    return from_nyi_robject("newpage",sxp);
     break; /* fresh node created in new page */
   case FREESXP:
-    return error_broken_robject(sxp);
+    return from_nyi_robject("gc",sxp);
     break; /* node released by GC */
   case FUNSXP:
     return from_nyi_robject("fun", sxp);
@@ -161,28 +159,19 @@ ZK attR(K x, SEXP sxp) {
   return addattR(x, att);
 }
 
-ZK error_broken_robject(SEXP sxp) { return krr("Broken R object."); }
-
 ZK from_nyi_robject(S marker, SEXP sxp) {
   return attR(kp((S) Rf_type2char(TYPEOF(sxp))), sxp);
 }
 
 ZK from_frame_robject(SEXP sxp) {
-  // TODO: Convert to table
   J length= LENGTH(sxp);
   SEXP colNames= Rf_getAttrib(sxp, R_NamesSymbol);
-  SEXP rowValues= Rf_getAttrib(sxp, R_RowNamesSymbol);
-  K kRowValues= from_any_robject(rowValues);
-
-  K k= ktn(KS, length + 1), v= ktn(0, length + 1);
-
-  kK(v)[0]= kRowValues;
-  kS(k)[0]= ss("row.names");
-
+
+  K k= ktn(KS, length), v= ktn(0, length);
   for(J i= 0; i < length; i++) {
-    kK(v)[i + 1]= from_any_robject(VECTOR_ELT(sxp, i));
+    kK(v)[i]= from_any_robject(VECTOR_ELT(sxp, i));
     const char *colName= CHAR(STRING_ELT(colNames, i));
-    kS(k)[i + 1]= ss((S) colName);
+    kS(k)[i]= ss((S) colName);
   }
 
   K tbl= xT(xD(k, v));
@@ -217,17 +206,6 @@ ZK from_symbol_robject(SEXP sxp) {
   return attR(x, sxp);
 }
 
-ZK from_pairlist_robject(SEXP sxp) {
-  K x= ktn(0, 2 * length(sxp));
-  SEXP s= sxp;
-  for(J i= 0; i < x->n; i+= 2) {
-    kK(x)[i]= from_any_robject(CAR(s));
-    kK(x)[i + 1]= from_any_robject(TAG(s));
-    s= CDR(s);
-  }
-  return attR(x, sxp);
-}
-
 ZK from_closure_robject(SEXP sxp) {
   K x= from_any_robject(FORMALS(sxp));
   K y= from_any_robject(BODY(sxp));
@@ -329,7 +307,7 @@ ZK from_character_robject(SEXP sxp) {
   else {
     x= ktn(0, length);
     for(i= 0; i < length; i++) {
-      xK[i]= kp((char *) CHAR(STRING_ELT(sxp, i)));
+      kK(x)[i]= kp((char *) CHAR(STRING_ELT(sxp, i)));
     }
   }
   return attR(x, sxp);
@@ -339,7 +317,16 @@ ZK from_vector_robject(SEXP sxp) {
   J i, length= LENGTH(sxp);
   K x= ktn(0, length);
   for(i= 0; i < length; i++) {
-    xK[i]= from_any_robject(VECTOR_ELT(sxp, i));
+    kK(x)[i]= from_any_robject(VECTOR_ELT(sxp, i));
+  }
+  SEXP colNames= Rf_getAttrib(sxp, R_NamesSymbol);
+  if(length==LENGTH(colNames)){
+    K k= ktn(KS, length);
+    for(J i= 0; i < length; i++) {
+      const char *colName= CHAR(STRING_ELT(colNames, i));
+      kS(k)[i]= ss((S) colName);
+    }
+    return xD(k,x);
   }
   return attR(x, sxp);
 }
@@ -352,10 +339,10 @@ ZK from_vector_robject(SEXP sxp) {
 static char *getkstring(K x) {
   char *s= NULL;
   int len;
-  switch(xt) {
+  switch(x->t) {
   case -KC:
     s= calloc(2, 1);
-    s[0]= xg;
+    s[0]= x->g;
     break;
   case KC:
     s= calloc(1 + xn, 1);

diff --git a/tests/testhat/tests-basic.R b/tests/testhat/tests-basic.R
diff --git a/tests/testthat.R b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(rkdb)
+
+test_check("rkdb")
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
@@ -0,0 +1,10 @@
+skip_unless_has_test_db <- function(expr) {
+  if (!identical(Sys.getenv("NOT_CRAN"), "true")) {
+    return(skip("On CRAN"))
+  }
+  tryCatch({
+    rkdb::open_connection()
+  }, error = function(e) {
+    skip(paste0("Test database not available:\n'", conditionMessage(e), "'"))
+  })
+}