tests/testthat/test-selenium.R

In borishejblum/vici: Vaccine Induced Cellular Immunogenicity with Bivariate Modeling

context("Selenium Test")

library(RSelenium)
library(testthat)
library(processx)


waitFor <- function(how,id){
  #webElem <- NULL
  
  i <- 0
  while(i<=1000){
    webElem <<- tryCatch({remDr$findElement(using = how, value = id)},
                         error = function(e){NULL})
    #loop until element with name <value> is found in <webpage url>
    
    i <- i+1
    if(!is.null(webElem)){
      break()
    }
  }
  if(!is.null(webElem)){
    return(webElem)
  }
  else{
    stop(paste0(id," not found \n"))
  }
}

wd <- getwd()

#Uncomment this for local test

# rD <- RSelenium::rsDriver(
#   browser = "firefox",
#   extraCapabilities = list(
#     "moz:firefoxOptions" = list(
#       args = list()#('--headless')
#     )
#   )
# )

remDr <-  remoteDriver(browserName = "firefox",port=4455L)#Use this for local test =>  rD$client 
remDr$open(silent = FALSE)
remDr$setTimeout(type = "page load", milliseconds = 5000)
appURL <- "http://127.0.0.1:8080"
#app %<-% vici::run_app()


test_that("can connect to app", {
  #skip_on_cran()
  x <- processx::process$new( 
    "R", 
    c(
      "-e", 
      "vici::run_app()"
    )
  )
  Sys.sleep(5)
  remDr$navigate(appURL)
  #sys.wa
  webElem <- waitFor("xpath","/html/body/div[2]/h2")#remDr$findElement(using = "xpath", value = "/html/body/div[2]/h2")
  textWebElem <- webElem$getElementText()
  expect_equal(as.character(textWebElem), "VICI: accurate estimation of Vaccine Induced Cellular Immunogenicity with bivariate modeling")
  x$kill()
})

test_that("Scénario standard example Data",{
  x <- processx::process$new( 
    "R", 
    c(
      "-e", 
      "vici::run_app()"
    )
  )
  Sys.sleep(5)
  remDr$navigate(appURL)
  loadButton <- remDr$findElement(using = "id", value = "settings_pan_ui_1-loadExample")
  loadButton$clickElement()
  
  Arm <- waitFor("xpath","/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[5]")#remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[5]")
  expect_equal(as.character(Arm$getElementText()), "Placebo")
  Response1 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[6]")
  expect_equal(as.character(Response1$getElementText()), "0.0801")
  
  fit <- remDr$findElement(using = "id", value = "modelfit_ui_1-fit")
  fit$clickElement()
  
  fRep <- waitFor("xpath","/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[1]/td[1]")#remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[1]/td[1]")
  expect_equal(as.character(fRep$getElementText()),"Response1 : Average response in reference stimulation NS in reference arm Placebo")
  standardError1 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[1]/td[3]")
  expect_equal(as.character(standardError1$getElementText()),"0.00760")
  pValue1 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[1]/td[4]")
  expect_equal(as.character(pValue1$getElementText()),"0.00000")
  
  lRep <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[11]/td[1]")
  expect_equal(as.character(lRep$getElementText()),"Response1 : Effect of arm A3 on response in stimulation S2")
  standardError2 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[11]/td[3]")
  expect_equal(as.character(standardError2$getElementText()),"0.01200")
  pValue2 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[1]/div/div[2]/div[2]/div/div/div[1]/div/div[2]/table/tbody/tr[11]/td[4]")
  expect_equal(as.character(pValue2$getElementText()),"0.72415")
  x$kill()
})

# test_that("Upload file and intra_Fit",{
#   x <- processx::process$new( 
#     "R", 
#     c(
#       "-e", 
#       "vici::run_app()"
#     )
#   )
#   Sys.sleep(5)
#   remDr$navigate(appURL)
#   
#   # uploadBtn <- waitFor("css",".btn-file")
#   # uploadBtn$clickElement()
#   
#   rdBtn <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[3]/div/div[2]/label/input")
#   rdBtn$clickElement()
#   
#   input <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[1]/div[1]/input")
#   uploadTrgt <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[1]/div[1]")#waitFor("id", "settings_pan_ui_1-datafile")
#   #uploadTrgt$setElementAttribute("style","display:true")
#   tryCatch({
#     remDr$executeScript(script = "arguments[0].removeAttribute('readonly','readonly');",args = list(input))
#     cat("File to upload: ")
#     f <- 'monfichier1_cp.csv'
#     cat(f,"\n")
#     uploadTrgt$sendKeysToElement(list(f))},
#     warning = function(war) {
#       cat("warning: ")
#       cat(war,"\n")
#     },
#     error = function(err) { 
#       RSelenium::errorHandler$errorDetails(type = "value") 								
#     }, 
#     finally = {  
#       
#     }
#   )
#   Arm <- waitFor("xpath","/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[2]")#remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[5]")
#   expect_equal(as.character(Arm$getElementText()), "223")
#   Response1 <- remDr$findElement(using = "xpath", value = "/html/body/div[2]/div/div[2]/div/div/div[2]/div[2]/div/table/tbody/tr[1]/td[4]")
#   expect_equal(as.character(Response1$getElementText()), "NS")
#   
#   modelSelecter <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[4]/div/div/div[1]")
#   modelSelecter$clickElement()
#   intra <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[4]/div/div/div[2]/div/div[2]")
#   intra$clickElement()
# 
#   subjectSelecter <- waitFor("xpath", "/html/body/div[2]/div/div[1]/form/div[5]/div/div/div[1]")
#   subjectSelecter$clickElement()
#   subject <- waitFor("xpath", "/html/body/div[2]/div/div[1]/form/div[6]/div/div/div[2]/div/div[1]")
#   subject$clickElement()
# 
#   stimuSelecter <- waitFor("xpath", "/html/body/div[2]/div/div[1]/form/div[6]/div/div/div[1]")
#   stimuSelecter$clickElement()
#   stimu <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[6]/div/div/div[2]/div/div[2]")
#   stimu$clickElement()
#   bckg <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[9]/div/div/div")
#   bckg$clickElement()
#   bckSelecter <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[9]/div/div/div/div[2]/div/div[3]")
# 
#   TimeSelecter <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[15]/div/div/div")
#   TimeSelecter$clickElement()
#   Time <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[15]/div/div/div/div[2]/div/div[1]")
#   Time$clickElement()
#   TimeIdentifier <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[16]/div/div/div/div[1]")
#   TimeIdentifier$clickElement()
#   TimeID <- waitFor("xpath","/html/body/div[2]/div/div[1]/form/div[16]/div/div/div/div[2]/div/div[1]")
# 
#   fit <- remDr$findElement(using = "id", value = "modelfit_ui_1-fit")
#   fit$clickElement()
#   x$kill()
# })

remDr$close()
#rD$server$stop()