[education/rkward] rkward: Add some more tests, and fix a problem with object removal detection that showed up in the process
Thomas Friedrichsmeier
null at kde.org
Sat Jun 11 15:24:21 BST 2022
Git commit ff51b2500d9e13b5899d1cf0567bd7788bc21676 by Thomas Friedrichsmeier.
Committed on 11/06/2022 at 14:11.
Pushed by tfry into branch 'master'.
Add some more tests, and fix a problem with object removal detection that showed up in the process
M +91 -17 rkward/autotests/core_test.cpp
M +3 -11 rkward/rbackend/rkrsupport.cpp
https://invent.kde.org/education/rkward/commit/ff51b2500d9e13b5899d1cf0567bd7788bc21676
diff --git a/rkward/autotests/core_test.cpp b/rkward/autotests/core_test.cpp
index 88ec965f..53c8c817 100644
--- a/rkward/autotests/core_test.cpp
+++ b/rkward/autotests/core_test.cpp
@@ -12,6 +12,9 @@
#include "../agents/rkquitagent.h"
#include "../rbackend/rksessionvars.h"
#include "../rbackend/rkrinterface.h"
+#include "../core/robject.h"
+#include "../core/robjectlist.h"
+#include "../core/renvironmentobject.h"
void RKDebug (int, int, const char* fmt, ...) {
va_list ap;
@@ -24,31 +27,42 @@ void RKDebug (int, int, const char* fmt, ...) {
class RKWardCoreTest: public QObject {
Q_OBJECT
- void runCommandWithTimeout(RCommand *command, RCommandChain* chain, std::function<void(RCommand*)> callback, int timeoutms = 1000) {
- QString ccopy = command->command();
- QElapsedTimer t;
- t.start();
- bool done = false;
- bool *_done = &done;
- connect(command->notifier(), &RCommandNotifier::commandFinished, this, [_done, callback](RCommand *command) { *_done = true; callback(command); });
- RInterface::issueCommand(command, chain);
- while (!done && t.elapsed() < timeoutms) {
- qApp->processEvents();
- }
- if (!done) {
- qDebug("Command timed out: %s", qPrintable(ccopy));
- QFAIL("Command timed out");
- }
- }
+ void runCommandWithTimeout(RCommand *command, RCommandChain* chain, std::function<void(RCommand*)> callback, int timeoutms = 1000) {
+ QString ccopy = command->command();
+ QElapsedTimer t;
+ t.start();
+ bool done = false;
+ bool *_done = &done;
+ connect(command->notifier(), &RCommandNotifier::commandFinished, this, [_done, callback](RCommand *command) { *_done = true; callback(command); });
+ RInterface::issueCommand(command, chain);
+ while (!done && t.elapsed() < timeoutms) {
+ qApp->processEvents();
+ }
+ if (!done) {
+ qDebug("Command timed out: %s", qPrintable(ccopy));
+ QFAIL("Command timed out");
+ }
+ }
+
+ void waitForAllFinished(int timeoutms = 1000) {
+ runCommandWithTimeout(new RCommand(QString(), RCommand::App | RCommand::EmptyCommand), nullptr, [](RCommand* command){}, timeoutms);
+ }
+
+ void cleanGlobalenv() {
+ RInterface::issueCommand(new RCommand("rm(list=ls(all.names=TRUE))", RCommand::User));
+ }
QPointer<RKWardMainWindow> main_win;
private slots:
void init() {
}
+ void cleanup() {
+ waitForAllFinished();
+ }
void initTestCase()
{
qputenv("QTWEBENGINE_CHROMIUM_FLAGS", "--no-sandbox"); // Allow test to be run as root, which, for some reason is being done on the SuSE CI.
- QLoggingCategory::setFilterRules("qt*=false");
+ QLoggingCategory::setFilterRules("qt.text.layout=false"); // Filter out some noise
KAboutData::setApplicationData(KAboutData("rkward")); // needed for .rc files to load
RK_Debug::RK_Debug_Level = DL_DEBUG;
qDebug(R_EXECUTABLE);
@@ -82,6 +96,66 @@ private slots:
});
}
+ void irregularShortNameTest() {
+ QVERIFY(RObject::irregularShortName("0x"));
+ QVERIFY(RObject::irregularShortName(".1x"));
+ QVERIFY(RObject::irregularShortName("_bla"));
+ QVERIFY(RObject::irregularShortName("..."));
+ QVERIFY(RObject::irregularShortName("b(la"));
+ QVERIFY(!RObject::irregularShortName(".x"));
+ QVERIFY(!RObject::irregularShortName("..1x"));
+ QVERIFY(!RObject::irregularShortName("x2"));
+ QVERIFY(!RObject::irregularShortName("x_y"));
+ }
+
+ void objectListTest() {
+ // check that resprentation a objects in backend is sane
+ RInterface::issueCommand("a <- list(x1=c(1, 2, 3), x2=letters, x3=datasets::women); b <- a", RCommand::User);
+ RInterface::whenAllFinished(this, []() {
+ auto a = RObjectList::getGlobalEnv()->findObject("a");
+ QVERIFY(a != nullptr);
+ QVERIFY(a->isContainer());
+ auto ac = static_cast<RContainerObject*>(a);
+ QCOMPARE(ac->numChildren(), 3);
+ QCOMPARE(ac->findChildByIndex(0)->getDataType(), RObject::DataNumeric);
+ QCOMPARE(ac->findChildByIndex(1)->getDataType(), RObject::DataCharacter);
+ QVERIFY(ac->findChildByIndex(2)->isDataFrame());
+ }, nullptr);
+ // check that changes are detected, and reflected, properly
+ RInterface::issueCommand("rm(a); b <- 1; c <- letters; .d <- c", RCommand::User);
+ RInterface::whenAllFinished(this, []() {
+ QVERIFY(RObjectList::getGlobalEnv()->findObject("a") == nullptr);
+ QCOMPARE(RObjectList::getGlobalEnv()->findObject("b")->getDataType(), RObject::DataNumeric);
+ QCOMPARE(RObjectList::getGlobalEnv()->findObject("c")->getDataType(), RObject::DataCharacter);
+ QCOMPARE(RObjectList::getGlobalEnv()->findObject(".d")->getDimensions(), RObjectList::getGlobalEnv()->findObject("c")->getDimensions());
+ }, nullptr);
+ cleanGlobalenv();
+ RInterface::whenAllFinished(this, [](RCommand*) {
+ QCOMPARE(RObjectList::getGlobalEnv()->numChildren(), 0);
+ });
+ }
+
+ void parseErrorTest() {
+ runCommandWithTimeout(new RCommand("x <- ", RCommand::User), nullptr, [](RCommand *command) {
+ QVERIFY(command->failed());
+ QVERIFY(command->errorIncomplete());
+ });
+ runCommandWithTimeout(new RCommand("(}", RCommand::App), nullptr, [](RCommand *command) {
+ QVERIFY(command->failed());
+ QVERIFY(command->errorSyntax());
+ });
+ runCommandWithTimeout(new RCommand("(}", RCommand::User), nullptr, [](RCommand *command) {
+ QVERIFY(command->failed());
+ QEXPECT_FAIL("", "Syntax error detection for User commands known to be broken, but doesn't really matter", Continue);
+ QVERIFY(command->errorSyntax());
+ });
+ runCommandWithTimeout(new RCommand("stop(\"123test\")", RCommand::User), nullptr, [](RCommand *command) {
+ QVERIFY(command->failed());
+ QVERIFY(command->error().contains("123test"));
+ });
+ cleanGlobalenv();
+ }
+
void cleanupTestCase()
{
// at least the backend should exit properly, to avoid creating emergency save files
diff --git a/rkward/rbackend/rkrsupport.cpp b/rkward/rbackend/rkrsupport.cpp
index 7d40112c..f2048e71 100644
--- a/rkward/rbackend/rkrsupport.cpp
+++ b/rkward/rbackend/rkrsupport.cpp
@@ -312,14 +312,6 @@ RKRShadowEnvironment* RKRShadowEnvironment::environmentFor(SEXP baseenvir) {
return environments[baseenvir];
}
-static bool nameInList(SEXP needle, SEXP haystack) {
- int count = Rf_length(haystack);
- for (int i = 0; i < count; ++i) {
- if (!strcmp(R_CHAR(needle), R_CHAR(STRING_ELT(haystack, i)))) return true;
- }
- return false;
-}
-
void RKRShadowEnvironment::updateCacheForGlobalenvSymbol(const QString& name) {
RK_DEBUG(RBACKEND, DL_DEBUG, "updating cached value for symbol %s", qPrintable(name));
environmentFor(R_GlobalEnv)->updateSymbolCache(name);
@@ -362,8 +354,8 @@ RKRShadowEnvironment::Result RKRShadowEnvironment::diffAndUpdate() {
for (int i = 0; i < count; ++i) {
SEXP name = Rf_installChar(STRING_ELT(symbols, i));
PROTECT(name);
- SEXP main = Rf_findVar(name, baseenvir);
- SEXP cached = Rf_findVar(name, shadowenvir);
+ SEXP main = Rf_findVarInFrame(baseenvir, name);
+ SEXP cached = Rf_findVarInFrame(shadowenvir, name);
if (main != cached) {
Rf_defineVar(name, main, shadowenvir);
if (cached == R_UnboundValue) {
@@ -386,7 +378,7 @@ RKRShadowEnvironment::Result RKRShadowEnvironment::diffAndUpdate() {
PROTECT(name);
// NOTE: R_findVar(), here, is enormously faster than searching the result of ls() for the name, at least when there is a large number of symbols.
// Importantly, environments provided hash-based lookup, by default.
- SEXP main = Rf_findVar(name, baseenvir);
+ SEXP main = Rf_findVarInFrame(baseenvir, name);
if (main == R_UnboundValue) {
res.removed.append(RKRSupport::SEXPToString(name));
unbindSymbolWrapper(name, shadowenvir);
More information about the rkward-tracker
mailing list