context("validateteImport_methods")
# validate_import_checkbox ------------------------------------------
test_that(
"0, 1, Unchecked, Checked, '', NA all pass",
{
test_checkbox <- c("0", "1",
"Unchecked", "UNCHECKED", "UnChEcKeD", "unchecked",
"Checked", "CHECKED", "ChEcKeD", "checked",
"", NA_character_)
check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
expect_equal(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___check1",
field_choice = check_define,
logfile = ""),
c("0", "1",
"0", "0", "0", "0",
"1", "1", "1", "1",
"0", NA_character_)
)
}
)
test_that(
"0, 1, NA all pass (numeric)",
{
test_checkbox <- c(0, 1, NA_real_)
check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
expect_equal(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___check1",
field_choice = check_define,
logfile = ""),
c("0", "1", NA_character_)
)
}
)
test_that(
"codes and labels pass",
{
test_checkbox <- c("check1", "Guitar")
check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
expect_equal(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___check1",
field_choice = check_define,
logfile = ""),
c("1", "1")
)
}
)
# Tests for validate_import_form_complete ---------------------------
test_that(
"Acceptable values are properly mapped and returned.",
{
input_value <- c("Incomplete", "Unverified", "Complete",
"0", "1", "2",
NA)
expect_equal(
validate_import_form_complete(input_value,
field_name = "form_complete",
logfile = ""),
c("0", "1", "2",
"0", "1", "2",
NA)
)
}
)
test_that(
"codes and labels pass (second option)",
{
test_checkbox <- c("check2", "Lute")
check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
expect_equal(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___check2",
field_choice = check_define,
logfile = ""),
c("1", "1")
)
}
)
test_that(
"0 code or 0 label returns 0",
{
test_checkbox <- c("0")
check_define <- "0, 0 | 1, 1"
expect_equal(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___0",
field_choice = check_define,
logfile = ""),
c("0")
)
}
)
test_that(
"unmapped values produce a message",
{
local_reproducible_output(width = 200)
test_checkbox <- c("check_lute")
check_define <- "check1, Guitar | check2, Lute | check3 , Harp "
expect_message(
validate_import_checkbox(test_checkbox,
field_name = "checkbox___check2",
field_choice = check_define,
logfile = ""),
"must be one of '0', '1', 'Checked', 'Unchecked', 'check2', 'Lute', ''"
)
}
)
test_that(
"Unacceptable values return a message",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_form_complete("Invalid",
field_name = "form_complete",
logfile = ""),
"Values[(]s[)] must be one of: 0, 1, 2, Incomplete, Unverified, or Complete."
)
}
)
# validate_import_date ----------------------------------------------
test_that(
"Date values are converted to YYYY-mm-dd format",
{
date_test <- Sys.Date()
expect_equal(
validate_import_date(date_test,
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
format(date_test, "%Y-%m-%d")
)
}
)
test_that(
"POSIXct values are converted to YYYY-mm-dd format",
{
datetime_test <- Sys.time()
expect_equal(
validate_import_date(datetime_test,
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
format(datetime_test, "%Y-%m-%d")
)
}
)
test_that(
"ymd, ymd HMS map to YYYY-mm-dd format",
{
test_strings <- c("2023-01-01", "2023-01-02 03:04:05")
compare_string <- seq(from = as.Date("2023-01-01"),
to = as.Date("2023-01-02"),
by = "1 day")
compare_string <- format(compare_string,
format = "%Y-%m-%d")
expect_equal(
validate_import_date(test_strings,
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"mdy, mdy HMS YYYY-mm-dd format",
{
test_strings <- c("01-01-2023", "01-02-2023 03:04:05")
compare_string <- as.Date(c("2023-01-01", "2023-01-02"))
compare_string <- format(compare_string,
format = "%Y-%m-%d")
expect_equal(
validate_import_date(test_strings,
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"dmy, dmy HMS YYYY-mm-dd format",
{
test_strings <- c("13-01-2023", "01-01-2023 03:04:05")
compare_string <- as.Date(c("2023-01-13", "2023-01-01"))
compare_string <- format(compare_string,
format = "%Y-%m-%d")
expect_equal(
validate_import_date(test_strings,
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"NA passes without a message",
{
expect_equal(
validate_import_date(c("2023-01-01", NA),
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
c("2023-01-01", NA)
)
}
)
test_that(
"Unmappable values return a message",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_date(c("2023-01-33", "not a date"),
field_name = "date",
field_min = NA,
field_max = NA,
logfile = ""),
"must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
)
}
)
test_that(
"When a date is less than field_min, a message is returned",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_date(as.Date(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = as.Date("2023-02-01"),
field_max = NA,
logfile = ""),
"before the stated minimum date"
)
}
)
test_that(
"When a date is greater than field_max, a message is returned",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_date(as.Date(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = NA,
field_max = as.Date("2023-02-01"),
logfile = ""),
"after the stated maximum date"
)
}
)
# validate_import_datetime ------------------------------------------
test_that(
"Date values are converted to YYYY-mm-dd format",
{
date_test <- Sys.Date()
expect_equal(
validate_import_datetime(date_test,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
format(date_test, "%Y-%m-%d %H:%M")
)
}
)
test_that(
"POSIXct values are converted to YYYY-mm-dd format",
{
datetime_test <- Sys.time()
expect_equal(
validate_import_datetime(datetime_test,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
format(datetime_test, "%Y-%m-%d %H:%M")
)
}
)
test_that(
"ymd, ymd HMS map to YYYY-mm-dd format",
{
test_strings <- c("2023-01-01", "2023-01-02 03:04:05")
compare_string <- as.POSIXct(c("2023-01-01 00:00:00",
"2023-01-02 03:04:05"),
tz = "UTC")
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M")
expect_equal(
validate_import_datetime(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"mdy, mdy HMS YYYY-mm-dd format",
{
test_strings <- c("01-01-2023", "01-02-2023 03:04:05")
compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05"))
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M")
expect_equal(
validate_import_datetime(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"dmy, dmy HMS YYYY-mm-dd format",
{
test_strings <- c("13-01-2023", "01-01-2023 03:04:05")
compare_string <- as.POSIXct(c("2023-01-13 00:00:00",
"2023-01-01 03:04:05"),
tz = "UTC")
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M")
expect_equal(
validate_import_datetime(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"NA passes without a message",
{
expect_equal(
validate_import_datetime(c("2023-01-01", NA),
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
c("2023-01-01 00:00", NA)
)
}
)
test_that(
"Unmappable values return a message",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_datetime(c("2023-01-33", "not a date"),
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
"must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
)
}
)
test_that(
"When a date is less than field_min, a message is returned",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_datetime(as.POSIXct(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = as.POSIXct("2023-02-01 00:00:00"),
field_max = NA,
logfile = ""),
"before the stated minimum date"
)
}
)
test_that(
"When a date is greater than field_max, a message is returned",
{
local_reproducible_output(width = 200)
expect_message(
validate_import_datetime(as.Date(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = NA,
field_max = as.POSIXct("2023-02-01"),
logfile = ""),
"after the stated maximum date"
)
}
)
# validate_import_datetime seconds ----------------------------------
test_that(
"Date values are converted to YYYY-mm-dd format",
{
date_test <- Sys.Date()
expect_equal(
validate_import_datetime_seconds(date_test,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
format(date_test, "%Y-%m-%d %H:%M:%S")
)
}
)
test_that(
"POSIXct values are converted to YYYY-mm-dd format",
{
datetime_test <- Sys.time()
expect_equal(
validate_import_datetime_seconds(datetime_test,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
format(datetime_test, "%Y-%m-%d %H:%M:%S")
)
}
)
test_that(
"ymd, ymd HMS map to YYYY-mm-dd format",
{
test_strings <- c("2023-01-01", "2023-01-02 03:04:05")
compare_string <- as.POSIXct(c("2023-01-01 00:00:00",
"2023-01-02 03:04:05"),
tz = "UTC")
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M:%S")
expect_equal(
validate_import_datetime_seconds(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"mdy, mdy HMS YYYY-mm-dd format",
{
test_strings <- c("01-01-2023", "01-02-2023 03:04:05")
compare_string <- as.POSIXct(c("2023-01-01 00:00:00", "2023-01-02 03:04:05"))
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M:%S")
expect_equal(
validate_import_datetime_seconds(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"dmy, dmy HMS YYYY-mm-dd format",
{
test_strings <- c("13-01-2023", "01-01-2023 03:04:05")
compare_string <- as.POSIXct(c("2023-01-13 00:00:00",
"2023-01-01 03:04:05"),
tz = "UTC")
compare_string <- format(compare_string,
format = "%Y-%m-%d %H:%M:%S")
expect_equal(
validate_import_datetime_seconds(test_strings,
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
compare_string
)
}
)
test_that(
"NA passes without a message",
{
expect_equal(
validate_import_datetime_seconds(c("2023-01-01", NA),
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
c("2023-01-01 00:00:00", NA)
)
}
)
test_that(
"Unmappable values return a message",
{
expect_message(
validate_import_datetime_seconds(c("2023-01-33", "not a date"),
field_name = "datetime",
field_min = NA,
field_max = NA,
logfile = ""),
"must have POSIXct class, Date class, or character class in ymd, mdy, or dmy format"
)
}
)
test_that(
"When a date is less than field_min, a message is returned",
{
expect_message(
validate_import_datetime_seconds(as.POSIXct(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = as.POSIXct("2023-02-01 00:00:00"),
field_max = NA,
logfile = ""),
"before the stated minimum date"
)
}
)
test_that(
"When a date is greater than field_max, a message is returned",
{
expect_message(
validate_import_datetime_seconds(as.Date(c("2023-01-01", "2023-03-01")),
field_name = "date",
field_min = NA,
field_max = as.POSIXct("2023-02-01"),
logfile = ""),
"after the stated maximum date"
)
}
)
# validate_import_time ----------------------------------------------
test_that(
"Character forms of HH:MM and HH:MM:SS pass",
{
time_test <- c("06:15", "06:15:00")
expect_equal(
validate_import_time(time_test,
field_name = "time",
field_min = NA,
field_max = NA,
logfile = ""),
rep("06:15", 2)
)
}
)
test_that(
"objects of class time pass. Also, NA",
{
time_test <- chron::as.times(c("06:15:00", NA))
expect_equal(
validate_import_time(time_test,
field_name = "time",
field_min = NA,
field_max = NA,
logfile = ""),
c("06:15", NA)
)
}
)
test_that(
"Times before field_min produce a message",
{
time_test <- c("06:00", "07:00", "08:00", "09:00")
expect_message(
validate_import_time(time_test,
field_name = "time",
field_min = "07:30",
field_max = NA,
logfile = ""),
"are before the stated minimum time"
)
}
)
test_that(
"Times after field_max produce a message",
{
time_test <- c("06:00", "07:00", "08:00", "09:00")
expect_message(
validate_import_time(time_test,
field_name = "time",
field_min = NA,
field_max = "07:30",
logfile = ""),
"are after the stated maximum time"
)
}
)
# validate_import_time_mm_ss ----------------------------------------
test_that(
"Character forms of HH:MM and HH:MM:SS pass",
{
time_test <- c("06:15", "00:06:15")
expect_equal(
validate_import_time_mm_ss(time_test,
field_name = "time",
field_min = NA,
field_max = NA,
logfile = ""),
rep("06:15", 2)
)
}
)
test_that(
"objects of class time pass. Also, NA",
{
time_test <- chron::as.times(c("00:06:15", NA))
expect_equal(
validate_import_time_mm_ss(time_test,
field_name = "time",
field_min = NA,
field_max = NA,
logfile = ""),
c("06:15", NA)
)
}
)
test_that(
"Times before field_min produce a message",
{
local_reproducible_output(width = 200)
time_test <- c("06:00", "07:00", "08:00", "09:00")
expect_message(
validate_import_time_mm_ss(time_test,
field_name = "time",
field_min = "07:30",
field_max = NA,
logfile = ""),
"are before the stated minimum time"
)
}
)
test_that(
"Times after field_max produce a message",
{
local_reproducible_output(width = 200)
time_test <- c("06:00", "07:00", "08:00", "09:00")
expect_message(
validate_import_time_mm_ss(time_test,
field_name = "time",
field_min = NA,
field_max = "07:30",
logfile = ""),
"are after the stated maximum time"
)
}
)
# validate_import_numeric -------------------------------------------
test_that(
"Values that can be coerced to numeric pass (including NA)",
{
test_numeric <- c("1.2", pi, NA_character_)
expect_equal(
validate_import_numeric(test_numeric,
field_name = "numeric",
field_min = NA,
field_max = NA,
logfile = ""),
c(1.2, pi, NA_real_)
)
}
)
test_that(
"Values that cannot be coerced to numeric produce a message",
{
local_reproducible_output(width = 200)
test_numeric <- c("a", "b", pi)
expect_message(
validate_import_numeric(test_numeric,
field_name = "numeric",
field_min = NA,
field_max = NA,
logfile = ""),
"must be numeric or coercible to numeric"
)
}
)
test_that(
"Values less than field_min produce a message",
{
local_reproducible_output(width = 200)
test_numeric <- 1:5
expect_message(
validate_import_numeric(test_numeric,
field_name = "numeric",
field_min = 3,
field_max = NA,
logfile = ""),
"are less than the stated minimum"
)
}
)
test_that(
"Values less than field_min produce a message",
{
local_reproducible_output(width = 200)
test_numeric <- 1:5
expect_message(
validate_import_numeric(test_numeric,
field_name = "numeric",
field_min = NA,
field_max = 3,
logfile = ""),
"are greater than the stated maximum"
)
}
)
# validate_import_zipcode -------------------------------------------
test_that(
"values in 12345, format or NA pass (from numeric)",
{
test_zip <- c(48169, NA_real_)
expect_equal(
validate_import_zipcode(test_zip,
field_name = "zip",
logfile = ""),
c("48169", NA_character_)
)
}
)
test_that(
"values in 12345, 12345-1234 format or NA pass (from character)",
{
test_zip <- c("48169", "48169-0133", NA_real_)
expect_equal(
validate_import_zipcode(test_zip,
field_name = "zip",
logfile = ""),
c("48169", "48169-0133", NA_real_)
)
}
)
test_that(
"values not in 12345 or 12345-1234 format are converted to NA (so they won't write)",
{
test_zip <- c("8169", "48169-01", "48169-abc", "zipcode")
expect_equal(
validate_import_zipcode(test_zip,
field_name = "zip",
logfile = ""),
rep(NA_character_, length(test_zip))
)
}
)
test_that(
"values not in 12345 or 12345-1234 format produce a message",
{
test_zip <- c("8169", "48169-01", "48169-abc", "zipcode")
expect_message(
validate_import_zipcode(test_zip,
field_name = "zip",
logfile = ""),
"must be in the format `12345` or `12345-1234`"
)
}
)
# validate_import_yesno ---------------------------------------------
test_that(
"yes, no, 0, 1, and NA are accepted (character)",
{
test_yes_no <- c("no", "yes", "0", "1", "No", "Yes", "NO", "YEs", "YES", NA_character_)
expect_equal(
validate_import_yesno(test_yes_no,
field_name = "yesno",
logfile = ""),
as.character(c(0, 1, 0, 1, 0, 1, 0, 1, 1, NA_real_))
)
}
)
test_that(
"0, 1, and NA are accepted (numeric)",
{
test_yes_no <- c(0, 1, NA_real_)
expect_equal(
validate_import_yesno(test_yes_no,
field_name = "yesno",
logfile = ""),
as.character(c(0, 1, NA_real_))
)
}
)
test_that(
"Unacceptable values are converted to NA to prevent writing (character)",
{
expect_equal(
validate_import_yesno(c("negative", "affirmative"),
field_name = "yesno",
logfile = ""),
rep(NA_character_, 2)
)
}
)
test_that(
"unacceptable values produce a message (character)",
{
expect_message(
validate_import_yesno(c("negative", "affirmative"),
field_name = "yesno",
logfile = ""),
"must be one of `0`, `1`, `No`, or `Yes`"
)
}
)
test_that(
"Unacceptable values are converted to NA to prevent writing (numeric)",
{
expect_equal(
validate_import_yesno(c(-1, pi, 12),
field_name = "yesno",
logfile = ""),
rep(NA_character_, 3)
)
}
)
test_that(
"unacceptable values produce a message (numeric)",
{
expect_message(
validate_import_yesno(c(-1, pi, 12),
field_name = "yesno",
logfile = ""),
"must be one of `0`, `1`, `No`, or `Yes`"
)
}
)
# validate_import_truefalse -----------------------------------------
test_that(
"true, false, yes, no, 0, 1, and NA are accepted (character)",
{
test_true_false <- c("true", "True", "TRUE", "truE",
"false", "False", "FALSE", "falsE",
"yes", "Yes", "YES", "yeS",
"no", "No", "NO", "nO",
"0", "1", NA_character_)
expect_equal(
validate_import_truefalse(test_true_false,
field_name = "truefalse",
logfile = ""),
as.character(c(1, 1, 1, 1,
0, 0, 0, 0,
1, 1, 1, 1,
0, 0, 0, 0,
0, 1, NA_real_))
)
}
)
test_that(
"0, 1, and NA are accepted (numeric)",
{
test_true_false <- c(0, 1, NA_real_)
expect_equal(
validate_import_truefalse(test_true_false,
field_name = "truefalse",
logfile = ""),
as.character(c(0, 1, NA_real_))
)
}
)
test_that(
"TRUE, FALSE, and NA are accepted (logical)",
{
test_true_false <- c(TRUE, FALSE, NA)
expect_equal(
validate_import_truefalse(test_true_false,
field_name = "truefalse",
logfile = ""),
as.character(c(1, 0, NA_real_))
)
}
)
test_that(
"Unacceptable values are converted to NA to prevent writing (character)",
{
expect_equal(
validate_import_truefalse(c("negative", "affirmative"),
field_name = "truefalse",
logfile = ""),
rep(NA_character_, 2)
)
}
)
test_that(
"unacceptable values produce a message (character)",
{
expect_message(
validate_import_truefalse(c("negative", "affirmative"),
field_name = "truefalse",
logfile = ""),
"must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`"
)
}
)
test_that(
"Unacceptable values are converted to NA to prevent writing (numeric)",
{
expect_equal(
validate_import_truefalse(c(-1, pi, 12),
field_name = "truefalse",
logfile = ""),
rep(NA_character_, 3)
)
}
)
test_that(
"unacceptable values produce a message (numeric)",
{
expect_message(
validate_import_truefalse(c(-1, pi, 12),
field_name = "truefalse",
logfile = ""),
"must be one of logical or one of `0`, `1`, `No`, `Yes`, `False`, or `True`"
)
}
)
# validate_import_select_dropdown_radio -----------------------------
test_that(
"mapped pairings with numeric and character codes pass (also NA)",
{
test_select <- c("-1", "0", "1", "a", "abc",
"negative one", "zero", "one", "A", "ABC",
NA_character_)
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_equal(
validate_import_select_dropdown_radio(test_select,
field_name = "select",
field_choice = mapping,
logfile = ""),
c("-1", "0", "1", "a", "abc",
"-1", "0", "1", "a", "abc",
NA_character_)
)
}
)
test_that(
"mapped pairings with numeric and character codes pass (also NA)",
{
test_select <- c(-1, 0, 1, NA_real_)
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_equal(
validate_import_select_dropdown_radio(test_select,
field_name = "select",
field_choice = mapping,
logfile = ""),
c("-1", "0", "1",NA_character_)
)
}
)
test_that(
"unmapped values are converted to NA (character)",
{
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_equal(
validate_import_select_dropdown_radio(c("XYZ", "15"),
field_name = "select",
field_choice = mapping,
logfile = ""),
c(NA_character_, NA_character_)
)
}
)
test_that(
"unmapped values are converted to NA (numeric)",
{
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_equal(
validate_import_select_dropdown_radio(c(pi, 10),
field_name = "select",
field_choice = mapping,
logfile = ""),
c(NA_character_, NA_character_)
)
}
)
test_that(
"unmapped values produce a message (character)",
{
local_reproducible_output(width = 200)
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_message(
validate_import_select_dropdown_radio(c("XYZ", "15"),
field_name = "select",
field_choice = mapping,
logfile = ""),
"must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'"
)
}
)
test_that(
"unmapped values produce a message (numeric)",
{
local_reproducible_output(width = 200)
mapping <- "-1, negative one | 0, zero | 1, one | a, A | abc, ABC"
expect_message(
validate_import_select_dropdown_radio(c(pi, 10),
field_name = "select",
field_choice = mapping,
logfile = ""),
"must be one of '-1', '0', '1', 'a', 'abc', 'negative one', 'zero', 'one', 'A', 'ABC'"
)
}
)
# validate_import_email ---------------------------------------------
test_that(
"common email addresses pass",
{
email <- c("somebody@domain.net",
"some.body1@domain.org",
"345somebody789@domain.net",
"somebody-else@domain.com",
"salesperson@dash-company.biz",
"percy_jackson@camp-half-blood.edu",
"someone+spam@domain.widget",
"high%shooting@sports.ball",
NA_character_)
expect_equal(
validate_import_email(email,
field_name = "email",
logfile = ""),
email
)
}
)
test_that(
"Invalid e-mails are changed to NA",
{
email <- c("Im@work@nowhere.net",
"no-suffix@junkmail",
"one-length-suffix@email.g",
"long-suffix@email.sunburst")
expect_equal(
validate_import_email(email,
field_name = "email",
logfile = ""),
rep(NA_character_, length(email))
)
}
)
test_that(
"Invalid e-mails are changed to NA",
{
email <- c("Im@work@nowhere.net",
"no-suffix@junkmail",
"one-length-suffix@email.g",
"long-suffix@email.sunburst")
expect_message(
validate_import_email(email,
field_name = "email",
logfile = ""),
"are not valid e-mail addresses"
)
}
)
# validate_import_phone ---------------------------------------------
test_that(
"valid phone numbers pass (including NA)",
{
phone_punct <- c("(207) 555-1234",
"207.555.1234",
"207-555-1234",
"207 555 1234")
# to test all valid phone numbers would be overly tedious.
# we'll just a sample. Change n_size to match your desired rigor
n_size <- 10
phone_random <- sprintf("%s%s%s %s%s%s %s%s%s%s",
sample(2:9, n_size, replace = TRUE),
sample(0:8, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(2:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE),
sample(0:9, n_size, replace = TRUE))
test_phone <- c(phone_punct, phone_random, NA_character_)
expect_equal(
validate_import_phone(test_phone,
field_name = "phone",
logfile = ""),
gsub("[[:punct:][:space:]]", "", test_phone)
)
}
)
test_that(
"phone numbers of more than 10 digits become NA",
{
expect_equal(
validate_import_phone(c("555-555-5555-5",
"555-555-5555-5555"),
field_name = "phone",
logfile = ""),
c(NA_character_, NA_character_)
)
}
)
test_that(
"phone numbers of more than ten digits produce a message",
{
expect_message(
validate_import_phone(c("555-555-5555-5",
"555-555-5555-5555"),
field_name = "phone",
logfile = ""),
"are not ten digit phone numbers"
)
}
)
test_that(
"phone numbers with invalid format become NA",
{
# The fives are valid digits. The non-five digits
# are placed where those values are not allowed
expect_equal(
validate_import_phone(c("055-555-5555",
"155-555-5555",
"595-555-5555",
"555-155-5555"),
field_name = "phone",
logfile = ""),
c(NA_character_, NA_character_, NA_character_, NA_character_)
)
}
)
test_that(
"phone numbers with invalid format produce a message",
{
expect_message(
validate_import_phone(c("055-555-5555",
"155-555-5555",
"595-555-5555",
"555-155-5555"),
field_name = "phone",
logfile = ""),
"are not valid North American phone numbers"
)
}
)
test_that(
"Validate number with fixed decimal places (number_1dp, etc)",
{
# number_1dp
expect_equal(validate_import_ndp(c(23, pi),
field_name = "number_1dp",
field_min = 0,
field_max = 100,
logfile = "",
ndp = 1,
comma = FALSE),
c("23.0", "3.1"))
# number_2dp
expect_equal(validate_import_ndp(c(23, pi),
field_name = "number_1dp",
field_min = 0,
field_max = 100,
logfile = "",
ndp = 2,
comma = FALSE),
c("23.00", "3.14"))
# number_1dp_comma
expect_equal(validate_import_ndp(c(23, pi),
field_name = "number_1dp",
field_min = 0,
field_max = 100,
logfile = "",
ndp = 1,
comma = TRUE),
c("23,0", "3,1"))
# number_2dp_comma
expect_equal(validate_import_ndp(c(23, pi),
field_name = "number_1dp",
field_min = 0,
field_max = 100,
logfile = "",
ndp = 2,
comma = TRUE),
c("23,00", "3,14"))
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.