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; }