avoid out of bounds indexing in references

ropensci · Nov 10, 2024 · 81bcac0 · 81bcac0
1 parent adef7ed
commit 81bcac0
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 5 deletions.
diff --git a/R/class_reference.R b/R/class_reference.R
@@ -3,15 +3,23 @@ reference_new <- function(parent, path = NULL, stage = NULL) {
 }
 
 reference_parent <- function(reference) {
-  .subset(reference, 1L)
+  reference[1L]
 }
 
 reference_path <- function(reference) {
-  .subset(reference, 2L)
+  if (length(reference) > 1L) {
+    reference[2L]
+  } else {
+    NA_character_
+  }
 }
 
 reference_stage <- function(reference) {
-  .subset2(reference, 3L)
+  if (length(reference) > 2L) {
+    reference[3L]
+  } else {
+    NA_character_
+  }
 }
 
 reference_produce_target <- function(reference, pipeline, name) {

diff --git a/tests/testthat/test-class_reference.R b/tests/testthat/test-class_reference.R
@@ -1,14 +1,20 @@
 tar_test("reference with only parent", {
   out <- reference_new(parent = "my_parent")
-  expect_equal(out, c("my_parent"))
+  expect_equal(out, "my_parent")
+  expect_equal(reference_parent(out), "my_parent")
+  expect_equal(reference_path(out), NA_character_)
+  expect_equal(reference_stage(out), NA_character_)
 })
 
 tar_test("reference with parent and path but no stage", {
   out <- reference_new(parent = "my_parent", path = "my_path")
   expect_equal(out, c("my_parent", "my_path"))
+  expect_equal(reference_parent(out), "my_parent")
+  expect_equal(reference_path(out), "my_path")
+  expect_equal(reference_stage(out), NA_character_)
 })
 
-tar_test("reference with parent and path", {
+tar_test("reference with parent, path, and stage", {
   out <- reference_new(
     "my_parent",
     "my_path",
@@ -18,6 +24,9 @@ tar_test("reference with parent and path", {
     out,
     c("my_parent", "my_path", "my_stage")
   )
+  expect_equal(reference_parent(out), "my_parent")
+  expect_equal(reference_path(out), "my_path")
+  expect_equal(reference_stage(out), "my_stage")
 })
 
 tar_test("reference_produce_target() and its inverse", {