static msg_t check_names(SEXP nn, SEXP type, const char * what) {
typedef enum { T_NAMED, T_UNIQUE, T_STRICT } name_t;
const char * expected = asString(type, "names");
if (strcmp(expected, "unnamed") == 0) {
if (isNull(nn))
return MSGT;
return make_msg("%s must be unnamed, but has names", what);
}
name_t checks;
if (strcmp(expected, "named") == 0) {
checks = T_NAMED;
} else if (strcmp(expected, "unique") == 0) {
checks = T_UNIQUE;
} else if (strcmp(expected, "strict") == 0) {
checks = T_STRICT;
} else {
error("Unknown type '%s' to specify check for names. Supported are 'unnamed', 'named', 'unique' and 'strict'.", expected);
}
if (isNull(nn) || any_missing_string(nn) || !all_nchar(nn, 1))
return make_msg("%s must be named", what);
if (checks >= T_UNIQUE) {
if (any_duplicated(nn, FALSE) != 0)
return make_msg("%s must be uniquely named", what);
if (checks >= T_STRICT && !check_strict_names(nn))
return make_msg("%s must be named according to R's variable naming rules", what);
}
return MSGT;
}
static msg_t check_min_chars(SEXP x, SEXP min_chars) {
if (!isNull(min_chars)) {
R_xlen_t n = asCount(min_chars, "min.chars");
if (n > 0 && !all_nchar(x, n))
return make_msg("All elements must have at least %g characters", (double)n);
}
return MSGT;
}
Rboolean all_nchar(SEXP x, const R_xlen_t n) {
if (!isString(x)) {
SEXP xs = PROTECT(coerceVector(x, STRSXP));
Rboolean res = all_nchar(xs, n);
UNPROTECT(1);
return res;
}
const R_xlen_t nx = xlength(x);
for (R_xlen_t i = 0; i < nx; i++) {
if (STRING_ELT(x, i) == NA_STRING || xlength(STRING_ELT(x, i)) < n)
return FALSE;
}
return TRUE;
}
Rboolean all_nchar(SEXP x, R_xlen_t n, Rboolean skip_na) {
if (!isString(x)) {
SEXP xs = PROTECT(coerceVector(x, STRSXP));
Rboolean res = all_nchar(xs, n, skip_na);
UNPROTECT(1);
return res;
}
const R_xlen_t nx = xlength(x);
for (R_xlen_t i = 0; i < nx; i++) {
if (STRING_ELT(x, i) == NA_STRING) {
if (skip_na) continue;
return FALSE;
}
if (xlength(STRING_ELT(x, i)) < n) {
return FALSE;
}
}
return TRUE;
}
