prepare for resubmission

Author: boennecd

cran-comments.md

@@ -2,7 +2,7 @@
 * Ubuntu 18.04 LTS
   R version 3.6.1
 * Ubuntu 16.04 LTS (on travis-ci with codename: xenial)
-  R version 3.6.0
+  R version 3.6.1
 * win-builder (devel and release)
 * Local Ubuntu 18.04 with R 3.5.2 and with clang 6.0.0 with ASAN and 
   UBSAN checks
@@ -11,7 +11,11 @@
 ## Resubmission
 This is a resubmission. In this version I have:
 
-* Used the `FCLEN` macro in the extern declaration of `dsyr` and `FCONE` 
-  when calling `dsyr`.
-
+* Used the `FCLEN` macro in the extern declaration of `dsyr` and `dchur` 
+  and `FCONE` in calls afterwards. I have fixed the error I made in the last 
+  submission by doing exactly as stated in WRE as emphasized by Tomas 
+  Kalibera on r-package-devel mailing list at the 3/9.
+* I cannot reproduce an error with gcc 10 which I got mail from Brian Ripley 
+  about with gcc 10.0.0 20191008, Ubuntu 16.04.6, R 3.6.1.
+  
 There is a note about the size on most platforms.

src/BLAS_LAPACK/R_BLAS_LAPACK.cpp

@@ -1,6 +1,5 @@
 #include <Rcpp.h>
 #include "../Rconfig-wrap.h"
-#include <R_ext/BLAS.h>
 #include <R_ext/Lapack.h>
 #include "../R_BLAS_LAPACK.h"
 
@@ -26,6 +25,11 @@ namespace R_BLAS_LAPACK {
         int*     // INFO,
         FCLEN FCLEN
     );
+
+    void F77_NAME(dsyr)(
+      const char *uplo, const int *n, const double *alpha,
+      const double *x, const int *incx,
+      double *a, const int *lda FCLEN);
   }
 
   void ddhazard_dchur(double *R, double *x, int n, int ldr){
@@ -207,7 +211,7 @@ namespace R_BLAS_LAPACK {
       double *b, const int *ldb){
     F77_CALL(dtrmm)(
         side, uplo, transa, diag, m, n, alpha, a, lda,
-        b, ldb FCONE FCONE FCONE);
+        b, ldb FCONE FCONE FCONE FCONE);
   }
 
   void dtrmv(
@@ -268,4 +272,10 @@ namespace R_BLAS_LAPACK {
               int* ipiv, double* work, const int* lwork, int* info){
     F77_CALL(dgetri)(n, a, lda, ipiv, work, lwork, info);
   }
+
+  void dsyr(const char *uplo, const int *n, const double *alpha,
+            const double *x, const int *incx,
+            double *a, const int *lda){
+    F77_CALL(dsyr)(uplo, n, alpha, x, incx, a, lda FCONE);
+  }
 }

src/Makevars

@@ -7,6 +7,7 @@ SOURCES_F = biglm/boundedQRf.f BLAS_LAPACK/dchur.f
 CXX_STD = CXX11
 OBJECTS = $(SOURCES_CPP:.cpp=.o) $(SOURCES_F:.f=.o)
 
+PKG_CPPFLAGS = -DUSE_FC_LEN_T
 # PKG_CPPFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -DDDHAZ_DEBUG
 PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS)
 

src/Makevars.win

@@ -7,6 +7,7 @@ SOURCES_F = biglm/boundedQRf.f BLAS_LAPACK/dchur.f
 CXX_STD = CXX11
 OBJECTS =$(SOURCES_CPP:.cpp=.o) $(SOURCES_F:.f=.o)
 
+PKG_CPPFLAGS = -DUSE_FC_LEN_T
 PKG_CXXFLAGS = $(BLAS_LIBS) $(USE_OPEN_BLAS) $(SHLIB_OPENMP_CXXFLAGS)
 
 ifeq "$(WIN)" "64"

src/PF/PF_score_n_Hess.cpp

@@ -2,14 +2,6 @@
 #include "../thread_pool.h"
 #include "importance_samplers.h"
 #include "resamplers.h"
-#include "../Rconfig-wrap.h"
-
-extern "C" {
-  void F77_NAME(dsyr)(
-      const char *uplo, const int *n, const double *alpha,
-      const double *x, const int *incx,
-      double *a, const int *lda FCLEN);
-}
 
 constexpr static char C_U = 'U';
 constexpr static int I_ONE = 1L;
@@ -220,9 +212,9 @@ derivs_output get_derivs_output
       if(!only_score){
         const double dd =
           dat.family->dd_log_like(dat.y[i], trunc_eta, dat.dts[i]);
-        F77_CALL(dsyr)(
+        R_BLAS_LAPACK::dsyr(
             &C_U, &dfixd, &dd, dat.X.colptr(i), &I_ONE, hess_terms.memptr(),
-            &score_dim FCONE);
+            &score_dim);
       }
     }
   }
@@ -467,9 +459,9 @@ score_n_hess_O_N_sq::score_n_hess_O_N_sq(
       if(!only_score){
         const double dd =
           dat.family->dd_log_like(dat.y[i], trunc_eta, dat.dts[i]);
-        F77_CALL(dsyr)(
+        R_BLAS_LAPACK::dsyr(
             &C_U, &dfixd, &dd, dat.X.colptr(i), &I_ONE, hess_terms.memptr(),
-            &score_dim FCONE);
+            &score_dim);
       }
     }
   }
@@ -531,9 +523,9 @@ score_n_hess_O_N_sq::score_n_hess_O_N_sq(
 
         /* add outer product of score terms from this pair */
         score_terms(obs_span) += obs_score_term;
-        F77_CALL(dsyr)(
+        R_BLAS_LAPACK::dsyr(
             &C_U, &score_dim, &w_i, score_terms.memptr(), &I_ONE,
-            hess_terms.memptr(), &score_dim FCONE);
+            hess_terms.memptr(), &score_dim);
 
         if(!is_first_it)
           hess_terms += w_i * old_res->get_hess_terms();
@@ -543,9 +535,9 @@ score_n_hess_O_N_sq::score_n_hess_O_N_sq(
 
   if(!only_score){
    /* subtract outer product of score */
-   F77_CALL(dsyr)(
+   R_BLAS_LAPACK::dsyr(
      &C_U, &score_dim, &D_NEG_ONE, score.memptr(), &I_ONE, hess_terms.memptr(),
-     &score_dim FCONE);
+     &score_dim);
 
    /* not needed as we later copy the upper part to the lower part */
    // hess_terms = arma::symmatu(hess_terms);

src/R_BLAS_LAPACK.h

@@ -65,4 +65,7 @@ namespace R_BLAS_LAPACK {
 
   void dgetri(const int*, double*, const int*,
               int*, double*, const int*, int*);
+
+  void dsyr(const char*, const int*, const double*, const double*,
+            const int*,double*, const int*);
 }

src/Rconfig-wrap.h

@@ -1,8 +1,7 @@
 #ifndef RCONFIG_WRAP_H
 #define RCONFIG_WRAP_H
-#define USE_FC_LEN_T
 #include <Rconfig.h>
-
+#include <R_ext/BLAS.h>
 #ifndef FCLEN
 #define FCLEN
 #endif