# Copyright (C) 2016-2023 IƱaki Ucar # # This file is part of simmer. # # simmer is free software: you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 2 of the License, or # (at your option) any later version. # # simmer is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with simmer. If not, see . test_that("priority queues are adhered to", { t <- trajectory() %>% seize("server", 1) %>% timeout(2) %>% release("server", 1) env <- simmer(verbose = env_verbose) %>% add_resource("server", 1) %>% add_generator("__nonprior", t, at(c(0, 0)), priority = 0) %>% add_generator("__prior", t, at(1), priority = 1) %>% # should be served second run() arrs <- env %>% get_mon_arrivals() expect_equal(arrs[arrs$name == "__prior0", ]$end_time, 4) }) test_that("priority queues are adhered to and same level priorities are processed FIFO", { t <- trajectory() %>% seize("server", 1) %>% timeout(2) %>% release("server", 1) env <- simmer(verbose = env_verbose) %>% add_resource("server", 1) %>% add_generator("_t0_prior", t, at(c(0, 2, 4, 6)), priority = 1) %>% add_generator("_t1_prior", t, at(c(1, 3, 5, 7)), priority = 1) %>% run() arrs <- env %>% get_mon_arrivals() arrs_ordered <- arrs[order(arrs$end_time), ] expect_equal(as.character(arrs_ordered$name), c("_t0_prior0", "_t1_prior0", "_t0_prior1", "_t1_prior1", "_t0_prior2", "_t1_prior2", "_t0_prior3", "_t1_prior3")) }) test_that("a lower priority arrival gets rejected before accessing the server", { t <- trajectory() %>% seize("dummy", 1) %>% timeout(10) %>% release("dummy", 1) env <- simmer(verbose = env_verbose) %>% add_generator("p0a", t, at(0, 0)) %>% add_generator("p1a", t, at(2, 3), priority = 1) %>% add_resource("dummy", 1, 2) %>% run() arrs <- env %>% get_mon_arrivals() arrs_ordered <- arrs[order(arrs$name), ] expect_equal(as.character(arrs[!arrs$finished, ]$name), "p0a1") expect_equal(arrs_ordered$end_time, c(10, 3, 20, 30)) }) test_that("priority works in non-saturated finite-queue resources", { low_prio <- trajectory() %>% seize("res", 1) %>% timeout(10) %>% release("res", 1) high_prio <- trajectory() %>% seize("res", 7) %>% timeout(10) %>% release("res", 7) env <- simmer(verbose = env_verbose) %>% add_resource("res", 0, 10) %>% add_generator("low_prio", low_prio, at(rep(0, 5))) %>% add_generator("high_prio", high_prio, at(1), priority = 1) %>% run() arr <- get_mon_arrivals(env) expect_true(all(grepl("low", arr$name))) expect_equal(arr$start_time, c(0, 0)) expect_equal(arr$end_time, c(1, 1)) expect_equal(arr$activity_time, c(0, 0)) }) test_that("out-of-range priorities are not enqueued", { t <- trajectory() %>% seize("res") %>% timeout(4) %>% release("res") env <- simmer(verbose = env_verbose) %>% add_resource("res", 3, queue_priority=1) %>% add_generator("lprio", t, at(0, 1), priority=0) %>% add_generator("hprio", t, at(0, 2), priority=2) %>% add_generator("nprio", t, at(0, 3), priority=1) %>% run() arr <- get_mon_arrivals(env) arr <- arr[order(arr$start_time),] expect_equal(arr$start_time, c(0, 0, 0, 1, 2, 3)) expect_equal(arr$end_time, c(4, 4, 4, 1, 8, 8)) expect_equal(arr$activity_time, c(4, 4, 4, 0, 4, 4)) expect_equal(arr$finished, c(TRUE, TRUE, TRUE, FALSE, TRUE, TRUE)) env <- simmer(verbose = env_verbose) %>% add_resource("res", 3, queue_priority=c(1, 1)) %>% add_generator("lprio", t, at(0, 1), priority=0) %>% add_generator("hprio", t, at(0, 2), priority=2) %>% add_generator("nprio", t, at(0, 3), priority=1) %>% run() arr <- get_mon_arrivals(env) arr <- arr[order(arr$start_time),] expect_equal(arr$start_time, c(0, 0, 0, 1, 2, 3)) expect_equal(arr$end_time, c(4, 4, 4, 1, 2, 8)) expect_equal(arr$activity_time, c(4, 4, 4, 0, 0, 4)) expect_equal(arr$finished, c(TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)) expect_error(simmer() %>% add_resource("res", queue_priority=c(1, 2, 3))) })