include synonyms in odbcListObjects() output

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(odbcListColumns,OdbcConnection)
 S3method(odbcListObjectTypes,default)
+S3method(odbcListObjects,"Microsoft SQL Server")
 S3method(odbcListObjects,OdbcConnection)
 S3method(odbcPreviewObject,OdbcConnection)
 export(databricks)

R/driver-sql-server.R

@@ -204,3 +204,56 @@ setMethod("odbcDataType", "Microsoft SQL Server",
     )
   }
 )
+
+#' @rdname SQLServer
+#' @description
+#' ## `odbcListObjects()`
+#'
+#' This method makes tables that are synonyms visible in the Connections pane.
+# See (#221).
+#' @usage NULL
+#' @export
+`odbcListObjects.Microsoft SQL Server` <- function(connection,
+                                                   catalog = NULL,
+                                                   schema = NULL,
+                                                   name = NULL,
+                                                   type = NULL,
+                                                   ...) {
+  objects <- NextMethod(
+    object = connection,
+    catalog = catalog,
+    schema = schema,
+    name = name,
+    type = type,
+    ...
+  )
+
+  if (is.null(catalog) | is.null(schema)) {
+    return(objects)
+  }
+
+  synonyms <- dbGetQuery(
+    connection,
+    "SELECT
+       catalog = DB.name,
+       [schema] = Sch.name,
+       name   = Syn.name
+     FROM sys.synonyms          AS Syn
+       INNER JOIN sys.schemas AS Sch
+         ON Sch.schema_id = Syn.schema_id
+       INNER JOIN sys.databases AS DB
+         ON Sch.principal_id = DB.database_id
+     WHERE DB.name = ? AND Sch.name = ?
+       AND OBJECTPROPERTY(Object_ID(Syn.base_object_name), 'IsTable') = 1;",
+    params = list(catalog, schema)
+  )
+
+  if (!is.null(name)) {
+    synonyms <- synonyms[synonyms$name == name, , drop = FALSE]
+  }
+
+  rbind(
+    objects,
+    data.frame(name = synonyms$name, type = rep("table", length(synonyms$name)))
+  )
+}

tests/testthat/test-driver-sql-server.R

@@ -337,3 +337,36 @@ test_that("captures multiline errors message", {
     }
   )
 })
+
+test_that("odbcListObjects shows synonyms (#221)", {
+  con <- test_con("SQLSERVER")
+  db <- dbGetQuery(con, "SELECT db_name()")[1,1]
+  dbExecute(con, "CREATE SCHEMA testSchema")
+  dbExecute(con, "CREATE SCHEMA testSchema2")
+
+  on.exit({
+    dbExecute(con, "DROP TABLE IF EXISTS testSchema.tbl")
+    dbExecute(con, "DROP SYNONYM IF EXISTS testSchema.tbl2")
+    dbExecute(con, "DROP SYNONYM IF EXISTS testSchema2.tbl2")
+    dbExecute(con, "DROP SCHEMA IF EXISTS testSchema")
+    dbExecute(con, "DROP SCHEMA IF EXISTS testSchema2")
+  })
+
+  dbExecute(con, "CREATE TABLE testSchema.tbl (x int)")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 1)
+
+  dbExecute(con, "CREATE SYNONYM testSchema.tbl2 for testSchema.tbl")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 2)
+  expect_equal(
+    nrow(odbcListObjects(con, catalog = db, schema = "testSchema", name = "tbl")),
+    1
+  )
+  expect_false("tbl2" %in% odbcListObjects(con))
+  dbExecute(con, "DROP SYNONYM testSchema.tbl2")
+
+  # ensure query filters out synonyms in schemas other than the one
+  # where the base object lives effectively
+  dbExecute(con, "CREATE SYNONYM testSchema2.tbl2 for testSchema.tbl")
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema")), 1)
+  expect_equal(nrow(odbcListObjects(con, catalog = db, schema = "testSchema2")), 1)
+})