From e3337327929b316aa6f8fc82b3d29ed68463aed3 Mon Sep 17 00:00:00 2001
From: Martin Petr <git@bodkan.net>
Date: Fri, 31 Mar 2023 11:17:10 +0200
Subject: [PATCH] Add tests for non-negative splits and sizes

---
 R/interface.R                 | 11 ++++++-----
 tests/testthat/test-msprime.R | 16 ++++++++++++++++
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/R/interface.R b/R/interface.R
index a3e137130..4b9f59c15 100644
--- a/R/interface.R
+++ b/R/interface.R
@@ -55,7 +55,11 @@ population <- function(name, time, N, parent = NULL, map = FALSE,
   if (!is.character(name) || length(name) != 1)
     stop("A population name must be a character scalar value", call. = FALSE)
 
-  time <- as.integer(time)
+  N <- round(N)
+  time <- round(time)
+
+  if (time < 1) stop("Split time must be a non-negative number", call. = FALSE)
+  if (N < 1) stop("Population size must be a non-negative number", call. = FALSE)
 
   # if this population splits from a parental population, check that the parent
   # really exists and that the split time make sense given the time of appearance
@@ -73,9 +77,6 @@ population <- function(name, time, N, parent = NULL, map = FALSE,
   if (!is.null(parent) && is.logical(map) && map == FALSE)
     map <- attr(parent, "map")
 
-  if (time < 1) stop("Split time must be a non-negative integer number", call. = FALSE)
-  N <- as.integer(N)
-
   if (inherits(map, "slendr_map")) {
     # define the population range as a simple geometry object
     # and bind it with the annotation info into an sf object
@@ -1185,7 +1186,7 @@ schedule_sampling <- function(model, times, ..., locations = NULL, strict = FALS
   if (!inherits(model, "slendr_model"))
     stop("A slendr_model object must be specified", call. = FALSE)
 
-  times <- unique(as.integer(sort(times)))
+  times <- unique(as.integer(round(sort(times))))
 
   samples <- list(...)
   sample_pops <- purrr::map(samples, 1)
diff --git a/tests/testthat/test-msprime.R b/tests/testthat/test-msprime.R
index 9138eb197..2daaaef86 100644
--- a/tests/testthat/test-msprime.R
+++ b/tests/testthat/test-msprime.R
@@ -340,3 +340,19 @@ test_that("ensure that a model reaches full coalescence", {
     "slendr_ts"
   )
 })
+
+test_that("population size must be a non-negative number", {
+  expect_error(pop <- population("asd", N = -1, time = 100),
+               "Population size must be a non-negative number")
+  expect_error(pop <- population("asd", N = 0, time = 100),
+               "Population size must be a non-negative number")
+  expect_s3_class(pop <- population("asd", N = 1, time = 100), "slendr_pop")
+})
+
+test_that("population time must be a non-negative number", {
+  expect_error(pop <- population("asd", N = 100, time = -1),
+               "Split time must be a non-negative number")
+  expect_error(pop <- population("asd", N = 100, time = 0),
+               "Split time must be a non-negative number")
+  expect_s3_class(pop <- population("asd", N = 1, time = 100), "slendr_pop")
+})