[rkward-cvs] SF.net SVN: rkward:[2541] trunk/rkward
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Tue Jun 23 10:20:55 UTC 2009
Revision: 2541
http://rkward.svn.sourceforge.net/rkward/?rev=2541&view=rev
Author: tfry
Date: 2009-06-23 10:20:55 +0000 (Tue, 23 Jun 2009)
Log Message:
-----------
Making progress on automated plugin testing. Not everything is quite correct, yet, but we're getting there.
Modified Paths:
--------------
trunk/rkward/rkward/plugin/rkcomponent.cpp
trunk/rkward/rkward/plugin/rkcomponentmap.cpp
trunk/rkward/rkward/plugin/rkcomponentmap.h
trunk/rkward/rkward/plugin/rkstandardcomponent.cpp
trunk/rkward/rkward/plugin/rkstandardcomponent.h
trunk/rkward/rkward/plugin/rkstandardcomponentgui.cpp
trunk/rkward/rkward/rbackend/rinterface.cpp
trunk/rkward/rkward/rbackend/rinterface.h
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
trunk/rkward/rkward/rbackend/rthread.cpp
trunk/rkward/tests/test.R
Added Paths:
-----------
trunk/rkward/tests/import_export_plugins.R
trunk/rkward/tests/import_export_plugins.tar
Modified: trunk/rkward/rkward/plugin/rkcomponent.cpp
===================================================================
--- trunk/rkward/rkward/plugin/rkcomponent.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkcomponent.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -53,11 +53,13 @@
if (it.value ()->isProperty ()) {
if (include_top_level) {
RKComponentPropertyBase *p = static_cast<RKComponentPropertyBase*> (it.value ());
- if (!p->isInternal ()) {
+ if (!p->isInternal ()) {
list->insert (prefix + it.key (), it.value ()->value ());
}
}
} else {
+ RK_ASSERT (it.value ()->isComponent ());
+ if (!static_cast<RKComponent *> (it.value ())->isEnabled ()) continue;
it.value ()->fetchPropertyValuesRecursive (list, true, prefix + it.key () + '.');
}
}
Modified: trunk/rkward/rkward/plugin/rkcomponentmap.cpp
===================================================================
--- trunk/rkward/rkward/plugin/rkcomponentmap.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkcomponentmap.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -235,7 +235,7 @@
}
//static
-bool RKComponentMap::invokeComponent (const QString &component_id, const QStringList &serialized_settings, ComponentInvocationMode submit_mode, QString *message) {
+bool RKComponentMap::invokeComponent (const QString &component_id, const QStringList &serialized_settings, ComponentInvocationMode submit_mode, QString *message, RCommandChain *in_chain) {
RK_TRACE (PLUGIN);
QString _message;
@@ -268,7 +268,7 @@
// Auto-Submit
if (submit_mode != ManualSubmit) {
// if the plugin takes longer than 5 seconds to settle, than that really is sort of buggy...
- bool submit_ok = component->submit (5000);
+ bool submit_ok = component->submit (5000, in_chain);
if (submit_ok || (submit_mode == AutoSubmitOrFail)) component->close ();
if (!submit_ok) {
_message.append (i18n ("\nThe plugin could not be auto-submitted with these settings."));
Modified: trunk/rkward/rkward/plugin/rkcomponentmap.h
===================================================================
--- trunk/rkward/rkward/plugin/rkcomponentmap.h 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkcomponentmap.h 2009-06-23 10:20:55 UTC (rev 2541)
@@ -43,6 +43,7 @@
class RKComponent;
class RKComponentMap;
+class RCommandChain;
class RKStandardComponent;
class QWidget;
class KActionCollection;
@@ -177,7 +178,7 @@
};
/** invokes the specified component as toplevel
@param message If a non-null pointer to QString is given, error messages are written into this string *instead* of being displayed */
- static bool invokeComponent (const QString &component_id, const QStringList &serialized_settings, ComponentInvocationMode submit_mode = ManualSubmit, QString *message=0);
+ static bool invokeComponent (const QString &component_id, const QStringList &serialized_settings, ComponentInvocationMode submit_mode = ManualSubmit, QString *message=0, RCommandChain *in_chain = 0);
private:
/** typedef for easy reference to iterator */
typedef QMap<QString, RKComponentHandle*> ComponentMap;
Modified: trunk/rkward/rkward/plugin/rkstandardcomponent.cpp
===================================================================
--- trunk/rkward/rkward/plugin/rkstandardcomponent.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkstandardcomponent.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -62,6 +62,7 @@
RKStandardComponent::filename = filename;
RKStandardComponent::handle = handle;
+ command_chain = 0;
backend = 0;
gui = 0;
wizard = 0;
@@ -309,22 +310,26 @@
changed ();
}
-bool RKStandardComponent::submit (int max_wait) {
+bool RKStandardComponent::submit (int max_wait, RCommandChain *in_chain) {
RK_TRACE (PLUGIN);
+ RCommandChain *old_chain = command_chain; // should always be 0, but let's store it cleanly
+ command_chain = in_chain;
+ bool result = false;
+
QTime t;
t.start ();
while ((handle_change_timer->isActive () || backend->isBusy ()) && (t.elapsed () < max_wait)) {
QCoreApplication::processEvents (QEventLoop::ExcludeUserInputEvents, (max_wait / 2));
}
- if (handle_change_timer->isActive () || backend->isBusy ()) {
- return false;
+ if (!(handle_change_timer->isActive () || backend->isBusy ())) {
+ if (isSatisfied ()) {
+ gui->ok ();
+ result = true;
+ }
}
- if (isSatisfied ()) {
- gui->ok ();
- return true;
- }
- return false;
+ command_chain = old_chain;
+ return result;
}
void RKStandardComponent::close () {
Modified: trunk/rkward/rkward/plugin/rkstandardcomponent.h
===================================================================
--- trunk/rkward/rkward/plugin/rkstandardcomponent.h 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkstandardcomponent.h 2009-06-23 10:20:55 UTC (rev 2541)
@@ -24,6 +24,7 @@
#include <QList>
class RKStandardComponentGUI;
+class RCommandChain;
class RKComponentHandle;
class RKStandardComponentStack;
class ScriptBackend;
@@ -70,10 +71,13 @@
bool haveHelp () { return have_help; };
/** tries to submit. Warning: This function waits for all changes to come in and may not return immediately!
@param max_wait Maximum time to wait for changes to settle in msecs (approx.)
+ at param in_chain The command chain to insert the command in (0 for regular command stack).
@return true, if the plugin-code could be submitted */
- bool submit (int max_wait=1000);
+ bool submit (int max_wait=1000, RCommandChain *in_chain = 0);
/** convenience access function: closes the corresponding GUI */
void close ();
+
+ RCommandChain *commandChain () const { return command_chain; };
public slots:
/** this gets called by the script-backend, when it's done. Might enable the
submit button or destruct the plugin. */
@@ -99,6 +103,7 @@
RKComponentHandle *handle;
RKStandardComponentStack *wizard;
QTimer *handle_change_timer;
+ RCommandChain *command_chain;
/** Avoid updating code-display, etc. until the component is fully created */
bool created;
bool createTopLevel (const QDomElement &doc_element, int force_mode=0, bool enslaved=false);
Modified: trunk/rkward/rkward/plugin/rkstandardcomponentgui.cpp
===================================================================
--- trunk/rkward/rkward/plugin/rkstandardcomponentgui.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/plugin/rkstandardcomponentgui.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -156,7 +156,7 @@
command.append (code_property->printout ());
command.append ("})\n");
- RKGlobals::rInterface ()->issueCommand (new RCommand (command, RCommand::Plugin | RCommand::DirectToOutput | RCommand::ObjectListUpdate));
+ RKGlobals::rInterface ()->issueCommand (new RCommand (command, RCommand::Plugin | RCommand::DirectToOutput | RCommand::ObjectListUpdate), component->commandChain ());
// re-run link
command.clear ();
@@ -167,7 +167,7 @@
}
// separator line
command.append (".rk.make.hr()\n");
- RKGlobals::rInterface ()->issueCommand (new RCommand (command, RCommand::Plugin | RCommand::DirectToOutput | RCommand::ObjectListUpdate));
+ RKGlobals::rInterface ()->issueCommand (new RCommand (command, RCommand::Plugin | RCommand::DirectToOutput | RCommand::ObjectListUpdate), component->commandChain ());
}
void RKStandardComponentGUI::cancel () {
Modified: trunk/rkward/rkward/rbackend/rinterface.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rinterface.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/rbackend/rinterface.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -79,6 +79,7 @@
new RCommandStackModel (this);
RCommandStack::regular_stack = new RCommandStack (0);
running_command_canceled = 0;
+ command_logfile_mode = NotRecordingCommands;
r_thread = new RThread ();
@@ -168,7 +169,15 @@
r_thread->pauseOutput (false);
}
} else if (ev->etype () == RKRBackendEvent::RCommandIn) {
- RKCommandLog::getLog ()->addInput (static_cast <RCommand *> (ev->data ()));
+ RCommand *command = static_cast <RCommand *> (ev->data ());
+ RKCommandLog::getLog ()->addInput (command);
+
+ if (command_logfile_mode != NotRecordingCommands) {
+ if ((!(command->type () & RCommand::Sync)) || command_logfile_mode == RecordingCommandsWithSync) {
+ command_logfile.write (command->command ().toUtf8 ());
+ command_logfile.write ("\n");
+ }
+ }
} else if (ev->etype () == RKRBackendEvent::RCommandOut) {
RCommand *command = static_cast <RCommand *> (ev->data ());
if (command->status & RCommand::Canceled) {
@@ -387,7 +396,7 @@
RKComponentMap::ComponentInvocationMode mode = RKComponentMap::ManualSubmit;
if (request->call[2] == "auto") mode = RKComponentMap::AutoSubmit;
else if (request->call[2] == "submit") mode = RKComponentMap::AutoSubmitOrFail;
- ok = RKComponentMap::invokeComponent (request->call[1], request->call.mid (3), mode, &message);
+ ok = RKComponentMap::invokeComponent (request->call[1], request->call.mid (3), mode, &message, request->in_chain);
if (message.isEmpty ()) {
issueCommand (".rk.set.reply (NULL)", RCommand::App | RCommand::Sync, QString::null, 0, 0, request->in_chain);
@@ -405,6 +414,31 @@
} else {
RK_ASSERT (false);
}
+ } else if (call == "recordCommands") {
+ if (request->call.count () == 3) {
+ QString filename = request->call[1];
+ bool with_sync = (request->call[2] == "include.sync");
+
+ if (filename.isEmpty ()) {
+ command_logfile_mode = NotRecordingCommands;
+ command_logfile.close ();
+ } else {
+ if (command_logfile_mode != NotRecordingCommands) {
+ issueCommand (".rk.set.reply (\"Attempt to start recording, while already recording commands. Ignoring.\")", RCommand::App | RCommand::Sync, QString::null, 0, 0, request->in_chain);
+ } else {
+ command_logfile.setFileName (filename);
+ bool ok = command_logfile.open (QIODevice::WriteOnly | QIODevice::Truncate);
+ if (ok) {
+ command_logfile_mode = RecordingCommands;
+ if (with_sync) command_logfile_mode = RecordingCommandsWithSync;
+ } else {
+ issueCommand (".rk.set.reply (\"Could not open file for writing. Not recording commands.\")", RCommand::App | RCommand::Sync, QString::null, 0, 0, request->in_chain);
+ }
+ }
+ }
+ } else {
+ RK_ASSERT (false);
+ }
} else {
issueCommand (".rk.set.reply (\"Unrecognized call '" + call + "'. Ignoring\")", RCommand::App | RCommand::Sync, QString::null, 0, 0, request->in_chain);
}
Modified: trunk/rkward/rkward/rbackend/rinterface.h
===================================================================
--- trunk/rkward/rkward/rbackend/rinterface.h 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/rbackend/rinterface.h 2009-06-23 10:20:55 UTC (rev 2541)
@@ -2,7 +2,7 @@
rinterface.h - description
-------------------
begin : Fri Nov 1 2002
- copyright : (C) 2002, 2004, 2005, 2006, 2007 by Thomas Friedrichsmeier
+ copyright : (C) 2002, 2004, 2005, 2006, 2007, 2009 by Thomas Friedrichsmeier
email : tfry at users.sourceforge.net
***************************************************************************/
@@ -20,6 +20,7 @@
#include <qobject.h>
#include <qmutex.h>
+#include <QFile>
#include "rcommand.h"
@@ -101,6 +102,13 @@
QTimer *flush_timer;
/** canceling the command that is (or seems to be) currently running is tricky: In order to do so, we need to signal an interrupt to the RThread. We need this pointer to find out, when the command has actually been interrupted, and we can resume processing. */
RCommand *running_command_canceled;
+/** Used by the testing framework. see R function rk.record.commands(). */
+ QFile command_logfile;
+ enum {
+ NotRecordingCommands,
+ RecordingCommands,
+ RecordingCommandsWithSync
+ } command_logfile_mode;
/** See \ref RThread::doSubstack (). Does the actual job. */
void processREvalRequest (REvalRequest *request);
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2009-06-23 10:20:55 UTC (rev 2541)
@@ -388,3 +388,21 @@
".rk.make.hr" <- function () {
.rk.cat.output ("<hr>\n");
}
+
+# Start recording commands that are submitted from rkward to R.
+# filename: filename to write to (file will be truncated!).
+# include.sync.commands: Should internal synchronisation commands be included?
+# To stop recording, supply NULL or "" as filename
+# Currently used for the purpose of automated testing, only. Perhaps in the future
+# this or a similar mechanism could also be added as a user feature.
+"rk.record.commands" <- function (filename, include.sync.commands = FALSE) {
+ if (is.null (filename)) filename = ""
+
+ res <- .rk.do.call ("recordCommands", c(as.character (filename), if (include.sync.commands) "include.sync" else "normal"))
+
+ if (is.null (res)) invisible (TRUE)
+ else {
+ warning (res)
+ invisible (FALSE)
+ }
+}
Modified: trunk/rkward/rkward/rbackend/rthread.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rthread.cpp 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/rkward/rbackend/rthread.cpp 2009-06-23 10:20:55 UTC (rev 2541)
@@ -373,10 +373,14 @@
waitIfOutputPaused ();
MUTEX_LOCK;
- // Unfortunately, errors still get printed to the output. We try this crude method for the time being:
+ // Unfortunately, errors still get printed to the output, UNLESS a sink() is in place. We try this crude method for the time being:
flushOutput ();
if (current_command) {
- current_command->output_list.last ()->type = ROutput::Error;
+ if (!current_command->output_list.isEmpty ()) {
+ if (current_command->output_list.last ()->output == call[0]) {
+ current_command->output_list.last ()->type = ROutput::Error;
+ }
+ }
current_command->status |= RCommand::HasError;
}
Added: trunk/rkward/tests/import_export_plugins.R
===================================================================
--- trunk/rkward/tests/import_export_plugins.R (rev 0)
+++ trunk/rkward/tests/import_export_plugins.R 2009-06-23 10:20:55 UTC (rev 2541)
@@ -0,0 +1,31 @@
+# This should be the first line in each test suite file: Include the
+# test framework, multiple inclusion should do no harm
+source ("test.R")
+
+x <- new ("RKTest", id="firsttest", call=function () rk.print (1))
+
+suite <- new ("RKTestSuite", id="import_export_plugins",
+ initCalls = list (
+ function () {
+ library ("R2HTML")
+ },
+ function () {
+ women <- datasets::women
+ save (women, file="women.RData")
+ }
+ ), tests = list (
+ new ("RKTest", id="load_r_object", call=function () {
+ suppressWarnings (rm ("women"))
+
+ rk.call.plugin ("rkward::load_r_object", file.selection="women.RData", other_env.state="0", submit.mode="submit")
+
+ stopifnot (all.equal (women, datasets::women))
+ }),
+ new ("RKTest", id="secondtest", call=function () rk.print (2)),
+ x
+ ), postCalls = list ()
+)
+
+y <- rktest.runRKTestSuite (suite)
+
+y
\ No newline at end of file
Added: trunk/rkward/tests/import_export_plugins.tar
===================================================================
(Binary files differ)
Property changes on: trunk/rkward/tests/import_export_plugins.tar
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Modified: trunk/rkward/tests/test.R
===================================================================
--- trunk/rkward/tests/test.R 2009-06-21 21:24:19 UTC (rev 2540)
+++ trunk/rkward/tests/test.R 2009-06-23 10:20:55 UTC (rev 2541)
@@ -9,8 +9,8 @@
)
setClass ("RKTest",
- representation (id="character", call="function", compare_code="logical", compare_output="logical", fuzzy_output="logical", expect_error="logical"),
- prototype(character(0), id=NULL, call=function () { stop () }, compare_code=TRUE, compare_output=TRUE, fuzzy_output=FALSE, expect_error=FALSE),
+ representation (id="character", call="function", fuzzy_output="logical", expect_error="logical"),
+ prototype(character(0), id=NULL, call=function () { stop () }, fuzzy_output=FALSE, expect_error=FALSE),
validity=function (object) {
if (is.null (object at id)) return (FALSE)
return (TRUE)
@@ -30,11 +30,11 @@
for (i in 1:length (object at id)) {
cat (format (object at id[i], width=20))
- cat (format (as.character (object at code_match[i]), width=15))
- cat (format (as.character (object at output_match[i]), width=15))
- cat (format (as.character (object at message_match[i]), width=15))
- cat (format (as.character (object at error[i]), width=15))
- cat (format (if (object at passed[i]) "PASS" else "FAIL", width=15))
+ cat (format (if (object at code_match[i]) "true" else "FALSE", width=15))
+ cat (format (if (object at output_match[i]) "true" else "FALSE", width=15))
+ cat (format (if (object at message_match[i]) "true" else "FALSE", width=15))
+ cat (format (if (object at error[i]) "TRUE" else "false", width=15))
+ cat (format (if (object at passed[i]) "pass" else "FAIL", width=15))
cat ("\n")
}
})
@@ -78,9 +78,37 @@
output.diff <- system(paste("diff", shQuote(file), shQuote(standard_file), "2>&1"), intern=TRUE)
if (!length (output.diff)) return (TRUE)
- return (!nzchar (output.diff))
+ if ((length (output.diff) == 1) && (!nzchar (output.diff))) return (TRUE)
+
+ print (paste ("Differences between", file, "and", standard_file, ":"))
+ print (output.diff)
+ return (FALSE)
}
+rktest.runRKTest.internal <- function (test, output_file, code_file, message_file) {
+ # save / restore old output file
+ old_output <- rk.get.output.html.file ()
+ rk.set.output.html.file (output_file)
+ on.exit (rk.set.output.html.file (old_output), add=TRUE)
+
+ message_file_handle <- file (message_file, open="w+")
+ sink(message_file_handle, type="message")
+ on.exit ({
+ sink (NULL, type="message")
+ close (message_file_handle)
+ }, add=TRUE)
+
+ rk.record.commands (code_file)
+ on.exit (rk.record.commands (NULL), add=TRUE)
+
+ failed <- TRUE
+ try ({
+ test at call ()
+ failed <- FALSE
+ })
+ return (failed)
+}
+
rktest.runRKTest <- function (test) {
result <- new ("RKTestResult") # FALSE by default
@@ -88,51 +116,50 @@
result at id <- test at id
if (!validObject (test)) return (result)
- # save / restore old output file
- old_output <- rk.get.output.html.file ()
- rk.set.output.html.file (rk.testrun.file (test at id, ".rkout"))
- on.exit (rk.set.output.html.file (old_output), add=TRUE)
-
+ output_file <- rktest.file (test at id, ".rkout")
+ code_file <- rktest.file (test at id, ".rkcom")
message_file <- rktest.file (test at id, ".rkwarn")
- #sink(message_file, type="message")
- #on.exit (sink (NULL, type="message"))
- #code_file <- rk.testrun.file (test at id, ".rkcom")
- #rk.record.user.commands (code_file)
- #on.exit (rk.record.user.commands (NULL))
+ # the essence of the test:
+ result at error <- rktest.runRKTest.internal (test, output_file, code_file, message_file)
- result at error <- TRUE
- try ({
- test at call ()
- result at error <- FALSE
- })
-
- result at output_match = rktest.compare.against.standard (rk.get.output.html.file ())
+ result at output_match = rktest.compare.against.standard (output_file)
result at message_match = rktest.compare.against.standard (message_file)
- #result at code_match = rktest.compare.against.standard (code_file)
- result at code_match = TRUE # TODO: only for now!
+ result at code_match = rktest.compare.against.standard (code_file)
if ((result at error == test at expect_error) && (result at output_match || test at fuzzy_output) && result at code_match && result at message_match) result at passed = TRUE
result
}
+rktest.cleanRKTestSuite <- function (suite, basedir=getwd ()) {
+ oldwd = getwd ()
+ on.exit (setwd (oldwd))
+ setwd (paste (basedir, suite at id, sep="/"))
+
+ files <- list.files ()
+ # do not delete the standards!
+ files <- grep (".*\\.standard$", files, value=TRUE, invert=TRUE)
+
+ file.remove (files)
+
+ invisible (NULL)
+}
+
rktest.runRKTestSuite <- function (suite, basedir=getwd ()) {
result <- new ("RKTestResult") # FALSE by default
if (!inherits (suite, "RKTestSuite")) return (result)
if (!validObject (suite)) return (result)
+ # clean any old results
+ rktest.cleanRKTestSuite (suite, basedir)
+
system (paste ("tar -xf", suite at id, ".tar", sep=""))
oldwd = getwd ()
on.exit (setwd (oldwd))
-
- # clean any old files
setwd (paste (basedir, suite at id, sep="/"))
- system ("find . -name '*.standard' -o -exec rm {} \\;")#
- setwd (paste (basedir, suite at id, sep="/"))
-
if (length (suite at initCalls) > 0) {
for (i in 1:length (suite at initCalls)) try (suite at initCalls[[i]]())
}
@@ -149,43 +176,45 @@
result
}
-rktest.packageSuiteStandards <- function (suite, basedir=getwd ()) {
+rktest.setSuiteStandards <- function (suite, basedir=getwd ()) {
if (!inherits (suite, "RKTestSuite")) return (result)
if (!validObject (suite)) return (result)
+ ok <- readline ("You are about to set new standards for this suite. This means you are certain that ALL tests in this suite have produced the expected/correct result on the last run. If you are absolutely sure, enter \"I am sure\" to proceed.");
+ if (ok != "I am sure") stop ("Aborted")
+
oldwd = getwd ()
on.exit (setwd (oldwd))
+ setwd (paste (basedir, suite at id, sep="/"))
+ files <- list.files ()
+ files <- grep (".*\\.(rkwarn|rkcom|rkout)$", files, value=TRUE)
+ file.copy (files, paste (files, ".standard", sep=""), overwrite=TRUE)
+
+ # clean anything that is *not* a standard file
+ rktest.cleanRKTestSuite (suite, basedir)
+
# create package
setwd (basedir)
system (paste ("tar -cf ", suite at id, ".tar ", suite at id, sep=""))
}
-rktest.setSuiteStandards <- function (suite, basedir=getwd ()) {
- if (!inherits (suite, "RKTestSuite")) return (result)
- if (!validObject (suite)) return (result)
- oldwd = getwd ()
- on.exit (setwd (oldwd))
- setwd (paste (basedir, suite at id, sep="/"))
+# You can use this to temporarily replace .rk.rerun.plugin.link.
+# This way, after running a plugin, you are shown the call needed to run this
+# plugin with those settings, instead of the link.
+.rk.rerun.plugin.link.replacement <- function (plugin, settings, label) {
+ .rk.cat.output ("<h3>Rerun code:</h3>")
+ .rk.cat.output ("<pre>")
+ .rk.cat.output ("rk.call.plugin (\"")
+ .rk.cat.output (plugin)
+ .rk.cat.output ("\", ")
+ .rk.cat.output (gsub ("=", "=\"", gsub ("\n", "\", ", gsub ("\"", "\\\"", settings))))
+ .rk.cat.output ("\", submit.mode=\"submit\")</pre>")
+}
- system ("find . -name '*.standard' -o -exec cp {} {}.standard \\;")#
+# HACK: Override date, so we don't get a difference for each call of rk.header ()
+# TODO: implement a clean solution inside rk.header()
+date <- function () {
+ return ("DATE")
}
-
-x <- new ("RKTest", id="firsttest", call=function () rk.print (1))
-
-suite <- new ("RKTestSuite", id="testsuite",
- initCalls = list (
- function () {
- library ("R2HTML")
- }
- ), tests = list (
- new ("RKTest", id="firsttestb", call=function () rk.print (1)),
- new ("RKTest", id="secondtest", call=function () rk.print (2)),
- x
- ), postCalls = list ()
-)
-
-y <- rktest.runRKTestSuite (suite)
-
-y
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the rkward-tracker
mailing list