[Dplr-commits] r726 - in pkg/dplR: . src

[noreply at r-forge.r-project.org]

Author: mvkorpel
Date: 2014-01-15 12:15:43 +0100 (Wed, 15 Jan 2014)
New Revision: 726

Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/src/redfit.c
Log:
In redfit.c: Avoid errors in case of redefined cbind() or length()


Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2014-01-14 18:05:30 UTC (rev 725)
+++ pkg/dplR/ChangeLog	2014-01-15 11:15:43 UTC (rev 726)
@@ -37,6 +37,12 @@
 - Use simpler but equivalent rules for checking validity of ModNegExp fit
 - Small optimizations (rep.int; save and reuse length of input)
 
+File: redfit.c
+--------------
+
+- Avoid possibly buggy behavior in the unlikely case that cbind()
+  or length() have been redefined by the user
+
 File: redfit.R
 --------------
 

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2014-01-14 18:05:30 UTC (rev 725)
+++ pkg/dplR/DESCRIPTION	2014-01-15 11:15:43 UTC (rev 726)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.5.8
-Date: 2014-01-14
+Date: 2014-01-15
 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph",
         "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko",
         "Korpela", role = c("aut", "trl")), person("Franco", "Biondi",

Modified: pkg/dplR/src/redfit.c
===================================================================
--- pkg/dplR/src/redfit.c	2014-01-14 18:05:30 UTC (rev 725)
+++ pkg/dplR/src/redfit.c	2014-01-15 11:15:43 UTC (rev 726)
@@ -104,7 +104,7 @@
     SETCAR(tmp, lmfit); tmp = CDR(tmp);
     SETCAR(tmp, x); tmp = CDR(tmp);
     SETCAR(tmp, y);
-    PROTECT(lmres = eval(lmcall, R_GlobalEnv));
+    PROTECT(lmres = eval(lmcall, R_EmptyEnv));
 
     /* dplR: get residuals from the list given by lm.fit(x, y) */
     lmnames = getAttrib(lmres, R_NamesSymbol);
@@ -112,7 +112,7 @@
     SET_TYPEOF(ncall, LANGSXP);
     SETCAR(tmp, lengthfun); tmp = CDR(tmp);
     SETCAR(tmp, lmnames);
-    PROTECT_WITH_INDEX(sn = eval(ncall, R_GlobalEnv), &ipx);
+    PROTECT_WITH_INDEX(sn = eval(ncall, R_BaseEnv), &ipx);
     REPROTECT(sn = coerceVector(sn, REALSXP), ipx);
     nameslength = (size_t) *REAL(sn);
     UNPROTECT(2);
@@ -130,13 +130,13 @@
     SET_TYPEOF(ncall, LANGSXP);
     SETCAR(tmp, lengthfun); tmp = CDR(tmp);
     SETCAR(tmp, y);
-    PROTECT_WITH_INDEX(sn = eval(ncall, R_GlobalEnv), &ipx);
+    PROTECT_WITH_INDEX(sn = eval(ncall, R_BaseEnv), &ipx);
     REPROTECT(sn = coerceVector(sn, REALSXP), ipx);
     n = (size_t) *REAL(sn);
     UNPROTECT(1);
     if (found) {
 	SETCAR(tmp, rduals);
-	PROTECT_WITH_INDEX(sn = eval(ncall, R_GlobalEnv), &ipx);
+	PROTECT_WITH_INDEX(sn = eval(ncall, R_BaseEnv), &ipx);
 	REPROTECT(sn = coerceVector(sn, REALSXP), ipx);
 	mismatch = n != (size_t) *REAL(sn);
 	UNPROTECT(1);
@@ -205,7 +205,7 @@
     SETCAR(tmp, install("cbind")); tmp = CDR(tmp);
     SETCAR(tmp, ScalarReal(1.0)); tmp = CDR(tmp);
     SETCAR(tmp, twk);
-    REPROTECT(twk = eval(cbindcall, R_GlobalEnv), pidx);
+    REPROTECT(twk = eval(cbindcall, R_BaseEnv), pidx);
     /* dplR: twk_data points to the non-constant column; the constant
      * column will not be altered */
     twk_data = REAL(twk) + nseg_val;