Merge branch 'development' into rc

Author: brodieG

DESCRIPTION

@@ -3,7 +3,7 @@ Title: Trust, but Verify
 Description: Declarative template-based framework for verifying that objects
   meet structural requirements, and auto-composing error messages when they do
   not.
-Version: 0.2.16
+Version: 0.2.16.9000
 Authors@R: c(
     person("Brodie", "Gaslam", email="brodie.gaslam@yahoo.com",
     role=c("aut", "cre")),

NEWS.md

@@ -1,3 +1,11 @@
+## 0.2.17
+
+* Fix bad C API accesses uncovered by new R-devel checks.
+
+## 0.2.16
+
+* Fix -Wformat warnings.
+
 ## 0.2.15
 
 * [#109](https://github.com/brodieG/vetr/issues/109) allow for substituted

src/alike.h

@@ -263,6 +263,7 @@ Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license.
   extern SEXP ALIKEC_SYM_tilde;
   extern SEXP ALIKEC_SYM_paren_open;
   extern SEXP ALIKEC_SYM_args;
+  extern SEXP ALIKEC_SYM_function;
   extern SEXP ALIKEC_SYM_deparse;
   extern SEXP ALIKEC_SYM_nlines;
   extern SEXP ALIKEC_SYM_getOption;

src/fun.c

@@ -46,19 +46,17 @@ struct ALIKEC_res ALIKEC_fun_alike_internal(
   if(!isFunction(target) || !isFunction(current))
     error("Arguments must be functions.");
 
-  SEXP tar_form, cur_form, args;
+  SEXP tar_form, cur_form, args, func;
   SEXPTYPE tar_type = TYPEOF(target), cur_type = TYPEOF(current);
   struct ALIKEC_res res = ALIKEC_res_init();
 
   // Translate specials and builtins to formals, if possible
 
   args = PROTECT(list2(ALIKEC_SYM_args, R_NilValue));
-  if(
-    tar_type == SPECIALSXP || tar_type == BUILTINSXP ||
-    cur_type == SPECIALSXP || cur_type == BUILTINSXP
-  ) {
-    SET_TYPEOF(args, LANGSXP);
-  }
+  SET_TYPEOF(args, LANGSXP);
+  func = PROTECT(list3(ALIKEC_SYM_function, R_NilValue, R_NilValue));
+  SET_TYPEOF(func, LANGSXP);
+
   if(tar_type == SPECIALSXP || tar_type == BUILTINSXP) {
     SETCADR(args, target);
     target = PROTECT(eval(args, R_BaseEnv));
@@ -69,6 +67,16 @@ struct ALIKEC_res ALIKEC_fun_alike_internal(
     current = PROTECT(eval(args, R_BaseEnv));
   } else PROTECT(R_NilValue);
 
+  // As of ~r86700 R became stricter about what we could call FORMALS on, so we
+  // need to make sure that we do get actual formals and not NULL.
+
+  if(TYPEOF(target) != CLOSXP) {
+    target = PROTECT(eval(func, R_BaseEnv));
+  } else PROTECT(R_NilValue);
+  if(TYPEOF(current) != CLOSXP) {
+    current = PROTECT(eval(func, R_BaseEnv));
+  } else PROTECT(R_NilValue);
+
   // Cycle through all formals
 
   int dots = 0, dots_last = 0, dots_reset = 0, tag_match = 1, dots_cur = 0;
@@ -156,7 +164,7 @@ struct ALIKEC_res ALIKEC_fun_alike_internal(
       res.dat.strings.target[2] = arg_type;
     }
   }
-  UNPROTECT(3);
+  UNPROTECT(6);
   if(!res.success) res.wrap = allocVector(VECSXP, 2);
   return res;
 }

src/init.c

@@ -107,6 +107,7 @@ SEXP ALIKEC_SYM_inherits;
 SEXP ALIKEC_SYM_paren_open;
 SEXP ALIKEC_SYM_tilde;
 SEXP ALIKEC_SYM_args;
+SEXP ALIKEC_SYM_function;
 SEXP ALIKEC_SYM_deparse;
 SEXP ALIKEC_SYM_nlines;
 SEXP ALIKEC_SYM_widthcutoff;
@@ -143,6 +144,7 @@ void R_init_vetr(DllInfo *info)
   ALIKEC_SYM_paren_open = install("(");
   ALIKEC_SYM_tilde = install("~");
   ALIKEC_SYM_args = install("args");
+  ALIKEC_SYM_function = install("function");
   ALIKEC_SYM_deparse = install("deparse");
   ALIKEC_SYM_nlines = install("nlines");
   ALIKEC_SYM_widthcutoff = install("width.cutoff");

src/merge.c

@@ -117,18 +117,17 @@ static SEXP ALIKEC_unique_msg(SEXP msgs) {
   R_xlen_t len = xlength(msgs);
   if(len < 2) return(msgs);
 
-  // Loop once to check for dupes
+  // Loop once to count how many distinct values
 
-  int some_dup = 0;
+  int distinct_vals = 1;
   for(R_xlen_t i = 1; i < len; ++i) {
-    if(R_compute_identical(VECTOR_ELT(msgs, i - 1), VECTOR_ELT(msgs, i), 16)) {
-      some_dup = 1;
-      break;
+    if(!R_compute_identical(VECTOR_ELT(msgs, i - 1), VECTOR_ELT(msgs, i), 16)) {
+      ++distinct_vals;
     }
   }
   SEXP res;
-  if(some_dup) {
-    res = PROTECT(allocVector(VECSXP, len));
+  if(distinct_vals != len) {
+    res = PROTECT(allocVector(VECSXP, distinct_vals));
     SET_VECTOR_ELT(res, 0, VECTOR_ELT(msgs, 0));
     R_xlen_t j = 1;
     for(R_xlen_t i = 1; i < len; ++i) {
@@ -138,7 +137,6 @@ static SEXP ALIKEC_unique_msg(SEXP msgs) {
         SET_VECTOR_ELT(res, j++, VECTOR_ELT(msgs, i));
       }
     }
-    SETLENGTH(res, j);
     UNPROTECT(1);
   } else res = msgs;
   return res;