fix entry bugs

R/GwasFineMappingResult.R

@@ -36,7 +36,14 @@ setClass("GwasFineMappingResult",
       if (!all(entryTypes))
         errors <- c(errors,
           "every element of the `entry` column must be a FineMappingEntry")
-      keyDf <- as.data.frame(object[, c("study", "method", "region_id")])
+      # Extract key columns directly rather than via `object[, keyCols]`:
+      # column-subsetting preserves the GwasFineMappingResult class while
+      # dropping the required `entry` column, and older S4Vectors revalidates
+      # that intermediate, spuriously failing with "missing columns: entry".
+      keyCols <- c("study", "method", "region_id")
+      keyDf <- as.data.frame(
+        lapply(keyCols, function(cn) object[[cn]]),
+        col.names = keyCols, stringsAsFactors = FALSE)
       if (anyDuplicated(keyDf))
         errors <- c(errors,
           "(study, method, region_id) tuple uniqueness violated")

R/QtlFineMappingResult.R

@@ -42,7 +42,13 @@ setClass("QtlFineMappingResult",
             "'%s' column must be character (got %s)", jc, class(vals)[[1L]]))
       }
       keyCols <- c("study", "context", "trait", "method", jointCols)
-      keyDf <- as.data.frame(object[, keyCols, drop = FALSE])
+      # Extract key columns directly rather than via `object[, keyCols]`:
+      # column-subsetting preserves the QtlFineMappingResult class while
+      # dropping the required `entry` column, and older S4Vectors revalidates
+      # that intermediate, spuriously failing with "missing columns: entry".
+      keyDf <- as.data.frame(
+        lapply(keyCols, function(cn) object[[cn]]),
+        col.names = keyCols, stringsAsFactors = FALSE)
       if (anyDuplicated(keyDf))
         errors <- c(errors,
           "(study, context, trait, method[, joint*]) tuple uniqueness violated")

R/qtlSumStats.R

@@ -35,7 +35,14 @@ setClass("QtlSumStats",
       if (!all(entryTypes))
         errors <- c(errors,
           "every element of the `entry` column must be a GRanges")
-      keyDf <- as.data.frame(object[, c("study", "context", "trait")])
+      # Extract key columns directly rather than via `object[, keyCols]`:
+      # column-subsetting preserves the QtlSumStats class while dropping the
+      # required `entry` column, and older S4Vectors revalidates that
+      # intermediate, spuriously failing with "missing columns: entry".
+      keyCols <- c("study", "context", "trait")
+      keyDf <- as.data.frame(
+        lapply(keyCols, function(cn) object[[cn]]),
+        col.names = keyCols, stringsAsFactors = FALSE)
       if (anyDuplicated(keyDf))
         errors <- c(errors,
           "(study, context, trait) tuple uniqueness violated")

R/twasWeights.R

@@ -42,7 +42,13 @@ setClass("TwasWeights",
             "'%s' column must be character (got %s)", jc, class(vals)[[1L]]))
       }
       keyCols <- c("study", "context", "trait", "method", jointCols)
-      keyDf <- as.data.frame(object[, keyCols, drop = FALSE])
+      # Extract key columns directly rather than via `object[, keyCols]`:
+      # column-subsetting preserves the TwasWeights class while dropping the
+      # required `entry` column, and older S4Vectors revalidates that
+      # intermediate, spuriously failing with "missing columns: entry".
+      keyDf <- as.data.frame(
+        lapply(keyCols, function(cn) object[[cn]]),
+        col.names = keyCols, stringsAsFactors = FALSE)
       if (anyDuplicated(keyDf))
         errors <- c(errors,
           "(study, context, trait, method[, joint*]) tuple uniqueness violated")

tests/testthat/test_GwasFineMappingResult.R

@@ -14,6 +14,23 @@ test_that("GwasFineMappingResult: builds a collection keyed by 2-tuple", {
 })
 
 
+test_that("GwasFineMappingResult: validity does not recurse on key subset (#546)", {
+  # The validity method builds a key-column data.frame to check tuple
+  # uniqueness. Doing so via `object[, keyCols]` preserves the
+  # GwasFineMappingResult class while dropping the required `entry` column;
+  # older S4Vectors revalidates that intermediate and fails with
+  # "missing columns: entry".
+  e <- .sc_makeFineMappingEntry(3)
+  res <- GwasFineMappingResult(study = "g1", method = "susie",
+                               entry = list(e))
+  expect_s4_class(res, "GwasFineMappingResult")
+  expect_true(validObject(res))
+
+  sub <- res[, c("study", "method", "region_id")]
+  expect_false("entry" %in% names(sub))
+})
+
+
 test_that("GwasFineMappingResult: errors on length mismatch", {
   e <- .sc_makeFineMappingEntry(3)
   expect_error(

tests/testthat/test_QtlFineMappingResult.R

@@ -17,6 +17,26 @@ test_that("QtlFineMappingResult: builds a collection keyed by 4-tuple", {
 })
 
 
+test_that("QtlFineMappingResult: validity does not recurse on key subset (#546)", {
+  # The validity method builds a key-column data.frame to check tuple
+  # uniqueness. Doing so via `object[, keyCols]` preserves the
+  # QtlFineMappingResult class while dropping the required `entry` column;
+  # older S4Vectors revalidates that intermediate and fails with
+  # "missing columns: entry". Guard the reporter's exact scenario.
+  e <- .sc_makeFineMappingEntry(3)
+  res <- QtlFineMappingResult(
+    study = "s", context = "c", trait = "t", method = "qsusie",
+    entry = list(e), ldSketch = NULL)
+  expect_s4_class(res, "QtlFineMappingResult")
+  expect_true(validObject(res))
+
+  # A bare key-column subset is itself an invalid QtlFineMappingResult;
+  # validity must never re-run over it.
+  sub <- res[, c("study", "context", "trait", "method"), drop = FALSE]
+  expect_false("entry" %in% names(sub))
+})
+
+
 test_that("QtlFineMappingResult: stores an LD sketch when supplied", {
   e <- .sc_makeFineMappingEntry(3)
   gh <- .sc_makeGenotypeHandle()

tests/testthat/test_TwasWeightsEntry.R

@@ -57,6 +57,19 @@ test_that("TwasWeights: rejects non-TwasWeightsEntry rows", {
 })
 
 
+test_that("TwasWeights: validity does not recurse on key subset (#546)", {
+  # Building the tuple-uniqueness key via `object[, keyCols]` preserves the
+  # TwasWeights class while dropping the required `entry` column; older
+  # S4Vectors revalidates that intermediate and fails with "missing columns".
+  e <- .sc_makeTwasWeightsEntry(p = 5L)
+  res <- TwasWeights(
+    study = "s1", context = "c1", trait = "t1", method = "lasso",
+    entry = list(e))
+  expect_s4_class(res, "TwasWeights")
+  expect_true(validObject(res))
+})
+
+
 
 # === Tests migrated from test_showMethods.R (TwasWeightsEntry) ===