Merge pull request #1146 from RcppCore/feature/message

Add Rcpp::message

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,10 @@
+2021-03-21  Dirk Eddelbuettel  <edd@debian.org>
+
+	* inst/include/Rcpp/api/meat/message.h: Add wrapper for base::message
+	* inst/include/Rcpp/api/meat/meat.h: Include new file
+	* inst/tinytest/test_misc.R: Simple test
+	* inst/tinytest/cpp/misc.cpp (messageWrapper): Test support
+
 2021-02-23  Dirk Eddelbuettel  <edd@debian.org>
 
 	* Contributing.md: Update unit test link to tinytest

inst/NEWS.Rd

@@ -14,6 +14,8 @@
       \ghpr{1138} fixing \ghit{1137})
       \item Global \code{Rcout} and \code{Rcerr} objects are supported
       via a compiler directive (Iñaki in \ghpr{1139} fixing \ghit{928})
+      \item Add support for \code{Rcpp::message} (Dirk in \ghpr{1146}
+      fixing \ghit{1145})
     }
     \item Changes in Rcpp Attributes:
     \itemize{

inst/include/Rcpp/api/meat/meat.h

@@ -42,6 +42,8 @@
 #include <Rcpp/api/meat/protection.h>
 #include <Rcpp/api/meat/wrap.h>
 
+#include <Rcpp/api/meat/message.h>
+
 #ifndef RCPP_NO_MODULES
 #include <Rcpp/api/meat/module/Module.h>
 #endif

inst/include/Rcpp/api/meat/message.h

@@ -0,0 +1,33 @@
+
+// message.h: Rcpp R/C++ interface class library -- Wrapper for base::message
+//
+// Copyright (C) 2021  Dirk Eddelbuettel
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_api_meat_message_h
+#define Rcpp_api_meat_message_h
+
+namespace Rcpp {
+
+    inline void message(SEXP s) {
+        Rcpp::Function msg = Rcpp::Environment::base_env()["message"];
+        msg(s);
+    }
+
+}
+
+#endif

inst/tinytest/cpp/misc.cpp

@@ -224,3 +224,8 @@ String testNullableString(Rcpp::Nullable<Rcpp::String> param = R_NilValue) {
   else
     return String("");
 }
+
+// [[Rcpp::export]]
+void messageWrapper(SEXP s) {
+    message(s);
+}

inst/tinytest/test_misc.R

@@ -1,5 +1,5 @@
 
-##  Copyright (C) 2010 - 2019  Dirk Eddelbuettel and Romain Francois
+##  Copyright (C) 2010 - 2021  Dirk Eddelbuettel and Romain Francois
 ##
 ##  This file is part of Rcpp.
 ##
@@ -176,9 +176,18 @@ expect_equal(testNullableString("blah"), "blah")
 expect_true(nchar(Rcpp:::bib()) > 0, info="bib file")
 
 #    test.getRcppVersion <- function() {
-expect_true(inherits(getRcppVersion(), "package_version"), info="package_version object")
-expect_true(getRcppVersion(devel=TRUE) >= getRcppVersion(devel=FALSE), info="dev greater equal release")
+expect_true(inherits(Rcpp::getRcppVersion(), "package_version"), info="package_version object")
+expect_true(Rcpp::getRcppVersion(devel=TRUE) >= Rcpp::getRcppVersion(devel=FALSE), info="dev greater equal release")
 
 ## if need be it can be useful to fail to test e.g. the Docker setup
 ## commented out now as we prefer to pass when not debugging ;-)
 # expect_true(FALSE, info="oh noes")
+
+## test that a message is output as is, and a suppressedMessage is not
+txt <- "ABCdef"
+expect_equal(capture.output(messageWrapper(txt), type="message"), txt)
+expect_equal(capture.output(suppressMessages(messageWrapper(txt)), type="message"), character())
+expect_message(messageWrapper(txt))
+## test for message component
+msg <- tryCatch(message(txt), message = identity)
+expect_equal(msg$message, paste(txt, "\n", sep=""))