Changeset: e49aa2d54dde for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=e49aa2d54dde
Added Files:
monetdb5/extras/rapi/converters.c
tools/embedded/rpackage/tests/testthat/test_dbi.R
Removed Files:
monetdb5/extras/rapi/converters.h
Modified Files:
clients/R/MonetDB.R/R/dbi.R
monetdb5/extras/rapi/rapi.c
tools/embedded/embedded.c
Branch: embedded
Log Message:
DBI test cases for embedded branch. All passing.
diffs (truncated from 386 to 300 lines):
diff --git a/clients/R/MonetDB.R/R/dbi.R b/clients/R/MonetDB.R/R/dbi.R
--- a/clients/R/MonetDB.R/R/dbi.R
+++ b/clients/R/MonetDB.R/R/dbi.R
@@ -92,7 +92,9 @@ setMethod("dbConnect", "MonetDBDriver",
stop("MonetDB package required for embedded mode")
}
monetdb_embedded_startup(embedded, !getOption("monetdb.debug.embedded",
FALSE))
- return(new("MonetDBEmbeddedConnection"))
+ connenv <- new.env(parent=emptyenv())
+ connenv$open <- TRUE
+ return(new("MonetDBEmbeddedConnection", connenv=connenv))
}
if (getOption("monetdb.debug.mapi", F)) message("II: Connecting to MonetDB
on host ", host, " at "
@@ -135,7 +137,7 @@ setMethod("dbConnect", "MonetDBDriver",
}
# if (getOption("monetdb.profile", T)) .profiler_enable(conn)
- return(conn)
+ conn
},
valueClass="MonetDBConnection")
@@ -144,7 +146,7 @@ valueClass="MonetDBConnection")
setClass("MonetDBConnection", representation("DBIConnection", socket="ANY",
connenv="environment"))
-setClass("MonetDBEmbeddedConnection", representation("MonetDBConnection"))
+setClass("MonetDBEmbeddedConnection", representation("MonetDBConnection",
connenv="environment"))
setMethod("dbGetInfo", "MonetDBConnection", def=function(dbObj, ...) {
@@ -152,7 +154,7 @@ setMethod("dbGetInfo", "MonetDBConnectio
ll <- as.list(envdata$value)
names(ll) <- envdata$name
ll$name <- "MonetDBConnection"
- return(ll)
+ ll
})
setMethod("dbIsValid", "MonetDBConnection", def=function(dbObj, ...) {
@@ -161,7 +163,12 @@ setMethod("dbIsValid", "MonetDBConnectio
setMethod("dbDisconnect", "MonetDBConnection", def=function(conn, ...) {
.mapiDisconnect(conn@socket)
- return(invisible(TRUE))
+ invisible(TRUE)
+})
+
+setMethod("dbDisconnect", "MonetDBEmbeddedConnection", def=function(conn, ...)
{
+ conn@connenv$open <- FALSE
+ invisible(TRUE)
})
setMethod("dbListTables", "MonetDBConnection", def=function(conn, ...,
sys_tables=F, schema_names=F) {
@@ -174,7 +181,7 @@ setMethod("dbListTables", "MonetDBConnec
df$sn <- quoteIfNeeded(conn, df$sn, warn=F)
res <- paste0(df$sn, ".", df$tn)
}
- return(as.character(res))
+ as.character(res)
})
if (is.null(getGeneric("dbTransaction"))) setGeneric("dbTransaction",
function(conn, ...)
@@ -296,6 +303,9 @@ setMethod("dbSendQuery", signature(conn=
# This one does all the work in this class
setMethod("dbSendQuery", signature(conn="MonetDBEmbeddedConnection",
statement="character"),
def=function(conn, statement, ..., list=NULL) {
+ if (!conn@connenv$open) {
+ stop("This connection was closed.")
+ }
if(!is.null(list) || length(list(...))){
if (length(list(...))) statement <- .bindParameters(statement, list(...))
if (!is.null(list)) statement <- .bindParameters(statement, list)
@@ -313,14 +323,13 @@ setMethod("dbSendQuery", signature(conn=
if (resp$type == Q_TABLE) {
meta <- new.env(parent=emptyenv())
meta$type <- Q_TABLE
- meta$id <- 42
+ meta$id <- -1
meta$rows <- NROW(resp$tuples)
meta$cols <- NCOL(resp$tuples)
meta$index <- 0
meta$names <- names(resp$tuples)
env$info <- meta
-
env$success = TRUE
env$conn <- conn
env$resp <- resp
@@ -381,10 +390,6 @@ quoteIfNeeded <- function(conn, x, warn=
x
}
-# # overload as per DBI documentation
-# setMethod("dbQuoteIdentifier", c("MonetDBConnection", "SQL"), function(conn,
x, ...) {x})
-
-# adapted from RMonetDB, very useful...
setMethod("dbWriteTable", "MonetDBConnection", def=function(conn, name, value,
overwrite=FALSE,
append=FALSE, csvdump=FALSE, transaction=TRUE,...) {
if (is.vector(value) && !is.list(value)) value <- data.frame(x=value)
@@ -413,6 +418,8 @@ setMethod("dbWriteTable", "MonetDBConnec
dbSendUpdate(conn, ct)
}
if (length(value[[1]])) {
+ # TODO: special handling for embedded mode
+
if (csvdump) {
tmp <- tempfile(fileext = ".csv")
write.table(value, tmp, sep = ",", quote = TRUE, row.names = FALSE,
col.names = FALSE,na="")
@@ -673,19 +680,13 @@ setMethod("dbFetch", signature(res="Mone
if (!dbIsValid(res)) {
stop("Cannot fetch results from closed response.")
}
-
if (n > -1) {
- stop("Cannot do partial fetch")
+ stop("No partial fetch, entire result already available")
}
res@env$delivered <- res@env$info$rows
res@env$resp$tuples
})
-setMethod("dbClearResult", "MonetDBEmbeddedResult", def = function(res, ...) {
- # no need to do anything here
- return(invisible(TRUE))
-}, valueClass = "logical")
-
setMethod("dbClearResult", "MonetDBResult", def = function(res, ...) {
if (res@env$info$type == Q_TABLE) {
resid <- res@env$info$id
@@ -697,6 +698,13 @@ setMethod("dbClearResult", "MonetDBResul
return(invisible(TRUE))
}, valueClass = "logical")
+setMethod("dbClearResult", "MonetDBEmbeddedResult", def = function(res, ...) {
+ if (res@env$info$type == Q_TABLE) {
+ res@env$open <- FALSE
+ }
+ return(invisible(TRUE))
+}, valueClass = "logical")
+
setMethod("dbHasCompleted", "MonetDBResult", def = function(res, ...) {
if (res@env$info$type == Q_TABLE) {
return(res@env$delivered == res@env$info$rows)
@@ -712,12 +720,19 @@ setMethod("dbIsValid", signature(dbObj="
})
setMethod("dbColumnInfo", "MonetDBResult", def = function(res, ...) {
- return(data.frame(field.name=res@env$info$names,
field.type=res@env$info$types,
+ data.frame(field.name=res@env$info$names, field.type=res@env$info$types,
data.type=monetTypes[res@env$info$types],
r.data.type=monetTypes[res@env$info$types],
- monetdb.data.type=res@env$info$types))
+ monetdb.data.type=res@env$info$types, stringsAsFactors=F)
},
valueClass = "data.frame")
+setMethod("dbColumnInfo", "MonetDBEmbeddedResult", def = function(res, ...) {
+ data.frame(field.name=res@env$info$names, stringsAsFactors=F)
+ # TODO: also export SQL types? Do we need this?
+},
+valueClass = "data.frame")
+
+
setMethod("dbGetInfo", "MonetDBResult", def=function(dbObj, ...) {
return(list(statement=dbObj@env$query, rows.affected=0,
row.count=dbObj@env$info$rows,
has.completed=dbHasCompleted(dbObj), is.select=TRUE))
diff --git a/monetdb5/extras/rapi/converters.h
b/monetdb5/extras/rapi/converters.c
rename from monetdb5/extras/rapi/converters.h
rename to monetdb5/extras/rapi/converters.c
diff --git a/monetdb5/extras/rapi/rapi.c b/monetdb5/extras/rapi/rapi.c
--- a/monetdb5/extras/rapi/rapi.c
+++ b/monetdb5/extras/rapi/rapi.c
@@ -37,7 +37,8 @@
//#define _RAPI_DEBUG_
-#include "converters.h"
+/* we need the BAT-SEXP-BAT conversion in two places, here and in
tools/embedded */
+#include "converters.c"
const char* rapi_enableflag = "embedded_r";
diff --git a/tools/embedded/embedded.c b/tools/embedded/embedded.c
--- a/tools/embedded/embedded.c
+++ b/tools/embedded/embedded.c
@@ -211,7 +211,8 @@ void monetdb_cleanup_result(void* output
(*res_table_destroy_ptr)((res_table*) output);
}
-#include "converters.h"
+/* we need the BAT-SEXP-BAT conversion in two places, here and in RAPI */
+#include "converters.c"
SEXP monetdb_query_R(SEXP query) {
res_table* output = NULL;
diff --git a/tools/embedded/rpackage/tests/testthat/test_dbi.R
b/tools/embedded/rpackage/tests/testthat/test_dbi.R
new file mode 100644
--- /dev/null
+++ b/tools/embedded/rpackage/tests/testthat/test_dbi.R
@@ -0,0 +1,185 @@
+library(testthat)
+library(MonetDB)
+library(MonetDB.R)
+
+tname <- "monetdbtest"
+data(iris)
+tsize <- function(conn, tname)
+ as.integer(dbGetQuery(conn, paste0("SELECT COUNT(*) FROM ",tname))[[1]])
+
+test_that("db starts up and accepts queries", {
+ con <<- dbConnect(MonetDB.R::MonetDB.R(), embedded=tempdir())
+ expect_is(con, "MonetDBEmbeddedConnection")
+ expect_true(dbIsValid(con))
+ res <- dbGetQuery(con, "SELECT 42")
+ expect_equal(res$single_value, 42)
+ expect_is(res, "data.frame")
+})
+
+test_that("raw sql handling", {
+ dbSendUpdate(con, "CREATE TABLE monetdbtest (a varchar(10),b integer,c
blob)")
+ expect_equal(dbExistsTable(con, tname), TRUE)
+ dbSendUpdate(con, "INSERT INTO monetdbtest VALUES ('one',1,'1111')")
+ dbSendUpdate(con, "INSERT INTO monetdbtest VALUES ('two',2,'22222222')")
+ expect_equal(dbGetQuery(con,"SELECT count(*) FROM monetdbtest")[[1]], 2)
+ #expect_equal(dbReadTable(con, "monetdbtest")[[3]],
list(charToRaw("1111"), charToRaw("22222222")))
+ # why does this not work?
+ dbRemoveTable(con, tname)
+ expect_false(dbExistsTable(con, tname))
+})
+
+test_that("import export", {
+ data(iris)
+ dbWriteTable(con, tname, iris)
+
+ expect_true(dbExistsTable(con, tname))
+ expect_false(dbExistsTable(con, "monetdbtest2"))
+
+ expect_true(tname %in% dbListTables(con))
+ expect_equal(dbListFields(con, tname), names(iris))
+
+ iris2 <- dbReadTable(con, tname)
+ expect_equal(dim(iris), dim(iris2))
+
+ res <- dbSendQuery(con, "SELECT \"Species\", \"Sepal.Width\" FROM
monetdbtest")
+ expect_true(dbIsValid(res))
+ expect_is(res, "MonetDBEmbeddedResult")
+ expect_true(res@env$success)
+ expect_equal(dbColumnInfo(res)[[1,1]], "Species")
+ expect_equal(dbColumnInfo(res)[[2,1]], "Sepal.Width")
+ expect_equal(dbGetInfo(res)$row.count, 150)
+ expect_equal(res@env$info$rows, 150)
+ expect_error(dbFetch(res,10))
+
+ data2 <- dbFetch(res,-1)
+ expect_equal(dim(data2)[[1]], 150)
+ expect_true(dbHasCompleted(res))
+ expect_true(dbIsValid(res))
+ dbClearResult(res)
+ expect_false(dbIsValid(res))
+
+ dbRemoveTable(con, tname)
+ expect_false(dbExistsTable(con, tname))
+ expect_error(dbFetch(res))
+})
+
+test_that("csv import", {
+ tf <- tempfile()
+ on.exit(unlink(tf))
+
+ write.table(iris, tf, sep=",", row.names=FALSE)
+ tname2 <- "Need to quote this table name"
+ monetdb.read.csv(con, tf, tname)
+ monetdb.read.csv(con, tf, tname2)
+ expect_true(dbExistsTable(con, tname))
+ expect_true(dbExistsTable(con,tname2))
+
+ iris3 <- dbReadTable(con, tname)
+ iris4 <- dbReadTable(con, tname2)
+ expect_equal(dim(iris), dim(iris3))
+ expect_equal(dim(iris), dim(iris4))
+ expect_equal(dbListFields(con,tname), names(iris))
+ expect_equal(dbListFields(con,tname2), names(iris))
+
+ dbRemoveTable(con, tname)
+ dbRemoveTable(con, tname2)
+ expect_false(dbExistsTable(con, tname))
+ expect_false(dbExistsTable(con, tname2))
+})
+
+test_that("write table with complications", {
+ # make sure table is gone before we start
+ if (dbExistsTable(con,tname))
+ dbRemoveTable(con,tname)
+
+ # table does not exist, append=F, overwrite=F, this should work
+ dbWriteTable(con, tname, mtcars, append=F, overwrite=F)
+ expect_true(dbExistsTable(con, tname))
+ expect_equal(nrow(mtcars), tsize(con, tname))
+
_______________________________________________
checkin-list mailing list
checkin-list@monetdb.org
https://www.monetdb.org/mailman/listinfo/checkin-list
