diff --git a/src/ts_rcpp.cpp b/src/ts_rcpp.cpp index 2df8549fe..d956d447f 100644 --- a/src/ts_rcpp.cpp +++ b/src/ts_rcpp.cpp @@ -31,6 +31,56 @@ using namespace Rcpp; namespace { +// Validate tip_data VALUES at the Rcpp boundary: build_dataset()/ +// simplify_patterns() treat each entry as a 1-based index into +// `token_states` (size n_tokens), with no further checking. A value outside +// [1, n_tokens] is an out-of-bounds read (0 or negative -> before the array +// start; > n_tokens -> past the end, likely a segfault). Public wrappers +// always build `tip_data` from a validated phyDat, so this only guards a +// direct internal call (`TreeSearch:::`) with a hand-crafted matrix. +void validate_tip_data_values(const int* tip_data_r, int n_tips, + int n_patterns, int n_tokens) { + const R_xlen_t n_entries = + static_cast(n_tips) * static_cast(n_patterns); + for (R_xlen_t i = 0; i < n_entries; ++i) { + int v = tip_data_r[i]; + if (v < 1 || v > n_tokens) { + Rcpp::stop("`tip_data` values must be in [1, nrow(contrast)] (%d); " + "found %d", n_tokens, v); + } + } +} + +// Validate an `addition_order` VALUE vector at the Rcpp boundary: +// wagner_tree() treats a non-empty `order` as a length-n_tips permutation of +// 0..n_tips-1 and reads order[0..2] / order[i] for i in [3, n_tips) with no +// further checking. A short vector reads past its end (segfault); an +// out-of-range or duplicated entry indexes tree.parent[]/tip_states[] out of +// bounds (heap write UB). Public wrappers never pass `addition_order` +// directly from unchecked user input, so this only guards a direct internal +// call (`TreeSearch:::`) with a hand-crafted vector. +void validate_addition_order(const IntegerVector& addition_order, + int n_tips) { + if (addition_order.size() == 0) return; + if (addition_order.size() != n_tips) { + Rcpp::stop("`addition_order` length (%d) must equal the number of tips " + "(%d)", static_cast(addition_order.size()), n_tips); + } + std::vector seen(n_tips, false); + for (int i = 0; i < addition_order.size(); ++i) { + int v = addition_order[i]; + if (v < 1 || v > n_tips) { + Rcpp::stop("`addition_order` values must be in [1, %d]; found %d", + n_tips, v); + } + if (seen[v - 1]) { + Rcpp::stop("`addition_order` must not contain duplicate values " + "(found %d more than once)", v); + } + seen[v - 1] = true; + } +} + // Sentinel: concavity = -1 means equal weights (Inf). // Rcpp can't auto-generate R_PosInf as an R default, so we use -1 // and convert here at the single gateway into the C++ engine. @@ -74,6 +124,7 @@ ts::DataSet make_dataset( Rcpp::stop("`obs_count` length (%d) must equal the number of characters " "(%d)", static_cast(obs_count.size()), n_patterns); } + validate_tip_data_values(INTEGER(tip_data), n_tips, n_patterns, n_tokens); std::vector level_strs(n_states); std::vector level_ptrs(n_states); @@ -934,6 +985,7 @@ List ts_wagner_tree( min_steps, concavity, infoAmounts); int n_tips = tip_data.nrow(); + validate_addition_order(addition_order, n_tips); ts::ConstraintData cd = build_constraint_from_r( n_tips, consSplitMatrix, consContrast, consTipData, consWeight, consLevels, consExpectedScore); @@ -2081,6 +2133,7 @@ List ts_resample_search( Rcpp::stop("`obs_count` length (%d) must equal the number of characters " "(%d)", static_cast(obs_count.size()), n_patterns); } + validate_tip_data_values(INTEGER(tip_data), n_tips, n_patterns, n_tokens); std::vector level_strs(n_states); std::vector level_ptrs(n_states); @@ -2209,6 +2262,7 @@ List ts_parallel_resample( Rcpp::stop("`obs_count` length (%d) must equal the number of characters " "(%d)", static_cast(obs_count.size()), n_patterns); } + validate_tip_data_values(INTEGER(tip_data), n_tips, n_patterns, n_tokens); std::vector level_strs(n_states); std::vector level_ptrs(n_states); @@ -2348,6 +2402,7 @@ List ts_successive_approx( Rcpp::stop("`obs_count` length (%d) must equal the number of characters " "(%d)", static_cast(obs_count.size()), n_patterns); } + validate_tip_data_values(INTEGER(tip_data), n_tips, n_patterns, n_tokens); std::vector level_strs(n_states); std::vector level_ptrs(n_states); @@ -2777,6 +2832,16 @@ List ts_simplify_diag( int n_tips = tip_data.nrow(); int n_patterns = tip_data.ncol(); + if (weight.size() != n_patterns) { + Rcpp::stop("`weight` length (%d) must equal the number of characters (%d)", + static_cast(weight.size()), n_patterns); + } + if (levels.size() != n_states) { + Rcpp::stop("`levels` length (%d) must equal ncol(contrast) (%d)", + static_cast(levels.size()), n_states); + } + validate_tip_data_values(INTEGER(tip_data), n_tips, n_patterns, n_tokens); + // Identify inapp_state int inapp_state = -1; for (int s = 0; s < n_states; ++s) { diff --git a/tests/testthat/test-ts-wagner.R b/tests/testthat/test-ts-wagner.R index 5240f0e77..d047b24cc 100644 --- a/tests/testthat/test-ts-wagner.R +++ b/tests/testthat/test-ts-wagner.R @@ -397,3 +397,121 @@ test_that("constrained sequential Wagner boundary edge: outside tip adjacent to child_tips <- sort(result$edge[result$edge[, 2] <= n_tip, 2L]) expect_equal(child_tips, seq_len(n_tip)) }) + +test_that("tip_data values outside [1, n_tokens] error cleanly (T-328)", { + # Rcpp-boundary guard: an out-of-range tip_data entry must not reach the + # unguarded 1-based index into token_states (src/ts_simplify.cpp) -- it + # should error, not silently misread or crash. + data("congreveLamsdellMatrices", package = "TreeSearch") + pd <- congreveLamsdellMatrices[[1]] + d <- prep_pd(pd) + n_tokens <- nrow(d$contrast) + + bad_low <- d$tip_data + bad_low[1, 1] <- 0L + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, bad_low, d$weight, d$levels), + "tip_data" + ) + + bad_high <- d$tip_data + bad_high[1, 1] <- n_tokens + 1L + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, bad_high, d$weight, d$levels), + "tip_data" + ) + + bad_negative <- d$tip_data + bad_negative[1, 1] <- -1L + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, bad_negative, d$weight, d$levels), + "tip_data" + ) +}) + +test_that("out-of-range tip_data errors via other Wagner entry points (T-328)", { + data("congreveLamsdellMatrices", package = "TreeSearch") + pd <- congreveLamsdellMatrices[[1]] + d <- prep_pd(pd) + n_tokens <- nrow(d$contrast) + bad <- d$tip_data + bad[1, 1] <- n_tokens + 1L + + expect_error( + TreeSearch:::ts_random_wagner_tree(d$contrast, bad, d$weight, d$levels), + "tip_data" + ) + expect_error( + TreeSearch:::ts_resample_search(d$contrast, bad, d$weight, d$levels), + "tip_data" + ) + expect_error( + TreeSearch:::ts_parallel_resample(d$contrast, bad, d$weight, d$levels), + "tip_data" + ) + expect_error( + TreeSearch:::ts_successive_approx(d$contrast, bad, d$weight, d$levels), + "tip_data" + ) + expect_error( + TreeSearch:::ts_simplify_diag(d$contrast, bad, d$weight, d$levels), + "tip_data" + ) +}) + +test_that("ts_simplify_diag validates weight/levels length (T-328 hardening)", { + data("congreveLamsdellMatrices", package = "TreeSearch") + pd <- congreveLamsdellMatrices[[1]] + d <- prep_pd(pd) + + expect_error( + TreeSearch:::ts_simplify_diag(d$contrast, d$tip_data, d$weight[-1], + d$levels), + "weight" + ) + expect_error( + TreeSearch:::ts_simplify_diag(d$contrast, d$tip_data, d$weight, + d$levels[-1]), + "levels" + ) +}) + +test_that("addition_order length/range/duplicate errors cleanly (T-323)", { + # Rcpp-boundary guard: wagner_tree() reads addition_order as a length-n_tip + # permutation with no validation -- a short vector reads past its end + # (segfault), an out-of-range or duplicated value corrupts the tree. + data("congreveLamsdellMatrices", package = "TreeSearch") + pd <- congreveLamsdellMatrices[[1]] + d <- prep_pd(pd) + n_tip <- length(pd) + + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, d$tip_data, d$weight, d$levels, + addition_order = 1L), + "addition_order" + ) + + bad_range <- seq_len(n_tip) + bad_range[1] <- n_tip + 1L + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, d$tip_data, d$weight, d$levels, + addition_order = bad_range), + "addition_order" + ) + + bad_zero <- seq_len(n_tip) + bad_zero[1] <- 0L + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, d$tip_data, d$weight, d$levels, + addition_order = bad_zero), + "addition_order" + ) + + dup <- seq_len(n_tip) + dup[2] <- dup[1] + expect_error( + TreeSearch:::ts_wagner_tree(d$contrast, d$tip_data, d$weight, d$levels, + addition_order = dup), + "addition_order" + ) +})