Skip to content

Commit

Permalink
Do not use SET_TYPEOF() to create function calls
Browse files Browse the repository at this point in the history
SET_TYPEOF() is not part of the public API and may be changed or
removed.

See #419.
  • Loading branch information
joshuaulrich committed Jun 25, 2024
1 parent 6003aa5 commit e68dace
Show file tree
Hide file tree
Showing 3 changed files with 36 additions and 39 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: xts
Type: Package
Title: eXtensible Time Series
Version: 0.14.0
Version: 0.14.1
Authors@R: c(
person(given=c("Jeffrey","A."), family="Ryan", role=c("aut","cph")),
person(given=c("Joshua","M."), family="Ulrich", role=c("cre","aut"), email="josh.m.ulrich@gmail.com"),
Expand Down
61 changes: 29 additions & 32 deletions src/merge.c
Original file line number Diff line number Diff line change
Expand Up @@ -32,33 +32,29 @@ SEXP xts_merge_make_colnames (SEXP colnames, SEXP suffixes, SEXP check_names, SE

// add suffixes
if (R_NilValue != suffixes) {
SEXP s, t;
PROTECT(s = t = allocList(4)); p++;
SET_TYPEOF(s, LANGSXP);

SETCAR(t, install("paste")); t = CDR(t);
SETCAR(t, newcolnames); t = CDR(t);
SETCAR(t, suffixes); t = CDR(t);
SETCAR(t, mkString(""));
SET_TAG(t, install("sep"));
SEXP args = PROTECT(allocList(3)); p++;
SEXP vals = args;
SETCAR(vals, newcolnames); vals = CDR(vals);
SETCAR(vals, suffixes); vals = CDR(vals);
SETCAR(vals, mkString(""));
SET_TAG(vals, install("sep"));

PROTECT(newcolnames = eval(s, env)); p++;
SEXP expr = PROTECT(LCONS(install("paste"), args)); p++;
PROTECT(newcolnames = eval(expr, env)); p++;
}

// check that names are 'valid R names'
if (LOGICAL(check_names)[0]) {
SEXP s, t, unique;
PROTECT(s = t = allocList(3)); p++;
SET_TYPEOF(s, LANGSXP);

PROTECT(unique = ScalarLogical(1)); p++;
SEXP args = PROTECT(allocList(2)); p++;
SEXP vals = args;
SETCAR(vals, newcolnames); vals = CDR(vals);
SETCAR(vals, ScalarLogical(1));
SET_TAG(vals, install("unique"));

SETCAR(t, install("make.names")); t = CDR(t);
SETCAR(t, newcolnames); t = CDR(t);
SETCAR(t, unique);
SET_TAG(t, install("unique"));

PROTECT(newcolnames = eval(s, env)); p++;
SEXP expr = PROTECT(LCONS(install("make.names"), args)); p++;
PROTECT(newcolnames = eval(expr, env)); p++;
}

UNPROTECT(p);
Expand Down Expand Up @@ -264,8 +260,7 @@ SEXP do_merge_xts (SEXP x, SEXP y,
int nrx, ncx, nry, ncy, len;
int left_join, right_join;
int p = 0;
SEXP xindex, yindex, index, result, attr, len_xindex;
SEXP s, t;
SEXP xindex, yindex, index, result, attr;

int *int_index=NULL, *int_xindex=NULL, *int_yindex=NULL;
double *real_index=NULL, *real_xindex=NULL, *real_yindex=NULL;
Expand All @@ -285,17 +280,19 @@ SEXP do_merge_xts (SEXP x, SEXP y,

/* convert to xts object if needed */
if (!asInteger(isXts(y))) {
PROTECT(s = t = allocList(4)); p++;
SET_TYPEOF(s, LANGSXP);
SETCAR(t, install("try.xts")); t = CDR(t);
SETCAR(t, y); t = CDR(t);
PROTECT(len_xindex = allocVector(INTSXP, 1)); p++;
INTEGER(len_xindex)[0] = length(xindex);
SETCAR(t, len_xindex);
SET_TAG(t, install("length.out")); t = CDR(t);
SETCAR(t, install(".merge.xts.scalar"));
SET_TAG(t, install("error"));
PROTECT(y = eval(s, env)); p++;

SEXP args = PROTECT(allocList(3)); p++;
SEXP vals = args;
SETCAR(vals, y); vals = CDR(vals);

SET_TAG(vals, install("length.out"));
SETCAR(vals, ScalarInteger(length(xindex))); vals = CDR(vals);

SET_TAG(vals, install("error"));
SETCAR(vals, install(".merge.xts.scalar"));

SEXP expr = PROTECT(LCONS(install("try.xts"), args)); p++;
PROTECT(y = eval(expr, env)); p++;
}

if (asInteger(isXts(y))) {
Expand Down
12 changes: 6 additions & 6 deletions src/tryXts.c
Original file line number Diff line number Diff line change
Expand Up @@ -28,14 +28,14 @@ SEXP tryXts (SEXP x)
{
if( !Rf_asInteger(isXts(x)) ) {
int P = 0;
SEXP s, t, result, env, str_xts;
PROTECT(s = t = allocList(2)); P++;
SET_TYPEOF(s, LANGSXP);
SETCAR(t, install("try.xts")); t = CDR(t);
SETCAR(t, x); t=CDR(t);
SEXP expr, result, env, str_xts;

PROTECT(str_xts = mkString("xts")); P++;
PROTECT(env = R_FindNamespace(str_xts)); P++;
PROTECT(result = eval(s, env)); P++;

PROTECT(expr = LCONS(install("try.xts"), x)); P++;
PROTECT(result = eval(expr, env)); P++;

if( !Rf_asInteger(isXts(result)) ) {
UNPROTECT(P);
error("rbind.xts requires xtsible data");
Expand Down

0 comments on commit e68dace

Please sign in to comment.