Skip unit tests involving closures in RserveClient macro tests

Closure REXPs don't have a Perl value representation and die on `to_pl`, so it's better to not even run them.
cubranic · Dec 17, 2014 · f9461c0 · f9461c0
1 parent 2c2bab3
commit f9461c0
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 4 deletions.
diff --git a/t/lib/TestCases.pm b/t/lib/TestCases.pm
@@ -304,6 +304,7 @@ use constant TEST_CASES => {
     'empty_clos' => {
         desc => 'function() {}',
         expr => 'function() {}',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             body => Statistics::R::REXP::Language->new(
                 elements => [
@@ -335,6 +336,7 @@ use constant TEST_CASES => {
     'clos_null' => {
         desc => 'function() NULL',
         expr => 'function() NULL',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             body => Statistics::R::REXP::Null->new,
             environment => Statistics::R::REXP::GlobalEnvironment->new(),
@@ -381,6 +383,7 @@ use constant TEST_CASES => {
     'clos_int' => {
         desc => 'function() 1L',
         expr => 'function() 1L',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             body => Statistics::R::REXP::Integer->new([1]),
             environment => Statistics::R::REXP::GlobalEnvironment->new(),
@@ -427,6 +430,7 @@ use constant TEST_CASES => {
     'clos_add' => {
         desc => 'function() 1+2',
         expr => 'function() 1+2',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             body => Statistics::R::REXP::Language->new([
                 Statistics::R::REXP::Symbol->new('+'),
@@ -480,6 +484,7 @@ use constant TEST_CASES => {
     'clos_args' => {
         desc => 'function(a, b) {a - b}',
         expr => 'function(a, b) {a - b}',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             args => ['a', 'b'],
             body => Statistics::R::REXP::Language->new(
@@ -522,6 +527,7 @@ use constant TEST_CASES => {
     'clos_defaults' => {
         desc => 'function(a=3, b) {a + b * pi}',
         expr => 'function(a=3, b) {a + b * pi}',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             args => ['a', 'b'],
             defaults => [ShortDoubleVector->new([2]), undef],
@@ -569,6 +575,7 @@ use constant TEST_CASES => {
     'clos_dots' => {
         desc => 'function(x=3, y, ...) {x * log(y) }',
         expr => 'function(x=3, y, ...) {x * log(y) }',
+        skip => 'webwork',
         value => ClosureLenientEnv->new(
             args => ['x', 'y', '...'],
             defaults => [ShortDoubleVector->new([3]), undef, undef],

diff --git a/xt/wwk-rserveclient.t b/xt/wwk-rserveclient.t
@@ -11,7 +11,7 @@ my $rserve_port = 6311;
 
 if (IO::Socket::INET->new(PeerAddr => $rserve_host,
                           PeerPort => $rserve_port)) {
-    plan tests => 33;
+    plan tests => 58;
 }
 else {
     plan skip_all => "Cannot connect to Rserve server at localhost:6311";
@@ -538,9 +538,18 @@ check_rserve_eval(
 
 
 while ( my ($name, $value) = each %{TEST_CASES()} ) {
-    check_rserve_eval($value->{expr},
-                      $value->{value}->to_pl,
-                      $value->{desc});
+  SKIP: {
+      skip "not applicable in WebWork macros", 1 if ($value->{skip} || '' =~ 'webwork');
+
+      ## If the expected value is wrapped in 'RexpOrUnknown', it will
+      ## be XT_UNKNOWN over Rserve
+      my $expected = $value->{value}->isa('RexpOrUnknown') ?
+          undef : $value->{value}->to_pl;
+
+      check_rserve_eval($value->{expr},
+                        $expected,
+                        $value->{desc});
+    }
 }