From 483a191f16902c263e54aec01fd69bb02ad61ce1 Mon Sep 17 00:00:00 2001 From: Sergey Vidyuk Date: Mon, 31 Jul 2017 09:06:53 +0100 Subject: [PATCH] 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 --- src/common.c | 53 +++++++++--- src/sexp2k.c | 59 +++++-------- tests/testhat/tests-basic.R | 96 --------------------- tests/testthat.R | 4 + tests/testthat/helper.R | 10 +++ tests/testthat/test-basic.R | 159 +++++++++++++++++++++++++++++++++++ tests/testthat/test-dict.R | 12 +++ tests/testthat/test-tables.R | 16 ++++ 8 files changed, 265 insertions(+), 144 deletions(-) delete mode 100644 tests/testhat/tests-basic.R create mode 100644 tests/testthat.R create mode 100644 tests/testthat/helper.R create mode 100644 tests/testthat/test-basic.R create mode 100644 tests/testthat/test-dict.R create mode 100644 tests/testthat/test-tables.R diff --git a/src/common.c b/src/common.c index 9ffcc09..5e4414e 100644 --- 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 index 086509d..1fe4aa5 100644 --- 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,7 +111,7 @@ 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); @@ -120,12 +119,11 @@ ZK from_any_robject(SEXP sxp) { 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 deleted file mode 100644 index 28b6c72..0000000 --- a/tests/testhat/tests-basic.R +++ /dev/null @@ -1,96 +0,0 @@ -# Run this test file with: -# library(testthat) -# test_results <- test_dir("./tests/testhat/", reporter="summary") - -# parameters -params <- list(server='localhost', port=1234) - -library(rkdb) -# this opens a connection -h <- open_connection(params$server,params$port) - -#' Helper to test kdb types are accurately converted to R types -#' -#' @param h connection object -#' @param x character command to be execute on the kdb server -#' @return result through \code{execute}. -testKdbToRType <- function(h, x){ - ans <- execute(h, x) - return(ans) -} - -# test kdb -> R -test_that("kdb types to R types", { - - bool <- testKdbToRType(h, '1b') - byte <- testKdbToRType(h, '0x26') - short <- testKdbToRType(h, '42h') - int <- testKdbToRType(h, '1i') - long <- testKdbToRType(h, '42000j') - real <- testKdbToRType(h, '4.2e') - float <- testKdbToRType(h, '4.2') - char <- testKdbToRType(h, '"a"') - symbol <- testKdbToRType(h, '`a') - timestamp <- testKdbToRType(h, '2015.01.01T00:00:00.000000000') - month <- testKdbToRType(h, '2015.01m') - date <- testKdbToRType(h, '2015.01.01') - datetime <- testKdbToRType(h, '2006.07.21T09:13:39') - timespan <- testKdbToRType(h, '12:00:00.000000000') - minute <- testKdbToRType(h, '12:00') - second <- testKdbToRType(h, '12:00:00') - time <- testKdbToRType(h, '12:00:00.000') - enumeration <- testKdbToRType(h, 'letters:`a`b`c`d; l:`a`b`a`b`d; `letters$l') - table <- testKdbToRType(h, '([] x:`a`b;y:2#1.;t:(1 2;3 4))') - keyed_table <- testKdbToRType(h, '([x:`a`b];y:2#1.;t:(1 2;3 4))') - dictionary <- testKdbToRType(h, '`a`b!(10 12)') - dictionary2 <- testKdbToRType(h, '`a`b!(10;`toto)') - fonction <- testKdbToRType(h, '{[x] 2*x}') - - list1 <- testKdbToRType(h, '1 2 3 4') - list2 <- testKdbToRType(h, '(1;"toto";`tata)') - list3 <- testKdbToRType(h, '(1 2;3 4;4 5)') - - expect_is( bool, "logical" ); expect_true( bool ) - expect_is( byte, "integer" ); expect_equal( byte, 38L ) - expect_is( short, "integer" ); expect_equal( short, 42L ) - expect_is( int, "integer" ); expect_equal( int, 1L ) - # kdb long is 8 bytes integer, R integer in 32 bytes integer - expect_is( long, "integer" ); expect_equal( long, 42000L ) - expect_is( real, "numeric" ); expect_equal( real, 4.2 ) - expect_is( float, "numeric" ); expect_equal( float, 4.2 ) - expect_is( char, "character" ); expect_equal( char, 'a' ) - expect_is( symbol, "character" ); expect_equal( symbol, 'a' ) - expect_is( timestamp, "POSIXt" ); expect_equal( timestamp, as.POSIXct('2015-01-01T00:00:00.000000') ) - expect_is( month, "character" ); expect_equal( month, '2015.01' ) - expect_is( date, "Date" ); expect_equal( date, as.Date('2015-01-01') ) - expect_is( datetime, "POSIXt" ); expect_equal( datetime, as.POSIXct('2006-07-21T09:13:39') ) - expect_is( timespan, "character" ); expect_equal( timespan, '12:00:00.000000000' ) - expect_is( minute, "character" ); expect_equal( minute, '12:00' ) - expect_is( second, "character" ); expect_equal( second, '12:00:00' ) - expect_is( time, "character" ); expect_equal( time, '12:00:00.000' ) - # use expect_equivalent to drop the attributes comparaison - expect_is( table, "data.frame" ); expect_equivalent( table, data.frame(x=c('a','b'),y=c(1,1),t=I(list(c(1,2),c(3,4))),stringsAsFactors=F) ) - expect_is( keyed_table, "data.frame" ); expect_equivalent( table, data.frame(x=c('a','b'),y=c(1,1),t=I(list(c(1,2),c(3,4))),stringsAsFactors=F) ) - expect_is( dictionary, "numeric" ); expect_equal( dictionary, c(a=10,b=12) ) - expect_is( dictionary2, "list" ); expect_equal( dictionary2, list(a=10,b='toto') ) - expect_is( fonction, "character" ); expect_equal( fonction, '{[x] 2*x}' ) - - expect_is( list1, "numeric" ); expect_equal( list1, c(1,2,3,4) ) - expect_is( list2, "list" ); expect_equal( list2, list(1,'toto','tata') ) - expect_is( list3, "list" ); expect_equal( list3, list(c(1,2),c(3,4),c(4,5)) ) - -}) - -# test R -> kdb -test_that("R types to kdb types", { - -int <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~-6h;x~1i)}', 1L); expect_equal( int, c(okType=TRUE, okValue=TRUE) ) -intV <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~6h;x~(1 2))}', c(1L,2L)); expect_equal( intV, c(okType=TRUE, okValue=TRUE) ) -dbl <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~-6h;x~1.)}', 1.); expect_equal( dbl, c(okType=TRUE, okValue=TRUE) ) -dblV <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~9h;x~(1. 2.))}', c(1.,2.)); expect_equal( dblV, c(okType=TRUE, okValue=TRUE) ) -unamedL <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~9h;x~(1. 2.))}', list(1.,2.)); expect_equal( unamedL, c(okType=TRUE, okValue=TRUE) ) -unamedL2 <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~0h;x~(1.;"2"))}', list(1.,"2")); expect_equal( unamedL2, c(okType=TRUE, okValue=TRUE) ) -namedV <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~9h;x~((`a`b)!(1. 2.)))}', c(a=1.,b=2.)); expect_equal( namedV, c(okType=TRUE, okValue=TRUE) ) -namedL <- execute(h, '{[x] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~9h;x~((`a`b)!(1. 2.)))}', list(a=1.,b=2.)); expect_equal( namedL, c(okType=TRUE, okValue=TRUE) ) - -}) \ No newline at end of file diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..b96f69d --- /dev/null +++ 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 new file mode 100644 index 0000000..e2a8d04 --- /dev/null +++ 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), "'")) + }) +} \ No newline at end of file diff --git a/tests/testthat/test-basic.R b/tests/testthat/test-basic.R new file mode 100644 index 0000000..477b38a --- /dev/null +++ b/tests/testthat/test-basic.R @@ -0,0 +1,159 @@ +context("basic") + +#' Helper to test kdb types are accurately converted to R types +#' +#' @param h connection object +#' @param x character command to be execute on the kdb server +#' @return result through \code{execute}. +testKdbToRType <- function(h, x){ + ans <- execute(h, x) + return(ans) +} +# test kdb -> R +test_that("kdb types to R types", { + h <- skip_unless_has_test_db() + + bool <- testKdbToRType(h, '1b') + expect_is(bool, "logical") + expect_true(bool) + + byte <- testKdbToRType(h, '0x26') + expect_is(byte, "integer") + expect_equal(byte, 38L) + + short <- testKdbToRType(h, '42h') + expect_is(short, "integer") + expect_equal(short, 42L) + + int <- testKdbToRType(h, '1i') + expect_is(int, "integer") + expect_equal(int, 1L) + + long <- testKdbToRType(h, '42000j') + # kdb long is 8 bytes integer, R integer in 32 bytes integer + expect_is(long, "numeric") + expect_equal(long, 42000L) + + real <- testKdbToRType(h, '4.2e') + expect_is(real, "numeric") + expect_equal(real,4.2,tolerance=1e-7) #not equal due to truncation to 32 bit + + float <- testKdbToRType(h, '4.2') + expect_is(float, "numeric") + expect_equal(float, 4.2) + + char <- testKdbToRType(h, '"a"') + expect_is(char, "character") + expect_equal(char, 'a') + + symbol <- testKdbToRType(h, '`a') + expect_is(symbol, "character") + expect_equal(symbol, 'a') + + timestamp <- testKdbToRType(h, '2015.01.01D00:01:00.000000000') + expect_is(timestamp, "POSIXt") + expect_equal(as.POSIXct(timestamp), as.POSIXct('2015-01-01 00:01:00.000000')) + + month <- testKdbToRType(h, '2015.01m') + expect_is(month, "integer") + expect_equal(month, 180L) + + date <- testKdbToRType(h, '2015.01.03') + expect_is(date, "Date") + expect_equal(date, as.Date('2015-01-03')) + + datetime <- testKdbToRType(h, '2006.07.21T09:13:39') + expect_is(datetime, "POSIXt") + expect_equal(datetime, as.POSIXct('2006-07-21 09:13:39')) + + timespan <- testKdbToRType(h, '12:00:00.000000000') + expect_is(timespan, "difftime") + expect_equal(timespan, as.difftime('12:00:00.000000000')) + + minute <- testKdbToRType(h, '12:00') + expect_is(minute, "difftime") + expect_equal(minute, as.difftime(12*60,units = 'mins')) + + second <- testKdbToRType(h, '12:00:00') + expect_is(second, "difftime") + expect_equal(second, as.difftime(12*60*60,units = 'secs')) + + time <- testKdbToRType(h, '12:00:00.000') + expect_is(time, "POSIXt") + expect_equal(time, as.POSIXct('12:00:00.000','%H:%M:%S')) + + + enumeration <- + testKdbToRType(h, 'letters:`a`b`c`d; l:`a`b`a`b`d; `letters$l') + expect_is(enumeration,"character") + expect_equal(enumeration,c('a','b','a','b','d')) + + table <- testKdbToRType(h, '([] x:`a`b;y:2#1.;t:(1 2;3 4))') + # use expect_equivalent to drop the attributes comparaison + expect_is(table, "data.frame") + expect_equivalent(table, data.frame( + x = c('a', 'b'), + y = c(1, 1), + t = I(list(c(1, 2), c(3, 4))), + stringsAsFactors = F + )) + keyed_table <- testKdbToRType(h, '([x:`a`b];y:2#1.;t:(1 2;3 4))') + expect_is(keyed_table, "data.frame") + expect_equivalent(keyed_table, data.frame( + x = c('a', 'b'), + y = c(1, 1), + t = I(list(c(1, 2), c(3, 4))), + stringsAsFactors = F + )) + + dictionary <- testKdbToRType(h, '`a`b!(10 12)') + expect_is(dictionary, "numeric") + expect_equal(dictionary, c(a = 10, b = 12)) + + dictionary2 <- testKdbToRType(h, '`a`b!(10;`toto)') + expect_is(dictionary2, "list") + expect_equal(dictionary2, list(a = 10, b = 'toto')) + + fonction <- testKdbToRType(h, '{[x] 2*x}') + expect_is(fonction, "character") + expect_equal(fonction, '{[x] 2*x}') + + list1 <- testKdbToRType(h, '1 2 3 4') + expect_is(list1, "numeric") + expect_equal(list1, c(1, 2, 3, 4)) + + list2 <- testKdbToRType(h, '(1;"toto";`tata)') + expect_is(list2, "list") + expect_equal(list2, list(1, 'toto', 'tata')) + + list3 <- testKdbToRType(h, '(1 2;3 4;4 5)') + expect_is(list3, "list") + expect_equal(list3, list(c(1, 2), c(3, 4), c(4, 5))) + +}) + +# test R -> kdb +test_that("R types to kdb types", { + h <- skip_unless_has_test_db() + remoteCheckFunc <- + '`cc set {[x;y;z] show("type is ",string[type[x]]); `tmp set x; :(`okType`okValue)!(type[x]~y;x~z)}' + execute(h, remoteCheckFunc) + int <- execute(h, 'cc[;6h;(),1i]', 1L) # R doesn't have scalars + expect_equal(int, c(okType = TRUE, okValue = TRUE)) + intV <- execute(h, 'cc[;6h;1 2i]', c(1L, 2L)) + expect_equal(intV, c(okType = TRUE, okValue = TRUE)) + dbl <- execute(h, 'cc[;9h;(),1.]', 1.) + expect_equal(dbl, c(okType = TRUE, okValue = TRUE)) + dblV <- execute(h, 'cc[;9h;(1. 2.)]', c(1., 2.)) + expect_equal(dblV, c(okType = TRUE, okValue = TRUE)) + unamedL <- execute(h, 'cc[;0h;((),1.;(),2.)]', list(1., 2.)) + expect_equal(unamedL, c(okType = TRUE, okValue = TRUE)) + unamedL2 <- execute(h, 'cc[;0h;((),1.;(),"2")]', list(1., "2")) + expect_equal(unamedL2, c(okType = TRUE, okValue = TRUE)) + namedVector <- execute(h, 'cc[;99h;`a`b!((),1.;(),2.)]', c(a = 1., b = 2.)) + expect_equal(namedVector, c(okType = TRUE, okValue = TRUE)) + namedList <- + execute(h, 'cc[;99h;`a`b!((),1.;(),2.)]', list(a = 1., b = 2.)) + expect_equal(namedList, c(okType = TRUE, okValue = TRUE)) + +}) \ No newline at end of file diff --git a/tests/testthat/test-dict.R b/tests/testthat/test-dict.R new file mode 100644 index 0000000..40e6211 --- /dev/null +++ b/tests/testthat/test-dict.R @@ -0,0 +1,12 @@ +context("dict") + +test_that("dict conversions", { + h <- skip_unless_has_test_db() + dictK <- execute(h, "`a`b!(1 2;1 2 3)") + dictR <-list(a=c(1,2),b=c(1,2,3)) + expect_equal(dictR, dictK) + dictK <- execute(h,"::",dictR) + expect_equal(dictR,dictK) + dictK <- execute(h,"::",as.pairlist(dictR)) + expect_equal(dictR,dictK) +}) \ No newline at end of file diff --git a/tests/testthat/test-tables.R b/tests/testthat/test-tables.R new file mode 100644 index 0000000..452567c --- /dev/null +++ b/tests/testthat/test-tables.R @@ -0,0 +1,16 @@ +context("tables") + +test_that("table shapes", { + h <- skip_unless_has_test_db() + col3K <- execute(h, "([]s:`a`b``1;e:``aa`bb`cc;qty:100 0N 0W -0Wi)") + col3R <- + data.frame( + s = c('a', 'b', '', '1'), + e = c('', 'aa', 'bb', 'cc'), + qty = c(100L, NA, as.integer(2147483647), -as.integer(2147483647)), + stringsAsFactors = FALSE + ) + expect_equal(col3R, col3K) + col3K<-execute(h,"::",col3R) + expect_equal(col3R, col3K) +}) \ No newline at end of file