Changeset: a2d131c7e1af for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=a2d131c7e1af
Modified Files:
clients/R/MonetDB.R/R/dbi.R
tools/embedded/build-rpkg.sh
tools/embedded/embedded.c
tools/embedded/rpackage/tests/testthat/test_dbi.R
Branch: embedded
Log Message:
RSQLite test cases passing
diffs (161 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
@@ -689,11 +689,24 @@ setMethod("dbFetch", signature(res="Mone
if (!dbIsValid(res)) {
stop("Cannot fetch results from closed response.")
}
+ if (n == 0) {
+ stop("Fetch 0 rows? Really?")
+ }
+ if (res@env$delivered < 0) {
+ res@env$delivered <- 0
+ }
+ if (res@env$delivered >= res@env$info$rows) {
+ return(res@env$resp$tuples[F,, drop=F])
+ }
if (n > -1) {
- stop("No partial fetch, entire result already available")
+ n <- min(n, res@env$info$rows - res@env$delivered)
+ res@env$delivered <- res@env$delivered + n
+ return(res@env$resp$tuples[(res@env$delivered - n +
1):(res@env$delivered),, drop=F])
}
- res@env$delivered <- res@env$info$rows
- res@env$resp$tuples
+ else {
+ res@env$delivered <- res@env$info$rows
+ return(res@env$resp$tuples)
+ }
})
setMethod("dbClearResult", "MonetDBResult", def = function(res, ...) {
diff --git a/tools/embedded/build-rpkg.sh b/tools/embedded/build-rpkg.sh
--- a/tools/embedded/build-rpkg.sh
+++ b/tools/embedded/build-rpkg.sh
@@ -1,5 +1,5 @@
#!/bin/sh
-set -x
+#set -x
STAGEDIR=/tmp/monetdb-embedded-stage
RPKG=MonetDB_1.0.0.tar.gz
diff --git a/tools/embedded/embedded.c b/tools/embedded/embedded.c
--- a/tools/embedded/embedded.c
+++ b/tools/embedded/embedded.c
@@ -274,10 +274,10 @@ static str monetdb_get_columns(const cha
s = (*mvc_bind_schema_ptr)(m, schema_name);
if (s == NULL)
- msg = createException(MAL, "embedded", "Missing schema!");
+ return createException(MAL, "embedded", "Missing schema!");
t = (*mvc_bind_table_ptr)(m, s, table_name);
if (t == NULL)
- msg = createException(MAL, "embedded", "Could not find table
%s", table_name);
+ return createException(MAL, "embedded", "Could not find table
%s", table_name);
columns = t->columns.set->cnt;
*column_count = columns;
diff --git a/tools/embedded/rpackage/tests/testthat/test_dbi.R
b/tools/embedded/rpackage/tests/testthat/test_dbi.R
--- a/tools/embedded/rpackage/tests/testthat/test_dbi.R
+++ b/tools/embedded/rpackage/tests/testthat/test_dbi.R
@@ -48,7 +48,6 @@ test_that("import export", {
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)
@@ -172,6 +171,87 @@ test_that("evil table from survey works"
dbRollback(con)
})
+
+# some DBI test cases borrowed from RSQLite
+basicDf <- data.frame(
+ name = c("Alice", "Bob", "Carl", "NA", NA),
+ fldInt = as.integer(c(as.integer(1:4), NA)),
+ fldDbl = as.double(c(1.1, 2.2, 3.3, 4.4, NA)),
+ stringsAsFactors = FALSE
+)
+
+test_that("round-trip leaves data.frame unchanged", {
+ dbWriteTable(con, "t1", basicDf, row.names = FALSE)
+ expect_equal(dbGetQuery(con, "select * from t1"), basicDf)
+ expect_equal(dbReadTable(con, "t1"), basicDf)
+ dbRemoveTable(con, "t1")
+})
+
+test_that("NAs work in first row", {
+ na_first <- basicDf[c(5, 1:4), ]
+ rownames(na_first) <- NULL
+ dbWriteTable(con, "t1", na_first, row.names = FALSE)
+ expect_equal(dbReadTable(con, "t1"), na_first)
+ dbRemoveTable(con, "t1")
+})
+
+test_that("row-by-row fetch is equivalent", {
+ dbWriteTable(con, "t1", basicDf, row.names = FALSE)
+
+ rs <- dbSendQuery(con, "SELECT * FROM t1")
+ on.exit(dbClearResult(rs))
+ for (i in 1:5) {
+ row <- dbFetch(rs, 1L)
+ expect_equal(row, basicDf[i, ], check.attributes = FALSE)
+ }
+
+ row <- dbFetch(rs, 1L)
+ expect_equal(nrow(row), 0L)
+
+ expect_true(dbHasCompleted(rs))
+ dbRemoveTable(con, "t1")
+})
+
+# TODO: fix this
+# test_that("column types as expected in presence of NULLs", {
+# dbWriteTable(con, "t1", datasets::USArrests)
+# a1 <- dbGetQuery(con, "SELECT Murder/(Murder - 8.1) FROM t1 LIMIT 10")
+# expect_is(a1[[1]], "numeric")
+# dbRemoveTable(con, "t1")
+# })
+
+test_that("correct number of columns, even if 0 rows", {
+ ans <- dbGetQuery(con, "select 1 as a, 2 as b where 1=1")
+ expect_equal(dim(ans), c(1L, 2L))
+ ans <- dbGetQuery(con, "select 1 as a, 2 as b where 0=1")
+ expect_equal(dim(ans), c(0L, 2L))
+})
+
+test_that("accessing cleared result throws error", {
+ res <- dbSendQuery(con, "SELECT 1;")
+ dbClearResult(res)
+ expect_error(dbFetch(res))
+})
+
+test_that("fetch with no arguments gets all rows", {
+ df <- data.frame(x = 1:1000)
+ dbWriteTable(con, "test", df)
+ rs <- dbSendQuery(con, "SELECT * FROM test")
+ expect_equal(nrow(dbFetch(rs)), 1000)
+ dbRemoveTable(con, "test")
+})
+
+test_that("fetch progressively pulls in rows", {
+ df <- data.frame(x = 1:25)
+ dbWriteTable(con, "test", df)
+ rs <- dbSendQuery(con, "SELECT * FROM test")
+ expect_equal(nrow(dbFetch(rs, 10)), 10)
+ expect_equal(nrow(dbFetch(rs, 10)), 10)
+ expect_equal(nrow(dbFetch(rs, 10)), 5)
+ dbRemoveTable(con, "test")
+})
+
+
test_that("dis/re-connect", {
expect_true(dbIsValid(con))
dbDisconnect(con)
@@ -182,3 +262,4 @@ test_that("dis/re-connect", {
res <- dbSendQuery(con, "SELECT 1")
expect_true(dbIsValid(res))
})
+
_______________________________________________
checkin-list mailing list
checkin-list@monetdb.org
https://www.monetdb.org/mailman/listinfo/checkin-list
