tests/testthat/test-dbWriteTable.R

In RPostgres: C++ Interface to PostgreSQL

if (postgresHasDefault()) {

  with_database_connection({
    describe("Writing to the database", {
      test_that("writing to a database table is successful", {
        with_table(con, "beaver2", {
          dbWriteTable(con, "beaver2", beaver2, temporary = TRUE)
          expect_equal(dbReadTable(con, "beaver2"), beaver2)
        })
      })

      test_that("writing to a database table with character features is successful", {
        with_table(con, "iris", {
          iris2 <- transform(iris, Species = as.character(Species))
          dbWriteTable(con, "iris", iris2, temporary = TRUE)
          expect_equal(dbReadTable(con, "iris"), iris2)
        })
      })
    })

    describe("Appending to the database", {
      test_that("append to a database table is successful", {
        with_table(con, "beaver2", {
          dbWriteTable(con, "beaver2", beaver2, temporary = TRUE)
          dbWriteTable(con, "beaver2", beaver2, append = TRUE, temporary = TRUE)
          expect_equal(dbReadTable(con, "beaver2"), rbind(beaver2, beaver2))
        })
      })

      test_that("append to a database table with character features is successful", {
        with_table(con, "iris", {
          iris2 <- transform(iris, Species = as.character(Species))
          dbWriteTable(con, "iris", iris2, temporary = TRUE)
          dbWriteTable(con, "iris", iris2, append = TRUE, temporary = TRUE)
          expect_equal(dbReadTable(con, "iris"), rbind(iris2, iris2))
        })
      })
    })

    describe("Usage of the field.types argument", {
      test_that("New table creation respects the field.types argument", {
        with_table(con, "iris", {
          iris2 <- transform(
            iris,
            Petal.Width = as.integer(Petal.Width),
            Species = as.character(Species)
          )
          field.types <- c("real", "double precision", "numeric", "bigint", "text")
          names(field.types) <- names(iris2)

          dbWriteTable(con, "iris", iris2, field.types = field.types, temporary = TRUE)

          iris3 <- transform(
            iris2,
            Petal.Width = bit64::as.integer64(Petal.Width)
          )
          expect_equal(dbReadTable(con, "iris"), iris3)

          # http://stackoverflow.com/questions/2146705/select-datatype-of-the-field-in-postgres
          types <- DBI::dbGetQuery(con,
            paste("select column_name, data_type from information_schema.columns ",
              "where table_name = 'iris'"))
          expected <- data.frame(column_name = colnames(iris2),
            data_type = field.types, stringsAsFactors = FALSE)
          types    <- without_rownames(types[order(types$column_name), ])
          expected <- without_rownames(expected[order(expected$column_name), ])

          expect_equal(types, expected)
        })
      })

      test_that("Appending fails when using the field.types argument", {
        with_table(con, "iris", {
          iris2       <- transform(iris, Petal.Width = as.integer(Petal.Width),
            Species = as.character(Species))
          field.types <- c("real", "double precision", "numeric", "bigint", "text")
          names(field.types) <- names(iris2)

          dbWriteTable(con, "iris", iris2, field.types = field.types, temporary = TRUE)
          expect_error(
            dbWriteTable(con, "iris", iris2, field.types = field.types, append = TRUE, temporary = TRUE),
            "field[.]types"
          )
        })
      })
    })

    describe("Writing to the database with possible numeric precision issues", {
      # reference value
      value <- data.frame(x = -0.000064925595060641, y = -0.00006492559506064059)
      test_that("dbWriteTable(copy = F)", {
        with_table(con, "xy", {
          dbWriteTable(con, name = "xy", value = value, copy = F)
          expect_equal(dbGetQuery(con, "SELECT * FROM xy"), value)
        })
      })

      test_that("dbWriteTable(append = T, copy = F)", {
        with_table(con, "xy", {
          dbExecute(con, "CREATE TEMPORARY TABLE xy ( x numeric NOT NULL, y numeric NOT NULL);")
          dbWriteTable(con, name = "xy", value = value, append = T, copy = F)
          expect_equal(dbGetQuery(con, "SELECT * FROM xy"), value)
        })
      })

      test_that("dbWriteTable(append = T, copy = T)", {
        with_table(con, "xy", {
          dbExecute(con, "CREATE TEMPORARY TABLE xy ( x numeric NOT NULL, y numeric NOT NULL);")
          dbWriteTable(con, name = "xy", value = value, append = T, copy = T)
          expect_equal(dbGetQuery(con, "SELECT * FROM xy"), value)
        })
      })

      test_that("dbWriteTable(append = F, copy = T, field.types=NUMERIC)", {
        with_table(con, "xy", {
          dbWriteTable(con, name = "xy", value = value, overwrite = F, append = F, copy = T, field.types = c(x = "NUMERIC", y = "NUMERIC"))
          expect_equal(dbGetQuery(con, "SELECT * FROM xy"), value)
        })
      })
    })

    describe("Inf values", {
      test_that("Inf values come back correctly", {
        skip_on_cran()

        res <- dbGetQuery(con, "SELECT '-inf'::float8 AS a, '+inf'::float8 AS b, 'NaN'::float8 AS c, NULL::float8 AS d")
        expect_equal(res$a, -Inf)
        expect_equal(res$b, Inf)
        expect_true(is.nan(res$c))
        expect_true(is.na(res$d))
        expect_false(is.nan(res$d))
      })

      test_that("Inf values are roundtripped correctly", {
        skip_on_cran()

        with_table(con, "xy", {
          data <- data.frame(
            column_1 = c("A", "B", "C"), column_2 = c(1, Inf, 3),
            stringsAsFactors = FALSE
          )
          dbWriteTable(con, "xy", data, row.names = FALSE)

          data_out <- dbReadTable(con, "xy")
          expect_equal(data, data_out)
        })
      })
    })
  })

}